├── .gitignore ├── Makefile ├── authors.txt ├── backend ├── crossref_chunk.ml ├── crossref_chunk.mli ├── crossref_code.ml ├── crossref_code.mli ├── dune ├── web_to_code.ml ├── web_to_code.mli ├── web_to_tex.ml └── web_to_tex.mli ├── bin ├── bugfix.txt ├── bugs.txt ├── changes.txt ├── copyright.txt ├── credits.txt ├── demos ├── .depend ├── Makefile ├── demo.ml.nw ├── demo.pdf ├── mapreduce │ ├── Makefile │ ├── Makefile.test │ ├── config.pg │ ├── distribution.ml │ ├── distribution.ml.nw │ ├── distribution.mli │ ├── distribution_test.ml │ ├── expected_res_mpi.out │ ├── expected_res_simple.out │ ├── expected_time.out │ ├── install.txt │ ├── ocamlmpi │ │ ├── .depend │ │ ├── Changes │ │ ├── LICENSE │ │ ├── Makefile │ │ ├── Makefile_old │ │ ├── README │ │ ├── camlmpi.h │ │ ├── collcomm.c │ │ ├── comm.c │ │ ├── groups.c │ │ ├── init.c │ │ ├── modif-orig.TXT │ │ ├── mpi.ml │ │ ├── mpi.mli │ │ ├── msgs.c │ │ ├── test.ml │ │ ├── test_mandel.ml │ │ ├── test_pad │ │ ├── test_pad.ml │ │ └── utils.c │ └── readme.txt ├── multi.nw ├── multi.pdf ├── multi1.nw └── multi2.nw ├── dune ├── dune-project ├── emacs ├── fix_noweb.el ├── hide-regexp.el ├── noweb-font-lock-mode.el ├── noweb-mode.el └── todo │ ├── mmm-mode-0.4.8.tar.gz │ └── mmm-noweb.el ├── env.sh ├── frontend ├── code.ml ├── code.mli ├── dune ├── lang.ml ├── lang.mli ├── signature.ml ├── signature.mli ├── web.ml └── web.mli ├── indexer ├── Makefile ├── Makefile.old ├── dune ├── dune-project ├── index_pfff.ml ├── main_indexer.ml └── syncweb_indexer.opam ├── install.txt ├── license.txt ├── lpizer ├── Comment_code.ml ├── Comment_code.mli ├── Lpize.ml ├── Lpize.mli ├── Main.ml └── dune ├── main ├── dune ├── main.ml ├── refactor.ml ├── refactor.mli ├── sync.ml └── sync.mli ├── notes.txt ├── project.el ├── readme.txt ├── skip_list.txt ├── syncweb.opam ├── tests ├── Makefile ├── final.ml ├── final.mli ├── final.orig ├── foo.nw ├── hello.c ├── hello.nw ├── hello2.c ├── hello2.nw ├── hello_modif1.c ├── lpizer │ └── foo.ml ├── noweb.sty ├── noweb.sty.old ├── simple.orig ├── simple.pdf └── test.ml.nw └── todo.txt /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .merlin 3 | 4 | # ocaml objects 5 | *.cm* 6 | *.annot 7 | *.opt 8 | 9 | # c objects 10 | *.o 11 | *.a 12 | 13 | # syncweb objects 14 | *.md5sum_* 15 | 16 | # make generated files 17 | .depend 18 | /Makefile.config 19 | 20 | # source generated files 21 | /globals/config.ml 22 | 23 | # binaries 24 | /syncweb 25 | /demos/demo 26 | /indexer/indexer 27 | /lpizer/lpizer 28 | 29 | # ????? 30 | /graph_code.marshall 31 | /graph_code.marshall.opti 32 | /syncweb.install 33 | /demos/demo.ml 34 | t 35 | /demos/demo.mli 36 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | ############################################################################### 3 | # Main targets 4 | ############################################################################### 5 | 6 | all: 7 | dune build 8 | install: 9 | dune install 10 | clean: 11 | dune clean 12 | 13 | setup: 14 | opam install --deps-only . 15 | 16 | ############################################################################### 17 | # Developer targets 18 | ############################################################################### 19 | 20 | # See https://github.com/aryx/codemap and https://github.com/aryx/fork-efuns 21 | visual: 22 | codemap -screen_size 3 -filter semgrep -efuns_client efuns_client -emacs_client /dev/null . 23 | -------------------------------------------------------------------------------- /authors.txt: -------------------------------------------------------------------------------- 1 | Yoann Padioleau 2 | 3 | -------------------------------------------------------------------------------- /backend/crossref_chunk.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | open Web 4 | 5 | (*****************************************************************************) 6 | (* Types *) 7 | (*****************************************************************************) 8 | 9 | (* the goal is that given a chunkid, we can know the previous and next 10 | * definitions sharing the same chunkname and the users of the chunk. 11 | *) 12 | type chunk_xref = { 13 | mutable prev_def: chunkid option; 14 | mutable next_def: chunkid option; 15 | mutable chunk_users: chunkid list; 16 | } 17 | 18 | (*****************************************************************************) 19 | (* Chunkname to X *) 20 | (*****************************************************************************) 21 | (* for web_to_code.ml and sync.ml *) 22 | let hchunkname_to_body__from_orig orig = 23 | let h = Hashtbl.create 101 in 24 | orig |> List.iter (function 25 | | Tex _xs -> () 26 | | ChunkDef (def, body) -> 27 | let key = def.chunkdef_key in 28 | Common2_.hupdate_default key (fun x -> x @ [body]) (fun()->[]) h; 29 | ); 30 | h 31 | 32 | (* for crossref_code.ml *) 33 | let hchunkname_to_defs__from_orig orig = 34 | (* use the Hashtbl.find_all *) 35 | let h = Hashtbl.create 101 in 36 | let aux orig = 37 | orig |> List.iter (function 38 | | Tex _xs -> () 39 | | ChunkDef (def, body) -> 40 | let key = def.chunkdef_key in 41 | Hashtbl.add h key (def, body) 42 | ); 43 | in 44 | aux orig; 45 | h 46 | 47 | (* for web_to_tex.ml *) 48 | let hchunkname_to_def__from_orig orig = 49 | let h = Hashtbl.create 101 in 50 | let aux orig = 51 | orig |> List.iter (function 52 | | Tex _xs -> () 53 | | ChunkDef (def, _body) -> 54 | let key = def.chunkdef_key in 55 | (* we refer to the first one *) 56 | if Hashtbl.mem h key 57 | then () 58 | else Hashtbl.add h key def 59 | ); 60 | in 61 | aux orig; 62 | h 63 | 64 | (*****************************************************************************) 65 | (* Chunkid to X *) 66 | (*****************************************************************************) 67 | 68 | let hchunkid_info__from_orig orig = 69 | let hchunkid_info = Hashtbl.create 101 in 70 | let hkey_to_defs = hchunkname_to_defs__from_orig orig in 71 | 72 | (* first pass *) 73 | orig |> List.iter (function 74 | | Tex _ -> () 75 | | ChunkDef (def, _body) -> 76 | let info = { 77 | prev_def = None; 78 | next_def = None; 79 | chunk_users = []; 80 | } in 81 | Hashtbl.add hchunkid_info def.chunkdef_id info 82 | ); 83 | let hlast_key_to_chunk = Hashtbl.create 101 in 84 | 85 | (* second pass *) 86 | let rec tex_or_chunkdef = function 87 | | Tex _ -> () 88 | | ChunkDef (def, body) -> 89 | let key = def.chunkdef_key in 90 | let id = def.chunkdef_id in 91 | let info = Hashtbl.find hchunkid_info id in 92 | let prev_opt = Common2_.hfind_option key hlast_key_to_chunk in 93 | Hashtbl.replace hlast_key_to_chunk key id; 94 | info.prev_def <- prev_opt; 95 | prev_opt |> Option.iter (fun previd -> 96 | let info_prev = Hashtbl.find hchunkid_info previd in 97 | info_prev.next_def <- Some id 98 | ); 99 | body |> List.iter (code_or_chunk id) 100 | 101 | and code_or_chunk id_enclosing_chunk = function 102 | | Code _ -> () 103 | | ChunkName (key, _indent) -> 104 | (* todo: should update the uses of all ids ... use a 105 | * Hashtbl.find_all? 106 | *) 107 | let defs = Hashtbl.find_all hkey_to_defs key in 108 | if defs =*= [] 109 | then failwith (spf "could not find key for %s" key); 110 | defs |> List.iter (fun (def, _body) -> 111 | let id = def.chunkdef_id in 112 | let info = Hashtbl.find hchunkid_info id in 113 | info.chunk_users <- id_enclosing_chunk::info.chunk_users 114 | ); 115 | in 116 | List.iter tex_or_chunkdef orig; 117 | hchunkid_info 118 | 119 | let label_of_id id = 120 | spf "NW%d" id 121 | -------------------------------------------------------------------------------- /backend/crossref_chunk.mli: -------------------------------------------------------------------------------- 1 | 2 | type chunk_xref = { 3 | mutable prev_def: Web.chunkid option; 4 | mutable next_def: Web.chunkid option; 5 | mutable chunk_users: Web.chunkid list; 6 | } 7 | 8 | val hchunkname_to_body__from_orig: 9 | Web.t -> (Web.chunkname, Web.code_or_chunk list list) Hashtbl.t 10 | 11 | val hchunkname_to_def__from_orig: 12 | Web.t -> (Web.chunkname, Web.chunkdef) Hashtbl.t 13 | (* use Hashtbl.find_all property to get all the defs *) 14 | val hchunkname_to_defs__from_orig: 15 | Web.t -> (Web.chunkname, Web.chunkdef * Web.code_or_chunk list) Hashtbl.t 16 | val hchunkid_info__from_orig: 17 | Web.t -> (Web.chunkid, chunk_xref) Hashtbl.t 18 | 19 | val label_of_id: Web.chunkid -> string 20 | -------------------------------------------------------------------------------- /backend/crossref_code.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | open Either 3 | 4 | open Web 5 | 6 | (*****************************************************************************) 7 | (* Types *) 8 | (*****************************************************************************) 9 | 10 | (* Yet another Parse_info.token_location, 11 | * but I don't want to depend on pfff/h_program-lang 12 | * (I do depend on it for syncweb/indexer/ but I don't want for syncweb itself). 13 | *) 14 | type loc = { 15 | file: string (* Common.filename *); 16 | line: int; 17 | } 18 | (* Yet another Entity_code.t, 19 | * but I don't want to depend on pfff/h_program-lang *) 20 | type entity_kind = 21 | | Function 22 | (* less: FunctionPrivate *) 23 | | Global 24 | (* less: GlobalPrivate *) 25 | 26 | | Constant 27 | | Macro 28 | | Constructor 29 | 30 | | Type 31 | | Field 32 | 33 | | Typedef 34 | | Structdef 35 | 36 | | Exception 37 | 38 | | Other of string 39 | 40 | type defs = ((string * entity_kind) * loc) list 41 | type uses = ((string * entity_kind) * loc) list 42 | 43 | let debug = ref false 44 | 45 | let string_of_loc { file; line } = 46 | spf "%s:%d" file line 47 | 48 | (*****************************************************************************) 49 | (* Parsing *) 50 | (*****************************************************************************) 51 | 52 | (* mostly copy-paste of Entity_code.entity_kind_of_string *) 53 | let kind_of_string_opt = function 54 | | "Function" -> Some Function 55 | | "Global" -> Some Global 56 | 57 | | "Constant" -> Some Constant 58 | | "Macro" -> Some Macro 59 | | "Constructor" -> Some Constructor 60 | 61 | | "Type" -> Some Type 62 | | "Field" -> Some Field 63 | 64 | | "Exception" -> Some Exception 65 | 66 | | "Prototype" 67 | | "GlobalExtern" 68 | 69 | | "Module" 70 | | "TopStmts" 71 | 72 | -> None 73 | | s -> failwith (spf "unsupported kind: %s" s) 74 | (* 75 | | "Class" -> Some Class 76 | | "Method" -> Some Method 77 | | "ClassConstant" -> Some ClassConstant 78 | | "File" -> Some File 79 | | "Dir" -> Some Dir 80 | | "MultiDirs" -> Some MultiDirs 81 | 82 | | _ when s =~ "Other:\\(.*\\)" -> Other (Common.matched1 s) 83 | | s -> None 84 | *) 85 | 86 | 87 | let adjust_name_and_kind s kind = 88 | match s, kind with 89 | (* graph_code_c adds some '__' suffix for static functions *) 90 | | _ when s =~ "^\\(.*\\)__[0-9]+$" -> 91 | Common.matched1 s ^ "<>", kind 92 | (* graph_code_c adds some 'S__' prefix to manage namespaces *) 93 | | _, Type when s =~ "^[SU]__\\(.*\\)$" -> 94 | Common.matched1 s, Structdef 95 | | _, Field when s =~ "^[SU]__\\(.*\\)$" -> 96 | Common.matched1 s, Field 97 | | _, Type when s =~ "^[T]__\\(.*\\)$" -> 98 | Common.matched1 s, Typedef 99 | | _, Type when s =~ "^[E]__\\(.*\\)$" -> 100 | Common.matched1 s, Type 101 | | _ -> 102 | s, kind 103 | 104 | 105 | (* the data is generated by ../indexer/index_pfff.ml *) 106 | let parse_defs_and_uses file = 107 | let defs = ref [] in 108 | let uses = ref [] in 109 | UFile.Legacy.cat file |> List.iter (fun s -> 110 | let xs = Str.split_delim (Str.regexp ":") s in 111 | match xs with 112 | | ["DEF";kind_str;file;line;name] -> 113 | let kind_opt = kind_of_string_opt kind_str in 114 | kind_opt |> Option.iter (fun kind -> 115 | defs |> Stack_.push (adjust_name_and_kind name kind, 116 | {file = file ;line = int_of_string line}) 117 | ) 118 | | ["USE";kind_str;file;line;name] -> 119 | let kind_opt = kind_of_string_opt kind_str in 120 | kind_opt |> Option.iter (fun kind -> 121 | uses |> Stack_.push (adjust_name_and_kind name kind, 122 | {file = file;line = int_of_string line}) 123 | ) 124 | | _ -> failwith (spf "unrecognized line in defs and uses file: %s" s) 125 | ); 126 | !defs, !uses 127 | 128 | (*****************************************************************************) 129 | (* Chunkid <-> loc list *) 130 | (*****************************************************************************) 131 | 132 | (*****************************************************************************) 133 | (* Chunkid -> defs * uses and Def -> Chunkid *) 134 | (*****************************************************************************) 135 | let hs__from_orig orig (defs, uses) = 136 | let hchunkname_to_defs = Crossref_chunk.hchunkname_to_defs__from_orig orig in 137 | 138 | let hdefs_and_uses_of_chunkid = Hashtbl.create 101 in 139 | let hchunkid_of_def = Hashtbl.create 101 in 140 | 141 | (* step1: get the list of files mentioned in defs and uses, so we know 142 | * all the toplevel file chunks 143 | *) 144 | let files = 145 | ((defs |> List.map (fun ((_, _), x) -> x.file))@ 146 | (uses |> List.map (fun ((_, _), x) -> x.file))) |> Common2.uniq 147 | in 148 | 149 | (* step2: tangle the toplevel file chunks (e.g., mk/main.c) while 150 | * remembering which LOC correspond to which chunkid 151 | *) 152 | (* use Hashtbl.find_all property *) 153 | let hchunkid_to_locs = Hashtbl.create 101 in 154 | files |> List.iter (fun file -> 155 | let loc = ref 1 in 156 | (* similar to web_to_code.ml *) 157 | if Hashtbl.find_all hchunkname_to_defs file =*= [] 158 | then failwith (spf "could not find defs for file %s" file); 159 | let rec aux key = 160 | let defs = Hashtbl.find_all hchunkname_to_defs key |> List.rev in 161 | incr loc (* the s: *); 162 | defs |> List.iter (fun (def, body) -> 163 | (* this assumes you are using -less_marks *) 164 | let id = def.chunkdef_id in 165 | body |> List.iter (function 166 | | Code _ -> 167 | Hashtbl.add hchunkid_to_locs id ({ file; line = !loc}); 168 | if !debug 169 | then UCommon.pr (spf "id = %d (name = %s), loc = %s:%d" 170 | id key file !loc); 171 | incr loc 172 | | ChunkName (key, _indent) -> 173 | aux key 174 | ); 175 | incr loc (* the e: or x: *) 176 | ); 177 | in 178 | aux file 179 | ); 180 | 181 | (* step3: create hashtbl to go from file x LOC to defs and uses *) 182 | let hloc_to_defs_uses = 183 | ((defs |> List.map (fun ((a, b), loc) -> loc, Left ((a, b), loc))) @ 184 | (uses |> List.map (fun ((a, b), loc) -> loc, Right ((a, b), loc))) 185 | ) 186 | (* bugfix: do not use '|> Common.hash_of_list' because it uses 187 | * Hashtbl.replace and we want Hashtbl.add (so that later we can 188 | * use Hashtbl.find_all). Indeed, the same LOC can contain multiple uses 189 | *) 190 | |> (fun xs -> 191 | let h = Hashtbl.create 101 in 192 | xs |> List.iter (fun (k, v) -> Hashtbl.add h k v); 193 | h 194 | ) 195 | in 196 | 197 | (* step4: iterate over all LOC for a chunkid and accumulate the defs 198 | * and uses there. 199 | * bugfix: use Common2.hkeys not Hashtbl.iter, otherwise will get 200 | * get defs multiple time for each loc of id. 201 | *) 202 | hchunkid_to_locs |> Common2_.hkeys |> List.iter (fun id -> 203 | let locs = Hashtbl.find_all hchunkid_to_locs id in 204 | let defs_uses = 205 | locs |> List_.filter_map (fun loc -> 206 | try 207 | (* bugfix: use Hashtbl.find_all, cos the same LOC can contain 208 | * multiple uses 209 | *) 210 | Some (Hashtbl.find_all hloc_to_defs_uses loc) 211 | with Not_found -> None 212 | ) |> List.flatten 213 | in 214 | let defs, uses = Either_.partition (fun x -> x) defs_uses in 215 | Hashtbl.add hdefs_and_uses_of_chunkid id (defs, uses); 216 | defs |> List.iter (fun ((s, kind), loc) -> 217 | let s = 218 | (* adjust_name adds this suffix for some static functions *) 219 | if s =~ "\\(.*\\)<>$" 220 | then Common.matched1 s 221 | else s 222 | in 223 | (* UGLY skip those for now, to avoid some ambiguity *) 224 | if kind <> Typedef 225 | then 226 | Hashtbl.add hchunkid_of_def s ((kind, loc), id) 227 | ) 228 | ); 229 | 230 | (* step5: adjust with adhoc definitions and uses found in .nw file *) 231 | let last_chunkid = ref 0 in 232 | let fake_loc = { file = "ADHOC DEF; no source file"; line = -1 } in 233 | orig |> List.iter (function 234 | | ChunkDef ({chunkdef_id = id; _ }, _) -> 235 | last_chunkid := id 236 | | Tex xs -> 237 | xs |> List.iter (fun s -> 238 | match s with 239 | | _ when s =~ "\\\\swdefs{\\(.*\\)}" -> 240 | let str = Common.matched1 s in 241 | let defs = Str.split (Str.regexp " *, *") str in 242 | defs |> List.iter (fun adhoc_def -> 243 | Hashtbl.add hchunkid_of_def adhoc_def 244 | ((Other "ADHOC DEF", fake_loc), !last_chunkid) 245 | ) 246 | | _ -> () 247 | ) 248 | ); 249 | 250 | hdefs_and_uses_of_chunkid, 251 | hchunkid_of_def 252 | 253 | let hdefs_and_uses_of_chunkid__from_orig orig (defs, uses) = 254 | hs__from_orig orig (defs, uses) |> fst 255 | 256 | let hchunkid_of_def__from_orig orig defs = 257 | hs__from_orig orig (defs, []) |> snd 258 | -------------------------------------------------------------------------------- /backend/crossref_code.mli: -------------------------------------------------------------------------------- 1 | 2 | type loc = { 3 | file: string (* Common.filename *); (* a relative (readable) path usually *) 4 | line: int; 5 | } 6 | 7 | val string_of_loc: loc -> string 8 | 9 | type entity_kind = 10 | | Function 11 | | Global 12 | 13 | | Constant 14 | | Macro 15 | | Constructor 16 | 17 | | Type (* include struct, union, enum *) 18 | | Field 19 | 20 | | Typedef 21 | | Structdef 22 | 23 | | Exception 24 | 25 | | Other of string (* e.g., token category, grammar rule, etc *) 26 | 27 | type defs = ((string * entity_kind) * loc) list 28 | type uses = ((string * entity_kind) * loc) list 29 | 30 | val parse_defs_and_uses: 31 | string (* Common.filename *) -> defs * uses 32 | 33 | val hdefs_and_uses_of_chunkid__from_orig: 34 | Web.t -> (defs * uses) -> 35 | (Web.chunkid, defs * uses) Hashtbl.t 36 | 37 | (* you can use Hashtbl.find_all on the returned hashtbl. If a string 38 | * has multiple matching defs then you need a way to disambiguate 39 | *) 40 | val hchunkid_of_def__from_orig: 41 | Web.t -> defs -> 42 | (string, (entity_kind * loc) * Web.chunkid) Hashtbl.t 43 | 44 | 45 | val debug: bool ref 46 | -------------------------------------------------------------------------------- /backend/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name backend) 3 | (wrapped false) 4 | (libraries 5 | commons 6 | commons2_ 7 | frontend 8 | ) 9 | (preprocess 10 | (pps ppx_deriving.show) 11 | ) 12 | ) 13 | -------------------------------------------------------------------------------- /backend/web_to_code.ml: -------------------------------------------------------------------------------- 1 | (* Copyright 2009-2017 Yoann Padioleau, see copyright.txt *) 2 | open Common 3 | 4 | open Web 5 | open Code 6 | 7 | (*****************************************************************************) 8 | (* Prelude *) 9 | (*****************************************************************************) 10 | (* Getting the code from a noweb file, 11 | * a.k.a. 'tangling' in Knuth's and literate programming terminology. 12 | * I could call this file tangle.ml, but I always found this terminology 13 | * confusing. 14 | * 15 | * related: 16 | * - notangle from noweb from Norma Ramsey 17 | * - nofake Perl script from Christian Lindig 18 | * - lipsum from Christian Lindig 19 | *) 20 | 21 | (*****************************************************************************) 22 | (* Helpers *) 23 | (*****************************************************************************) 24 | let generate_n_spaces i = 25 | Common2.repeat " " i |> String.concat "" 26 | 27 | let s_of_chunkdef_body xs = 28 | xs |> List.map (function 29 | | Code s -> s 30 | | ChunkName (s, i) -> 31 | let spaces = generate_n_spaces i in 32 | spaces ^ (spf "<<%s>>" s) 33 | ) |> Common2_.unlines 34 | 35 | 36 | (*****************************************************************************) 37 | (* Orig->View *) 38 | (*****************************************************************************) 39 | 40 | 41 | (* then see Code.unparse to save the code in a file *) 42 | let web_to_code ~topkey orig = 43 | let h = Crossref_chunk.hchunkname_to_body__from_orig orig in 44 | 45 | let rec aux (key, i) = 46 | let bodys = 47 | try 48 | Hashtbl.find h key 49 | with Not_found -> 50 | failwith (spf "view_of_orig: not able to find the chunkdef of '%s'" key) 51 | in 52 | 53 | bodys |> List.map (fun body -> 54 | 55 | let s = s_of_chunkdef_body body in 56 | let md5sum = Signature.signature_of_string s in 57 | 58 | let body' = 59 | body |> List.map (function 60 | | Code s -> [RegularCode s] 61 | | ChunkName (s,i) -> 62 | aux (s,i) 63 | ) |> List.flatten 64 | in 65 | 66 | ChunkCode ({ 67 | chunk_key = key; 68 | chunk_md5sum = Some md5sum; 69 | pretty_print = None; 70 | }, body', i) 71 | ) 72 | in 73 | aux (topkey, 0) 74 | 75 | let view_of_orig ~topkey a = 76 | (* Profiling.profile_code "view_of_orig" (fun () -> *) 77 | web_to_code ~topkey a 78 | (* ) *) 79 | -------------------------------------------------------------------------------- /backend/web_to_code.mli: -------------------------------------------------------------------------------- 1 | 2 | val web_to_code: 3 | topkey:Web.chunkname -> Web.t -> Code.t 4 | (* alias *) 5 | val view_of_orig: 6 | topkey:Web.chunkname -> Web.t -> Code.t 7 | 8 | (* used by sync.ml *) 9 | val s_of_chunkdef_body: 10 | Web.code_or_chunk list -> string 11 | -------------------------------------------------------------------------------- /backend/web_to_tex.mli: -------------------------------------------------------------------------------- 1 | 2 | (* todo: codegraph info at some point? *) 3 | val web_to_tex: 4 | Web.t -> string (* Common.filename *) (* jobname *) -> 5 | (Crossref_code.defs * Crossref_code.uses) -> 6 | unit 7 | -------------------------------------------------------------------------------- /bin: -------------------------------------------------------------------------------- 1 | _build/install/default/bin -------------------------------------------------------------------------------- /bugfix.txt: -------------------------------------------------------------------------------- 1 | -*- org -*- 2 | 3 | * 4 | 5 | ** 6 | <<<<<<< orig <<<<<<<< 7 | <> 8 | let foo x = 1 9 | 10 | let bar y = 2 11 | 12 | <> 13 | <> 14 | ==================== 15 | <> 16 | let foo x = 1 17 | 18 | let bar y = 2 19 | 20 | <> 21 | <> 22 | <> 23 | <> 24 | 25 | 26 | 27 | 28 | ==> pad: must agglomerate 29 | 30 | 31 | ** 32 | 33 | ==> must be more flexible on the order 34 | -------------------------------------------------------------------------------- /bugs.txt: -------------------------------------------------------------------------------- 1 | To submit bug reports, create a new github issue here: 2 | https://github.com/aryx/syncweb/issues 3 | -------------------------------------------------------------------------------- /changes.txt: -------------------------------------------------------------------------------- 1 | # -*- org -*- 2 | 3 | * 0.7 (Q2 2025) 4 | 5 | ** lpizer 6 | - resume lpizer, switch to dune and latest semgrep libs 7 | 8 | ** Internals: 9 | - update to latest commons in semgrep 1.109.0 10 | 11 | * 0.6 (Q2 2024) 12 | 13 | ** Internals: 14 | - update to latest commons in semgrep 1.70.0 15 | 16 | * 0.5 (Q1 2023) 17 | 18 | ** Internals: 19 | - switch to dune 20 | 21 | * 0.4 (Q1 2018) 22 | 23 | ** Features: 24 | - automatic indexing provided by codegraph! 25 | - index for defs and uses of entities, including record fields! 26 | (better than ctwill of Knuth?) 27 | - mini-indexes a la ctwill of Knuth (see his books such as MMIXware). 28 | 29 | ** Internals: 30 | - bypass completely noweb. Generate .tex directly 31 | (I used to have a noweblatexpad script, but it was a hack, and 32 | for the automatic indexing, easier to bypass noweb which is not 33 | a big help) 34 | 35 | * 0.3 36 | 37 | ** Features: 38 | - md5sum marks can now be generated in an auxillary file instead of 39 | the view file. This reduces the clutter in the source files. See 40 | the -md5sum_in_auxfile command line option 41 | - repetitive marks can be avoided. For instance often got things such as 42 | (*e: common.mli basic features *) 43 | (*s: common.mli basic features *) 44 | as often append chunks together. Instead of the 2 preceding marks, we can 45 | just generate" 46 | (*x: common.mli basic features *) 47 | This again reduces the clutter in the source files. 48 | See the -less_marks command line option. See also emacs/fix_noweb.el 49 | for tricks to put in a special color those marks. 50 | - support for multiple files; Your literate document can now be splitted 51 | in multiple .nw files and still synced. You can thus sync M original 52 | files vs N view files. Have to use some tricks to make it work though. 53 | - better file position information when something goes wrong in 54 | the original document or views. 55 | 56 | * 0.2 57 | 58 | ** Features: 59 | - show contextual diff of changes instead of just the 2 variations. Helpful 60 | when modify big chunks. 61 | - can now handle multiple languages output, not just ocaml, with the -lang 62 | command line option 63 | - can reorder chunk in orig without causing synchronisation needs. 64 | - handle what before was stopping the synchronisation of 65 | "a chunk has been deleted" 66 | - better error message, show chunk name 67 | 68 | ** Internals: 69 | - reorganize types 70 | 71 | ** Bugfix: 72 | - agglomerate chunkname in view_of_orig 73 | - dont print space for blank_string line, otherwise make sync will not fixpoint 74 | 75 | ** Documentations: 76 | - describe limitations 77 | - add stuff on copy-paste and AOP 78 | - improved documentation related to emacs 79 | 80 | * 0.1 81 | 82 | ** first public release 83 | 84 | ** Features: 85 | - fine grained sync using md5sum 86 | 87 | * Beta 88 | 89 | ** Features: 90 | - sync 91 | - specific to ocaml 92 | - make a few assumptions on format of literate document and its markup. 93 | 94 | * Alpha 95 | -------------------------------------------------------------------------------- /copyright.txt: -------------------------------------------------------------------------------- 1 | Syncweb - Yoann Padioleau 2 | 3 | Copyright (C) 2009-2010, 2014, 2018, 2023 Yoann Padioleau 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License (GPL) 7 | version 2 as published by the Free Software Foundation. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | file license.txt for more details. 13 | 14 | 15 | The contents of some files in this directory was derived from external 16 | sources with compatible licenses. The original copyright and license 17 | notice was preserved in the affected files. 18 | -------------------------------------------------------------------------------- /credits.txt: -------------------------------------------------------------------------------- 1 | Thanks to 2 | - Thorsten.Ohl for noweb-mode.el 3 | - Norman Ramsey for noweb obviously 4 | - Richard Jones for his dumper module, 5 | 6 | Thanks of course also to Stallman, Linus, Leroy, Knuth and their 7 | acolytes for respectively Emacs, Linux, OCaml, and (La)TeX. 8 | -------------------------------------------------------------------------------- /demos/.depend: -------------------------------------------------------------------------------- 1 | demo.cmo: demo.cmi 2 | demo.cmx: demo.cmi 3 | distribution.cmo: ../commons/common.cmi distribution.cmi 4 | distribution.cmx: ../commons/common.cmx distribution.cmi 5 | distribution_test.cmo: distribution.cmi ../commons/common.cmi 6 | distribution_test.cmx: distribution.cmx ../commons/common.cmx 7 | -------------------------------------------------------------------------------- /demos/Makefile: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Variables 3 | ############################################################################## 4 | 5 | SRC=demo.ml 6 | 7 | OBJS= $(SRC:.ml=.cmo) 8 | OPTOBJS= $(SRC:.ml=.cmx) 9 | 10 | INCLUDES=-I ../commons -I ocamlmpi 11 | 12 | SYSLIBS=str.cma unix.cma bigarray.cma 13 | 14 | ############################################################################## 15 | # Generic ocaml variables 16 | ############################################################################## 17 | 18 | #dont use -custom, it makes the bytecode unportable. 19 | OCAMLCFLAGS?=-g -dtypes # -w A 20 | 21 | # This flag is also used in subdirectories so don't change its name here. 22 | OPTFLAGS?= 23 | 24 | 25 | OCAMLC=ocamlc$(OPTBIN) $(OCAMLCFLAGS) $(INCLUDES) -thread 26 | OCAMLOPT=ocamlopt$(OPTBIN) $(OPTFLAGS) $(INCLUDES) -thread 27 | OCAMLLEX=ocamllex #-ml # -ml for debugging lexer, but slightly slower 28 | OCAMLYACC=ocamlyacc -v 29 | OCAMLDEP=ocamldep $(INCLUDES) 30 | OCAMLMKTOP=ocamlmktop -g -custom $(INCLUDES) -thread 31 | 32 | # can also be set via 'make static' 33 | STATIC= #-ccopt -static 34 | 35 | # can also be unset via 'make purebytecode' 36 | BYTECODE_STATIC=-custom 37 | 38 | ############################################################################## 39 | # Top rules 40 | ############################################################################## 41 | 42 | all: demo 43 | 44 | 45 | 46 | demo: $(OBJS) 47 | $(OCAMLC) $(BYTECODE_STATIC) -o $@ $(SYSLIBS) $^ 48 | clean:: 49 | rm -f demo 50 | 51 | 52 | multi_main: multi_main.mli multi_main.ml 53 | $(OCAMLC) -o $@ $^ 54 | clean:: 55 | rm -f multi_main 56 | 57 | ############################################################################## 58 | # Literate programming 59 | ############################################################################## 60 | 61 | SYNCWEB=../syncweb 62 | NOWEB=../scripts/noweblatex 63 | NOTANGLE=notangle 64 | 65 | # for dot2texi package, need --shell-escape 66 | PDFLATEX=pdflatex --shell-escape 67 | 68 | SYNCFLAGS=-md5sum_in_auxfile -less_marks 69 | 70 | #------------------------------------------------------------------------------ 71 | # demo example related 72 | #------------------------------------------------------------------------------ 73 | sync: 74 | $(SYNCWEB) $(SYNCFLAGS) demo.ml.nw demo.mli 75 | $(SYNCWEB) $(SYNCFLAGS) demo.ml.nw demo.ml 76 | 77 | pdf: 78 | $(NOWEB) demo.ml.nw > demo.tex 79 | $(PDFLATEX) demo.tex 80 | $(PDFLATEX) demo.tex 81 | 82 | lpclean:: 83 | rm -f demo.ml demo.mli 84 | rm -f demo.tex main.pdf 85 | rm -f .md5sum_* 86 | 87 | clean:: 88 | rm -f demo_main.tex demo_main.pdf 89 | 90 | #------------------------------------------------------------------------------ 91 | # multi example related 92 | #------------------------------------------------------------------------------ 93 | SRC3=multi.nw multi1.nw multi2.nw 94 | sync3: 95 | $(SYNCWEB) $(SYNCFLAGS) $(SRC3) multi_main.ml 96 | $(SYNCWEB) $(SYNCFLAGS) $(SRC3) multi_main.mli 97 | 98 | pdf3: 99 | $(NOWEB) multi.nw > multi.tex 100 | $(PDFLATEX) multi.tex 101 | $(PDFLATEX) multi.tex 102 | 103 | #old: pp -P multi.nw > multi_total.nw 104 | #noweave -n -index -backend scopehack *.nw 105 | # $(NOWEBMULTI) multi.nw multi1.nw multi2.nw > multi.tex 106 | 107 | 108 | lpclean:: 109 | rm -f multi_main.ml multi_main.mli 110 | rm -f multi.pdf multi.tex multi_total.nw 111 | 112 | #------------------------------------------------------------------------------ 113 | clean:: 114 | rm -f *.aux *.dvi *.log *.toc 115 | 116 | 117 | ############################################################################## 118 | # Generic ocaml rules 119 | ############################################################################## 120 | 121 | .SUFFIXES: .ml .mli .cmo .cmi .cmx 122 | 123 | .ml.cmo: 124 | $(OCAMLC) -c $< 125 | .mli.cmi: 126 | $(OCAMLC) -c $< 127 | .ml.cmx: 128 | $(OCAMLOPT) -c $< 129 | 130 | .ml.mldepend: 131 | $(OCAMLC) -i $< 132 | 133 | clean:: 134 | rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot 135 | rm -f *~ .*~ *.exe gmon.out #*# 136 | 137 | distclean:: 138 | rm -f .depend 139 | 140 | beforedepend:: 141 | 142 | depend:: beforedepend 143 | $(OCAMLDEP) *.mli *.ml > .depend 144 | 145 | -include .depend 146 | -------------------------------------------------------------------------------- /demos/demo.ml.nw: -------------------------------------------------------------------------------- 1 | \documentclass{report} 2 | 3 | \usepackage{noweb} 4 | 5 | \begin{document} 6 | 7 | \section{Introduction} 8 | 9 | <>= 10 | type x = int (* *) 11 | type y = float 12 | @ 13 | 14 | \section{Interface} 15 | 16 | <>= 17 | <> 18 | @ 19 | 20 | 21 | \section{Implementation} 22 | 23 | <>= 24 | <> 25 | let foo x = 1 26 | let bar y = 2 27 | 28 | <> 29 | <> 30 | @ 31 | 32 | <>= 33 | let misc = 3 34 | @ 35 | 36 | 37 | <>= 38 | let part1bis x = 1 39 | @ 40 | 41 | <>= 42 | let part1bisbis x = 1 43 | @ 44 | 45 | 46 | <>= 47 | let part1bisbisbis x = 1 48 | @ 49 | 50 | 51 | <>= 52 | let part2 x = 3 53 | @ 54 | 55 | \end{document} 56 | -------------------------------------------------------------------------------- /demos/demo.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/demos/demo.pdf -------------------------------------------------------------------------------- /demos/mapreduce/Makefile: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Variables 3 | ############################################################################## 4 | 5 | SRC=distribution.ml distribution_test.ml 6 | 7 | OBJS= $(SRC:.ml=.cmo) 8 | OPTOBJS= $(SRC:.ml=.cmx) 9 | 10 | INCLUDES=-I commons -I ocamlmpi 11 | 12 | SYSLIBS=str.cma unix.cma bigarray.cma 13 | 14 | ############################################################################## 15 | # Generic ocaml variables 16 | ############################################################################## 17 | 18 | #dont use -custom, it makes the bytecode unportable. 19 | OCAMLCFLAGS?=-g -dtypes # -w A 20 | 21 | # This flag is also used in subdirectories so don't change its name here. 22 | OPTFLAGS?= 23 | 24 | 25 | OCAMLC=ocamlc$(OPTBIN) $(OCAMLCFLAGS) $(INCLUDES) -thread 26 | OCAMLOPT=ocamlopt$(OPTBIN) $(OPTFLAGS) $(INCLUDES) -thread 27 | OCAMLLEX=ocamllex #-ml # -ml for debugging lexer, but slightly slower 28 | OCAMLYACC=ocamlyacc -v 29 | OCAMLDEP=ocamldep $(INCLUDES) 30 | OCAMLMKTOP=ocamlmktop -g -custom $(INCLUDES) -thread 31 | 32 | # can also be set via 'make static' 33 | STATIC= #-ccopt -static 34 | 35 | # can also be unset via 'make purebytecode' 36 | BYTECODE_STATIC=-custom 37 | 38 | ############################################################################## 39 | # Top rules 40 | ############################################################################## 41 | 42 | distribution_test: distribution.mli distribution.ml distribution_test.ml 43 | $(OCAMLC) -c distribution.mli 44 | $(OCAMLC) -c distribution.ml 45 | $(OCAMLC) -c distribution_test.ml 46 | $(OCAMLC) -custom $(SYSLIBS) commons/commons.cma ocamlmpi/mpi.cma distribution.cmo distribution_test.cmo -o $@ 47 | 48 | clean:: 49 | rm -f distribution_test 50 | 51 | 52 | ############################################################################## 53 | # Literate programming 54 | ############################################################################## 55 | 56 | SYNCFLAGS=-md5sum_in_auxfile -less_marks 57 | 58 | SYNCWEB=../../syncweb $(SYNCFLAGS) 59 | NOWEB=../../scripts/noweblatexpad 60 | NOTANGLE=notangle 61 | 62 | # for dot2texi package, need --shell-escape 63 | PDFLATEX=pdflatex --shell-escape 64 | 65 | 66 | #------------------------------------------------------------------------------ 67 | # distribution example related 68 | #------------------------------------------------------------------------------ 69 | TIMEFORMAT="TIME: %es" 70 | EXPECTEDSIMPLE=expected_res_simple.out 71 | EXPECTEDMPI=expected_res_mpi.out 72 | BENCHRES=expected_time.out 73 | 74 | all2: 75 | make sync 76 | make distribution_test 77 | ./distribution_test > $(EXPECTEDSIMPLE) 78 | mpirun -p4pg config.pg ./distribution_test > $(EXPECTEDMPI) 2>&1 79 | cat $(EXPECTEDMPI) 80 | make pdf 81 | make test 82 | 83 | compile: 84 | make sync 85 | make distribution_test 86 | 87 | test: 88 | make -f Makefile.test 89 | make -f Makefile.test copy_binary 90 | echo "---- without MPI, naive_map_reduce ---" > $(BENCHRES) 91 | time -f $(TIMEFORMAT) -a -o $(BENCHRES) ./distribution_test 92 | scp distribution_test phantom:/tmp/ 93 | echo "---- with MPI ---" >> $(BENCHRES) 94 | time -f $(TIMEFORMAT) -a -o $(BENCHRES) mpirun -p4pg config.pg ./distribution_test 95 | 96 | 97 | 98 | #------------------------------------------------------------------------------ 99 | sync: 100 | $(SYNCWEB) distribution.ml.nw distribution.mli 101 | $(SYNCWEB) distribution.ml.nw distribution.ml 102 | $(SYNCWEB) distribution.ml.nw distribution_test.ml 103 | #TOREPUT 104 | # $(SYNCWEB) -lang shell distribution.ml.nw Makefile.test 105 | # $(SYNCWEB) -lang shell distribution.ml.nw config.pg 106 | # $(SYNCWEB) -lang shell distribution.ml.nw get_dependencies.sh 107 | # chmod a+x get_dependencies.sh 108 | 109 | # $(NOTANGLE) distribution.ml.nw -RMakefile.test > Makefile.test 110 | # $(NOTANGLE) distribution.ml.nw -Rconfig.pg > config.pg 111 | # $(NOTANGLE) distribution.ml.nw -Rget_distribute_dependencies.sh > get_distribute_dependencies.sh 112 | 113 | pdf: 114 | $(NOWEB) distribution.ml.nw > distribution.tex 115 | $(PDFLATEX) distribution.tex 116 | $(PDFLATEX) distribution.tex 117 | 118 | 119 | lpclean:: 120 | rm -f distribution.ml distribution.mli 121 | rm -f distribution.tex 122 | rm -f distribution-dot2tex* 123 | # rm -f Makefile.test 124 | rm -f config.pg get_dependencies.sh 125 | rm -f distribution_test.ml 126 | rm -f distribution.pdf 127 | rm -f distribution.out 128 | 129 | 130 | #------------------------------------------------------------------------------ 131 | clean:: 132 | rm -f *.aux *.dvi *.log *.toc 133 | 134 | 135 | ############################################################################## 136 | # Package rules 137 | ############################################################################## 138 | 139 | VERSION=0.1 140 | PACKAGE=mapreduce-$(VERSION) 141 | TMP=/tmp 142 | 143 | package: 144 | make srctar 145 | 146 | srctar: 147 | cp distribution.pdf save.pdf 148 | make clean 149 | make lpclean 150 | make sync 151 | mv save.pdf distribution.pdf 152 | cp -a . $(TMP)/$(PACKAGE) 153 | cd $(TMP); tar cvfz $(PACKAGE).tgz \ 154 | --exclude=CVS --exclude=_darcs \ 155 | --exclude=ocamlmpi --exclude=commons --exclude=latex \ 156 | $(PACKAGE) 157 | rm -rf $(TMP)/$(PACKAGE) 158 | 159 | #install: distribution-latest.tgz 160 | 161 | 162 | ############################################################################## 163 | # Website rules 164 | ############################################################################## 165 | WEBSITE=/home/pad/mobile/homepage/ocaml 166 | 167 | #en-html: 168 | # emacs -l ~/.emacs --eval "(progn (htmlize-many-files '(\"changes.txt\")) (kill-emacs))" 169 | 170 | website: 171 | cp $(TMP)/$(PACKAGE).tgz $(WEBSITE) 172 | rm -f $(WEBSITE)/LATEST_MAPREDUCE* $(WEBSITE)/mapreduce-latest.tgz 173 | cd $(WEBSITE); touch LATEST_MAPREDUCE_IS_$(VERSION); ln -s $(PACKAGE).tgz mapreduce-latest.tgz 174 | cp distribution.pdf $(WEBSITE)/mapreduce.pdf 175 | 176 | # cp readme.txt $(WEBSITE) 177 | # cp changes.txt $(WEBSITE) 178 | 179 | WEBSITE=/home/pad/mobile/homepage/software/project-syncweb/demo 180 | websitedemo: 181 | mkdir -p $(WEBSITE) 182 | cp distribution.ml.nw $(WEBSITE) 183 | cp distribution.pdf $(WEBSITE) 184 | cp distribution.ml distribution.mli $(WEBSITE) 185 | 186 | ############################################################################## 187 | # Generic ocaml rules 188 | ############################################################################## 189 | 190 | .SUFFIXES: .ml .mli .cmo .cmi .cmx 191 | 192 | .ml.cmo: 193 | $(OCAMLC) -c $< 194 | .mli.cmi: 195 | $(OCAMLC) -c $< 196 | .ml.cmx: 197 | $(OCAMLOPT) -c $< 198 | 199 | .ml.mldepend: 200 | $(OCAMLC) -i $< 201 | 202 | clean:: 203 | rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot 204 | rm -f *~ .*~ *.exe gmon.out #*# 205 | 206 | distclean:: 207 | rm -f .depend 208 | 209 | beforedepend:: 210 | 211 | depend:: beforedepend 212 | $(OCAMLDEP) *.mli *.ml > .depend 213 | 214 | -include .depend 215 | -------------------------------------------------------------------------------- /demos/mapreduce/Makefile.test: -------------------------------------------------------------------------------- 1 | # nw_s: Makefile.test |b545e8d98f67b814c3298c9233a7979c# 2 | INCLUDES=-I commons -I ocamlmpi 3 | OCAMLC=ocamlc 4 | SYSLIBS=str.cma unix.cma bigarray.cma 5 | 6 | distribution_test: distribution.ml distribution.mli 7 | $(OCAMLC) $(INCLUDES) -c distribution.mli 8 | $(OCAMLC) $(INCLUDES) -c distribution.ml 9 | $(OCAMLC) $(INCLUDES) -c distribution_test.ml 10 | $(OCAMLC) $(INCLUDES) -custom $(SYSLIBS) commons/commons.cma ocamlmpi/mpi.cma \ 11 | distribution.cmo distribution_test.cmo -o $@ 12 | # nw_e: Makefile.test # 13 | # nw_s: Makefile.test |82d327960aac5aed23fbbb8f5dd9c41a# 14 | copy_binary: 15 | scp distribution_test phantom.cs.uiuc.edu:/tmp 16 | # nw_e: Makefile.test # 17 | -------------------------------------------------------------------------------- /demos/mapreduce/config.pg: -------------------------------------------------------------------------------- 1 | # nw_s: config.pg |# 2 | aryx.cs.uiuc.edu 0 /home/pad/c__syncweb/demos/mapreduce/distribution_test 3 | 4 | #aryx: 2 processors, local machine 5 | 6 | aryx.cs.uiuc.edu 1 /home/pad/c__syncweb/demos/mapreduce/distribution_test 7 | aryx.cs.uiuc.edu 1 /home/pad/c__syncweb/demos/mapreduce/distribution_test 8 | 9 | -------------------------------------------------------------------------------- /demos/mapreduce/distribution.ml: -------------------------------------------------------------------------------- 1 | (*s: distribution.ml *) 2 | (*s: copyright header *) 3 | (* Yoann Padioleau 4 | * 5 | * Copyright (C) 2009 University of Urbana Champaign 6 | * 7 | * This program is free software; you can redistribute it and/or 8 | * modify it under the terms of the GNU General Public License (GPL) 9 | * version 2 as published by the Free Software Foundation. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * file license.txt for more details. 15 | *) 16 | (*e: copyright header *) 17 | open Common 18 | 19 | (*****************************************************************************) 20 | (* Prelude *) 21 | (*****************************************************************************) 22 | 23 | (* cf the distribution.ml.nw literate document for the documentation *) 24 | 25 | (*****************************************************************************) 26 | (* Globals *) 27 | (*****************************************************************************) 28 | (*s: debug global *) 29 | let debug_mpi = ref false 30 | (*e: debug global *) 31 | 32 | (*****************************************************************************) 33 | (* Protocol *) 34 | (*****************************************************************************) 35 | (*s: protocol for master/workers *) 36 | let rank_master = 0 37 | (*x: protocol for master/workers *) 38 | exception TaskFinished 39 | (*x: protocol for master/workers *) 40 | type ('a, 'b) protocol = DataIn of 'a | DataRes of 'b | StopWorker 41 | (*x: protocol for master/workers *) 42 | exception ProtocolError 43 | (*x: protocol for master/workers *) 44 | let notag = 0 45 | (*e: protocol for master/workers *) 46 | 47 | (*****************************************************************************) 48 | (* Helpers *) 49 | (*****************************************************************************) 50 | (*s: worker *) 51 | let worker ~fmap:map_ex = 52 | let rank = Mpi.comm_rank Mpi.comm_world in 53 | let hostname = Unix.gethostname () in 54 | 55 | (*s: debug worker *) 56 | if !debug_mpi 57 | then Common._prefix_pr := (spf "W%d:" rank); 58 | if !debug_mpi 59 | then pr2 (spf "DEBUG: mpi worker %s, rank=%d" hostname rank); 60 | (*e: debug worker *) 61 | 62 | Common.unwind_protect (fun () -> 63 | (*s: enter worker loop *) 64 | while true do 65 | let req = Mpi.receive rank_master notag Mpi.comm_world in 66 | match req with 67 | | DataIn req -> 68 | (* big work *) 69 | let res = map_ex req in 70 | Mpi.send (DataRes res) rank_master notag Mpi.comm_world 71 | | StopWorker -> 72 | (*s: debug worker exit *) 73 | if !debug_mpi 74 | then pr2 ("DEBUG: worker exiting"); 75 | flush stderr; flush stdout; 76 | (*e: debug worker exit *) 77 | raise (UnixExit (0)) 78 | | DataRes _ -> raise ProtocolError 79 | done 80 | (*e: enter worker loop *) 81 | ) 82 | (fun e -> 83 | (*s: exit worker *) 84 | match e with 85 | | UnixExit(0) -> exit 0 86 | | _ -> 87 | pr2 (spf "PB: mpi worker dying: %s" (Common.exn_to_s e)); 88 | (*e: exit worker *) 89 | ) 90 | 91 | (*e: worker *) 92 | 93 | (*s: master *) 94 | let master ~freduce:reduce_ex acc xs = 95 | let available_workers = Mpi.comm_size Mpi.comm_world - 1 in 96 | let actual_workers = min (List.length xs) available_workers in 97 | 98 | (*s: debug master *) 99 | if !debug_mpi 100 | then Common._prefix_pr := ("MS:"); 101 | if !debug_mpi 102 | then pr2 (spf "DEBUG: mpi master, number of clients=%d" available_workers); 103 | (*e: debug master *) 104 | (*s: killing_workers helper *) 105 | let killing_workers xs = 106 | xs +> List.iter (fun i -> Mpi.send StopWorker i notag Mpi.comm_world) 107 | (*e: killing_workers helper *) 108 | in 109 | 110 | 111 | let in_list = ref xs in 112 | let out_list = ref [] in 113 | let working = ref 0 in 114 | Common.unwind_protect (fun () -> 115 | 116 | assert(List.length !in_list >= actual_workers); 117 | 118 | (*s: send initial work to valid workers *) 119 | for i = 1 to actual_workers do 120 | let arg = Common.pop2 in_list in 121 | Mpi.send (DataIn arg) i notag Mpi.comm_world; 122 | incr working; 123 | done; 124 | (*e: send initial work to valid workers *) 125 | (*s: kill idle workers *) 126 | killing_workers (Common.enum_safe (actual_workers+1) available_workers); 127 | (*e: kill idle workers *) 128 | (*s: enter server loop, [[in_list]] shrinks and [[out_list]] grows *) 129 | while !working > 0 do 130 | let (res, src, _) = Mpi.receive_status Mpi.any_source notag Mpi.comm_world in 131 | (match res with 132 | | DataRes x -> 133 | Common.push2 x out_list; 134 | | DataIn _ | StopWorker -> raise ProtocolError 135 | ); 136 | 137 | if not (null !in_list) then begin 138 | let arg = Common.pop2 in_list in 139 | Mpi.send (DataIn arg) src notag Mpi.comm_world; 140 | end 141 | else decr working; 142 | done; 143 | (*e: enter server loop, [[in_list]] shrinks and [[out_list]] grows *) 144 | (*s: no more remaining, kill workers *) 145 | killing_workers (Common.enum 1 actual_workers); 146 | flush stderr;flush stdout; 147 | (*e: no more remaining, kill workers *) 148 | 149 | (* big work *) 150 | List.fold_left reduce_ex acc !out_list 151 | 152 | ) (fun e -> 153 | (*s: kill workers because problem *) 154 | pr2 (spf "PB: mpi master dying: %s" (Common.exn_to_s e)); 155 | killing_workers (Common.enum 1 available_workers); 156 | (*e: kill workers because problem *) 157 | ) 158 | (*e: master *) 159 | 160 | (*s: under_mpirun *) 161 | let under_mpirun () = 162 | Sys.argv +> Array.to_list +> List.exists (fun x -> 163 | x ="-p4pg" || x = "-p4rmrank" 164 | ) 165 | (*e: under_mpirun *) 166 | 167 | (*****************************************************************************) 168 | (* Main entry point *) 169 | (*****************************************************************************) 170 | (*s: map_reduce *) 171 | let map_reduce ~fmap:map_ex ~freduce:reduce_ex acc xs = 172 | if under_mpirun () 173 | then begin 174 | (*s: map_reduce mpi case *) 175 | let rank = Mpi.comm_rank Mpi.comm_world in 176 | if rank = rank_master 177 | then 178 | master ~freduce:reduce_ex acc xs 179 | else begin 180 | worker ~fmap:map_ex; 181 | raise TaskFinished (* for the type system *) 182 | end 183 | (*e: map_reduce mpi case *) 184 | end 185 | else 186 | List.fold_left reduce_ex acc (List.map map_ex xs) 187 | (*e: map_reduce *) 188 | 189 | (*s: map_reduce_lazy *) 190 | (* same but with xs lazy, so workers don't need to compute it *) 191 | let map_reduce_lazy ~fmap:map_ex ~freduce:reduce_ex acc fxs = 192 | if under_mpirun () 193 | then begin 194 | let rank = Mpi.comm_rank Mpi.comm_world in 195 | if rank = rank_master 196 | then 197 | master ~freduce:reduce_ex acc (fxs()) (* changed code *) 198 | else 199 | begin 200 | worker ~fmap:map_ex; (* normally raise already a UnixExit *) 201 | raise TaskFinished 202 | end 203 | end 204 | else 205 | let xs = fxs() in (* changed code *) 206 | List.fold_left reduce_ex acc (List.map map_ex xs) 207 | 208 | (*e: map_reduce_lazy *) 209 | 210 | (*****************************************************************************) 211 | (* Extra *) 212 | (*****************************************************************************) 213 | (*s: protocol for argv *) 214 | type protocol_argv = Argv of string list 215 | (*e: protocol for argv *) 216 | (*s: mpi_adjust_argv *) 217 | let mpi_adjust_argv argvold = 218 | let rank = Mpi.comm_rank Mpi.comm_world in 219 | let numworkers = Mpi.comm_size Mpi.comm_world - 1 in 220 | if rank = rank_master 221 | then 222 | (*s: adjust argv for master *) 223 | begin 224 | (* the master get the full list of arguments, but also some 225 | * extra stuff that we must filter *) 226 | let xs = Array.to_list argvold in 227 | let xs = xs +> Common.take_until (fun s -> s = "-p4pg") in 228 | (* send good argv to workers *) 229 | for i = 1 to numworkers do 230 | Mpi.send (Argv xs) i notag Mpi.comm_world; 231 | done; 232 | Array.of_list xs 233 | end 234 | (*e: adjust argv for master *) 235 | else 236 | (*s: adjust argv for worker *) 237 | begin 238 | (* recieve argv from master as mpirun does not pass it to us *) 239 | let (Argv res, src, _) = 240 | Mpi.receive_status Mpi.any_source notag Mpi.comm_world in 241 | Array.of_list res 242 | end 243 | (*e: adjust argv for worker *) 244 | (*e: mpi_adjust_argv *) 245 | 246 | (*e: distribution.ml *) 247 | -------------------------------------------------------------------------------- /demos/mapreduce/distribution.mli: -------------------------------------------------------------------------------- 1 | (*s: distribution.mli *) 2 | val map_reduce: 3 | fmap:('a -> 'b) -> freduce:('c -> 'b -> 'c) -> 4 | 'c -> 'a list -> 'c 5 | (*x: distribution.mli *) 6 | val map_reduce_lazy: 7 | fmap:('a -> 'b) -> freduce:('c -> 'b -> 'c) -> 8 | 'c -> (unit -> 'a list) -> 'c 9 | (*x: distribution.mli *) 10 | val debug_mpi: bool ref 11 | (*x: distribution.mli *) 12 | (*****************************************************************************) 13 | (* Private *) 14 | (*****************************************************************************) 15 | (*s: distribution.mli private *) 16 | val under_mpirun : unit -> bool 17 | (*x: distribution.mli private *) 18 | val master : freduce:('c -> 'b -> 'c) -> 'c -> 'b list -> 'c 19 | (*x: distribution.mli private *) 20 | val worker : fmap:('a -> 'b) -> unit 21 | (*x: distribution.mli private *) 22 | exception TaskFinished 23 | (*x: distribution.mli private *) 24 | val mpi_adjust_argv : string array -> string array 25 | (*e: distribution.mli private *) 26 | (*e: distribution.mli *) 27 | -------------------------------------------------------------------------------- /demos/mapreduce/distribution_test.ml: -------------------------------------------------------------------------------- 1 | (*s: distribution_test.ml *) 2 | open Common 3 | 4 | let rec fib n = 5 | if n = 0 then 0 6 | else 7 | if n = 1 then 1 8 | else fib (n-1) + fib (n-2) 9 | 10 | 11 | let map_ex arg = 12 | pr (spf "map: %d" arg); 13 | fib arg 14 | 15 | let reduce_ex acc e = 16 | pr (spf "reduce: acc=%d, e=%d" acc e); 17 | acc + e 18 | 19 | (*x: distribution_test.ml *) 20 | let naive_map_reduce ~fmap ~freduce acc xs = 21 | List.fold_left freduce acc (List.map fmap xs) 22 | (*x: distribution_test.ml *) 23 | let test_no_mpi () = 24 | let res = naive_map_reduce ~fmap:map_ex ~freduce:reduce_ex 25 | 0 [1;2;3;10] in 26 | pr (spf "result = %d" res); 27 | () 28 | (*x: distribution_test.ml *) 29 | let test_no_mpi_bis () = 30 | let res = naive_map_reduce ~fmap:fib ~freduce:(fun acc e -> acc + e) 31 | 0 [1;2;3;10] in 32 | pr (spf "result = %d" res); 33 | () 34 | (*x: distribution_test.ml *) 35 | let test_mpi () = 36 | let res = Distribution.map_reduce ~fmap:map_ex ~freduce:reduce_ex 37 | 0 [35;35;35;35] in 38 | pr (spf "result = %d" res); 39 | () 40 | 41 | let main = 42 | (*s: set debug mpi flag if necessary *) 43 | Distribution.debug_mpi := true; 44 | (*e: set debug mpi flag if necessary *) 45 | test_mpi () 46 | 47 | (*x: distribution_test.ml *) 48 | let test_mpi_raw () = 49 | let rank = Mpi.comm_rank Mpi.comm_world in 50 | pr (spf "rank: %d" rank); 51 | if rank = 0 52 | then 53 | Distribution.master reduce_ex [1;2;3;10] 54 | else begin 55 | Distribution.worker map_ex; 56 | raise Distribution.TaskFinished 57 | end 58 | 59 | (*e: distribution_test.ml *) 60 | -------------------------------------------------------------------------------- /demos/mapreduce/expected_res_mpi.out: -------------------------------------------------------------------------------- 1 | MS:DEBUG: mpi master, number of clients=6 2 | W1:DEBUG: mpi worker axyr, rank=1 3 | W3:DEBUG: mpi worker phantom.cs.uiuc.edu, rank=3 4 | W4:DEBUG: mpi worker phantom.cs.uiuc.edu, rank=4 5 | W2:map: 35 6 | W2:DEBUG: mpi worker axyr, rank=2 7 | W5:DEBUG: mpi worker phantom.cs.uiuc.edu, rank=5 8 | W6:DEBUG: mpi worker phantom.cs.uiuc.edu, rank=6 9 | W1:map: 35 10 | W4:map: 35 11 | W3:map: 35 12 | W6:DEBUG: worker exiting 13 | W5:DEBUG: worker exiting 14 | MS:reduce: acc=0, e=9227465 15 | W1:DEBUG: worker exiting 16 | MS:reduce: acc=9227465, e=9227465 17 | MS:reduce: acc=18454930, e=9227465 18 | MS:reduce: acc=27682395, e=9227465 19 | MS:result = 36909860 20 | W2:DEBUG: worker exiting 21 | W4:DEBUG: worker exiting 22 | W3:DEBUG: worker exiting 23 | P4 procgroup file is config.pg. 24 | -------------------------------------------------------------------------------- /demos/mapreduce/expected_res_simple.out: -------------------------------------------------------------------------------- 1 | map: 35 2 | map: 35 3 | map: 35 4 | map: 35 5 | reduce: acc=0, e=9227465 6 | reduce: acc=9227465, e=9227465 7 | reduce: acc=18454930, e=9227465 8 | reduce: acc=27682395, e=9227465 9 | result = 36909860 10 | -------------------------------------------------------------------------------- /demos/mapreduce/expected_time.out: -------------------------------------------------------------------------------- 1 | ---- without MPI, naive_map_reduce --- 2 | TIME: 9.29s 3 | ---- with MPI --- 4 | TIME: 3.39s 5 | -------------------------------------------------------------------------------- /demos/mapreduce/install.txt: -------------------------------------------------------------------------------- 1 | Look distribution.pdf 2 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/.depend: -------------------------------------------------------------------------------- 1 | mpi.cmo: mpi.cmi 2 | mpi.cmx: mpi.cmi 3 | test.cmo: mpi.cmi 4 | test.cmx: mpi.cmx 5 | test_mandel.cmo: mpi.cmi 6 | test_mandel.cmx: mpi.cmx 7 | test_pad.cmo: mpi.cmi 8 | test_pad.cmx: mpi.cmx 9 | collcomm.o: collcomm.c /home/pad/packages/Linux/include/mpi.h \ 10 | /home/pad/packages/Linux/include/mpidefs.h \ 11 | /home/pad/packages/Linux/include/mpio.h \ 12 | /home/pad/packages/Linux/include/mpi.h \ 13 | /home/pad/packages/Linux/include/mpi_errno.h \ 14 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 15 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/compatibility.h \ 16 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/config.h \ 17 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/misc.h \ 18 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/memory.h \ 19 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 20 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/alloc.h \ 21 | camlmpi.h 22 | comm.o: comm.c /home/pad/packages/Linux/include/mpi.h \ 23 | /home/pad/packages/Linux/include/mpidefs.h \ 24 | /home/pad/packages/Linux/include/mpio.h \ 25 | /home/pad/packages/Linux/include/mpi.h \ 26 | /home/pad/packages/Linux/include/mpi_errno.h \ 27 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 28 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/compatibility.h \ 29 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/config.h \ 30 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/misc.h \ 31 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/alloc.h \ 32 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 33 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/memory.h \ 34 | camlmpi.h 35 | groups.o: groups.c /home/pad/packages/Linux/include/mpi.h \ 36 | /home/pad/packages/Linux/include/mpidefs.h \ 37 | /home/pad/packages/Linux/include/mpio.h \ 38 | /home/pad/packages/Linux/include/mpi.h \ 39 | /home/pad/packages/Linux/include/mpi_errno.h \ 40 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 41 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/compatibility.h \ 42 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/config.h \ 43 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/misc.h \ 44 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/alloc.h \ 45 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 46 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/memory.h \ 47 | camlmpi.h 48 | init.o: init.c /home/pad/packages/Linux/include/mpi.h \ 49 | /home/pad/packages/Linux/include/mpidefs.h \ 50 | /home/pad/packages/Linux/include/mpio.h \ 51 | /home/pad/packages/Linux/include/mpi.h \ 52 | /home/pad/packages/Linux/include/mpi_errno.h \ 53 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 54 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/compatibility.h \ 55 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/config.h \ 56 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/misc.h \ 57 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/memory.h \ 58 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 59 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/alloc.h \ 60 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/fail.h \ 61 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/callback.h \ 62 | camlmpi.h 63 | msgs.o: msgs.c /home/pad/packages/Linux/include/mpi.h \ 64 | /home/pad/packages/Linux/include/mpidefs.h \ 65 | /home/pad/packages/Linux/include/mpio.h \ 66 | /home/pad/packages/Linux/include/mpi.h \ 67 | /home/pad/packages/Linux/include/mpi_errno.h \ 68 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 69 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/compatibility.h \ 70 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/config.h \ 71 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/misc.h \ 72 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/alloc.h \ 73 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 74 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/memory.h \ 75 | camlmpi.h 76 | utils.o: utils.c /home/pad/packages/Linux/include/mpi.h \ 77 | /home/pad/packages/Linux/include/mpidefs.h \ 78 | /home/pad/packages/Linux/include/mpio.h \ 79 | /home/pad/packages/Linux/include/mpi.h \ 80 | /home/pad/packages/Linux/include/mpi_errno.h \ 81 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 82 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/compatibility.h \ 83 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/config.h \ 84 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/misc.h \ 85 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/memory.h \ 86 | /home/pad/packages/stow/godi-3.10/lib/ocaml/std-lib/caml/mlvalues.h \ 87 | camlmpi.h 88 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/Changes: -------------------------------------------------------------------------------- 1 | Version 1.01: 2 | - Relicensed under the LGPL 3 | - Modernized build and installation procedure. 4 | 5 | Version 1.00: 6 | - First public release. 7 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/Makefile: -------------------------------------------------------------------------------- 1 | OCAMLC=ocamlc 2 | OCAMLOPT=ocamlopt 3 | OCAMLDEP=ocamldep 4 | 5 | DESTDIR=`$(OCAMLC) -where`/ocamlmpi 6 | MPIINCDIR=/home/pad/packages/Linux/include 7 | MPILIBDIR=/home/pad/packages/Linux/lib 8 | #/usr/local/lib/mpich/lib/LINUX/ch_p4 9 | 10 | CC=gcc 11 | CFLAGS=-I`$(OCAMLC) -where` -I$(MPIINCDIR) -O -g -Wall 12 | 13 | COBJS=init.o comm.o msgs.o collcomm.o groups.o utils.o 14 | OBJS=mpi.cmo 15 | 16 | all: libcamlmpi.a mpi.cma mpi.cmxa 17 | 18 | install: 19 | cp mpi.mli mpi.cmi mpi.cma mpi.cmxa mpi.a libcamlmpi.a $(DESTDIR) 20 | 21 | libcamlmpi.a: $(COBJS) 22 | rm -f $@ 23 | ar rc $@ $(COBJS) 24 | 25 | mpi.cma: $(OBJS) 26 | $(OCAMLC) -a -o mpi.cma -custom $(OBJS) -cclib -lcamlmpi -ccopt -L$(MPILIBDIR) -cclib -lmpich 27 | 28 | mpi.cmxa: $(OBJS:.cmo=.cmx) 29 | $(OCAMLOPT) -a -o mpi.cmxa $(OBJS:.cmo=.cmx) -cclib -lcamlmpi -ccopt -L$(MPILIBDIR) -cclib -lmpich 30 | 31 | .SUFFIXES: .ml .mli .cmo .cmi .cmx 32 | 33 | .ml.cmo: 34 | $(OCAMLC) -c $< 35 | .mli.cmi: 36 | $(OCAMLC) -c $< 37 | .ml.cmx: 38 | $(OCAMLOPT) -c $< 39 | 40 | testmpi: test.ml mpi.cma libcamlmpi.a 41 | ocamlc -o testmpi unix.cma mpi.cma test.ml -ccopt -L. 42 | 43 | clean:: 44 | rm -f testmpi 45 | 46 | test: testmpi 47 | mpirun -np 5 ./testmpi 48 | 49 | test_mandel: test_mandel.ml mpi.cmxa libcamlmpi.a 50 | ocamlopt -o test_mandel graphics.cmxa mpi.cmxa test_mandel.ml -ccopt -L. 51 | 52 | test_pad: test_pad.ml mpi.cma 53 | ocamlc -o test_pad -I ../commons bigarray.cma str.cma unix.cma ../commons/commons.cma mpi.cma test_pad.ml -ccopt -L. 54 | 55 | test2: 56 | mpirun -np 3 ./test_pad arg1 arg2 57 | 58 | clean:: 59 | rm -f test_mandel 60 | 61 | clean:: 62 | rm -f *.cm* *.o *.a 63 | depend: 64 | $(OCAMLDEP) *.ml > .depend 65 | gcc -MM $(CFLAGS) *.c >> .depend 66 | 67 | include .depend 68 | 69 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/Makefile_old: -------------------------------------------------------------------------------- 1 | OCAMLC=ocamlc 2 | OCAMLOPT=ocamlopt 3 | OCAMLDEP=ocamldep 4 | OCAMLMKLIB=ocamlmklib 5 | 6 | DESTDIR=`$(OCAMLC) -where`/ocamlmpi 7 | MPIINCDIR=/home/pad/packages/Linux/include 8 | MPILIBDIR=/home/pad/packages/Linux/lib 9 | #MPIINCDIR=/usr/include/mpitata 10 | #MPILIBDIR=/usr/local/lib/mpich/lib/LINUX/ch_p4 11 | #MPILIB=mpich 12 | #MPILIBDIR=/home/yyzhou/pad/packages/lib 13 | #MPIINCDIR=/usr/include/mpitata 14 | #MPILIBDIR=/usr/lib/mpich/lib 15 | #MPIINCDIR=/usr/include/mpitata 16 | MPILIB=mpich 17 | 18 | CC=gcc 19 | CFLAGS=-I`$(OCAMLC) -where` -I$(MPIINCDIR) -O -g -Wall 20 | 21 | ############################################################################## 22 | COBJS=init.o comm.o msgs.o collcomm.o groups.o utils.o 23 | OBJS=mpi.cmo 24 | 25 | ############################################################################## 26 | all: libmpi_stubs.a mpi.cma 27 | all.opt: mpi.cmxa 28 | opt: all.opt 29 | 30 | libmpi_stubs.a: $(COBJS) 31 | $(OCAMLMKLIB) -o mpi_stubs $(COBJS) -L$(MPILIBDIR) -l$(MPILIB) 32 | 33 | mpi.cma: $(OBJS) 34 | ocamlc -a -thread -dllib dllmpi_stubs.so -cclib -lmpi_stubs -ccopt -L$(MPILIBDIR) -cclib -l$(MPILIB) -o mpi.cma $(OBJS) 35 | # $(OCAMLMKLIB) -o mpi -cclib -lmpi_stubs -cclib -l$(MPILIB) $(OBJS) 36 | 37 | 38 | mpi.cmxa: $(OBJS:.cmo=.cmx) 39 | ocamlopt -a -thread -cclib -lmpi_stubs -ccopt -L$(MPILIBDIR) -cclib -l$(MPILIB) -o mpi.cmxa $(OBJS:.cmo=.cmx) 40 | # $(OCAMLMKLIB) -o mpi $(OBJS:.cmo=.cmx) -ccopt -L$(MPILIBDIR) -cclib -l$(MPILIB) 41 | 42 | 43 | ############################################################################## 44 | testmpi: test.ml mpi.cma libcamlmpi.a 45 | ocamlc -o testmpi unix.cma mpi.cma test.ml -ccopt -L. 46 | 47 | clean:: 48 | rm -f testmpi 49 | 50 | test: testmpi 51 | mpirun -np 5 ./testmpi 52 | 53 | test_mandel: test_mandel.ml mpi.cmxa libcamlmpi.a 54 | ocamlopt -o test_mandel graphics.cmxa mpi.cmxa test_mandel.ml -ccopt -L. 55 | 56 | test_pad: test_pad.ml mpi.cma 57 | ocamlc -o test_pad -I ../commons str.cma unix.cma ../commons/commons.cma mpi.cma test_pad.ml -ccopt -L. 58 | 59 | test2: 60 | mpirun -np 3 ./test_pad arg1 arg2 61 | 62 | clean:: 63 | rm -f test_mandel test_pad 64 | 65 | 66 | 67 | install: 68 | cp mpi.mli mpi.cmi mpi.cma mpi.cmxa mpi.a libcamlmpi.a $(DESTDIR) 69 | 70 | 71 | 72 | 73 | ############################################################################## 74 | .SUFFIXES: .ml .mli .cmo .cmi .cmx 75 | 76 | .ml.cmo: 77 | $(OCAMLC) -c $< 78 | .mli.cmi: 79 | $(OCAMLC) -c $< 80 | .ml.cmx: 81 | $(OCAMLOPT) -c $< 82 | 83 | clean:: 84 | rm -f *.cm* *.o *.a dll*.so 85 | depend: 86 | $(OCAMLDEP) *.ml > .depend 87 | gcc -MM $(CFLAGS) *.c >> .depend 88 | 89 | -include .depend 90 | 91 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/README: -------------------------------------------------------------------------------- 1 | This is OcamlMPI version 1.01, a Caml binding to the Message Passing 2 | Interface (MPI). 3 | 4 | 5 | WHAT IS MPI? 6 | 7 | MPI is a popular library for distributed-memory parallel programming 8 | in SPMD (single program, multiple data) style. 9 | 10 | MPI offers both point-to-point message passing and group communication 11 | operations (broadcast, scatter/gather, etc). 12 | 13 | Several implementations of MPI are available, both for networks of 14 | Unix workstations and for supercomputers with specialized communication 15 | networks. 16 | 17 | More info on MPI is available at: 18 | 19 | http://www.mcs.anl.gov/mpi/index.html 20 | 21 | MPICH is a popular, free implementation of MPI for network of 22 | Unix workstations. It is available at: 23 | 24 | http://www.mcs.anl.gov/mpi/mpich/index.html 25 | 26 | 27 | THE OCAMLMPI INTERFACE: 28 | 29 | OCamlMPI provides Caml bindings for a large subset of MPI functions. 30 | I omitted a number of MPI functions for which I had no use, though. 31 | The file mpi.mli in this directory lists the MPI functions provided, 32 | along with short documentation. See the MPI docs at the URLs above 33 | for more detailed info. 34 | 35 | Most communication functions come in five flavors: 36 | - one generic function operating on any data type (e.g. Mpi.send) 37 | - four specialized functions for the following types: 38 | int (Mpi.send_int) 39 | float (Mpi.send_float 40 | int array (Mpi.send_int_array) 41 | float array (Mpi.send_float_array) 42 | The generic function is simpler to use, and more general, but involves 43 | more overhead than the specialized functions. 44 | 45 | The data types that can be transmitted using the "generic" 46 | communication functions are those that can be marshaled by the 47 | Marshal.to_channel function (q.v.) with the Marshal.Closures option. 48 | That is: 49 | - all concrete data structures (base types, arrays, records, variant types) 50 | - function closures 51 | - but not objects 52 | - nor certain abstract types (in_channel, out_channel, Graphics.image). 53 | 54 | 55 | BUILDING OCAMLMPI: 56 | 57 | Edit the Makefile and set the MPIINCDIR, MPILIBDIR and DESTDIR 58 | variables to the right directories: 59 | 60 | MPIINCDIR directory containing the MPI include file 61 | MPILIBDIR directory containing the MPI library -lmpi 62 | DESTDIR where to install the OcamlMPI library 63 | 64 | Also adjust CC and CFLAGS if necessary. Then do "make all". 65 | 66 | For final installation: become super-user and do "make install". 67 | 68 | 69 | TESTING OCAMLMPI: 70 | 71 | There are two test programs included: 72 | testmpi is a regression test 73 | test_mandel is a parallel Mandelbrot set plotter 74 | 75 | 76 | USING OCAMLMPI: 77 | 78 | Bytecode: 79 | ocamlc -I +ocamlmpi mpi.cma 80 | 81 | Native-code: 82 | ocamlopt -I +ocamlmpi mpi.cmxa 83 | 84 | 85 | LICENSING: 86 | 87 | The OCamlMPI library is copyright 1998 INRIA and distributed under the 88 | terms of the GNU Library General Public License version 2, with a 89 | special exception on clause 6 described in the file LICENSE. 90 | 91 | 92 | AUTHOR AND SUPPORT: 93 | 94 | Written by Xavier Leroy . Bug reports are 95 | welcome, but I don't guarantee any support for this code. It is 96 | provided "as is". 97 | 98 | Questions about the following issues should be directed to MPI 99 | newsgroups, mailing-lists or implementation vendors, but not to me: 100 | semantics of MPI functions, how to program with MPI, finding and 101 | installing implementations of MPI, performance tuning of MPI 102 | applications, etc. 103 | 104 | 105 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/camlmpi.h: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id: camlmpi.h,v 1.6 2003/03/31 14:22:56 xleroy Exp $ */ 15 | 16 | /* Common definitions */ 17 | 18 | #define Comm_val(comm) (*((MPI_Comm *) &Field(comm, 1))) 19 | #define Group_val(comm) (*((MPI_Group *) &Field(comm, 1))) 20 | 21 | extern value caml_mpi_alloc_comm(MPI_Comm c); 22 | 23 | extern void caml_mpi_decode_intarray(value array, mlsize_t len); 24 | extern void caml_mpi_encode_intarray(value array, mlsize_t len); 25 | 26 | #ifdef ARCH_ALIGN_DOUBLE 27 | 28 | extern double * caml_mpi_input_floatarray(value data, mlsize_t len); 29 | extern double * caml_mpi_output_floatarray(value data, mlsize_t len); 30 | extern void caml_mpi_free_floatarray(double * d); 31 | extern void caml_mpi_commit_floatarray(double * d, value data, mlsize_t len); 32 | extern double * caml_mpi_input_floatarray_at_node(value data, mlsize_t len, 33 | value root, value comm); 34 | extern double * caml_mpi_output_floatarray_at_node(value data, mlsize_t len, 35 | value root, value comm); 36 | 37 | #else 38 | 39 | #define caml_mpi_input_floatarray(data,len) ((double *)(data)) 40 | #define caml_mpi_output_floatarray(data,len) ((double *)(data)) 41 | #define caml_mpi_free_floatarray(d) 42 | #define caml_mpi_commit_floatarray(d,data,len) 43 | #define caml_mpi_input_floatarray_at_node(data,len,root,comm) ((double *)(data)) 44 | #define caml_mpi_output_floatarray_at_node(data,len,root,comm) ((double *)(data)) 45 | 46 | #endif 47 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/collcomm.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id: collcomm.c,v 1.5 2003/03/31 14:38:36 xleroy Exp $ */ 15 | 16 | /* Group communication */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include "camlmpi.h" 23 | 24 | /* Barrier synchronization */ 25 | 26 | value caml_mpi_barrier(value comm) 27 | { 28 | MPI_Barrier(Comm_val(comm)); 29 | return Val_unit; 30 | } 31 | 32 | /* Broadcast */ 33 | 34 | value caml_mpi_broadcast(value buffer, value root, value comm) 35 | { 36 | MPI_Bcast(String_val(buffer), string_length(buffer), MPI_BYTE, 37 | Int_val(root), Comm_val(comm)); 38 | return Val_unit; 39 | } 40 | 41 | value caml_mpi_broadcast_int(value data, value root, value comm) 42 | { 43 | long n = Long_val(data); 44 | MPI_Bcast(&n, 1, MPI_LONG, Int_val(root), Comm_val(comm)); 45 | return Val_long(n); 46 | } 47 | 48 | value caml_mpi_broadcast_float(value data, value root, value comm) 49 | { 50 | double d = Double_val(data); 51 | MPI_Bcast(&d, 1, MPI_DOUBLE, Int_val(root), Comm_val(comm)); 52 | return copy_double(d); 53 | } 54 | 55 | value caml_mpi_broadcast_intarray(value data, value root, value comm) 56 | { 57 | MPI_Bcast(&Field(data, 0), Wosize_val(data), MPI_LONG, 58 | Int_val(root), Comm_val(comm)); 59 | return Val_unit; 60 | } 61 | 62 | value caml_mpi_broadcast_floatarray(value data, value root, value comm) 63 | { 64 | mlsize_t len = Wosize_val(data) / Double_wosize; 65 | double * d = caml_mpi_input_floatarray(data, len); 66 | MPI_Bcast(d, len, MPI_DOUBLE, Int_val(root), Comm_val(comm)); 67 | caml_mpi_commit_floatarray(d, data, len); 68 | return Val_unit; 69 | } 70 | 71 | /* Scatter */ 72 | 73 | static void caml_mpi_counts_displs(value lengths, 74 | /* out */ int ** counts, 75 | /* out */ int ** displs) 76 | { 77 | int size, disp, i; 78 | 79 | size = Wosize_val(lengths); 80 | if (size > 0) { 81 | *counts = stat_alloc(size * sizeof(int)); 82 | *displs = stat_alloc(size * sizeof(int)); 83 | for (i = 0, disp = 0; i < size; i++) { 84 | (*counts)[i] = Int_val(Field(lengths, i)); 85 | (*displs)[i] = disp; 86 | disp += (*counts)[i]; 87 | } 88 | } else { 89 | *counts = NULL; 90 | *displs = NULL; 91 | } 92 | } 93 | 94 | value caml_mpi_scatter(value sendbuf, value sendlengths, 95 | value recvbuf, 96 | value root, value comm) 97 | { 98 | int * sendcounts, * displs; 99 | 100 | caml_mpi_counts_displs(sendlengths, &sendcounts, &displs); 101 | MPI_Scatterv(String_val(sendbuf), sendcounts, displs, MPI_BYTE, 102 | String_val(recvbuf), string_length(recvbuf), MPI_BYTE, 103 | Int_val(root), Comm_val(comm)); 104 | if (sendcounts != NULL) { 105 | stat_free(sendcounts); 106 | stat_free(displs); 107 | } 108 | return Val_unit; 109 | } 110 | 111 | value caml_mpi_scatter_int(value data, value root, value comm) 112 | { 113 | value n; 114 | 115 | MPI_Scatter(&Field(data, 0), 1, MPI_LONG, 116 | &n, 1, MPI_LONG, 117 | Int_val(root), Comm_val(comm)); 118 | return n; 119 | } 120 | 121 | value caml_mpi_scatter_float(value data, value root, value comm) 122 | { 123 | mlsize_t len = Wosize_val(data) / Double_wosize; 124 | double * src = caml_mpi_input_floatarray(data, len); 125 | double dst; 126 | MPI_Scatter(src, 1, MPI_DOUBLE, &dst, 1, MPI_DOUBLE, 127 | Int_val(root), Comm_val(comm)); 128 | caml_mpi_free_floatarray(src); 129 | return copy_double(dst); 130 | } 131 | 132 | value caml_mpi_scatter_intarray(value source, value dest, 133 | value root, value comm) 134 | { 135 | mlsize_t len = Wosize_val(dest); 136 | MPI_Scatter(&Field(source, 0), len, MPI_LONG, 137 | &Field(dest, 0), len, MPI_LONG, 138 | Int_val(root), Comm_val(comm)); 139 | return Val_unit; 140 | } 141 | 142 | value caml_mpi_scatter_floatarray(value source, value dest, 143 | value root, value comm) 144 | { 145 | mlsize_t srclen = Wosize_val(source) / Double_wosize; 146 | mlsize_t len = Wosize_val(dest) / Double_wosize; 147 | double * src = caml_mpi_input_floatarray_at_node(source, srclen, root, comm); 148 | double * dst = caml_mpi_output_floatarray(dest, len); 149 | 150 | MPI_Scatter(src, len, MPI_DOUBLE, dst, len, MPI_DOUBLE, 151 | Int_val(root), Comm_val(comm)); 152 | caml_mpi_free_floatarray(src); 153 | caml_mpi_commit_floatarray(dst, dest, len); 154 | return Val_unit; 155 | } 156 | 157 | /* Gather */ 158 | 159 | value caml_mpi_gather(value sendbuf, 160 | value recvbuf, value recvlengths, 161 | value root, value comm) 162 | { 163 | int * recvcounts, * displs; 164 | 165 | caml_mpi_counts_displs(recvlengths, &recvcounts, &displs); 166 | MPI_Gatherv(String_val(sendbuf), string_length(sendbuf), MPI_BYTE, 167 | String_val(recvbuf), recvcounts, displs, MPI_BYTE, 168 | Int_val(root), Comm_val(comm)); 169 | if (recvcounts != NULL) { 170 | stat_free(recvcounts); 171 | stat_free(displs); 172 | } 173 | return Val_unit; 174 | } 175 | 176 | value caml_mpi_gather_int(value data, value result, value root, value comm) 177 | { 178 | MPI_Gather(&data, 1, MPI_LONG, 179 | &Field(result, 0), 1, MPI_LONG, 180 | Int_val(root), Comm_val(comm)); 181 | return Val_unit; 182 | } 183 | 184 | value caml_mpi_gather_intarray(value data, value result, 185 | value root, value comm) 186 | { 187 | mlsize_t len = Wosize_val(data); 188 | MPI_Gather(&Field(data, 0), len, MPI_LONG, 189 | &Field(result, 0), len, MPI_LONG, 190 | Int_val(root), Comm_val(comm)); 191 | return Val_unit; 192 | } 193 | 194 | value caml_mpi_gather_float(value data, value result, value root, value comm) 195 | { 196 | mlsize_t len = Wosize_val(data) / Double_wosize; 197 | mlsize_t reslen = Wosize_val(result) / Double_wosize; 198 | double * d = caml_mpi_input_floatarray(data, len); 199 | double * res = 200 | caml_mpi_output_floatarray_at_node(result, reslen, root, comm); 201 | MPI_Gather(d, len, MPI_DOUBLE, res, len, MPI_DOUBLE, 202 | Int_val(root), Comm_val(comm)); 203 | caml_mpi_free_floatarray(d); 204 | caml_mpi_commit_floatarray(res, result, reslen); 205 | return Val_unit; 206 | } 207 | 208 | /* Gather to all */ 209 | 210 | value caml_mpi_allgather(value sendbuf, 211 | value recvbuf, value recvlengths, 212 | value comm) 213 | { 214 | int * recvcounts, * displs; 215 | 216 | caml_mpi_counts_displs(recvlengths, &recvcounts, &displs); 217 | MPI_Allgatherv(String_val(sendbuf), string_length(sendbuf), MPI_BYTE, 218 | String_val(recvbuf), recvcounts, displs, MPI_BYTE, 219 | Comm_val(comm)); 220 | stat_free(recvcounts); 221 | stat_free(displs); 222 | return Val_unit; 223 | } 224 | 225 | value caml_mpi_allgather_int(value data, value result, value comm) 226 | { 227 | MPI_Allgather(&data, 1, MPI_LONG, 228 | &Field(result, 0), 1, MPI_LONG, 229 | Comm_val(comm)); 230 | return Val_unit; 231 | } 232 | 233 | value caml_mpi_allgather_intarray(value data, value result, value comm) 234 | { 235 | mlsize_t len = Wosize_val(data); 236 | MPI_Allgather(&Field(data, 0), len, MPI_LONG, 237 | &Field(result, 0), len, MPI_LONG, 238 | Comm_val(comm)); 239 | return Val_unit; 240 | } 241 | 242 | value caml_mpi_allgather_float(value data, value result, value comm) 243 | { 244 | mlsize_t len = Wosize_val(data) / Double_wosize; 245 | mlsize_t reslen = Wosize_val(result) / Double_wosize; 246 | double * d = caml_mpi_input_floatarray(data, len); 247 | double * res = caml_mpi_output_floatarray(result, reslen); 248 | 249 | MPI_Allgather(d, len, MPI_DOUBLE, res, len, MPI_DOUBLE, 250 | Comm_val(comm)); 251 | caml_mpi_free_floatarray(d); 252 | caml_mpi_commit_floatarray(res, result, reslen); 253 | return Val_unit; 254 | } 255 | 256 | /* Reduce */ 257 | 258 | static MPI_Op reduce_intop[] = 259 | { MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD, MPI_BAND, MPI_BOR, MPI_BXOR }; 260 | static MPI_Op reduce_floatop[] = 261 | { MPI_MAX, MPI_MIN, MPI_SUM, MPI_PROD }; 262 | 263 | value caml_mpi_reduce_int(value data, value op, value root, value comm) 264 | { 265 | long d = Long_val(data); 266 | long r = 0; 267 | MPI_Reduce(&d, &r, 1, MPI_LONG, 268 | reduce_intop[Int_val(op)], Int_val(root), Comm_val(comm)); 269 | return Val_long(r); 270 | } 271 | 272 | value caml_mpi_reduce_intarray(value data, value result, value op, 273 | value root, value comm) 274 | { 275 | mlsize_t len = Wosize_val(data); 276 | int i, myrank; 277 | /* Decode data at all nodes in place */ 278 | caml_mpi_decode_intarray(data, len); 279 | for (i = 0; i < len; i++) Field(data, i) = Long_val(Field(data, i)); 280 | /* Do the reduce */ 281 | MPI_Reduce(&Field(data, 0), &Field(result, 0), len, MPI_LONG, 282 | reduce_intop[Int_val(op)], Int_val(root), Comm_val(comm)); 283 | /* Re-encode data at all nodes in place */ 284 | caml_mpi_encode_intarray(data, len); 285 | /* At root node, also encode result */ 286 | MPI_Comm_rank(Comm_val(comm), &myrank); 287 | if (myrank == Int_val(root)) caml_mpi_encode_intarray(result, len); 288 | return Val_unit; 289 | } 290 | 291 | value caml_mpi_reduce_float(value data, value op, value root, value comm) 292 | { 293 | double d = Double_val(data); 294 | double r = 0.0; 295 | MPI_Reduce(&d, &r, 1, MPI_DOUBLE, 296 | reduce_floatop[Int_val(op)], Int_val(root), Comm_val(comm)); 297 | return copy_double(r); 298 | } 299 | 300 | value caml_mpi_reduce_floatarray(value data, value result, value op, 301 | value root, value comm) 302 | { 303 | mlsize_t len = Wosize_val(data) / Double_wosize; 304 | double * d = caml_mpi_input_floatarray(data, len); 305 | double * res = caml_mpi_output_floatarray(result, len); 306 | 307 | MPI_Reduce(d, res, len, MPI_DOUBLE, 308 | reduce_floatop[Int_val(op)], Int_val(root), Comm_val(comm)); 309 | caml_mpi_free_floatarray(d); 310 | caml_mpi_commit_floatarray(res, result, len); 311 | return Val_unit; 312 | } 313 | 314 | /* Allreduce */ 315 | 316 | value caml_mpi_allreduce_int(value data, value op, value comm) 317 | { 318 | long d = Long_val(data); 319 | long r; 320 | MPI_Allreduce(&d, &r, 1, MPI_LONG, 321 | reduce_intop[Int_val(op)], Comm_val(comm)); 322 | return Val_long(r); 323 | } 324 | 325 | value caml_mpi_allreduce_intarray(value data, value result, value op, 326 | value comm) 327 | { 328 | mlsize_t len = Wosize_val(data); 329 | /* Decode data at all nodes in place */ 330 | caml_mpi_decode_intarray(data, len); 331 | /* Do the reduce */ 332 | MPI_Allreduce(&Field(data, 0), &Field(result, 0), len, MPI_LONG, 333 | reduce_intop[Int_val(op)], Comm_val(comm)); 334 | /* Re-encode data at all nodes in place */ 335 | caml_mpi_encode_intarray(data, len); 336 | /* Re-encode result at all nodes in place */ 337 | caml_mpi_encode_intarray(result, len); 338 | return Val_unit; 339 | } 340 | 341 | value caml_mpi_allreduce_float(value data, value op, value comm) 342 | { 343 | double d = Double_val(data); 344 | double r; 345 | MPI_Allreduce(&d, &r, 1, MPI_DOUBLE, 346 | reduce_floatop[Int_val(op)], Comm_val(comm)); 347 | return copy_double(r); 348 | } 349 | 350 | value caml_mpi_allreduce_floatarray(value data, value result, value op, 351 | value comm) 352 | { 353 | mlsize_t len = Wosize_val(data) / Double_wosize; 354 | double * d = caml_mpi_input_floatarray(data, len); 355 | double * res = caml_mpi_output_floatarray(result, len); 356 | 357 | MPI_Allreduce(d, res, len, MPI_DOUBLE, 358 | reduce_floatop[Int_val(op)], Comm_val(comm)); 359 | caml_mpi_free_floatarray(d); 360 | caml_mpi_commit_floatarray(res, result, len); 361 | return Val_unit; 362 | } 363 | 364 | /* Scan */ 365 | 366 | value caml_mpi_scan_int(value data, value op, value comm) 367 | { 368 | long d = Long_val(data); 369 | long r; 370 | 371 | MPI_Scan(&d, &r, 1, MPI_LONG, reduce_intop[Int_val(op)], Comm_val(comm)); 372 | return Val_long(r); 373 | } 374 | 375 | value caml_mpi_scan_intarray(value data, value result, value op, value comm) 376 | { 377 | mlsize_t len = Wosize_val(data); 378 | 379 | /* Decode data at all nodes in place */ 380 | caml_mpi_decode_intarray(data, len); 381 | /* Do the scan */ 382 | MPI_Scan(&Field(data, 0), &Field(result, 0), len, MPI_LONG, 383 | reduce_intop[Int_val(op)], Comm_val(comm)); 384 | /* Re-encode data at all nodes in place */ 385 | caml_mpi_encode_intarray(data, len); 386 | /* Encode result */ 387 | caml_mpi_encode_intarray(result, len); 388 | return Val_unit; 389 | } 390 | 391 | value caml_mpi_scan_float(value data, value op, value comm) 392 | { 393 | double d = Double_val(data), r; 394 | 395 | MPI_Scan(&d, &r, 1, MPI_DOUBLE, 396 | reduce_floatop[Int_val(op)], Comm_val(comm)); 397 | return copy_double(r); 398 | } 399 | 400 | value caml_mpi_scan_floatarray(value data, value result, value op, value comm) 401 | { 402 | mlsize_t len = Wosize_val(data) / Double_wosize; 403 | double * d = caml_mpi_input_floatarray(data, len); 404 | double * res = caml_mpi_output_floatarray(result, len); 405 | 406 | MPI_Scan(d, res, len, MPI_DOUBLE, 407 | reduce_floatop[Int_val(op)], Comm_val(comm)); 408 | caml_mpi_free_floatarray(d); 409 | caml_mpi_commit_floatarray(res, result, len); 410 | return Val_unit; 411 | } 412 | 413 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/comm.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id: comm.c,v 1.7 2003/03/31 14:38:36 xleroy Exp $ */ 15 | 16 | /* Handling of communicators */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include "camlmpi.h" 23 | 24 | static void caml_mpi_finalize_comm(value v) 25 | { 26 | MPI_Comm_free(&Comm_val(v)); 27 | } 28 | 29 | value caml_mpi_alloc_comm(MPI_Comm c) 30 | { 31 | value res = 32 | alloc_final(1 + (sizeof(MPI_Comm) + sizeof(value) - 1) / sizeof(value), 33 | caml_mpi_finalize_comm, 1, 100); 34 | Comm_val(res) = c; 35 | return res; 36 | } 37 | 38 | value caml_mpi_get_comm_world(value unit) 39 | { 40 | return caml_mpi_alloc_comm(MPI_COMM_WORLD); 41 | } 42 | 43 | value caml_mpi_comm_size(value comm) 44 | { 45 | int size; 46 | MPI_Comm_size(Comm_val(comm), &size); 47 | return Val_int(size); 48 | } 49 | 50 | value caml_mpi_comm_rank(value comm) 51 | { 52 | int rank; 53 | MPI_Comm_rank(Comm_val(comm), &rank); 54 | return Val_int(rank); 55 | } 56 | 57 | value caml_mpi_comm_compare(value comm1, value comm2) 58 | { 59 | int res; 60 | MPI_Comm_compare(Comm_val(comm1), Comm_val(comm2), &res); 61 | return Val_bool(res); 62 | } 63 | 64 | value caml_mpi_comm_split(value comm, value color, value key) 65 | { 66 | MPI_Comm newcomm; 67 | MPI_Comm_split(Comm_val(comm), Int_val(color), Int_val(key), &newcomm); 68 | return caml_mpi_alloc_comm(newcomm); 69 | } 70 | 71 | value caml_mpi_get_undefined(value unit) 72 | { 73 | return Val_int(MPI_UNDEFINED); 74 | } 75 | 76 | value caml_mpi_cart_create(value comm, value vdims, value vperiods, 77 | value reorder) 78 | { 79 | int ndims = Wosize_val(vdims); 80 | int * dims = stat_alloc(ndims * sizeof(int)); 81 | int * periods = stat_alloc(ndims * sizeof(int)); 82 | int i; 83 | MPI_Comm newcomm; 84 | 85 | for (i = 0; i < ndims; i++) dims[i] = Int_val(Field(vdims, i)); 86 | for (i = 0; i < ndims; i++) periods[i] = Int_val(Field(vperiods, i)); 87 | MPI_Cart_create(Comm_val(comm), ndims, dims, periods, 88 | Bool_val(reorder), &newcomm); 89 | stat_free(dims); 90 | stat_free(periods); 91 | return caml_mpi_alloc_comm(newcomm); 92 | } 93 | 94 | value caml_mpi_dims_create(value vnnodes, value vdims) 95 | { 96 | int ndims = Wosize_val(vdims); 97 | int * dims = stat_alloc(ndims * sizeof(int)); 98 | int i; 99 | value res; 100 | 101 | for (i = 0; i < ndims; i++) dims[i] = Int_val(Field(vdims, i)); 102 | MPI_Dims_create(Int_val(vnnodes), ndims, dims); 103 | res = alloc_tuple(ndims); 104 | for (i = 0; i < ndims; i++) Field(res, i) = Val_int(dims[i]); 105 | stat_free(dims); 106 | return res; 107 | } 108 | 109 | value caml_mpi_cart_rank(value comm, value vcoords) 110 | { 111 | int ndims = Wosize_val(vcoords); 112 | int * coords = stat_alloc(ndims * sizeof(int)); 113 | int i, rank; 114 | 115 | for (i = 0; i < ndims; i++) coords[i] = Int_val(Field(vcoords, i)); 116 | MPI_Cart_rank(Comm_val(comm), coords, &rank); 117 | stat_free(coords); 118 | return Val_int(rank); 119 | } 120 | 121 | value caml_mpi_cart_coords(value comm, value rank) 122 | { 123 | int ndims, i; 124 | int * coords; 125 | value res; 126 | 127 | MPI_Cartdim_get(Comm_val(comm), &ndims); 128 | coords = stat_alloc(ndims * sizeof(int)); 129 | MPI_Cart_coords(Comm_val(comm), Int_val(rank), ndims, coords); 130 | res = alloc_tuple(ndims); 131 | for (i = 0; i < ndims; i++) Field(res, i) = Val_int(coords[i]); 132 | stat_free(coords); 133 | return res; 134 | } 135 | 136 | value caml_mpi_comm_create(value comm, value group) 137 | { 138 | MPI_Comm newcomm; 139 | MPI_Comm_create(Comm_val(comm), Group_val(group), &newcomm); 140 | return caml_mpi_alloc_comm(newcomm); 141 | } 142 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/groups.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id: groups.c,v 1.2 2003/03/31 14:38:37 xleroy Exp $ */ 15 | 16 | /* Handling of groups */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include "camlmpi.h" 23 | 24 | static void caml_mpi_finalize_group(value v) 25 | { 26 | MPI_Group_free(&Group_val(v)); 27 | } 28 | 29 | value caml_mpi_alloc_group(MPI_Group g) 30 | { 31 | value res = 32 | alloc_final(1 + (sizeof(MPI_Group) + sizeof(value) - 1) / sizeof(value), 33 | caml_mpi_finalize_group, 1, 100); 34 | Group_val(res) = g; 35 | return res; 36 | } 37 | 38 | value caml_mpi_group_size(value group) 39 | { 40 | int size; 41 | MPI_Group_size(Group_val(group), &size); 42 | return Val_int(size); 43 | } 44 | 45 | value caml_mpi_group_rank(value group) 46 | { 47 | int size; 48 | MPI_Group_rank(Group_val(group), &size); 49 | return Val_int(size); 50 | } 51 | 52 | value caml_mpi_group_translate_ranks(value group1, value ranks, value group2) 53 | { 54 | int n = Wosize_val(ranks); 55 | int * ranks1 = stat_alloc(n * sizeof(int)); 56 | int * ranks2 = stat_alloc(n * sizeof(int)); 57 | int i; 58 | value res; 59 | 60 | for (i = 0; i < n; i++) ranks1[i] = Int_val(Field(ranks, i)); 61 | MPI_Group_translate_ranks(Group_val(group1), n, ranks1, 62 | Group_val(group2), ranks2); 63 | res = alloc(n, 0); 64 | for (i = 0; i < n; i++) Field(res, i) = Val_int(ranks2[i]); 65 | stat_free(ranks1); 66 | stat_free(ranks2); 67 | return res; 68 | } 69 | 70 | value caml_mpi_comm_group(value comm) 71 | { 72 | MPI_Group group; 73 | MPI_Comm_group(Comm_val(comm), &group); 74 | return caml_mpi_alloc_group(group); 75 | } 76 | 77 | value caml_mpi_group_union(value group1, value group2) 78 | { 79 | MPI_Group group; 80 | MPI_Group_union(Group_val(group1), Group_val(group2), &group); 81 | return caml_mpi_alloc_group(group); 82 | } 83 | 84 | value caml_mpi_group_difference(value group1, value group2) 85 | { 86 | MPI_Group group; 87 | MPI_Group_difference(Group_val(group1), Group_val(group2), &group); 88 | return caml_mpi_alloc_group(group); 89 | } 90 | 91 | value caml_mpi_group_intersection(value group1, value group2) 92 | { 93 | MPI_Group group; 94 | MPI_Group_intersection(Group_val(group1), Group_val(group2), &group); 95 | return caml_mpi_alloc_group(group); 96 | } 97 | 98 | value caml_mpi_group_incl(value group, value vranks) 99 | { 100 | MPI_Group newgroup; 101 | int n = Wosize_val(vranks); 102 | int * ranks = stat_alloc(n * sizeof(int)); 103 | int i; 104 | 105 | for (i = 0; i < n; i++) ranks[i] = Int_val(Field(vranks, i)); 106 | MPI_Group_incl(Group_val(group), n, ranks, &newgroup); 107 | stat_free(ranks); 108 | return caml_mpi_alloc_group(newgroup); 109 | } 110 | 111 | value caml_mpi_group_excl(value group, value vranks) 112 | { 113 | MPI_Group newgroup; 114 | int n = Wosize_val(vranks); 115 | int * ranks = stat_alloc(n * sizeof(int)); 116 | int i; 117 | 118 | for (i = 0; i < n; i++) ranks[i] = Int_val(Field(vranks, i)); 119 | MPI_Group_excl(Group_val(group), n, ranks, &newgroup); 120 | stat_free(ranks); 121 | return caml_mpi_alloc_group(newgroup); 122 | } 123 | 124 | static void caml_mpi_extract_ranges(value vranges, 125 | /*out*/ int * num, 126 | /*out*/ int (**rng)[3]) 127 | { 128 | int n = Wosize_val(vranges); 129 | int (*ranges)[3] = stat_alloc(n * sizeof(int[3])); 130 | int i; 131 | for (i = 0; i < n; i++) { 132 | value rng = Field(vranges, i); 133 | ranges[n][0] = Int_val(Field(rng, 0)); 134 | ranges[n][1] = Int_val(Field(rng, 1)); 135 | ranges[n][2] = Int_val(Field(rng, 2)); 136 | } 137 | *num = n; 138 | *rng = ranges; 139 | } 140 | 141 | value caml_mpi_group_range_incl(value group, value vranges) 142 | { 143 | int num; 144 | int (*ranges)[3]; 145 | MPI_Group newgroup; 146 | caml_mpi_extract_ranges(vranges, &num, &ranges); 147 | MPI_Group_range_incl(Group_val(group), num, ranges, &newgroup); 148 | stat_free(ranges); 149 | return caml_mpi_alloc_group(newgroup); 150 | } 151 | 152 | value caml_mpi_group_range_excl(value group, value vranges) 153 | { 154 | int num; 155 | int (*ranges)[3]; 156 | MPI_Group newgroup; 157 | caml_mpi_extract_ranges(vranges, &num, &ranges); 158 | MPI_Group_range_excl(Group_val(group), num, ranges, &newgroup); 159 | stat_free(ranges); 160 | return caml_mpi_alloc_group(newgroup); 161 | } 162 | 163 | 164 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/init.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id: init.c,v 1.5 2003/03/31 14:38:37 xleroy Exp $ */ 15 | 16 | /* Initialization and error handling */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include 23 | #include 24 | #include "camlmpi.h" 25 | 26 | /* Error handling */ 27 | 28 | static value * caml_mpi_exn = NULL; 29 | 30 | static void caml_mpi_error_handler(MPI_Comm * comm, int * errcode, ...) 31 | { 32 | char errmsg[MPI_MAX_ERROR_STRING + 1]; 33 | int resultlen; 34 | value msg; 35 | 36 | MPI_Error_string(*errcode, errmsg, &resultlen); 37 | msg = copy_string(errmsg); 38 | if (caml_mpi_exn == NULL) { 39 | caml_mpi_exn = caml_named_value("Mpi.Error"); 40 | if (caml_mpi_exn == NULL) 41 | invalid_argument("Exception MPI.Error not initialized"); 42 | } 43 | raise_with_arg(*caml_mpi_exn, msg); 44 | } 45 | 46 | /* Initialization and finalization */ 47 | 48 | value caml_mpi_init(value arguments) 49 | { 50 | int argc, i; 51 | char ** argv; 52 | MPI_Errhandler hdlr; 53 | 54 | argc = Wosize_val(arguments); 55 | argv = stat_alloc((argc + 1) * sizeof(char *)); 56 | for (i = 0; i < argc; i++) argv[i] = String_val(Field(arguments, i)); 57 | argv[i] = NULL; 58 | MPI_Init(&argc, &argv); 59 | /* Register an error handler */ 60 | MPI_Errhandler_create((MPI_Handler_function *)caml_mpi_error_handler, &hdlr); 61 | MPI_Errhandler_set(MPI_COMM_WORLD, hdlr); 62 | return Val_unit; 63 | } 64 | 65 | value caml_mpi_finalize(value unit) 66 | { 67 | MPI_Finalize(); 68 | return Val_unit; 69 | } 70 | 71 | value caml_mpi_wtime(value unit) 72 | { 73 | return copy_double(MPI_Wtime()); 74 | } 75 | 76 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/modif-orig.TXT: -------------------------------------------------------------------------------- 1 | it's version 1.01 from xavier leroy homepage 2 | 3 | added: 4 | test_map.ml 5 | generate library with ocamlmklib et linkall 6 | 7 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/msgs.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id: msgs.c,v 1.6 2003/03/31 14:22:57 xleroy Exp $ */ 15 | 16 | /* Point-to-point communication */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include 22 | #include "camlmpi.h" 23 | 24 | extern void output_value_to_malloc(value v, value flags, 25 | /*out*/ char ** buf, /*out*/ long * len); 26 | extern value input_value_from_malloc(char * data, long ofs); 27 | 28 | /* Sending */ 29 | 30 | value caml_mpi_send(value data, value flags, 31 | value dest, value tag, value vcomm) 32 | { 33 | MPI_Comm comm = Comm_val(vcomm); 34 | char * buffer; 35 | long len; 36 | 37 | Begin_root(vcomm) /* prevent deallocation of communicator */ 38 | output_value_to_malloc(data, flags, &buffer, &len); 39 | /* This also allocates the buffer */ 40 | enter_blocking_section(); 41 | MPI_Send(buffer, len, MPI_BYTE, Int_val(dest), Int_val(tag), comm); 42 | leave_blocking_section(); 43 | End_roots(); 44 | stat_free(buffer); 45 | return Val_unit; 46 | } 47 | 48 | value caml_mpi_send_int(value data, value dest, value tag, value comm) 49 | { 50 | long n = Long_val(data); 51 | MPI_Send(&n, 1, MPI_LONG, Int_val(dest), Int_val(tag), Comm_val(comm)); 52 | return Val_unit; 53 | } 54 | 55 | value caml_mpi_send_intarray(value data, value dest, value tag, value comm) 56 | { 57 | MPI_Send(&Field(data, 0), Wosize_val(data), MPI_LONG, 58 | Int_val(dest), Int_val(tag), Comm_val(comm)); 59 | return Val_unit; 60 | } 61 | 62 | value caml_mpi_send_float(value data, value dest, value tag, value comm) 63 | { 64 | mlsize_t len = Wosize_val(data) / Double_wosize; 65 | double * d = caml_mpi_input_floatarray(data, len); 66 | 67 | MPI_Send(d, len, MPI_DOUBLE, Int_val(dest), Int_val(tag), Comm_val(comm)); 68 | caml_mpi_free_floatarray(d); 69 | return Val_unit; 70 | } 71 | 72 | /* Probe for pending messages and determine length */ 73 | 74 | value caml_mpi_probe(value source, value tag, value comm) 75 | { 76 | MPI_Status status; 77 | int count; 78 | value res; 79 | 80 | MPI_Probe(Int_val(source), Int_val(tag), Comm_val(comm), &status); 81 | MPI_Get_count(&status, MPI_BYTE, &count); 82 | res = alloc_tuple(3); 83 | Field(res, 0) = Val_int(count); 84 | Field(res, 1) = Val_int(status.MPI_SOURCE); 85 | Field(res, 2) = Val_int(status.MPI_TAG); 86 | return res; 87 | } 88 | 89 | /* Receive */ 90 | 91 | value caml_mpi_receive(value vlen, value source, value tag, value vcomm) 92 | { 93 | MPI_Comm comm = Comm_val(vcomm); 94 | mlsize_t len = Long_val(vlen); 95 | char * buffer; 96 | MPI_Status status; 97 | value res; 98 | 99 | Begin_root(vcomm) /* prevent deallocation of communicator */ 100 | buffer = stat_alloc(len); 101 | enter_blocking_section(); 102 | MPI_Recv(buffer, len, MPI_BYTE, 103 | Int_val(source), Int_val(tag), comm, &status); 104 | leave_blocking_section(); 105 | res = input_value_from_malloc(buffer, 0); 106 | /* This also deallocates the buffer */ 107 | End_roots(); 108 | return res; 109 | } 110 | 111 | value caml_mpi_receive_int(value source, value tag, value comm) 112 | { 113 | MPI_Status status; 114 | long n; 115 | 116 | MPI_Recv(&n, 1, MPI_LONG, 117 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 118 | return Val_long(n); 119 | } 120 | 121 | value caml_mpi_receive_intarray(value data, value source, value tag, value comm) 122 | { 123 | MPI_Status status; 124 | 125 | MPI_Recv(&Field(data, 0), Wosize_val(data), MPI_LONG, 126 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 127 | return Val_unit; 128 | } 129 | 130 | value caml_mpi_receive_float(value source, value tag, value comm) 131 | { 132 | MPI_Status status; 133 | double d; 134 | 135 | MPI_Recv(&d, 1 , MPI_DOUBLE, 136 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 137 | return copy_double(d); 138 | } 139 | 140 | value caml_mpi_receive_floatarray(value data, value source, value tag, value comm) 141 | { 142 | MPI_Status status; 143 | mlsize_t len = Wosize_val(data) / Double_wosize; 144 | double * d = caml_mpi_output_floatarray(data, len); 145 | 146 | MPI_Recv(d, len, MPI_DOUBLE, 147 | Int_val(source), Int_val(tag), Comm_val(comm), &status); 148 | caml_mpi_commit_floatarray(d, data, len); 149 | return Val_unit; 150 | } 151 | 152 | /* Auxiliaries */ 153 | 154 | value caml_mpi_get_any_tag(value unit) 155 | { 156 | return Val_int(MPI_ANY_TAG); 157 | } 158 | 159 | value caml_mpi_get_any_source(value unit) 160 | { 161 | return Val_int(MPI_ANY_SOURCE); 162 | } 163 | 164 | 165 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/test_mandel.ml: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* The Caml/MPI interface *) 4 | (* *) 5 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6 | (* *) 7 | (* Copyright 1998 Institut National de Recherche en Informatique et *) 8 | (* en Automatique. All rights reserved. This file is distributed *) 9 | (* under the terms of the GNU Library General Public License, with *) 10 | (* the special exception on linking described in file LICENSE. *) 11 | (* *) 12 | (***********************************************************************) 13 | 14 | (* $Id: test_mandel.ml,v 1.2 2003/03/31 14:22:57 xleroy Exp $ *) 15 | 16 | open Graphics 17 | 18 | (* compute the color of a pixel *) 19 | let color_pixel cr ci res = 20 | let zr = ref cr in 21 | let zi = ref ci in 22 | let c = ref 0 in 23 | while !c < res && !zr *. !zr +. !zi *. !zi <= 4.0 do 24 | let nzr = !zr *. !zr -. !zi *. !zi -. cr 25 | and nzi = 2.0 *. !zr *. !zi -. ci in 26 | zr := nzr; 27 | zi := nzi; 28 | c := !c + 1 29 | done; 30 | !c 31 | 32 | (* compute a displayable color *) 33 | let color_factor = 255*255*255+255*255+255 34 | let colorof c res = c * color_factor / res 35 | 36 | (* produce a line *) 37 | let mandel_row (x0,y0,x1,y1) n res j = 38 | let dx = (x1-.x0)/.(float n) in 39 | let dy = (y1-.y0)/.(float n) in 40 | let zi = y0 +. (dy *. (float j)) in 41 | let line = Array.create n black in 42 | for i = 0 to n - 1 do 43 | let zr = x0 +. (dx *. (float i)) in 44 | line.(i) <- colorof (color_pixel zr zi res) res 45 | done; 46 | (j, line) 47 | 48 | (* Worker function: produce lines and send them to display *) 49 | 50 | let worker window n res = 51 | try 52 | while true do 53 | let j = Mpi.receive_int 0 0 Mpi.comm_world in 54 | if j >= n then raise Exit; 55 | Mpi.send (mandel_row window n res j) 0 0 Mpi.comm_world 56 | done 57 | with Exit -> () 58 | 59 | (* Plot one line *) 60 | let plot_row (j, line) = 61 | draw_image (make_image [| line |]) 0 j 62 | 63 | (* Server function: distribute work and plot the lines *) 64 | 65 | let server n = 66 | open_graph (Printf.sprintf " %dx%d" n n); 67 | let numworkers = Mpi.comm_size Mpi.comm_world - 1 in 68 | (* Send initial work *) 69 | for i = 1 to numworkers do 70 | Mpi.send_int (i - 1) i 0 Mpi.comm_world 71 | done; 72 | (* Enter server loop *) 73 | let numlines = ref n in 74 | let nextline = ref numworkers in 75 | while !numlines > 0 do 76 | let (row, src, _) = Mpi.receive_status Mpi.any_source 0 Mpi.comm_world in 77 | Mpi.send_int !nextline src 0 Mpi.comm_world; 78 | incr nextline; 79 | plot_row row; 80 | decr numlines 81 | done; 82 | print_string "Press to terminate..."; flush stdout; read_line(); () 83 | 84 | (* Entry point *) 85 | 86 | let _ = 87 | let window = (-1.0, -1.0, 2.0, 1.0) in 88 | let n = 500 in 89 | if Mpi.comm_rank Mpi.comm_world = 0 90 | then server n 91 | else worker window n 500; 92 | Mpi.barrier Mpi.comm_world 93 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/test_pad: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/demos/mapreduce/ocamlmpi/test_pad -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/test_pad.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | let server () = 4 | let numworkers = Mpi.comm_size Mpi.comm_world - 1 in 5 | begin 6 | 7 | pr2 ("server"); 8 | end 9 | 10 | let worker rank = 11 | begin 12 | pr2 (spf "worker: %d" rank); 13 | end 14 | 15 | let main () = 16 | match Array.to_list Sys.argv with 17 | | xs -> 18 | let rank = Mpi.comm_rank Mpi.comm_world in 19 | if rank = 0 20 | then begin 21 | xs +> List.iter pr2; 22 | server () 23 | end 24 | else begin 25 | xs +> List.iter pr2; 26 | worker rank 27 | end 28 | (* Mpi.barrier Mpi.comm_world *) 29 | 30 | | _ -> failwith "not enough arg" 31 | 32 | 33 | let _ = 34 | main () 35 | -------------------------------------------------------------------------------- /demos/mapreduce/ocamlmpi/utils.c: -------------------------------------------------------------------------------- 1 | /***********************************************************************/ 2 | /* */ 3 | /* The Caml/MPI interface */ 4 | /* */ 5 | /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ 6 | /* */ 7 | /* Copyright 1998 Institut National de Recherche en Informatique et */ 8 | /* en Automatique. All rights reserved. This file is distributed */ 9 | /* under the terms of the GNU Library General Public License, with */ 10 | /* the special exception on linking described in file LICENSE. */ 11 | /* */ 12 | /***********************************************************************/ 13 | 14 | /* $Id: utils.c,v 1.2 2003/03/31 14:22:57 xleroy Exp $ */ 15 | 16 | /* Utility functions on arrays */ 17 | 18 | #include 19 | #include 20 | #include 21 | #include "camlmpi.h" 22 | 23 | void caml_mpi_decode_intarray(value data, mlsize_t len) 24 | { 25 | mlsize_t i; 26 | for (i = 0; i < len; i++) Field(data, i) = Long_val(Field(data, i)); 27 | } 28 | 29 | void caml_mpi_encode_intarray(value data, mlsize_t len) 30 | { 31 | mlsize_t i; 32 | for (i = 0; i < len; i++) Field(data, i) = Val_long(Field(data, i)); 33 | } 34 | 35 | #ifdef ARCH_ALIGN_DOUBLE 36 | 37 | double * caml_mpi_input_floatarray(value data, mlsize_t len) 38 | { 39 | double * d = stat_alloc(len * sizeof(double)); 40 | bcopy((double *) data, d, len * sizeof(double)); 41 | return d; 42 | } 43 | 44 | double * caml_mpi_output_floatarray(value data, mlsize_t len) 45 | { 46 | return stat_alloc(len * sizeof(double)); 47 | } 48 | 49 | void caml_mpi_free_floatarray(double * d) 50 | { 51 | if (d != NULL) stat_free(d); 52 | } 53 | 54 | void caml_mpi_commit_floatarray(double * d, value data, mlsize_t len) 55 | { 56 | if (d != NULL) { 57 | bcopy(d, (double *) data, len * sizeof(double)); 58 | stat_free(d); 59 | } 60 | } 61 | 62 | double * caml_mpi_input_floatarray_at_node(value data, mlsize_t len, 63 | value root, value comm) 64 | { 65 | int myrank; 66 | MPI_Comm_rank(Comm_val(comm), &myrank); 67 | if (myrank == Int_val(root)) 68 | return caml_mpi_input_floatarray(data, len); 69 | else 70 | return NULL; 71 | } 72 | 73 | double * caml_mpi_output_floatarray_at_node(value data, mlsize_t len, 74 | value root, value comm) 75 | { 76 | int myrank; 77 | MPI_Comm_rank(Comm_val(comm), &myrank); 78 | if (myrank == Int_val(root)) 79 | return caml_mpi_output_floatarray(data, len); 80 | else 81 | return NULL; 82 | } 83 | 84 | #endif 85 | -------------------------------------------------------------------------------- /demos/mapreduce/readme.txt: -------------------------------------------------------------------------------- 1 | Look distribution.pdf 2 | -------------------------------------------------------------------------------- /demos/multi.nw: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | 3 | \usepackage{noweb} 4 | %\pagestyle{noweb} 5 | \noweboptions{} 6 | 7 | \begin{document} 8 | 9 | #include "multi1.nw" 10 | #include "multi2.nw" 11 | 12 | \end{document} 13 | -------------------------------------------------------------------------------- /demos/multi.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/demos/multi.pdf -------------------------------------------------------------------------------- /demos/multi1.nw: -------------------------------------------------------------------------------- 1 | \section{Section1} 2 | 3 | 4 | <>= 5 | val t1: int 6 | 7 | @ 8 | 9 | <>= 10 | let t1 = 3 11 | 12 | @ 13 | -------------------------------------------------------------------------------- /demos/multi2.nw: -------------------------------------------------------------------------------- 1 | \section{Section2} 2 | 3 | 4 | <>= 5 | val t2 : int 6 | 7 | @ 8 | 9 | <>= 10 | let t2 = 4 11 | 12 | @ 13 | 14 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | ; copy-pasted from from semgrep/dune 2 | (env 3 | (_ 4 | (flags (:standard -w -52-6)))) 5 | 6 | (dirs 7 | main 8 | frontend 9 | backend 10 | lpizer 11 | ;TODO: lpizer 12 | ) 13 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | (name syncweb) 3 | 4 | -------------------------------------------------------------------------------- /emacs/fix_noweb.el: -------------------------------------------------------------------------------- 1 | (require 'noweb-mode) 2 | 3 | ; By default noweb tries to be lazy and font-lockify chunks or latex parts 4 | ; only when the cursor is on the chunk. This function allows instead to force 5 | ; the font-lockifying when opening the file. 6 | (defun pad-noweb-force-mode-all-file () 7 | (interactive) 8 | (message "hook") 9 | (save-excursion 10 | (while (not (eobp)) 11 | (next-line-nomark) 12 | (noweb-select-mode) 13 | ) 14 | )) 15 | 16 | (setq noweb-mode-hook 'pad-noweb-force-mode-all-file) 17 | 18 | ; The default behavior of newline in noweb is electric, I hate it. 19 | (define-key noweb-minor-mode-map [return] 'newline) 20 | 21 | 22 | ; trick to hide those special comments. need hide-regexp.el 23 | (require 'hide-regexp) 24 | 25 | ; for ocaml (tuareg-mode), you can easily extend it to other langauges. 26 | (setq hide-regexp-alist 27 | '( 28 | ("\<(* nw_s: " . nil) 29 | ("(* nw_e: " . nil) 30 | ("(* nw_s: .*|" . nil) 31 | ("(*s: " . nil) 32 | ("(*e: " . nil) 33 | ; ("(* nw_e: .*|" . nil) dont need for the end 34 | )) 35 | 36 | (add-hook 'tuareg-mode-hook (lambda () (hide-regexp))) 37 | 38 | ; better colorization of syncweb marks, less intrusive 39 | (defun Set-face-foreground (f c) (make-face f) (set-face-foreground f c)) 40 | (Set-face-foreground 'pad-syncweb-face "DimGray") 41 | 42 | ; Mostly copy paste of tuareg.el. Modified for my syncweb fontification. 43 | ; Could not do it via a regular font-lock-add-keywords as in: 44 | ; (font-lock-add-keywords 'tuareg-mode 45 | ; '(("\\((\*s:.*\\)" 46 | ; 1 font-lock-builtin-face prepend))) 47 | ; because the function below takes precedence over font-lock :( 48 | (defun tuareg-fontify (begin end) 49 | (if (eq major-mode 'tuareg-mode) 50 | (save-excursion 51 | (tuareg-modify-syntax) 52 | 53 | (let ((case-fold-search nil) 54 | (modified (buffer-modified-p))) ; Emacs hack (see below) 55 | (goto-char begin) 56 | (beginning-of-line) 57 | (setq begin (point)) 58 | (goto-char (1- end)) 59 | (end-of-line) 60 | ;; Dirty hack to trick `font-lock-default-unfontify-region' 61 | (if (not tuareg-with-xemacs) (forward-line 2)) 62 | (setq end (point)) 63 | 64 | (while (> end begin) 65 | (goto-char (1- end)) 66 | (tuareg-in-literal-or-comment) 67 | (cond 68 | ((cdr tuareg-last-loc) 69 | (tuareg-beginning-of-literal-or-comment) 70 | (put-text-property (max begin (point)) end 'face 71 | ; pad: monkey patch 72 | (if (looking-at 73 | "(\\*[se]:") 74 | 'pad-syncweb-face 75 | (if (looking-at 76 | "(\\*[Tt][Ee][Xx]\\|(\\*\\*[^*]") 77 | tuareg-doc-face 78 | 'font-lock-comment-face))) 79 | (setq end (1- (point)))) 80 | ((car tuareg-last-loc) 81 | (tuareg-beginning-of-literal-or-comment) 82 | (put-text-property (max begin (point)) end 'face 83 | 'font-lock-string-face) 84 | (setq end (point))) 85 | (t (while (and tuareg-cache-local 86 | (or (> (caar tuareg-cache-local) end) 87 | (eq 'b (cadar tuareg-cache-local)))) 88 | (setq tuareg-cache-local (cdr tuareg-cache-local))) 89 | (setq end (if tuareg-cache-local 90 | (caar tuareg-cache-local) begin))))) 91 | (if (not (or tuareg-with-xemacs modified)) ; properties taken 92 | (set-buffer-modified-p nil))) ; too seriously... 93 | 94 | (tuareg-restore-syntax)))) 95 | -------------------------------------------------------------------------------- /emacs/hide-regexp.el: -------------------------------------------------------------------------------- 1 | 2 | (defvar hide-regexp 3 | "list of regexps specifying what to hide" 4 | nil) 5 | 6 | (defun hide-regexp () 7 | (interactive) 8 | (activate-hide-regexp) 9 | (save-excursion 10 | (mapcar (lambda (e) 11 | ;simple: (goto-char (point-min)) 12 | ;simple: (while (re-search-forward "history:" nil t) 13 | ;simple: (let ((ov (make-overlay (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))) 14 | (goto-char (point-min)) 15 | (while (re-search-forward (car e) nil t) 16 | ; (message (match-string 0)) 17 | ; if = overview | index | ... then do nothing (special case cos sometimes want see them (and only them) 18 | (let* ((matched (match-string 0)) 19 | (ov (make-overlay 20 | ; (save-excursion (beginning-of-line) (point)) ; customize: if want hide all (good for flyspell) 21 | (point) 22 | (if (cdr e) 23 | (progn (re-search-forward (cdr e) nil t) (point)) 24 | ;(progn (end-of-line) (point)) ; customize: if dont want pack together keywords 25 | (progn (forward-line) 26 | (while (re-search-forward ;(car e) 27 | matched 28 | (save-excursion (end-of-line) (point)) t) 29 | (forward-line)) 30 | (forward-line -1) 31 | (end-of-line) 32 | (point)) 33 | )))) 34 | ; if outline is activated then buffer-invisibility-spec is changed 35 | ; and so put t for 'invisible is not enough 36 | (overlay-put ov 'invisible 'hr) 37 | ; want tag this overlay so can differientiate when have to 38 | ; delete them to avoid delete other overlay (such as outline 39 | ; one, selective-display, ...) 40 | (overlay-put ov 'invisible 'hr) 41 | (overlay-put ov 'evaporate t) ; if region to hide is empty then do nothing (useful for %plan: in latex) 42 | (overlay-put ov 'hr t) 43 | (overlay-put ov 'after-string "...") 44 | ))) 45 | hide-regexp-alist 46 | ) 47 | ) 48 | ) 49 | 50 | (defun activate-hide-regexp () 51 | (interactive) 52 | ; (add-to-list 'buffer-invisibility-spec '(hr . nil)) 53 | (setq buffer-invisibility-spec '((hr . nil) (outline . t))) 54 | (make-local-variable 'line-move-ignore-invisible) 55 | (setq line-move-ignore-invisible t) ;src: hide-search.el 56 | ) 57 | 58 | (defun unhide-regexp () 59 | (interactive) 60 | (mapcar (lambda (ov) 61 | (when (overlay-get ov 'hr) (delete-overlay ov) ; dont touch other overlays 62 | )) 63 | (overlays-in (point-min) (point-max))) 64 | ) 65 | 66 | (provide 'hide-regexp) 67 | -------------------------------------------------------------------------------- /emacs/todo/mmm-mode-0.4.8.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/emacs/todo/mmm-mode-0.4.8.tar.gz -------------------------------------------------------------------------------- /env.sh: -------------------------------------------------------------------------------- 1 | #!!!!You need to source me with "source env.sh" from the _RIGHT_ directory!!!! 2 | if [ ! -r main.ml ] 3 | then echo "There is no main.ml here. 4 | Are you sure you run this script from the source directory ? 5 | "; 6 | fi 7 | 8 | # To run. To find the config/ files. 9 | echo setting SYNCWEB_HOME 10 | export SYNCWEB_HOME=`pwd` 11 | 12 | -------------------------------------------------------------------------------- /frontend/code.ml: -------------------------------------------------------------------------------- 1 | (* Copyright 2009-2017 Yoann Padioleau, see copyright.txt *) 2 | open Common 3 | 4 | (*****************************************************************************) 5 | (* Prelude *) 6 | (*****************************************************************************) 7 | 8 | (*****************************************************************************) 9 | (* Types *) 10 | (*****************************************************************************) 11 | 12 | (* a view is a codetree list because a orig can contain multiple occurences 13 | * of the view name, that then must be appended to each other in the view 14 | *) 15 | type t = codetree list 16 | 17 | and codetree = 18 | | RegularCode of string 19 | | ChunkCode of 20 | chunk_info * 21 | codetree list (* have adjusted indentation *) * 22 | int (* indentation, local *) 23 | 24 | and chunk_info = { 25 | chunk_key: string; 26 | 27 | (* advanced: md5sum corresponding code_or_chunk list in orig *) 28 | chunk_md5sum: Signature.t option; 29 | 30 | mutable pretty_print: position option; 31 | } 32 | (* work with the -less_marks flag *) 33 | and position = First (* s: *) | Middle (* x: *) | Last (* e: *) 34 | 35 | (*****************************************************************************) 36 | (* Helpers *) 37 | (*****************************************************************************) 38 | let generate_n_spaces i = 39 | Common2.repeat " " i |> String.concat "" 40 | 41 | (*****************************************************************************) 42 | (* Helpers parser *) 43 | (*****************************************************************************) 44 | 45 | (* First version, again we assume line-oriented and special cases. 46 | * Do special case for first chunk, generate chunk corresponding 47 | * to filename with fake prelude and postlude ? 48 | * 49 | * Do multi files? well no need I think, just call sync multiple 50 | * times with the different view files. 51 | *) 52 | 53 | (* for better error reporting *) 54 | type pinfo = { 55 | file: string (* filename *); 56 | line: int; 57 | } 58 | let s_of_pinfo pinfo = 59 | spf "%s:%d" pinfo.file pinfo.line 60 | let mkp file line = 61 | { file = file; line = line} 62 | 63 | type mark2 = 64 | | Regular2 of string * pinfo 65 | | Start2 of string * int * Signature.t option * pinfo 66 | | End2 of string option * int * pinfo 67 | 68 | let readjust_mark2_remove_indent i body = 69 | body |> List.map (function 70 | | Start2 (s, j, md5sum, pinfo) -> 71 | if j < i 72 | then failwith (s_of_pinfo pinfo ^ 73 | " nested chunk with smaller indentation at "); 74 | Start2 (s, j - i, md5sum, pinfo) 75 | | Regular2 (s, pinfo) -> 76 | if Common2_.is_blank_string s 77 | then Regular2 (s, pinfo) 78 | else 79 | if s=~ "\\([ \t]*\\)\\(.*\\)" 80 | then 81 | let spaces, rest = matched2 s in 82 | let j = String.length spaces in 83 | if j < i 84 | then 85 | failwith (s_of_pinfo pinfo ^ 86 | " nested chunk with smaller indentation at "); 87 | let spaces' = generate_n_spaces (j - i) in 88 | Regular2 (spaces' ^ rest, pinfo) 89 | else raise Impossible 90 | | End2 (x,i, pinfo) -> 91 | (* dont care about End2 indent info *) 92 | End2 (x, i, pinfo) 93 | ) 94 | 95 | (* patch the Start2 with the signature information in the md5sum_aux file *) 96 | let readjust_start2_with_signatures file xs = 97 | let sigfile = Signature.signaturefile_of_file file in 98 | if Sys.file_exists sigfile 99 | then 100 | let md5s = Signature.parse_signaturefile sigfile in 101 | let rec aux mark2s md5sums = 102 | match mark2s, md5sums with 103 | | [], [] -> [] 104 | | (Start2(s, j, md5sum, pinfo) as x)::xs, (s2, md5sum2)::ys -> 105 | if s <> s2 106 | then begin 107 | UCommon.pr2 (spf "not same key in view and md5sum_auxfile: %s VS %s" s s2); 108 | if (Common2_.y_or_no 109 | "This may be because you moved entities. Continue?") 110 | then x::xs 111 | else failwith "Stop here" 112 | 113 | end 114 | else 115 | if md5sum =*= None 116 | then 117 | (Start2(s, j, Some md5sum2, pinfo))::aux xs ys 118 | else 119 | failwith "md5sums present in view file" 120 | | ((End2 _|Regular2 _) as x)::xs, ys -> 121 | x::aux xs ys 122 | | (Start2(_, _j, _md5sum, _pinfo) as x)::xs, [] -> 123 | UCommon.pr2 "more marks in view file than md5sums in md5sum_auxfile"; 124 | if (Common2_.y_or_no 125 | "This may be because you moved entities. Continue?") 126 | then x::xs 127 | else failwith "Stop here" 128 | 129 | | [], _y::_ys -> 130 | UCommon.pr2 "more md5sums in md5sum_auxfile than start marks in view file"; 131 | if (Common2_.y_or_no 132 | "This may be because you moved entities. Continue?") 133 | then [] 134 | else failwith "Stop here" 135 | 136 | in 137 | aux xs md5s 138 | 139 | else xs 140 | 141 | (*****************************************************************************) 142 | (* Parser *) 143 | (*****************************************************************************) 144 | 145 | (* old: was computing a first "implicit" chunk corresponding to the name if 146 | * the file, but not worth the extra complexity. 147 | *) 148 | let parse2 ~lang file = 149 | let xs = UFile.Legacy.cat file in 150 | 151 | let xs' = xs |> List_.index_list_1 |> List.map (fun (s, line) -> 152 | match lang.Lang.parse_mark_startend s with 153 | | Some (tabs, key, md5) -> 154 | [End2 (Some key, String.length tabs, mkp file line); 155 | Start2 (key, String.length tabs, md5, mkp file line); 156 | ] 157 | | None -> 158 | (match lang.Lang.parse_mark_start s with 159 | | Some (tabs, key, md5) -> 160 | [Start2 (key, String.length tabs, md5, mkp file line)] 161 | | None -> 162 | (match lang.Lang.parse_mark_end s with 163 | | Some (tabs, key) -> 164 | [End2 (key, String.length tabs, mkp file line)] 165 | | None -> 166 | [Regular2 (s, mkp file line)] 167 | ) 168 | ) 169 | ) |> List.flatten |> readjust_start2_with_signatures file 170 | in 171 | 172 | (* the view does not need to contain the key at the end mark; it's 173 | * redundant. But it is used for now to easily find the matching End2 174 | * of a Start2. If the key is not there, then have to find the 175 | * corresponding End2 by not stopping at the first one and by 176 | * counting. 177 | *) 178 | let rec aux xs = 179 | match xs with 180 | | [] -> [] 181 | | x::xs -> 182 | (match x with 183 | | Start2 (s, i, md5sum, pinfo) -> 184 | let (body, _endmark, rest) = 185 | try 186 | Common2.split_when (fun x -> match x with 187 | | End2 (s2,_, _pinfo2) -> 188 | (match s2 with 189 | | None -> raise Todo 190 | | Some s2 -> s = s2 191 | ) 192 | | _ -> false 193 | ) xs 194 | with Not_found -> 195 | failwith (s_of_pinfo pinfo ^ " could not find end mark") 196 | in 197 | let body' = aux (readjust_mark2_remove_indent i body) in 198 | ChunkCode ({ 199 | chunk_key = s; 200 | chunk_md5sum = md5sum; 201 | pretty_print = None; 202 | }, body', i)::aux rest 203 | | End2 (_s, _i, pinfo) -> 204 | failwith (s_of_pinfo pinfo ^ " a end mark without a start at") 205 | | Regular2 (s, _pinfo) -> 206 | RegularCode s::aux xs 207 | ) 208 | in 209 | let codetrees = aux xs' in 210 | codetrees 211 | 212 | let parse ~lang a = 213 | (* Common.profile_code "Code.parse" (fun () -> *) 214 | parse2 ~lang a 215 | (* ) *) 216 | 217 | (*****************************************************************************) 218 | (* Unparser *) 219 | (*****************************************************************************) 220 | 221 | let rec adjust_pretty_print_field view = 222 | match view with 223 | | [] -> () 224 | | x::xs -> 225 | (match x with 226 | | RegularCode _ -> 227 | adjust_pretty_print_field xs 228 | | ChunkCode (info, _, indent) -> 229 | let same_key, rest = 230 | List_.span (fun y -> 231 | match y with 232 | | ChunkCode (info2, _, indent2) -> 233 | info.chunk_key = info2.chunk_key && 234 | indent =|= indent2 (* always the same ? *) 235 | | _ -> false 236 | ) (x::xs) 237 | in 238 | (* recurse *) 239 | adjust_pretty_print_field rest; 240 | same_key |> List.iter (function 241 | | ChunkCode (_info, xs, _i) -> 242 | adjust_pretty_print_field xs 243 | | _ -> raise Impossible 244 | ); 245 | let same_key' = same_key |> List.map (function 246 | | ChunkCode(info, _, _) -> info 247 | | _ -> raise Impossible 248 | ) 249 | in 250 | 251 | if List.length same_key' >= 2 then begin 252 | let (hd, middle, tl) = Common2.head_middle_tail same_key' in 253 | hd.pretty_print <- Some First; 254 | tl.pretty_print <- Some Last; 255 | middle |> List.iter (fun x -> x.pretty_print <- Some Middle); 256 | end 257 | ) 258 | 259 | 260 | (* assume first chunkcode corresponds to the filename? *) 261 | let unparse 262 | ?(md5sum_in_auxfile=false) 263 | ?(less_marks=false) 264 | ~lang views filename 265 | = 266 | let md5sums = ref [] in 267 | if less_marks 268 | then adjust_pretty_print_field views; 269 | 270 | UFile.Legacy.with_open_outfile filename (fun (pr_no_nl, _chan) -> 271 | let pr s = pr_no_nl (s ^ "\n") in 272 | let pr_indent indent = Common2_.do_n indent (fun () -> pr_no_nl " ") in 273 | 274 | let rec aux (x, body, i) = 275 | let key = x.chunk_key in 276 | let md5sum = 277 | if md5sum_in_auxfile 278 | then begin 279 | Stack_.push (spf "%s |%s" key 280 | (Signature.to_hex (Common2_.some x.chunk_md5sum))) 281 | md5sums; 282 | None 283 | end 284 | else x.chunk_md5sum 285 | in 286 | 287 | pr_indent (i); 288 | (match x.pretty_print with 289 | | None | Some First -> 290 | pr (lang.Lang.unparse_mark_start key md5sum); 291 | | (Some (Middle|Last)) -> 292 | pr (lang.Lang.unparse_mark_startend key md5sum); 293 | ); 294 | body |> List.iter (function 295 | | RegularCode s -> 296 | (* bugfix: otherwise make sync will not fixpoint *) 297 | if Common2_.is_blank_string s 298 | then pr s 299 | else begin 300 | pr_indent i; 301 | pr s; 302 | end 303 | | ChunkCode (x, body, j) -> 304 | aux (x, body, i+j); 305 | 306 | (* if decide to not show toplevel chunk 307 | let key = x.chunk_key in 308 | pr_indent (i+j); 309 | pr (spf "(* nw_s: %s |%s*)" key x.chunk_md5sum); 310 | aux (x, i+j); 311 | pr_indent (i+j); 312 | pr (spf "(* nw_e: %s *)" key); 313 | *) 314 | ); 315 | (match x.pretty_print with 316 | | None | Some Last -> 317 | (* bugfix: the pr_indent call must be here, not outside *) 318 | pr_indent (i); 319 | pr (lang.Lang.unparse_mark_end key); 320 | | Some (First | Middle) -> 321 | () 322 | ) 323 | in 324 | 325 | views |> List.iter (function 326 | | ChunkCode (chunkcode, body, i) -> 327 | aux (chunkcode, body, i) 328 | | RegularCode _s -> 329 | failwith "no chunk at toplevel" 330 | ); 331 | () 332 | ); 333 | 334 | if md5sum_in_auxfile then begin 335 | UFile.Legacy.write_file ~file:(Signature.signaturefile_of_file filename) 336 | (!md5sums |> List.rev |> String.concat "\n"); 337 | end; 338 | () 339 | -------------------------------------------------------------------------------- /frontend/code.mli: -------------------------------------------------------------------------------- 1 | 2 | (* a .c, .h, .ml, .mli, ... *) 3 | type t = codetree list 4 | and codetree = 5 | | RegularCode of string 6 | | ChunkCode of 7 | chunk_info * 8 | codetree list (* have adjusted indentation *) * 9 | int (* indentation, local *) 10 | 11 | and chunk_info = { 12 | chunk_key: string; 13 | (* the md5sum can be in the view or in .md5sum_... aux file *) 14 | chunk_md5sum: Signature.t option; 15 | mutable pretty_print: position option; 16 | } 17 | (* work with the -less_marks flag *) 18 | and position = First (* s: *) | Middle (* x: *) | Last (* e: *) 19 | 20 | (* may also parse the .md5sum_xxx file if it exists *) 21 | val parse: lang:Lang.mark_language -> string (* Common.filename *) -> t 22 | 23 | val unparse: 24 | ?md5sum_in_auxfile:bool -> 25 | ?less_marks:bool -> 26 | lang:Lang.mark_language -> t -> string (* Common.filename *) -> unit 27 | -------------------------------------------------------------------------------- /frontend/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name frontend) 3 | (wrapped false) 4 | (libraries 5 | commons 6 | commons2 7 | commons2_ 8 | ) 9 | (preprocess 10 | (pps ppx_deriving.show) ; ppx_profiling 11 | ) 12 | ) 13 | 14 | -------------------------------------------------------------------------------- /frontend/lang.ml: -------------------------------------------------------------------------------- 1 | (* Copyright 2009-2016 Yoann Padioleau, see copyright.txt *) 2 | open Common 3 | 4 | module S = Signature 5 | 6 | (*****************************************************************************) 7 | (* Prelude *) 8 | (*****************************************************************************) 9 | 10 | (*****************************************************************************) 11 | (* Types *) 12 | (*****************************************************************************) 13 | 14 | type mark_language = { 15 | (* 's:' return (space, key, signature option) *) 16 | parse_mark_start: string -> (string * string * Signature.t option) option; 17 | (* 'e:' return (space, key option) *) 18 | parse_mark_end: string -> (string * string option) option; 19 | 20 | unparse_mark_start: key:string -> md5:Signature.t option -> string; 21 | unparse_mark_end: key:string -> string; 22 | 23 | (* 'x:' works with less_marks flag *) 24 | parse_mark_startend: string -> (string * string * Signature.t option) option; 25 | unparse_mark_startend: key:string -> md5:Signature.t option -> string; 26 | } 27 | 28 | (* from common2.ml *) 29 | let (==~) s re = 30 | Str.string_match re s 0 31 | 32 | (*****************************************************************************) 33 | (* Language specific handling in views *) 34 | (*****************************************************************************) 35 | 36 | (* todo: could factorize because many languages use the same comment format. 37 | * Maybe we could just provide the tokens to make a comment ? 38 | * todo: without key in endmark ? but need adjust parse_view 39 | *) 40 | 41 | (* no mark in the comment, shorter format because of md5sum_in_auxfile *) 42 | let mark_ocaml_short = 43 | { 44 | parse_mark_start = (fun s -> 45 | if s =~ "\\([ \t]*\\)(\\*s: \\(.*\\) \\*)$" 46 | then 47 | let (a,b) = Common.matched2 s in 48 | Some (a, b, None) 49 | else 50 | None 51 | ); 52 | parse_mark_end = (fun s -> 53 | if s =~ "\\([ \t]*\\)(\\*e: \\(.*\\) \\*)$" 54 | then 55 | let (a,b) = Common.matched2 s in 56 | Some (a, Some b) 57 | else None 58 | ); 59 | unparse_mark_start = (fun ~key ~md5 -> 60 | (match md5 with 61 | | None -> spf "(*s: %s *)" key; 62 | | Some _ -> failwith "this language works only with -md5sum_in_auxfile" 63 | ) 64 | ); 65 | unparse_mark_end = (fun ~key -> 66 | spf "(*e: %s *)" key 67 | ); 68 | 69 | 70 | parse_mark_startend = (fun s -> 71 | if s =~ "\\([ \t]*\\)(\\*x: \\(.*\\) \\*)$" 72 | then 73 | let (a,b) = Common.matched2 s in 74 | Some (a, b, None) 75 | else 76 | None 77 | ); 78 | unparse_mark_startend = (fun ~key ~md5 -> 79 | (match md5 with 80 | | None -> spf "(*x: %s *)" key; 81 | | Some _ -> failwith "this language works only with -md5sum_in_auxfile" 82 | ) 83 | ); 84 | } 85 | 86 | let mark_ocaml = 87 | let re_start = Str.regexp 88 | "\\([ \t]*\\)(\\* nw_s: \\(.*\\) |\\(.*\\)\\*)$" 89 | in 90 | let re_end = Str.regexp 91 | "\\([ \t]*\\)(\\* nw_e: \\(.*\\) \\*)$" 92 | in 93 | { 94 | 95 | parse_mark_start = (fun s -> 96 | if s ==~ re_start 97 | then 98 | let (a,b,c) = Common.matched3 s in 99 | Some (a, b, Some (S.from_hex c)) 100 | else 101 | None 102 | ); 103 | 104 | parse_mark_end = (fun s -> 105 | if s ==~ re_end 106 | then 107 | let (a,b) = Common.matched2 s in 108 | Some (a, Some b) 109 | else None 110 | ); 111 | 112 | unparse_mark_start = (fun ~key ~md5 -> 113 | spf "(* nw_s: %s |%s*)" key 114 | (match md5 with None -> "" | Some s -> S.to_hex s)); 115 | unparse_mark_end = (fun ~key -> 116 | spf "(* nw_e: %s *)" key); 117 | 118 | parse_mark_startend = (fun _ -> None); 119 | unparse_mark_startend = (fun ~key ~md5 -> 120 | ignore(key, md5); 121 | failwith "-less_marks is not supported for this language" 122 | ); 123 | } 124 | 125 | let mark_shell = 126 | let re_start = Str.regexp 127 | "\\([ \t]*\\)# nw_s: \\(.*\\) |\\(.*\\)#$" 128 | in 129 | let re_end = Str.regexp 130 | "\\([ \t]*\\)# nw_e: \\(.*\\) #$" 131 | in 132 | { 133 | parse_mark_start = (fun s -> 134 | if s ==~ re_start 135 | then 136 | let (a,b,c) = Common.matched3 s in 137 | Some (a, b, if c = "" then None else Some (S.from_hex c)) 138 | else None 139 | ); 140 | parse_mark_end = (fun s -> 141 | if s ==~ re_end 142 | then 143 | let (a,b) = Common.matched2 s in 144 | Some (a, Some b) 145 | else None 146 | ); 147 | unparse_mark_start = (fun ~key ~md5 -> 148 | spf "# nw_s: %s |%s#" key 149 | (match md5 with None -> "" | Some s -> S.to_hex s)); 150 | unparse_mark_end = (fun ~key -> 151 | spf "# nw_e: %s #" key); 152 | 153 | parse_mark_startend = (fun _ -> 154 | None); 155 | unparse_mark_startend = (fun ~key ~md5 -> 156 | ignore(key, md5); 157 | failwith "-less_marks is not supported for this language" 158 | ); 159 | } 160 | 161 | let mark_ocamlyacc_short = 162 | { 163 | parse_mark_start = (fun s -> 164 | if s =~ "\\([ \t]*\\)/\\*(\\*s: \\(.*\\) \\*)\\*/$" 165 | then 166 | let (a,b) = Common.matched2 s in 167 | Some (a, b, None) 168 | else 169 | None 170 | ); 171 | parse_mark_end = (fun s -> 172 | if s =~ "\\([ \t]*\\)/\\*(\\*e: \\(.*\\) \\*)\\*/$" 173 | then 174 | let (a,b) = Common.matched2 s in 175 | Some (a, Some b) 176 | else None 177 | ); 178 | unparse_mark_start = (fun ~key ~md5 -> 179 | (match md5 with 180 | | None -> spf "/*(*s: %s *)*/" key; 181 | | Some _ -> failwith "this language works only with -md5sum_in_auxfile" 182 | ) 183 | ); 184 | unparse_mark_end = (fun ~key -> 185 | spf "/*(*e: %s *)*/" key 186 | ); 187 | 188 | 189 | 190 | parse_mark_startend = (fun s -> 191 | if s =~ "\\([ \t]*\\)/\\*(\\*x: \\(.*\\) \\*)\\*/$" 192 | then 193 | let (a,b) = Common.matched2 s in 194 | Some (a, b, None) 195 | else 196 | None 197 | ); 198 | unparse_mark_startend = (fun ~key ~md5 -> 199 | (match md5 with 200 | | None -> spf "/*(*x: %s *)*/" key; 201 | | Some _ -> failwith "this language works only with -md5sum_in_auxfile" 202 | ) 203 | ); 204 | } 205 | 206 | 207 | let mark_C = 208 | let re_start = Str.regexp 209 | "\\([ \t]*\\)/\\* nw_s: \\(.*\\) |\\(.*\\)\\*/$" 210 | in 211 | let re_end = Str.regexp 212 | "\\([ \t]*\\)/\\* nw_e: \\(.*\\) \\*/$" 213 | in 214 | { 215 | parse_mark_start = (fun s -> 216 | if s ==~ re_start 217 | then 218 | let (a,b,c) = Common.matched3 s in 219 | Some (a, b, if c = "" then None else Some (S.from_hex c)) 220 | else None 221 | ); 222 | parse_mark_end = (fun s -> 223 | if s ==~ re_end 224 | then 225 | let (a,b) = Common.matched2 s in 226 | Some (a, Some b) 227 | else None 228 | ); 229 | unparse_mark_start = (fun ~key ~md5 -> 230 | spf "/* nw_s: %s |%s*/" key 231 | (match md5 with None -> "" | Some s -> S.to_hex s)); 232 | unparse_mark_end = (fun ~key -> 233 | spf "/* nw_e: %s */" key); 234 | 235 | parse_mark_startend = (fun _ -> None); 236 | unparse_mark_startend = (fun ~key ~md5 -> 237 | ignore(key, md5); 238 | failwith "-less_marks is not supported for this language" 239 | ); 240 | } 241 | 242 | let mark_C_short = 243 | { 244 | parse_mark_start = (fun s -> 245 | if s =~ "\\([ \t]*\\)/\\*s: \\(.*\\) \\*/$" 246 | then 247 | let (a,b) = Common.matched2 s in 248 | Some (a, b, None) 249 | else 250 | None 251 | ); 252 | parse_mark_end = (fun s -> 253 | if s =~ "\\([ \t]*\\)/\\*e: \\(.*\\) \\*/$" 254 | then 255 | let (a,b) = Common.matched2 s in 256 | Some (a, Some b) 257 | else None 258 | ); 259 | unparse_mark_start = (fun ~key ~md5 -> 260 | (match md5 with 261 | | None -> spf "/*s: %s */" key; 262 | | Some _s -> failwith "this language works only with -md5sum_in_auxfile" 263 | ) 264 | ); 265 | unparse_mark_end = (fun ~key -> 266 | spf "/*e: %s */" key 267 | ); 268 | 269 | 270 | 271 | parse_mark_startend = (fun s -> 272 | if s =~ "\\([ \t]*\\)/\\*x: \\(.*\\) \\*/$" 273 | then 274 | let (a,b) = Common.matched2 s in 275 | Some (a, b, None) 276 | else 277 | None 278 | ); 279 | unparse_mark_startend = (fun ~key ~md5 -> 280 | (match md5 with 281 | | None -> spf "/*x: %s */" key; 282 | | Some _s -> failwith "this language works only with -md5sum_in_auxfile" 283 | ) 284 | ); 285 | } 286 | 287 | let mark_haskell_short = 288 | { 289 | parse_mark_start = (fun s -> 290 | if s =~ "\\([ \t]*\\){-s: \\(.*\\) -}$" 291 | then 292 | let (a,b) = Common.matched2 s in 293 | Some (a, b, None) 294 | else 295 | None 296 | ); 297 | parse_mark_end = (fun s -> 298 | if s =~ "\\([ \t]*\\){-e: \\(.*\\) -}$" 299 | then 300 | let (a,b) = Common.matched2 s in 301 | Some (a, Some b) 302 | else None 303 | ); 304 | unparse_mark_start = (fun ~key ~md5 -> 305 | (match md5 with 306 | | None -> spf "{-s: %s -}" key; 307 | | Some _s -> failwith "this language works only with -md5sum_in_auxfile" 308 | ) 309 | ); 310 | unparse_mark_end = (fun ~key -> 311 | spf "{-e: %s -}" key 312 | ); 313 | 314 | 315 | 316 | parse_mark_startend = (fun s -> 317 | if s =~ "\\([ \t]*\\){-x: \\(.*\\) -}$" 318 | then 319 | let (a,b) = Common.matched2 s in 320 | Some (a, b, None) 321 | else 322 | None 323 | ); 324 | unparse_mark_startend = (fun ~key ~md5 -> 325 | (match md5 with 326 | | None -> spf "{-x: %s -}" key; 327 | | Some _s -> failwith "this language works only with -md5sum_in_auxfile" 328 | ) 329 | ); 330 | } 331 | 332 | (*****************************************************************************) 333 | (* Final table *) 334 | (*****************************************************************************) 335 | 336 | let lang_table auxfile = [ 337 | "ocaml", if auxfile then mark_ocaml_short else mark_ocaml; 338 | "C", if auxfile then mark_C_short else mark_C; 339 | "shell", mark_shell; 340 | "ocamlyacc", mark_ocamlyacc_short; 341 | "php", mark_C_short; 342 | "haskell", mark_haskell_short; 343 | ] 344 | -------------------------------------------------------------------------------- /frontend/lang.mli: -------------------------------------------------------------------------------- 1 | 2 | type mark_language = { 3 | (* return (space, key, signature option) *) 4 | parse_mark_start: string -> (string * string * Signature.t option) option; 5 | (* return (space, key option) *) 6 | parse_mark_end: string -> (string * string option) option; 7 | 8 | unparse_mark_start: key:string -> md5:Signature.t option -> string; 9 | unparse_mark_end: key:string -> string; 10 | 11 | (* works with less_marks flag *) 12 | parse_mark_startend: string -> (string * string * Signature.t option) option; 13 | unparse_mark_startend: key:string -> md5:Signature.t option -> string; 14 | } 15 | 16 | val lang_table : 17 | bool (* use md5sum auxfile *) -> (string, mark_language) Assoc.t 18 | 19 | (* for testing *) 20 | 21 | val mark_ocaml_short: mark_language 22 | val mark_ocaml: mark_language 23 | val mark_C_short: mark_language 24 | -------------------------------------------------------------------------------- /frontend/signature.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | (* this uses md5sum internally *) 4 | type t = Digest.t 5 | 6 | let to_hex a = Digest.to_hex a 7 | let from_hex a = Digest.from_hex a 8 | 9 | let signature_of_string a = 10 | (* old: Common2.md5sum_of_string a 11 | * but really slower than Digest because it forks a process *) 12 | Digest.string a 13 | [@@profiling] 14 | 15 | 16 | let signaturefile_of_file file = 17 | let (d,b) = Filename_.db_of_filename file in 18 | let oldformat = Filename_.filename_of_db (d, ".md5sum_" ^ b) in 19 | if Sys.file_exists oldformat 20 | then oldformat 21 | else 22 | let (d,b,e) = Filename_.dbe_of_filename file in 23 | (* works better with codemap, and also mkmany in plan9 *) 24 | Filename_.filename_of_dbe (d, spf ".md5sum_%s_%s" b e, "") 25 | 26 | let re_signature_in_signaturefile = Str.regexp 27 | "\\(.*\\) |\\(.*\\)$" 28 | 29 | let (==~) s re = 30 | Str.string_match re s 0 31 | 32 | let parse_signaturefile sigfile = 33 | UFile.Legacy.cat sigfile |> List.map (fun s -> 34 | if s ==~ re_signature_in_signaturefile 35 | then 36 | let (a,b) = Common.matched2 s in 37 | (a, from_hex b) 38 | else failwith ("wrong format in Signature.parse_signaturefile: " ^ s) 39 | ) 40 | -------------------------------------------------------------------------------- /frontend/signature.mli: -------------------------------------------------------------------------------- 1 | 2 | type t 3 | 4 | val to_hex: t -> string 5 | val from_hex: string -> t 6 | 7 | val signature_of_string: string -> t 8 | 9 | val signaturefile_of_file: string (* Common.filename *) -> string (* Common.filename*) 10 | val parse_signaturefile: string (* Common.filename *) -> (string (* key *) * t) list 11 | 12 | 13 | -------------------------------------------------------------------------------- /frontend/web.ml: -------------------------------------------------------------------------------- 1 | (* Copyright 2009-2017 Yoann Padioleau, see copyright.txt *) 2 | open Common 3 | 4 | (*****************************************************************************) 5 | (* Prelude *) 6 | (*****************************************************************************) 7 | (* 8 | * Web.t below used to be called Engine.orig, and Code.t Engine.view, so 9 | * many of the comments below refer to this old naming scheme. 10 | * This was before I decided that syncweb could also generate 11 | * the .tex (bypassing completely noweb). 12 | *) 13 | 14 | (*****************************************************************************) 15 | (* Types *) 16 | (*****************************************************************************) 17 | 18 | (* note: in fact it's not really a list but more an alternating list. We can 19 | * not have a Tex::Tex::_ normally. A Tex is always followed by a Chunkdef. 20 | * But is it worthwhile to be more precise? hmmm in fact you can have 21 | * at least ChunkDef::ChunkDef::_ so probably not worthwhile. 22 | *) 23 | type t = tex_or_chunkdef list 24 | 25 | and tex_or_chunkdef = 26 | (* this can contain some #include (pad's hack) and noweb quotes [[]] *) 27 | | Tex of tex_string list (* why a list? because each elt is a line *) 28 | | ChunkDef of chunkdef * code_or_chunk list 29 | 30 | and chunkdef = { 31 | chunkdef_key: chunkname; 32 | chunkdef_end: string; (* specific string *) 33 | (* this is used in web_to_tex to store in external hashtbl additional 34 | * information about a chunk 35 | *) 36 | chunkdef_id: chunkid; 37 | } 38 | and code_or_chunk = 39 | | Code of string 40 | | ChunkName of chunkname * int (* indentation *) 41 | (* Those strings can contain noweb quotes ([[ ]]), but they are 42 | * not parsed here. See Web_to_tex.tex_string instead. 43 | *) 44 | and tex_string = string 45 | and chunkname = tex_string 46 | and chunkid = int 47 | 48 | (*****************************************************************************) 49 | (* Invariants *) 50 | (*****************************************************************************) 51 | 52 | (* let check_view v = 53 | * 54 | * can not have multiple chunkname with same key and different ident 55 | * and not consecutive. 56 | * 57 | *) 58 | 59 | (* let check_orig x = 60 | *) 61 | 62 | 63 | (*****************************************************************************) 64 | (* Helpers *) 65 | (*****************************************************************************) 66 | 67 | let (==~) s re = 68 | Str.string_match re s 0 69 | 70 | (*****************************************************************************) 71 | (* Parser *) 72 | (*****************************************************************************) 73 | 74 | (* First version: do as in nofake, very line-oriented and assume 75 | * a few things: 76 | * - <>= and @ in first column and alone and on single line 77 | * - <> inside chunk are singular, possibly with a prefix 78 | * code and postfix code, but there is only one <> per line. 79 | * 80 | * Have some limitations, but simpler, and in practice probably good enough. 81 | * 82 | * less: allow optional '@' when have a Start1 after another Start1? 83 | *) 84 | 85 | type mark1 = Regular1 | Start1 | End1 86 | 87 | (* less: use pcre so can do .*? *) 88 | let regexp_chunkdef = Str.regexp "^<<\\(.*\\)>>=[ \t]*$" 89 | 90 | let regexp_chunkdef_end = Str.regexp "^@[ \t]*$" 91 | 92 | (* (.*[^\@]* )<<([^<>@]+)>>(. * ) *) 93 | (* todo: more flexible ? *) 94 | let regexp_chunk_ref = Str.regexp 95 | "\\([ \t]*\\)<<\\(.*\\)>>[ \t]*$" 96 | 97 | let key_and_index_chunk_ref_string s = 98 | if s ==~ regexp_chunk_ref 99 | then 100 | let (space_or_tabs, key) = matched2 s in 101 | (* todo? handle tabs ? *) 102 | key, String.length space_or_tabs 103 | else failwith "not a chunk_ref string" 104 | 105 | let key_of_chunckdef_string s = 106 | if s ==~ regexp_chunkdef 107 | then matched1 s 108 | else failwith "not a chunkdef string" 109 | 110 | 111 | let fst3 (x, _, _) = x 112 | let snd3 (_, y, _) = y 113 | let thd3 (_, _, z) = z 114 | 115 | let cnt_id = ref 0 116 | 117 | let parse file = 118 | let xs = UFile.Legacy.cat file in 119 | let xs' = xs |> List_.index_list_1 |> List.map (fun (s, i) -> 120 | s, i, 121 | (match s with 122 | | _ when s ==~ regexp_chunkdef_end -> End1 123 | | _ when s ==~ regexp_chunkdef -> Start1 124 | | _ -> Regular1 125 | ) 126 | ) 127 | in 128 | (* todo: more flexible *) 129 | let process_body ys = 130 | ys |> List.map (fun s -> 131 | if s ==~ regexp_chunk_ref 132 | then 133 | let (key, indent) = key_and_index_chunk_ref_string s in 134 | ChunkName (key, indent) 135 | else Code s 136 | ) 137 | in 138 | let rec agglomerate xs = 139 | match xs with 140 | | [] -> [] 141 | | x::xs -> 142 | let line = snd3 x in 143 | 144 | (match thd3 x with 145 | | Regular1 -> 146 | let (regs, rest) = List_.span (fun x -> thd3 x =*= Regular1) xs in 147 | let item = Tex (fst3 x::(List.map fst3 regs)) in 148 | item::agglomerate rest 149 | | Start1 -> 150 | (try 151 | let (body, endmark, rest) = 152 | Common2.split_when (fun x -> thd3 x =*= End1) xs 153 | in 154 | if (not (body |> List.for_all (fun x -> thd3 x =*= Regular1))) 155 | then failwith 156 | (spf "line %d: body of chunkdef contains other chunkdef" line); 157 | 158 | let body' = List.map fst3 body in 159 | incr cnt_id; 160 | let item = ChunkDef ({ 161 | chunkdef_key = key_of_chunckdef_string (fst3 x); 162 | chunkdef_end = fst3 endmark; 163 | chunkdef_id = !cnt_id; 164 | }, process_body body') in 165 | item::agglomerate rest 166 | with Not_found -> 167 | failwith (spf "no end mark found, at line %d" line) 168 | ) 169 | 170 | | End1 -> failwith (spf "line %d: a end mark without a start" line) 171 | ) 172 | in 173 | agglomerate xs' 174 | [@@profiling] 175 | 176 | (*****************************************************************************) 177 | (* Unparser *) 178 | (*****************************************************************************) 179 | 180 | let unparse orig filename = 181 | UFile.Legacy.with_open_outfile filename (fun (pr_no_nl, _chan) -> 182 | let pr s = pr_no_nl (s ^ "\n") in 183 | orig |> List.iter (function 184 | | Tex xs -> 185 | xs |> List.iter pr; 186 | | ChunkDef (def, body) -> 187 | let start = spf "<<%s>>=" def.chunkdef_key in 188 | let end_mark = def.chunkdef_end in 189 | pr start; 190 | body |> List.iter (function 191 | | Code s -> 192 | pr s 193 | | ChunkName (s, indent) -> 194 | Common2_.do_n indent (fun () -> pr_no_nl " "); 195 | let item = spf "<<%s>>" s in 196 | pr item; 197 | ); 198 | pr end_mark; 199 | ); 200 | ) 201 | [@@profiling] 202 | 203 | (*****************************************************************************) 204 | (* Multi file support *) 205 | (*****************************************************************************) 206 | 207 | let expand_sharp_include orig = 208 | orig |> List.map (function 209 | | Tex xs -> 210 | xs |> List.map (fun s -> 211 | match s with 212 | | _ when s =~ "#include +\"\\(.*\\.nw\\)\"" -> 213 | let file = Common.matched1 s in 214 | let orig = parse file in 215 | orig 216 | | _ -> [Tex [s]] 217 | ) |> List.flatten 218 | | ChunkDef (def, xs) -> 219 | [ChunkDef (def, xs)] 220 | ) |> List.flatten 221 | 222 | 223 | (* For the moment the multi file support is really a hack. I just 224 | * abuse the Tex constructor to remember that a serie of tex_or_chunkdef 225 | * belongs to a file. This hack allows to use 'sync' as-is, without any 226 | * additional coding, for free. 227 | * 228 | * Assumption: the file list are given in a good order, the order of 229 | * the #include inside the .nw files. Moreover it assumes the appended chunks 230 | * are defined in the good order too. As most of the time I use the multi 231 | * file in a very basic way, just to split a big .nw. this is not a problem 232 | * I think. 233 | * 234 | * less? could introduce a MultiFileHack of Common.filename constructor 235 | * instead of abusing Tex 236 | *) 237 | 238 | let pack_multi xs = 239 | xs |> List.map (fun (file, xs) -> 240 | Tex (["MULTIFILE:" ^ file])::xs 241 | ) |> List.flatten 242 | 243 | 244 | let unpack_multi orig = 245 | let (pre, groups) = 246 | Common2_.group_by_pre (fun x -> 247 | match x with 248 | | Tex [s] when s =~ "MULTIFILE:.*" -> true 249 | | _ -> false 250 | ) orig 251 | in 252 | if not (List_.null pre) 253 | then failwith "could not find a MULTIFILE mark in packed orig, weird"; 254 | 255 | groups |> List.map (fun (x, xs) -> 256 | match x with 257 | | Tex [s] when s =~ "MULTIFILE:\\(.*\\)$" -> 258 | Common.matched1 s, xs 259 | | _ -> raise Impossible 260 | ) 261 | 262 | -------------------------------------------------------------------------------- /frontend/web.mli: -------------------------------------------------------------------------------- 1 | 2 | (* usually a .nw file *) 3 | type t = tex_or_chunkdef list 4 | and tex_or_chunkdef = 5 | (* this can contain some #include (pad's hack) and noweb quotes [[]] *) 6 | | Tex of tex_string list 7 | | ChunkDef of chunkdef * code_or_chunk list 8 | 9 | and chunkdef = { 10 | chunkdef_key: chunkname; 11 | chunkdef_end: string; (* usually just '@' *) 12 | (* this is used in web_to_tex to store in external hashtbl additional 13 | * information about a chunk 14 | *) 15 | chunkdef_id: chunkid; 16 | } 17 | and code_or_chunk = 18 | | Code of string 19 | | ChunkName of chunkname * int (* indentation *) 20 | (* Those strings can contain noweb quotes ([[ ]]), but they are 21 | * not parsed here. See Web_to_tex.texstring instead. 22 | *) 23 | and tex_string = string 24 | and chunkname = tex_string 25 | and chunkid = int 26 | 27 | val parse: string (* Common.filename *) -> t 28 | 29 | val unparse: t -> string (* Common.filename *) -> unit 30 | 31 | (* multi file support for weaving *) 32 | val expand_sharp_include: 33 | t -> t 34 | 35 | (* multi file support for sync *) 36 | val pack_multi: 37 | (string (* Common.filename *) * t) list -> t 38 | val unpack_multi: 39 | t -> (string (* Common.filename *) * t) list 40 | -------------------------------------------------------------------------------- /indexer/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune build 3 | clean: 4 | dune clean 5 | test: 6 | dune runtest 7 | install: 8 | dune install 9 | 10 | .PHONY: all clean install test dump 11 | -------------------------------------------------------------------------------- /indexer/Makefile.old: -------------------------------------------------------------------------------- 1 | TOP=.. 2 | ############################################################################## 3 | # Variables 4 | ############################################################################## 5 | TARGET=indexer 6 | 7 | SRC= index_pfff.ml \ 8 | main_indexer.ml 9 | 10 | OCAMLCOMPILERDIR=$(shell ocamlc -where)/compiler-libs 11 | OCAMLCOMPILERCMA=$(OCAMLCOMPILERDIR)/ocamlcommon.cma 12 | 13 | #todo: use $(TOP)/external/ at some point for that too 14 | PFFF=/home/pad/pfff 15 | INCLUDE_LIBS=commons \ 16 | h_program-lang graph_code \ 17 | lang_cpp/parsing lang_c/parsing lang_c/analyze \ 18 | lang_ml/parsing lang_ml/analyze \ 19 | lang_cmt/parsing lang_cmt/analyze \ 20 | 21 | LINK_LIBS=commons commons_wrappers/graph \ 22 | globals\ 23 | h_program-lang graph_code matcher \ 24 | lang_cpp/parsing lang_c/parsing lang_c/analyze \ 25 | lang_ml/parsing lang_ml/analyze \ 26 | lang_cmt/parsing lang_cmt/analyze \ 27 | 28 | 29 | INCLUDEDIRS=$(INCLUDE_LIBS:%=$(PFFF)/%/) ../lpizer $(OCAMLCOMPILERDIR) 30 | SYSLIBS=nums.cma bigarray.cma unix.cma str.cma $(OCAMLCOMPILERCMA) 31 | LIBS= $(PFFF)/external/ocamlgraph/ocamlgraph.cma \ 32 | $(PFFF)/commons/lib.cma \ 33 | $(PFFF)/commons_core/commons_core.cma \ 34 | $(LINK_LIBS:%=$(PFFF)/%/lib.cma) 35 | 36 | ############################################################################## 37 | # Generic 38 | ############################################################################## 39 | -include $(TOP)/Makefile.common 40 | 41 | ############################################################################## 42 | # Top rules 43 | ############################################################################## 44 | all:: $(TARGET) 45 | all.opt: $(TARGET).opt 46 | 47 | $(TARGET): $(LIBS) ../lpizer/find_source.cmo $(OBJS) 48 | $(OCAMLC) -o $@ $(SYSLIBS) $^ 49 | 50 | $(TARGET).opt: $(LIBS:.cma=.cmxa) $(OPTOBJS) 51 | $(OCAMLOPT) -o $@ $^ 52 | 53 | clean:: 54 | rm -f $(TARGET) 55 | -------------------------------------------------------------------------------- /indexer/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names main_indexer) 3 | (libraries 4 | str 5 | bigarray 6 | ocamlgraph 7 | dyp 8 | 9 | ; for lang_cmt 10 | compiler-libs compiler-libs.common 11 | 12 | commons commons_core 13 | pfff-commons-graph 14 | pfff-h_program-lang pfff-graph_code 15 | 16 | pfff-lang_ml pfff-lang_ml-analyze 17 | pfff-lang_cmt pfff-lang_cmt-analyze 18 | pfff-lang_cpp 19 | pfff-lang_c pfff-lang_c-analyze 20 | 21 | ; for find_source Lib_parsing_xxx 22 | pfff-lang_java 23 | pfff-lang_js 24 | pfff-lang_lisp 25 | pfff-lang_php 26 | pfff-lang_python 27 | 28 | pfff-lang_GENERIC 29 | 30 | ) 31 | ; for ocamldebug 32 | (modes byte) 33 | ) 34 | 35 | 36 | (install 37 | (package syncweb_indexer) 38 | (section bin) 39 | (files (main_indexer.exe as syncweb_indexer) 40 | ) 41 | ) 42 | -------------------------------------------------------------------------------- /indexer/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.1) 2 | (name syncweb_indexer) 3 | -------------------------------------------------------------------------------- /indexer/index_pfff.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | module G = Graph_code 4 | module E = Entity_code 5 | module PI = Parse_info 6 | 7 | (* copy paste of pfff/main_codegraph.ml *) 8 | 9 | let find_source__files_of_dir_or_files ~lang xs = 10 | match lang with 11 | | "cmt" -> 12 | Lib_parsing_ml.find_cmt_files_of_dir_or_files xs 13 | | _ -> Find_source.files_of_dir_or_files ~lang xs 14 | 15 | let find_source__files_of_root ~lang root = 16 | match lang with 17 | | "cmt" -> 18 | Lib_parsing_ml.find_cmt_files_of_dir_or_files [root] 19 | | _ -> Find_source.files_of_root ~lang root 20 | 21 | 22 | let verbose = ref false 23 | (*let output_dir = ref None *) 24 | 25 | let dep_file_of_dir dir = 26 | Filename.concat dir Graph_code.default_filename 27 | 28 | (* special hooks *) 29 | let hook_def_node node g = 30 | let info = Graph_code.nodeinfo node g in 31 | let name = fst node in 32 | let loc = info.G.pos in 33 | let kind = E.string_of_entity_kind (snd node) in 34 | pr (spf "DEF:%s:%s:%d:%s" kind loc.PI.file loc.PI.line name) 35 | 36 | 37 | let hook_use_edge _src dst _g loc = 38 | let name = fst dst in 39 | let kind = E.string_of_entity_kind (snd dst) in 40 | pr (spf "USE:%s:%s:%d:%s" kind loc.PI.file loc.PI.line name) 41 | (*(fst src) not needed *) 42 | 43 | 44 | 45 | 46 | (* copy paste of pfff/main_codegraph.ml *) 47 | let build_graph_code lang xs = 48 | let xs = List.map Common.fullpath xs in 49 | let root, files = 50 | match xs with 51 | | [root] -> 52 | root, find_source__files_of_root ~lang root 53 | | _ -> 54 | let root = Common2.common_prefix_of_files_or_dirs xs in 55 | let files = 56 | find_source__files_of_dir_or_files ~lang xs in 57 | root, files 58 | in 59 | 60 | let empty = Graph_code.empty_statistics () in 61 | let _g, _stats = 62 | try ( 63 | match lang with 64 | | "ml" -> 65 | Graph_code_ml.build ~verbose:!verbose root files, empty 66 | | "cmt" -> 67 | let ml_files = Find_source.files_of_root ~lang:"ml" root in 68 | let cmt_files = files in 69 | 70 | Graph_code_cmt.hook_def_node := hook_def_node; 71 | Graph_code_cmt.hook_use_edge := (fun (src, dst) g loc -> 72 | hook_use_edge src dst g loc; 73 | ); 74 | 75 | Graph_code_cmt.build ~verbose:!verbose ~root ~cmt_files ~ml_files, 76 | empty 77 | | "c" -> 78 | Parse_cpp.init_defs !Flag_parsing_cpp.macros_h; 79 | let local = Filename.concat root "pfff_macros.h" in 80 | if Sys.file_exists local 81 | then Parse_cpp.add_defs local; 82 | 83 | Graph_code_c.hook_def_node := hook_def_node; 84 | Graph_code_c.hook_use_edge := (fun _ctx _in_assign (src, dst) g loc -> 85 | hook_use_edge src dst g loc; 86 | ); 87 | 88 | Graph_code_c.build ~verbose:!verbose root files, empty 89 | | _ -> failwith ("language not supported: " ^ lang) 90 | ) 91 | with Graph_code.Error err -> 92 | pr2 (Graph_code.string_of_error err); 93 | raise (Graph_code.Error err) 94 | in 95 | (* 96 | let output_dir = !output_dir ||| (Sys.getcwd()) in 97 | Graph_code.save g (dep_file_of_dir output_dir); 98 | Graph_code.print_statistics stats g; 99 | *) 100 | () 101 | -------------------------------------------------------------------------------- /indexer/main_indexer.ml: -------------------------------------------------------------------------------- 1 | (* Copyright 2009-2017 Yoann Padioleau, see copyright.txt *) 2 | open Common 3 | 4 | (*****************************************************************************) 5 | (* Purpose *) 6 | (*****************************************************************************) 7 | 8 | (*****************************************************************************) 9 | (* Flags *) 10 | (*****************************************************************************) 11 | 12 | let lang = ref "c" 13 | 14 | (* action mode *) 15 | let action = ref "" 16 | 17 | (*****************************************************************************) 18 | (* Helpers *) 19 | (*****************************************************************************) 20 | 21 | (*****************************************************************************) 22 | (* Actions *) 23 | (*****************************************************************************) 24 | 25 | let actions () = [ 26 | ] 27 | 28 | (*****************************************************************************) 29 | (* Main action *) 30 | (*****************************************************************************) 31 | 32 | let main_action xs = 33 | Index_pfff.build_graph_code !lang xs 34 | 35 | (*****************************************************************************) 36 | (* The options *) 37 | (*****************************************************************************) 38 | 39 | let all_actions () = 40 | actions() @ 41 | [] 42 | 43 | let options () = [ 44 | "-lang", Arg.Set_string lang, 45 | (spf " choose language (default = %s)" !lang); 46 | ] @ 47 | Common2.cmdline_flags_devel () @ 48 | Common.options_of_actions action (all_actions()) @ 49 | [] 50 | 51 | (*****************************************************************************) 52 | (* Main entry point *) 53 | (*****************************************************************************) 54 | 55 | let main () = 56 | 57 | let usage_msg = 58 | "Usage: " ^ Filename.basename Sys.argv.(0) ^ 59 | " [options] " ^ "\n" ^ "Options are:" 60 | in 61 | (* does side effect on many global flags *) 62 | let args = Common.parse_options (options()) usage_msg Sys.argv in 63 | 64 | (* must be done after Arg.parse, because Common.profile is set by it *) 65 | Common.profile_code "Main total" (fun () -> 66 | 67 | (match args with 68 | 69 | (* --------------------------------------------------------- *) 70 | (* actions, useful to debug subpart *) 71 | (* --------------------------------------------------------- *) 72 | | xs when List.mem !action (Common.action_list (all_actions())) -> 73 | Common.do_action !action xs (all_actions()) 74 | 75 | | _ when not (Common.null_string !action) -> 76 | failwith ("unrecognized action or wrong params: " ^ !action) 77 | 78 | (* --------------------------------------------------------- *) 79 | (* main entry *) 80 | (* --------------------------------------------------------- *) 81 | | x::xs -> 82 | main_action (x::xs) 83 | (* --------------------------------------------------------- *) 84 | (* empty entry *) 85 | (* --------------------------------------------------------- *) 86 | | [] -> 87 | Common.usage usage_msg (options()); 88 | failwith "too few arguments" 89 | ) 90 | ) 91 | 92 | (*****************************************************************************) 93 | let _ = 94 | Common.main_boilerplate (fun () -> 95 | main (); 96 | ) 97 | -------------------------------------------------------------------------------- /indexer/syncweb_indexer.opam: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/indexer/syncweb_indexer.opam -------------------------------------------------------------------------------- /install.txt: -------------------------------------------------------------------------------- 1 | You must first install a recent version of 2 | - OPAM and OCaml (at least OCaml 4.12.0), 3 | see https://opam.ocaml.org/doc/Install.html 4 | - Noweb 5 | see http://www.cs.tufts.edu/~nr/noweb/ 6 | - TeX/LaTeX 7 | see http://www.tug.org/texlive/ 8 | 9 | Then simply type 10 | $ make setup 11 | $ make 12 | $ make install 13 | 14 | The 'syncweb' binary should then be in your PATH. 15 | -------------------------------------------------------------------------------- /lpizer/Comment_code.ml: -------------------------------------------------------------------------------- 1 | (* Yoann Padioleau 2 | * 3 | * Copyright (C) 2014 Facebook 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public License 7 | * version 2.1 as published by the Free Software Foundation, with the 8 | * special exception on linking described in file license.txt. 9 | * 10 | * This library is distributed in the hope that it will be useful, but 11 | * WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file 13 | * license.txt for more details. 14 | *) 15 | open Common 16 | module PI = Lib_ast_fuzzy 17 | 18 | (*****************************************************************************) 19 | (* Prelude *) 20 | (*****************************************************************************) 21 | (* A few helpers to deal with comment tokens in code. 22 | * 23 | * See Lib_ast_fuzzy.token_kind 24 | * 25 | * todo: extract and factorize more from comment_php.ml 26 | * 27 | * history: 28 | * - comment_php in pfff 29 | * - comment_code.ml at some point in pfff 30 | * - removed in semgrep, went to TODO-pfff-trimmage 31 | * - restored for syncweb lpizer 32 | *) 33 | 34 | (*****************************************************************************) 35 | (* Types *) 36 | (*****************************************************************************) 37 | 38 | (* Use the Token_.ml helpers to put in those field 39 | * (e.g, Token_helpers_ml.{token_kind_of_tok,info_of_tok}) 40 | *) 41 | (* todo: duplicate of matcher/parse_fuzzy.ml *) 42 | type 'tok hooks = { 43 | kind : 'tok -> Lib_ast_fuzzy.token_kind; 44 | tokf : 'tok -> Tok.t; 45 | } 46 | 47 | (*****************************************************************************) 48 | (* Helpers *) 49 | (*****************************************************************************) 50 | 51 | let drop_space_and_newline hooks toks = 52 | toks |> Common2.drop_while (fun t -> 53 | let kind = hooks.kind t in 54 | match kind with 55 | | PI.Esthet PI.Newline 56 | | PI.Esthet PI.Space -> 57 | true 58 | | _ -> false 59 | ) 60 | 61 | (*****************************************************************************) 62 | (* API *) 63 | (*****************************************************************************) 64 | 65 | let toks_before hooks (tok : Tok.t) all_toks = 66 | let pos = Tok.bytepos_of_tok tok in 67 | all_toks 68 | |> Common2.take_while (fun tok2 -> 69 | let info = hooks.tokf tok2 in 70 | let pos2 = Tok.bytepos_of_tok info in 71 | pos2 < pos) 72 | 73 | let toks_after hooks (tok : Tok.t) all_toks = 74 | let pos = Tok.bytepos_of_tok tok in 75 | all_toks 76 | |> Common2.drop_while (fun tok2 -> 77 | let info = hooks.tokf tok2 in 78 | let pos2 = Tok.bytepos_of_tok info in 79 | pos2 <= pos 80 | ) 81 | 82 | let comment_before hooks (tok : Tok.t) all_toks : Tok.t option = 83 | let before = toks_before hooks tok all_toks in 84 | let first_non_space = 85 | List.rev before |> drop_space_and_newline hooks 86 | in 87 | match first_non_space with 88 | | x :: _xs when hooks.kind x =*= PI.Esthet PI.Comment -> 89 | let info = hooks.tokf x in 90 | if Tok.col_of_tok info =|= 0 then Some info else None 91 | | _ -> None 92 | 93 | let comment_after hooks (tok : Tok.t) all_toks : Tok.t option = 94 | let after = toks_after hooks tok all_toks in 95 | let line = Tok.line_of_tok tok in 96 | let first_non_space = after |> drop_space_and_newline hooks in 97 | match first_non_space with 98 | | x :: _xs when hooks.kind x =*= PI.Esthet PI.Comment -> 99 | let info = hooks.tokf x in 100 | (* for ocaml comments they are not necessarily in 101 | * column 0, but they must be just after 102 | *) 103 | if 104 | Tok.line_of_tok info =|= line || Tok.line_of_tok info =|= line + 1 105 | (* && PI.col_of_info info > 0 *) 106 | then Some info 107 | else None 108 | | _ -> None 109 | -------------------------------------------------------------------------------- /lpizer/Comment_code.mli: -------------------------------------------------------------------------------- 1 | 2 | (* Use the Token_.ml helpers to put in those field 3 | * (e.g, Token_helpers_ml.{token_kind_of_tok,info_of_tok}) 4 | *) 5 | type 'tok hooks = { 6 | kind : 'tok -> Lib_ast_fuzzy.token_kind; 7 | tokf : 'tok -> Tok.t; 8 | } 9 | 10 | val toks_before: 'a hooks -> Tok.t -> 'a list -> 'a list 11 | val toks_after: 'a hooks -> Tok.t -> 'a list -> 'a list 12 | 13 | val comment_before : 'a hooks -> Tok.t -> 'a list -> Tok.t option 14 | 15 | val comment_after : 'a hooks -> Tok.t -> 'a list -> Tok.t option 16 | 17 | val drop_space_and_newline: 'a hooks -> 'a list -> 'a list 18 | -------------------------------------------------------------------------------- /lpizer/Lpize.mli: -------------------------------------------------------------------------------- 1 | 2 | val lpize: Fpath.t list -> unit 3 | -------------------------------------------------------------------------------- /lpizer/Main.ml: -------------------------------------------------------------------------------- 1 | (* Copyright 2009-2017 Yoann Padioleau, see copyright.txt *) 2 | 3 | (*****************************************************************************) 4 | (* Purpose *) 5 | (*****************************************************************************) 6 | (* Assist in producing a first version of a literate programming (LP) 7 | * document. 8 | * 9 | * history: 10 | * - was in pfff -lpize before. 11 | *) 12 | 13 | (*****************************************************************************) 14 | (* Flags *) 15 | (*****************************************************************************) 16 | 17 | (* action mode *) 18 | let action = ref "" 19 | 20 | (*****************************************************************************) 21 | (* Helpers *) 22 | (*****************************************************************************) 23 | 24 | (*****************************************************************************) 25 | (* Actions *) 26 | (*****************************************************************************) 27 | 28 | let actions () = [ 29 | ] 30 | 31 | (*****************************************************************************) 32 | (* Main action *) 33 | (*****************************************************************************) 34 | 35 | (* for lpification, to get a list of files and handling the skip list *) 36 | (* 37 | let find_source xs = 38 | let root = Common2_.common_prefix_of_files_or_dirs xs in 39 | let root = Unix.realpath root |> Common2_.chop_dirsymbol in 40 | let files = 41 | failwith "TODO: find_source use Find_generic in codegraph" 42 | in 43 | (* Find_source.files_of_dir_or_files ~lang:!lang xs in *) 44 | files |> List.iter (fun file -> 45 | Logs.info (fun m -> m "processing: %s" (Filename_.readable root file)) 46 | ) 47 | *) 48 | 49 | let main_action (xs : Fpath.t list) : unit = 50 | Lpize.lpize xs 51 | 52 | (*****************************************************************************) 53 | (* The options *) 54 | (*****************************************************************************) 55 | 56 | (* 57 | "-find_source", " ", 58 | Common.mk_action_n_arg find_source; 59 | *) 60 | let all_actions () = 61 | actions() @ 62 | [] 63 | 64 | (* TODO: add 65 | "-lang", Arg.Set_string lang, 66 | (spf " choose language (default = %s)" !lang); 67 | "-verbose", Arg.Set verbose, 68 | " "; 69 | *) 70 | 71 | let options () = [ 72 | ] @ 73 | Common2.cmdline_flags_devel () @ 74 | Arg_.options_of_actions action (all_actions()) @ 75 | [] 76 | 77 | (*****************************************************************************) 78 | (* Main entry point *) 79 | (*****************************************************************************) 80 | 81 | let main () = 82 | 83 | let usage_msg = 84 | "Usage: " ^ Filename.basename Sys.argv.(0) ^ 85 | " [options] " ^ "\n" ^ "Options are:" 86 | in 87 | (* does side effect on many global flags *) 88 | let args = Arg_.parse_options (options()) usage_msg Sys.argv in 89 | 90 | (* must be done after Arg.parse, because Common.profile is set by it *) 91 | Profiling.profile_code "Main total" (fun () -> 92 | 93 | (match args with 94 | 95 | (* --------------------------------------------------------- *) 96 | (* actions, useful to debug subpart *) 97 | (* --------------------------------------------------------- *) 98 | | xs when List.mem !action (Arg_.action_list (all_actions())) -> 99 | Arg_.do_action !action xs (all_actions()) 100 | 101 | | _ when not (String_.empty !action) -> 102 | failwith ("unrecognized action or wrong params: " ^ !action) 103 | 104 | (* --------------------------------------------------------- *) 105 | (* main entry *) 106 | (* --------------------------------------------------------- *) 107 | | x::xs -> 108 | main_action (Fpath_.of_strings (x::xs)) 109 | (* --------------------------------------------------------- *) 110 | (* empty entry *) 111 | (* --------------------------------------------------------- *) 112 | | [] -> 113 | Arg_.usage usage_msg (options()); 114 | failwith "too few arguments" 115 | ) 116 | ) 117 | 118 | (*****************************************************************************) 119 | let _ = 120 | UCommon.main_boilerplate (fun () -> 121 | main (); 122 | ) 123 | -------------------------------------------------------------------------------- /lpizer/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names Main) 3 | (libraries 4 | ; external libs 5 | logs 6 | fpath 7 | 8 | ; from semgrep-libs 9 | commons 10 | parser_cpp.ast parser_cpp.menhir parser_cpp.ast_generic 11 | parser_ocaml.ast parser_ocaml.menhir parser_ocaml.ast_generic 12 | parser_ocaml.tree_sitter ; to parse Cap object types 13 | 14 | ; from codemap now 15 | commons2_ 16 | graph_code 17 | 18 | ; from codegraph now 19 | pfff-lang_ml-analyze 20 | 21 | ; internal 22 | ; frontend 23 | ; backend 24 | ) 25 | (preprocess (pps ppx_deriving.show )) ; LATER: ppx_profiling 26 | ; 'byte' is useful for ocamldebug 27 | ; 'best' is 'native' with a fallback to 'byte' when native compilation isn’t available. 28 | (modes (best exe) byte) 29 | ) 30 | 31 | (install 32 | (package syncweb) 33 | (section bin) 34 | (files (Main.exe as lpizer)) 35 | ) 36 | -------------------------------------------------------------------------------- /main/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names Main) 3 | (libraries 4 | ; external libs 5 | logs 6 | fpath 7 | commons 8 | 9 | ; internal 10 | frontend 11 | backend 12 | ) 13 | (preprocess (pps ppx_deriving.show )) ; LATER: ppx_profiling 14 | ; 'byte' is useful for ocamldebug 15 | ; 'best' is 'native' with a fallback to 'byte' when native compilation isn’t available. 16 | (modes (best exe) byte) 17 | ) 18 | 19 | (install 20 | (package syncweb) 21 | (section bin) 22 | (files (Main.exe as syncweb)) 23 | ) 24 | -------------------------------------------------------------------------------- /main/refactor.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | open Web 4 | open Code 5 | 6 | (*****************************************************************************) 7 | (* Prelude *) 8 | (*****************************************************************************) 9 | (* 10 | * adhoc scripts to adjust .nw files. 11 | *) 12 | 13 | (*****************************************************************************) 14 | (* Helpers *) 15 | (*****************************************************************************) 16 | 17 | let count_dollar s = 18 | let cnt = ref 0 in 19 | for i = 0 to String.length s - 1 do 20 | if String.get s i =$= '$' 21 | then incr cnt 22 | done; 23 | !cnt 24 | 25 | let trim s = 26 | Str.global_replace (Str.regexp " +$") "" s 27 | 28 | (*****************************************************************************) 29 | (* Renaming chunks *) 30 | (*****************************************************************************) 31 | 32 | (* less: could make this a generic mapper *) 33 | let rename_chunknames xs = 34 | let subst_maybe s = 35 | let s, suffix = 36 | match s with 37 | | _ when s =~ "^\\([^(]+\\)\\(([ax][r8][m6])\\)$" -> 38 | Common.matched2 s 39 | | _ when s =~ "^\\([^(]+\\)\\((raspberry pi[12])(arm)\\)$" -> 40 | Common.matched2 s 41 | 42 | (* for CompilerGenerator.nw *) 43 | | _ when s =~ "^\\([^(]+\\)\\((lex)\\)$" -> 44 | Common.matched2 s 45 | | _ when s =~ "^\\([^(]+\\)\\((yacc)\\)$" -> 46 | Common.matched2 s 47 | 48 | | _ when s =~ "^\\([^(]+\\) \\(([a-z_0-9]+/.*)\\)$" -> 49 | let (a, b) = Common.matched2 s in 50 | a, spf "([[%s]])" b 51 | | _ -> s, "" 52 | in 53 | let s = trim s in 54 | let res = 55 | match s with 56 | | _ when s =~ "^function \\([a-zA-Z0-9_.]+\\)$" -> 57 | spf "function [[%s]]" (Common.matched1 s) 58 | | _ when s =~ "^signature \\([a-zA-Z0-9_.]+\\)$" -> 59 | spf "signature [[%s]]" (Common.matched1 s) 60 | | _ when s =~ "^exception \\([a-zA-Z0-9_.]+\\)$" -> 61 | spf "exception [[%s]]" (Common.matched1 s) 62 | | _ when s =~ "^constructor \\([a-zA-Z0-9_.]+\\)$" -> 63 | spf "constructor [[%s]]" (Common.matched1 s) 64 | | _ when s =~ "^destructor \\([a-zA-Z0-9_]+\\)$" -> 65 | spf "destructor [[%s]]" (Common.matched1 s) 66 | | _ when s =~ "^global \\([a-zA-Z0-9_.]+\\)$" -> 67 | spf "global [[%s]]" (Common.matched1 s) 68 | | _ when s =~ "^enum \\([a-zA-Z0-9_.]+\\)$" -> 69 | spf "enum [[%s]]" (Common.matched1 s) 70 | | _ when s =~ "^type \\([a-zA-Z0-9_.]+\\)$" -> 71 | spf "type [[%s]]" (Common.matched1 s) 72 | | _ when s =~ "^struct \\([a-zA-Z0-9_]+\\)$" -> 73 | spf "struct [[%s]]" (Common.matched1 s) 74 | | _ when s =~ "^macro \\([a-zA-Z0-9_]+\\)$" -> 75 | spf "macro [[%s]]" (Common.matched1 s) 76 | | _ when s =~ "^constant \\([a-zA-Z0-9_.]+\\)$" -> 77 | spf "constant [[%s]]" (Common.matched1 s) 78 | | _ when s =~ "^toplevel \\([a-zA-Z0-9_.]+\\)$" -> 79 | spf "toplevel [[%s]]" (Common.matched1 s) 80 | | _ when s =~ "^typedef \\([a-zA-Z0-9_.]+\\)$" -> 81 | spf "typedef [[%s]]" (Common.matched1 s) 82 | 83 | | _ when s =~ "^enum _anon_ \\(.*\\)$" -> 84 | spf "enum [[_anon_ %s]]" (Common.matched1 s) 85 | | _ -> s 86 | in 87 | res ^ suffix 88 | in 89 | xs |> List.iter (fun file -> 90 | let orig = Web.parse file in 91 | 92 | let rec tex_or_chunkdef x = 93 | match x with 94 | | Tex xs -> Tex xs 95 | | ChunkDef (def, ys) -> 96 | let def = { def with chunkdef_key = subst_maybe def.chunkdef_key } in 97 | ChunkDef (def, ys |> List.map code_or_chunk) 98 | and code_or_chunk x = 99 | match x with 100 | | Code s -> Code s 101 | | ChunkName (s, i) -> ChunkName (subst_maybe s, i) 102 | in 103 | let orig2 = List.map tex_or_chunkdef orig in 104 | Web.unparse orig2 file 105 | ) 106 | 107 | (*****************************************************************************) 108 | (* Rename chunks to indicate arch specific code (x86) or (arm) *) 109 | (*****************************************************************************) 110 | 111 | let rename_chunknames_archi xs = 112 | let origs, views = xs |> Either_.partition (fun file -> 113 | if file =~ ".*.nw$" 114 | then Left file 115 | else Right file 116 | ) 117 | in 118 | 119 | let hchunks = Hashtbl.create 101 in 120 | 121 | views |> List.iter (fun file -> 122 | let view = Code.parse ~lang:Lang.mark_C_short file in 123 | 124 | let rec codetree x = 125 | match x with 126 | | RegularCode _ -> () 127 | | ChunkCode (info, xs, _indent) -> 128 | Hashtbl.replace hchunks info.chunk_key true; 129 | xs |> List.iter codetree 130 | in 131 | List.iter codetree view; 132 | hchunks |> Hashtbl_.hash_to_list |> List.iter (fun (k, _) -> 133 | UCommon.pr k 134 | ); 135 | ); 136 | let subst_maybe s = 137 | if s =~ ".*8[acl]/" 138 | || s =~ ".*386" 139 | || s =~ ".*x86" (* avoid apply on what was already applied *) 140 | || s = "kernel basic includes" 141 | || s =~ ".*\\.[chs]$" 142 | then s 143 | else 144 | if Hashtbl.mem hchunks s 145 | then s ^ "(x86)" 146 | else s 147 | in 148 | 149 | origs |> List.iter (fun file -> 150 | let orig = Web.parse file in 151 | 152 | let rec tex_or_chunkdef x = 153 | match x with 154 | | Tex xs -> Tex xs 155 | | ChunkDef (def, ys) -> 156 | let def = { def with chunkdef_key = subst_maybe def.chunkdef_key } in 157 | ChunkDef (def, ys |> List.map code_or_chunk) 158 | and code_or_chunk x = 159 | match x with 160 | | Code s -> Code s 161 | | ChunkName (s, i) -> ChunkName (subst_maybe s, i) 162 | in 163 | let orig2 = List.map tex_or_chunkdef orig in 164 | Web.unparse orig2 file 165 | ) 166 | 167 | (*****************************************************************************) 168 | (* Merge files?? *) 169 | (*****************************************************************************) 170 | 171 | let merge_files xs = 172 | let hchunkkey_to_files = Hashtbl.create 101 in 173 | let htopkeysfile = Hashtbl.create 101 in 174 | let hfile_to_topkeys = Hashtbl.create 101 in 175 | 176 | (* first pass, find duplicate chunk names in different .nw *) 177 | xs |> List.iter (fun file -> 178 | let orig = 179 | try 180 | Web.parse file 181 | with exn -> 182 | failwith (spf "PB with %s, exn = %s" file (Common.exn_to_s exn)) 183 | in 184 | 185 | let rec tex_or_chunkdef x = 186 | match x with 187 | | Tex _xs -> () 188 | | ChunkDef (def, ys) -> 189 | let key = def.chunkdef_key in 190 | let hfiles_of_key = 191 | try Hashtbl.find hchunkkey_to_files key 192 | with Not_found -> 193 | let h = Hashtbl.create 101 in 194 | Hashtbl.add hchunkkey_to_files key h; 195 | h 196 | in 197 | Hashtbl.replace hfiles_of_key file true; 198 | if key =~ ".*\\.ml[i]?$" 199 | then begin 200 | let path = Filename.concat (Filename.dirname file) key in 201 | if Sys.file_exists path && not (Hashtbl.mem htopkeysfile path) 202 | then begin 203 | Hashtbl.add htopkeysfile path true; 204 | (* pr2 (spf " %s\\" path); *) 205 | Hashtbl.add hfile_to_topkeys file key 206 | end 207 | end; 208 | 209 | ys |> List.iter code_or_chunk 210 | and code_or_chunk x = 211 | match x with 212 | | Code _s -> () 213 | | ChunkName (_s, _i) -> () 214 | in 215 | List.iter tex_or_chunkdef orig 216 | ); 217 | 218 | let lastdir = ref "" in 219 | 220 | (* second pass, rename them *) 221 | xs |> List.iter (fun file -> 222 | let dir = Filename.dirname file in 223 | (* let pr _ = () in (* TODO *) *) 224 | if dir <> !lastdir then begin 225 | UCommon.pr ""; 226 | UCommon.pr (spf "\\chapter{[[%s]]}" dir); 227 | UCommon.pr ""; 228 | lastdir := dir 229 | end; 230 | 231 | UCommon.pr (spf "\\section{[[%s]]}" file); 232 | 233 | (* to have a single topkey entry *) 234 | let xs = Hashtbl.find_all hfile_to_topkeys file in 235 | xs |> List.iter (fun topkey -> 236 | UCommon.pr (spf "<<%s/%s>>=" dir topkey); 237 | UCommon.pr (spf "<<%s>>" topkey); 238 | UCommon.pr "@"; 239 | UCommon.pr "" 240 | ); 241 | 242 | let orig = Web.parse file in 243 | 244 | let subst_maybe key = 245 | try 246 | let h = Hashtbl.find hchunkkey_to_files key in 247 | let files = Hashtbl_.hashset_to_list h in 248 | if List.length files > 1 249 | then key ^ (spf "(%s)" (Filename.basename file)) 250 | else key 251 | with Not_found -> key 252 | in 253 | 254 | let rec tex_or_chunkdef x = 255 | match x with 256 | | Tex xs -> 257 | [Tex (xs |> List.map (fun s -> 258 | if s =~ "^\\\\section" || 259 | s =~ "^\\\\subsection" || 260 | s =~ "^%----" 261 | then s 262 | else "%%" ^ s 263 | ))] 264 | | ChunkDef (def, ys) -> 265 | (*TODO: detect if even number of $ in which case need 266 | * add a fake %$ to the end 267 | *) 268 | let def = { def with chunkdef_key = subst_maybe def.chunkdef_key } in 269 | let nbdollars = ys |> List.map (function 270 | | Code s -> count_dollar s 271 | | ChunkName (s, _) -> count_dollar s 272 | ) |> Common2_.sum 273 | in 274 | [ChunkDef (def, ys |> List.map code_or_chunk)] @ 275 | (if nbdollars mod 2 =|= 1 276 | then [Tex ["%$"]] 277 | else [] 278 | ) 279 | and code_or_chunk x = 280 | match x with 281 | | Code s -> Code s 282 | | ChunkName (s, i) -> ChunkName (subst_maybe s, i) 283 | in 284 | let orig2 = List.map tex_or_chunkdef orig |> List.flatten in 285 | Web.unparse orig2 file; 286 | 287 | UFile.Legacy.cat file |> List.iter UCommon.pr; 288 | Sys.command (spf "rm -f %s" file) |> ignore; 289 | 290 | Hashtbl.find_all hfile_to_topkeys file |> List.iter (fun topkey -> 291 | Sys.command (spf "rm -f %s/%s" dir topkey) |> ignore; 292 | ) 293 | ) 294 | -------------------------------------------------------------------------------- /main/refactor.mli: -------------------------------------------------------------------------------- 1 | 2 | val rename_chunknames : string (* Common.filename *) list -> unit 3 | val rename_chunknames_archi : string (* Common.filename *) list -> unit 4 | val merge_files : string (* Common.filename *) list -> unit 5 | -------------------------------------------------------------------------------- /main/sync.ml: -------------------------------------------------------------------------------- 1 | (* Copyright 2009-2017 Yoann Padioleau, see copyright.txt *) 2 | open Common 3 | 4 | open Web 5 | open Code 6 | 7 | (*****************************************************************************) 8 | (* Prelude *) 9 | (*****************************************************************************) 10 | (* 11 | * history: I started by defining types for orig and view that describes 12 | * how I want the two formats. Basically a list of stuff (aka chunks in 13 | * LP terminology) . Then I wrote parse_orig, parse_view, the unparser, 14 | * and then view_of_orig and orig_of_view. Then finally I wrote sync. 15 | * 16 | * Later: 17 | * - the md5sum marks can be in an auxillary file 18 | * 19 | * note: I took inspirations from nofake. Fun to see how Perl is quite 20 | * good. The nofake program is very short. But Lindig does multiple 21 | * things at the same time: parsing, building the hash, etc. 22 | *) 23 | 24 | (*****************************************************************************) 25 | (* Types *) 26 | (*****************************************************************************) 27 | 28 | type orig = Web.t 29 | type view = Code.t 30 | 31 | (*****************************************************************************) 32 | (* Helpers *) 33 | (*****************************************************************************) 34 | 35 | let rec uniq_agglomerate_chunkname xs = 36 | match xs with 37 | | [] -> [] 38 | | [x] -> [x] 39 | | x::y::xs -> 40 | (match x, y with 41 | | ChunkName (k1, i1), ChunkName(k2, i2) -> 42 | if k1 = k2 43 | then begin 44 | assert (i1 =|= i2); 45 | uniq_agglomerate_chunkname (y::xs); 46 | end else 47 | x::(uniq_agglomerate_chunkname (y::xs)) 48 | | _ -> x::(uniq_agglomerate_chunkname (y::xs)) 49 | ) 50 | 51 | (* can not necessarily know the order, in which order the chunkdefs 52 | * were put, but can reconstruct a hash with the def of each chunk 53 | *) 54 | let build_chunk_hash_from_views views = 55 | let h = Hashtbl.create 101 in 56 | let rec aux view = 57 | match view with 58 | | ChunkCode (x, body, _i) -> 59 | let key = x.chunk_key in 60 | let md5sum = x.chunk_md5sum in 61 | 62 | let body' = 63 | body |> List.map (* and side effect *) (fun x -> 64 | match x with 65 | | ChunkCode (y, _body, j) -> 66 | aux x; 67 | ChunkName (y.chunk_key, j) 68 | | RegularCode s -> 69 | Code s 70 | ) 71 | in 72 | (* bugfix: some nested chunks can be defined in multiple parts, 73 | * e.g. <> can be defined by multiple <>=, then 74 | * when expanded, we dont want to return a serie of <> 75 | * as in the following: 76 | * [ChunkName ("type", 0); Code "let foo x = 1"; Code ""; 77 | * Code "let bar y = 2"; Code ""; 78 | * ChunkName ("part1", 0); 79 | * ChunkName ("part1", 0); 80 | * ChunkName ("part1", 0); 81 | * ChunkName ("part2", 0)] 82 | *) 83 | let body'' = uniq_agglomerate_chunkname body' in 84 | 85 | Common2_.hupdate_default key (fun x -> x @ [md5sum, body'']) 86 | (fun()->[]) h; 87 | 88 | | RegularCode s -> 89 | failwith ("code without enclosing chunk: " ^ s) 90 | in 91 | views |> List.iter aux; 92 | h 93 | 94 | (*****************************************************************************) 95 | (* Diff *) 96 | (*****************************************************************************) 97 | 98 | let show_orig_view ?(force_display=false)key s_orig s_view = 99 | UCommon.pr2 ("DIFF for: " ^ key); 100 | if (Common2_.nblines s_orig > 5 || Common2_.nblines s_view > 5) && 101 | not force_display 102 | then 103 | () 104 | else begin 105 | UCommon.pr2 "<<<<<<< orig <<<<<<<<"; 106 | Common2_.pr2_no_nl s_orig; 107 | UCommon.pr2 "===================="; 108 | Common2_.pr2_no_nl s_view; 109 | UCommon.pr2 ">>>>>>> view >>>>>>>>"; 110 | end 111 | 112 | let show_diff stra strb = 113 | let tmpa = "/tmp/a" in 114 | let tmpb = "/tmp/b" in 115 | UFile.Legacy.write_file ~file:tmpa stra; 116 | UFile.Legacy.write_file ~file:tmpb strb; 117 | Sys.command (spf "diff -u %s %s" tmpa tmpb) |> ignore; 118 | () 119 | 120 | (*****************************************************************************) 121 | (* Merger *) 122 | (*****************************************************************************) 123 | 124 | (* When this function is called ? when a chunk body_orig was not found. 125 | * Maybe this orig was modified, Maybe the corresponding view was modified. 126 | * Maybe a new chunk was inserted, or modified and moved around. 127 | * 128 | * This function is supposed to return a set of view_elems that is 129 | * safe to "sync" with body_orig. For instance we may not want to return 130 | * the next elem in view_elems because maybe it is equal to the 131 | * next elem in orig_elems. It is ok to return an empty list. 132 | * 133 | * pre: body_orig can not be in view_elems. but it should be the 134 | * first in orig_elems. 135 | *) 136 | let candidates_against_orig _body_orig view_elems _orig_elems = 137 | view_elems 138 | 139 | 140 | (* Pierce with his lenses takes also the original view, but I instead use the 141 | * md5sum in the view as a way to access the original version of orig. 142 | *) 143 | let sync2 ~lang orig views = 144 | ignore(lang); 145 | 146 | let h = build_chunk_hash_from_views views in 147 | let chunks = h |> Hashtbl_.hash_to_list |> List.map (fun (k, v) -> k, ref v) in 148 | let h_view = Hashtbl_.hash_of_list chunks in 149 | 150 | 151 | let h = Crossref_chunk.hchunkname_to_body__from_orig orig in 152 | let chunks = h |> Hashtbl_.hash_to_list |> List.map (fun (k, v) -> k, ref v) in 153 | let h_orig = Hashtbl_.hash_of_list chunks in 154 | 155 | (* we explore the orig in the original order *) 156 | let orig' = 157 | orig |> List.map (function 158 | | Tex s -> 159 | Tex s 160 | | ChunkDef (def, body_orig) -> 161 | let key = def.chunkdef_key in 162 | 163 | (match Common2_.hfind_option key h_view with 164 | | None -> 165 | (* Case1: new chunk in orig *) 166 | ChunkDef (def, body_orig) 167 | 168 | (* need to do the following ? 169 | * aref_orig := Common.remove_first body_orig !aref_orig; ?? 170 | * no, not needed cos there is no key anyway in h_view. 171 | *) 172 | 173 | | Some aref_view -> 174 | 175 | (match !aref_view with 176 | | [] -> 177 | (* Case2: old chunk in orig deleted *) 178 | let s_orig = Web_to_code.s_of_chunkdef_body body_orig in 179 | 180 | UCommon.pr2 ("a chunk has been deleted or moved for: " ^ key); 181 | UCommon.pr2 "<<<<<<< orig <<<<<<<<"; 182 | Common2_.pr2_no_nl s_orig; 183 | UCommon.pr2 "===================="; 184 | if (Common2_.y_or_no "keep the one in orig?") 185 | then ChunkDef (def, body_orig) 186 | else failwith "stopped" 187 | 188 | | _x::_xs -> 189 | 190 | (* no need try here *) 191 | let aref_orig = Hashtbl.find h_orig key in 192 | 193 | (try 194 | (* Case3: equal chunk *) 195 | let elem_view = 196 | !aref_view |> List.find (fun (_md5, body_view) -> 197 | (* bugfix: have written body_view = body_view :) 198 | * type system can not catch such bugs :( 199 | *) 200 | body_orig =*= body_view 201 | ) 202 | in 203 | aref_orig := Common2_.remove_first body_orig !aref_orig; 204 | aref_view := Common2_.remove_first elem_view !aref_view; 205 | ChunkDef (def, body_orig) 206 | 207 | with Not_found -> 208 | (* maybe someone inserted a new append-chunk, and we 209 | * would not like that with a simple shift the user 210 | * could be forced to resynchronize and confirm for all the 211 | * other parts. So instead try to better match 212 | * chunk together. 213 | *) 214 | let candidates = 215 | candidates_against_orig body_orig !aref_view !aref_orig 216 | in 217 | (match candidates with 218 | | [] -> 219 | (* Case1bis: new chunk in orig ? *) 220 | aref_orig := Common2_.remove_first body_orig !aref_orig; 221 | ChunkDef (def, body_orig) 222 | 223 | | elem_view::_xs -> 224 | (* case4: multiple possible reasons. *) 225 | 226 | aref_orig := Common2_.remove_first body_orig !aref_orig; 227 | aref_view := Common2_.remove_first elem_view !aref_view; 228 | 229 | let (md5sum_orig_in_view_opt, body_view) = elem_view in 230 | 231 | let md5sum_past = 232 | match md5sum_orig_in_view_opt with 233 | | None -> 234 | (* TODO: probably a chunk got deleted in view file 235 | * one trick to fix this is to: 236 | * - delete the view, make sync, look in the 237 | * diff which chunk got deleted 238 | * - git reset --hard; put empty chunk in the view 239 | * - make sync should now work 240 | *) 241 | failwith (spf "TODO: didnt find the md5sum in %s" 242 | (Dumper.dump elem_view)) 243 | | Some s -> s 244 | in 245 | 246 | let s_orig = Web_to_code.s_of_chunkdef_body body_orig in 247 | let s_view = Web_to_code.s_of_chunkdef_body body_view in 248 | 249 | let md5sum_orig= Signature.signature_of_string s_orig in 250 | let md5sum_view= Signature.signature_of_string s_view in 251 | 252 | show_orig_view key s_orig s_view; 253 | 254 | UCommon.pr2 "orig view"; 255 | (* ask choice or merge *) 256 | 257 | let first_heuristic = 258 | match () with 259 | | _ when md5sum_past =*= md5sum_orig -> 260 | show_diff s_orig s_view; 261 | if (Common2_.y_or_no 262 | " <---- changed?") 263 | then Some body_view 264 | else None 265 | 266 | | _ when md5sum_past =*= md5sum_view -> 267 | show_diff s_view s_orig; 268 | if (Common2_.y_or_no 269 | "changed ----> ?") 270 | then Some body_orig 271 | else None 272 | 273 | | _ -> None 274 | in 275 | let body' = 276 | match first_heuristic with 277 | | Some x -> x 278 | | None -> 279 | show_orig_view ~force_display:true 280 | key s_orig s_view; 281 | 282 | 283 | show_diff s_orig s_view; 284 | UCommon.pr2 "who is right ? orig ? view ? both ? o/v/b ? "; 285 | 286 | let answer = read_line() in 287 | (match answer with 288 | | "o" -> body_orig 289 | | "v" -> body_view 290 | | "b" -> raise Todo 291 | | _ -> failwith "not a valid answer" 292 | ) 293 | in 294 | ChunkDef({ 295 | chunkdef_key = key; 296 | chunkdef_end = def.chunkdef_end; 297 | chunkdef_id = def.chunkdef_id; 298 | }, body') 299 | ) 300 | ) 301 | ) 302 | ) 303 | ) 304 | in 305 | 306 | (* check if have consumed every elements in the view *) 307 | h_view |> Hashtbl_.hash_to_list |> List.iter (fun (k,v) -> 308 | match !v with 309 | | [] -> () 310 | | x::xs -> 311 | Logs.warn (fun m -> m "Not consumed: %s" k); 312 | let strs = (x::xs) |> List.map snd |> List.map 313 | Web_to_code.s_of_chunkdef_body in 314 | strs |> List.iter Common2_.pr2_no_nl; 315 | ); 316 | 317 | orig' 318 | 319 | let sync ~lang a b = 320 | (* Common.profile_code "Sync.sync" (fun () -> *) 321 | sync2 ~lang a b 322 | (* ) *) 323 | 324 | -------------------------------------------------------------------------------- /main/sync.mli: -------------------------------------------------------------------------------- 1 | 2 | type orig = Web.t 3 | type view = Code.t 4 | 5 | (* main entry *) 6 | val sync: lang:Lang.mark_language -> orig -> view -> orig 7 | -------------------------------------------------------------------------------- /notes.txt: -------------------------------------------------------------------------------- 1 | you can move chunks from the source files directly, but you must 2 | not modify the content of the chunk at the same time. If you need 3 | to do so do it in two steps. Move the chunk; syncweb; then 4 | modify the chunk. 5 | -------------------------------------------------------------------------------- /project.el: -------------------------------------------------------------------------------- 1 | (defun pad-ocaml-project-xxx () 2 | (interactive) 3 | 4 | (setq 5 | pad-ocaml-project-path "/home/pad/c__syncweb" 6 | pad-ocaml-project-subdirs 7 | (split-string 8 | "commons globals extra 9 | h_version-control h_statistics 10 | gui 11 | ") 12 | pad-ocaml-project-toplevel "syncweb.top" 13 | ) 14 | 15 | ; -------------------------------------------------------------------------- 16 | ; xxx 17 | ; -------------------------------------------------------------------------- 18 | (setq 19 | pad-ocaml-project-prog "syncweb" 20 | pad-ocaml-project-args 21 | (join-string 22 | (list 23 | "-debugger" 24 | (case 11 25 | 26 | (0 "foo") 27 | (1 "-view_of_orig tests/hello.nw hello.c") 28 | (2 "-parse_view demos/demo.mli") 29 | (3 "-sync tests/hello.nw tests/hello.c") 30 | 31 | (10 "demos/demo.ml.nw demos/demo.ml") 32 | (11 "-less_marks demos/demo.ml.nw demos/demo.ml") 33 | (20 "-md5sum_in_auxfile demos/multi.nw demos/multi1.nw demos/multi2.nw multi_main.ml") 34 | 35 | (30 "-less_marks -unparse_view demos/demo.ml.nw demo.ml") 36 | ) 37 | ) 38 | ) 39 | ) 40 | 41 | ; -------------------------------------------------------------------------- 42 | ; xxx2 43 | ; -------------------------------------------------------------------------- 44 | 45 | (setq 46 | pad-ocaml-project-prog "xxx2" 47 | ;pad-ocaml-project-prog "gui/test" 48 | pad-ocaml-project-args 49 | (join-string 50 | (list 51 | "-debugger" 52 | (case 0 53 | (0 "") 54 | ) 55 | )) 56 | ) 57 | 58 | ; -------------------------------------------------------------------------- 59 | ; for the help system, for C-c C-h to find where to look for 60 | (mapcar (lambda (p) 61 | (ocaml-add-path (concat pad-ocaml-project-path "/" p)) 62 | (ocaml-add-path "/usr/lib/ocaml/3.09.2/lablgtk2") 63 | (ocaml-add-path "/usr/lib/ocaml/3.09.2/lablgtksourceview") 64 | (ocaml-add-path "/home/pad/comments/ocamlgtk/src") 65 | (ocaml-add-path "/home/pad/packages/lib/ocaml/std-lib") 66 | (ocaml-add-path "/home/pad/packages/lib/ocaml/pkg-lib/lablgtk2") 67 | (ocaml-add-path "/home/pad/packages/lib/ocaml/pkg-lib/lablgtksourceview") 68 | ) 69 | pad-ocaml-project-subdirs 70 | ) 71 | ) 72 | 73 | ;(setq ocaml-lib-path nil) 74 | ;(setq ocaml-module-alist 'lazy) 75 | -------------------------------------------------------------------------------- /readme.txt: -------------------------------------------------------------------------------- 1 | Syncweb, Literate Programming meets Unison 2 | 3 | 4 | Introduction 5 | ---------------- 6 | 7 | Syncweb is a command-line tool enabling programmers to use the 8 | literate programming[1] development methodology, using the noweb[2] 9 | tool, while still being able to modify the generated files 10 | from the literate document. syncweb provides a way to 11 | "synchronize" the possibly modified original document with its 12 | possibly modified views with an interface similar to unison[3]. In 13 | addition, syncweb synchronizes data at a fine grained level by 14 | computing and storing md5sum of the different chunks. 15 | 16 | Note that literate programming is different from using javadoc, or 17 | doxygen, or ocamlweb. Noweb, and syncweb, do not provide the same kind 18 | of services. Literate programming allows programmers to explain their 19 | code in the order they think the code will be better understood, and 20 | allows among other things to explain code piece by piece with the 21 | possibility to present a high-level view first of the code. Moreover, 22 | because noweb is essentially a macro-processing language, one can also 23 | "program" at the noweb level, which can sometimes overcome some of the 24 | limitations or the language of the documented program. For instance, 25 | for OCaml programs, using noweb frees the programmer to declare the types both 26 | in the .mli and .ml file, avoiding tedious copy-paste and maintenance 27 | problems. One can also do some forms of Aspect-oriented Programming 28 | at the noweb level. 29 | 30 | Syncweb continues the long tradition of tools like cweb and noweb of 31 | using a very confusing name in the Web-era for a program that has 32 | nothing to do with the Web. Syncweb does not synchronize the Web. 33 | 34 | Example of use 35 | ---------------- 36 | 37 | To install syncweb, see install.txt. Once installed, you can 38 | test it by applying it to some of the files in the demos/ directory. 39 | For instance, to generate for the first time the .mli and .ml file 40 | mentionned in demos/demo.ml.nw do: 41 | 42 | $ cd demos 43 | $ syncweb demo.ml.nw demo.ml 44 | $ syncweb demo.ml.nw demo.mli 45 | 46 | To generate the latex document demo.tex from the literate document, 47 | and combine it with another demo_main.tex file containing extra 48 | documentation do: 49 | 50 | $ noweblatex demo.ml.nw > demo.tex 51 | $ pdflatex demo_main.tex # demo_main.tex contains a \input{demo} 52 | 53 | You can then modify either the literate document demo.ml.nw, or the ml 54 | files and propagate the modifications to each other using again 55 | syncweb. For instance, after modifying the beginning of a chunk in 56 | demo.ml.nw, and the end of a chunk in demo.ml, one can synchronize by 57 | doing: 58 | 59 | $ syncweb demo.ml.nw demo.ml 60 | 61 | The output of the tool, with some of the input given by the user indicated 62 | by a !!! mark, should look like this: 63 | 64 | DIFF 65 | <<<<<<< orig <<<<<<<< 66 | type x = int 67 | ==================== 68 | type x = int 69 | type y = float 70 | >>>>>>> view >>>>>>>> 71 | orig view 72 | <---- changed ? (y/n) !!!y!!! 73 | DIFF 74 | <<<<<<< orig <<<<<<<< 75 | <> 76 | let foo x = 1 77 | 78 | let bar y = 2 79 | 80 | ==================== 81 | <> 82 | let foo x = 1 83 | 84 | >>>>>>> view >>>>>>>> 85 | orig view 86 | changed ----> ? (y/n) !!!y!!! 87 | orig has been updated 88 | view has been regenerated 89 | 90 | syncweb can automatically infer the direction the change 91 | should go (---> or <---- in the preceding output) by storing 92 | somewhere the md5sum of the original chunks; it uses 93 | the same technique than unison. 94 | 95 | Marks 96 | ------------------- 97 | 98 | To make it possible to backpropagate modifications from a view 99 | (e.g. a .ml file), to its original document (a .nw file), 100 | syncweb generates in the view file some special comment marks 101 | like in demos/demo.mli: 102 | 103 | (* nw_s: type |2b70b211995152060feb826763f38330*) 104 | type x = int 105 | type y = float 106 | (* nw_e: type *) 107 | 108 | update: by using the -md5sum_in_auxfile and -less_marks command 109 | line flags, syncweb can generate less verbose marks. In particular 110 | the md5sum code can be stored in an auxillary file (a .md5sum_xxx file), 111 | which makes it even closer to what unison does (with its ~/.unison/ 112 | directory). The previous view demos/demo.mli then looks like 113 | 114 | (* s: type *) 115 | type x = int 116 | type y = float 117 | (* e: type *) 118 | 119 | Limitations 120 | ------------------- 121 | 122 | One must not modify the marks and if one move some code, 123 | one must take care to move both the start and ending mark 124 | correspondingly. An easier way to move some code is of 125 | course to modify the literate document. 126 | 127 | The current version of syncweb does not handle well files using tabs 128 | instead of spaces. This can usually be easily overcomed by configuring 129 | your editors, for instance with Emacs by adding the command 130 | (setq-default indent-tabs-mode nil) in your .emacs file. You can also 131 | use the M-x untabify Emacs macro to convert files. Nevertheless, 132 | for certain files like Makefiles, which relies on the tab symbol, 133 | syncweb can not be used. 134 | 135 | 136 | Options 137 | ------------------- 138 | 139 | By default syncweb generates marks suited for OCaml programs. You 140 | can change this behavior by using the -lang option, for instance 141 | with: 142 | 143 | $ syncweb -lang C demo.nw foo.c 144 | 145 | The -md5sum_in_auxfile and -less_marks options have been discussed 146 | previously. 147 | 148 | Makefile example 149 | ------------------- 150 | 151 | If you want to integrate syncweb and literate programming in your 152 | development cycle, just add a 'sync' and 'pdf' targets 153 | where you list all the files involved in literate documents 154 | as in: 155 | 156 | SYNCWEB=syncweb 157 | NOWEB=noweblatex 158 | 159 | sync: 160 | $(SYNCWEB) demo.ml.nw demo.mli 161 | $(SYNCWEB) demo.ml.nw demo.ml 162 | 163 | pdf: 164 | $(NOWEB) demo.ml.nw > demo.tex 165 | pdflatex demo.tex 166 | pdflatex demo.tex 167 | 168 | 169 | Extra information 170 | ------------------- 171 | 172 | The emacs/ directory contains the noweb-mode.el emacs mode to edit 173 | noweb files allowing among other things the correct fontification of 174 | both the latex and program fragments. This directory contains also 175 | some hacks to change the default behavior of noweb-mode.el that you 176 | may find useful, as well as hacks to use when editing the view file. 177 | For instance one can easily hide the marks in the view files. 178 | 179 | 180 | References 181 | --------------- 182 | 183 | [1] http://en.wikipedia.org/wiki/Literate_programming 184 | [2] http://www.cs.tufts.edu/~nr/noweb/ 185 | [3] http://www.seas.upenn.edu/~bcpierce/unison/ 186 | 187 | -------------------------------------------------------------------------------- /skip_list.txt: -------------------------------------------------------------------------------- 1 | # -*- sh -*- 2 | 3 | # to focus only on pfff code in codemap 4 | #dir: commons 5 | dir: demos/mapreduce 6 | 7 | # ------------------------------------------------------------------------- 8 | # cmt, for codegraph to skip 9 | # ------------------------------------------------------------------------- 10 | 11 | dir: external/OPAM_DIR 12 | 13 | #dir: external/FOR_MERLIN 14 | # I uppercased below the first letter of directories I don't want to skip 15 | # (e.g., we want json-wheel, and ocaml hence JLO uppercase below) 16 | dir: external/FOR_MERLIN/[abcdefghiJklmnOpqrstuvwxyz] 17 | # We skip cairo2 above because the external/ contains the .cmt (good citizen) 18 | # We want stdlib and otherlibs (unix/str) 19 | dir: external/FOR_MERLIN/ocaml-base-compiler.4.07.1/[abcdefghijklmnOpqrStuvwxyz] 20 | dir: external/FOR_MERLIN/ocaml-base-compiler.4.07.1/otherlibs/dynlink 21 | dir: external/FOR_MERLIN/ocaml-base-compiler.4.07.1/otherlibs/threads 22 | dir: external/FOR_MERLIN/ocaml-base-compiler.4.07.1/ocamldoc 23 | dir: external/FOR_MERLIN/ocaml-migrate-parsetree 24 | dir: external/FOR_MERLIN/ocaml[abcdefghijklmnopqrstuvwxyz] 25 | -------------------------------------------------------------------------------- /syncweb.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "syncweb" 3 | version: "0.5.1" 4 | synopsis: "Syncweb, Literate Programming meets Unison" 5 | description: """ 6 | Syncweb is a command-line tool enabling programmers to use the 7 | literate programming[1] development methodology, using the noweb[2] 8 | tool, while still being able to modify the generated files 9 | from the literate document. syncweb provides a way to 10 | "synchronize" the possibly modified original document with its 11 | possibly modified views with an interface similar to unison[3]. In 12 | addition, syncweb synchronizes data at a fine grained level by 13 | computing and storing md5sum of the different chunks. 14 | 15 | [1] http://en.wikipedia.org/wiki/Literate_programming 16 | [2] http://www.cs.tufts.edu/~nr/noweb/ 17 | [3] http://www.seas.upenn.edu/~bcpierce/unison/ 18 | """ 19 | 20 | maintainer: "Yoann Padioleau " 21 | authors: [ "Yoann Padioleau " ] 22 | license: "GPL-2.0-only" 23 | homepage: "https://github.com/aryx/syncweb" 24 | dev-repo: "git+https://github.com/aryx/syncweb" 25 | bug-reports: "https://github.com/aryx/syncweb/issues" 26 | 27 | depends: [ 28 | "ocaml" {>= "4.12.0"} 29 | "dune" {>= "3.2.0" } 30 | "commons" {>= "1.5.5" } 31 | ] 32 | 33 | build: ["dune" "build" "-p" name "-j" jobs] 34 | -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # Noweb illustration 3 | ############################################################################## 4 | simple.pdf: simple.orig 5 | noweave -index -latex simple.orig > simple.tex 6 | pdflatex simple.tex 7 | 8 | -------------------------------------------------------------------------------- /tests/final.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/tests/final.ml -------------------------------------------------------------------------------- /tests/final.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/tests/final.mli -------------------------------------------------------------------------------- /tests/final.orig: -------------------------------------------------------------------------------- 1 | % -*- noweb -*- 2 | 3 | \title{Final Example} 4 | \author{Yoann Padioleau} 5 | \maketitle 6 | 7 | \section{Overview} 8 | -------------------------------------------------------------------------------- /tests/foo.nw: -------------------------------------------------------------------------------- 1 | \documentclass[]{report} 2 | 3 | \usepackage{noweb} 4 | \noweboptions{footnotesizecode,nomargintag} 5 | %\noweboptions{shortxref} 6 | \usepackage{hyperref} 7 | \hypersetup{colorlinks=true} 8 | 9 | \begin{document} 10 | 11 | \title{Foo} 12 | \author{Bar} 13 | 14 | \maketitle 15 | 16 | \chapter{First chapter} 17 | 18 | \section{First section} 19 | 20 | This is some example 21 | of latex. 22 | Here is a quote [[foo_bar()]]. 23 | Another quote [[$(OBJS)]] %$ 24 | and [[$@]] or [[$^]] or [[#include]] or [['&']] or [['\']] or [['%']] 25 | 26 | Here is pad special quote {{main()}}. 27 | 28 | Here is some chunks 29 | <>= 30 | <> 31 | // This is some comment 32 | <> 33 | // And another one 34 | @ 35 | 36 | \section{Second section} 37 | 38 | And now some included files: 39 | <>= 40 | #include "foo.h" 41 | @ 42 | 43 | \pagebreak 44 | 45 | \section{Third section} 46 | 47 | <>= 48 | void main() { 49 | int i; 50 | } 51 | @ 52 | 53 | <>= 54 | #include "bar.h" 55 | @ 56 | 57 | <>= 58 | void 59 | badusage(void) 60 | { 61 | 62 | fprint(STDERR, 63 | "Usage: mk [-f file] [-(n|a|e|t|k|i)] [-d[egp]] [targets ...]\n"); 64 | Exit(); 65 | } 66 | @ 67 | \section{Index} 68 | 69 | \nowebindex 70 | 71 | \end{document} 72 | -------------------------------------------------------------------------------- /tests/hello.c: -------------------------------------------------------------------------------- 1 | (* nw_s: includes *) 2 | #include /* for printf */ 3 | (* nw_e: includes *) 4 | 5 | int main(int argc, char** argv) 6 | { 7 | (* nw_s: say hello *) 8 | printf("Hello World!\n"); 9 | (* nw_e: say hello *) 10 | return 0; 11 | } 12 | -------------------------------------------------------------------------------- /tests/hello.nw: -------------------------------------------------------------------------------- 1 | <>= 2 | <> 3 | 4 | int main(int argc, char** argv) 5 | { 6 | <> 7 | return 0; 8 | } 9 | @ 10 | 11 | <>= 12 | printf("Hello World!\n"); 13 | @ 14 | 15 | <>= 16 | #include /* for printf */ 17 | @ 18 | -------------------------------------------------------------------------------- /tests/hello2.c: -------------------------------------------------------------------------------- 1 | (* nw_s: includes *) 2 | #include /* for printf */ 3 | (* nw_e: includes *) 4 | (* nw_s: includes *) 5 | #include /* 2 for printf */ 6 | (* nw_e: includes *) 7 | 8 | int main(int argc, char** argv) 9 | { 10 | (* nw_s: say hello *) 11 | printf("Hello World!\n"); 12 | (* nw_e: say hello *) 13 | (* nw_s: say hello *) 14 | printf("Hello World2!\n"); 15 | (* nw_e: say hello *) 16 | return 0; 17 | } 18 | -------------------------------------------------------------------------------- /tests/hello2.nw: -------------------------------------------------------------------------------- 1 | <>= 2 | <> 3 | 4 | int main(int argc, char** argv) 5 | { 6 | <> 7 | return 0; 8 | } 9 | @ 10 | 11 | <>= 12 | printf("Hello World!\n"); 13 | @ 14 | 15 | 16 | <>= 17 | #include /* for printf */ 18 | @ 19 | 20 | <>= 21 | printf("Hello World2!\n"); 22 | @ 23 | 24 | <>= 25 | #include /* 2 for printf */ 26 | @ 27 | -------------------------------------------------------------------------------- /tests/hello_modif1.c: -------------------------------------------------------------------------------- 1 | (* nw_s: includes *) 2 | #include /* for printf */ 3 | (* nw_e: includes *) 4 | 5 | int main(int argc, char** argv) 6 | { 7 | 8 | (* nw_s: say hello *) 9 | printf("Hello World!\n"); 10 | 11 | (* nw_e: say hello *) 12 | return 0; 13 | } 14 | -------------------------------------------------------------------------------- /tests/lpizer/foo.ml: -------------------------------------------------------------------------------- 1 | 2 | let foo x = 3 | x + x 4 | 5 | let bar x = 6 | x + x 7 | [@@profiling] 8 | 9 | let foo () = 10 | ( 11 | some big call 12 | ) 13 | 14 | (* comment before *) 15 | let foo () = 16 | () 17 | 18 | -------------------------------------------------------------------------------- /tests/noweb.sty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/tests/noweb.sty -------------------------------------------------------------------------------- /tests/noweb.sty.old: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/tests/noweb.sty.old -------------------------------------------------------------------------------- /tests/simple.orig: -------------------------------------------------------------------------------- 1 | % -*- noweb -*- 2 | 3 | %cf http://en.wikipedia.org/wiki/Noweb 4 | %noweave -filter l2h -index -html hello.noweb | htmltoc > hello.html 5 | %noweave -index -latex hello.noweb > hello.tex 6 | %notangle -Rhello.c hello.noweb > hello.c 7 | %notangle -Rhello.php hello.noweb > hello.php 8 | 9 | 10 | \title{My First Literate Document} 11 | \author{Yoann Padioleau} 12 | \maketitle 13 | 14 | \section{Overview} 15 | 16 | Here is the organization of the code: 17 | <<*>>= 18 | <> 19 | <> 20 | <> 21 | <> 22 | @ 23 | \section{Main} 24 | 25 | The main code: 26 | <>= 27 | let main = 28 | Printf.printf ("%d\n" x + y) 29 | @ 30 | 31 | \section{Sec1} 32 | 33 | First definition. 34 | 35 | <>= 36 | let x = 1 37 | @ 38 | 39 | \section{Sec2} 40 | 41 | Second definition 42 | 43 | <>= 44 | let y = 2 45 | @ 46 | 47 | 48 | 49 | 50 | 51 | \section{Sec3} 52 | 53 | Here are a set of definitions. 54 | 55 | % was += before 56 | <>= 57 | let z = 1 58 | @ 59 | 60 | % was += before 61 | <>= 62 | let z = 2 63 | @ 64 | 65 | <>= 66 | let z = 3 67 | @ 68 | 69 | -------------------------------------------------------------------------------- /tests/simple.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aryx/syncweb/f9a976fb31071e48761fafa9cfb953fab553df68/tests/simple.pdf -------------------------------------------------------------------------------- /tests/test.ml.nw: -------------------------------------------------------------------------------- 1 | <>= 2 | jsdjffff 3 | @ 4 | 5 | <>= 6 | <> 7 | @ 8 | 9 | -------------------------------------------------------------------------------- /todo.txt: -------------------------------------------------------------------------------- 1 | # -*- org -*- 2 | 3 | * Last 4 | 5 | ** Last 6 | 7 | *** answer Ben about his markdown idea? meh 8 | 9 | *** restore some elements from the deleted Makefile in 10 | https://github.com/aryx/syncweb/commit/8cc3f10599bf65ab57947950f30cb6b18d83db14 11 | 12 | *** once graph_code, codegraph, the parser_xxx are added to OPAM, 13 | can start to also package the indexer and lpizer 14 | 15 | *** see autodefs.ocaml script in fork-tiger/old/ 16 | to pretty print better ocaml code. 17 | Try on VCS.nw? just copy what noweb does 18 | in syncweb -to_tex 19 | 20 | *** fix the int x = ...; that leads to 21 | a Uses x 22 | probably because graph_code_c unsugar such decl as a decl + separate assign. 23 | 24 | *** populate also hdefs_and_uses_of_chunkid 25 | and support \swuses{} and use it for lname, etc? 26 | also for rules? meh. 27 | 28 | *** index external functions, put 'print (stdio.h)' 29 | now that mk index use header deps (to have a low number of lookup 30 | failures), I can use those header information to improve the automatic indexing 31 | 32 | * Features 33 | 34 | ** literate programming automatic index 35 | step1: DONE get an index displayed 36 | step2: DONE get complete and correct index displayed (use codegraph? cover fields?) 37 | step3: SEMI get nice index displayed (in margin? mini indexes? no duplicate, sorted) 38 | 39 | *** syncweb/noweb 40 | 41 | **** handle twocolumns format, right now the chunk crossrefs triangle 42 | are at the wrong place 43 | 44 | **** have index on double columns? 45 | \twocolumn causes a pagebreak 46 | 47 | **** can use makeindex? look what I did for my PhD thesis 48 | 49 | **** less: [] 50 | so can reference right chunk! 51 | maybe no need now that I use candidate strategy, 52 | maybe for OCaml it can be useful, but not even sure 53 | 54 | **** maybe do not add subpageref for entities that are 55 | defined partly in the same section (when functions defined by multiple pieces) 56 | 57 | *** syncweb/codegraph 58 | 59 | **** later: generate refs for stuff from stdlib? 60 | nil, strlen, etc? with reference to Libcore? 61 | 62 | **** later: codegraph for C via 5c-in-ocaml, so have use deps for fields too 63 | long, lots of stuff to fix in 5c-in-ocaml ... 64 | 65 | but codegraph does not have info for fields actually, maybe better to 66 | start from 5c-in-ocaml :) 67 | 68 | Also it adds many dependencies. Maybe easier to start from scratch 69 | and precisely from 5c-in-ocaml? 70 | 71 | ***** resume 5c-in-ocaml on code of mk 72 | parse correctly everything? 73 | 74 | ***** fix LOC and preprocessor 75 | need take pen and paper and go through ... 76 | maybe can save result and present it in Compiler.nw or something. 77 | Hard to understand tables. 78 | 79 | ***** start generate the defs 80 | 81 | ***** start generate the uses 82 | need resolve, but have type information so should be doable. 83 | 84 | ***** look at code of graph_code_clang.ml because when I was using clang 85 | I had to dedupe files because I was also processing preprocessed ASTs 86 | 87 | 88 | *** syncweb/ctwill mini indexes 89 | 90 | **** later: generate mini-index a la ctwill? 91 | or maybe better the mini-index a la noweb in the end? 92 | see below 93 | 94 | **** can use ctwillmac with latex? 95 | try hand generate some \mini 96 | reread milp.pdf? 97 | => I can generate everything from scratch, without even using noweb or cweb 98 | 99 | but seems hard. plain tex and latex seems incompatible 100 | 101 | **** send email to Hanson and Ramsey to learn about mini-index on 102 | left and right places? 103 | Or can incorporate ctwill macros?? 104 | Or look in .aux file a la nuweb and generate myself? 105 | 106 | **** later: can noweb generate mini-indexes like ctwill does? 107 | it generates defs/uses after each chunk, nice, but I prefer 108 | the mini-indexes I think 109 | dave hanson managed to do it 110 | 111 | **** build mini-indexes like in Hanson books, like ctwill of Knuth, 112 | but filter to only put important crossref? like not the one available 113 | on the same page? 114 | 115 | apparently according to http://www.literateprogramming.com/best.pdf 116 | the index information is generated in raw form from noweb in latex file, 117 | and david hanson wrote Icon program to dig in .aux file and build 118 | the mini-indexes 119 | 120 | use margin notes? 121 | --------------------------------------------------------------------------------