Merge remote-tracking branch 'upstream/sessions' into travis

basicsettings.ml

@@ -98,3 +98,6 @@ let optimise = Settings.add_bool("optimise", false, `User)
 
 (* Compile & cache whole program, closures, and HTML *)
 let cache_whole_program = Settings.add_bool("cache_whole_program", false, `User)
+
+(* Paths to look for .links files in chasing pass *)
+let links_file_paths = Settings.add_string("links_file_paths", "", `User)

chaser.ml

@@ -5,12 +5,41 @@ open ModuleUtils
 
 type prog_map = program StringMap.t
 type filename = string
+(* Helper functions *)
 
+(* Given fully-qualified module name, gets root module name *)
 let module_file_name module_name =
   match (Str.split (Str.regexp module_sep) module_name) with
     | [] -> failwith "Internal error: empty list in module_file_name"
     | (x::_xs) -> x
 
+(* Helper function: given top-level module name, maps to expected filename *)
+let top_level_filename module_name =
+  (String.uncapitalize module_name) ^ ".links"
+
+let print_sorted_deps xs =
+  print_list (List.map print_list xs)
+
+(* Given a module name, try and locate / parse the module file *)
+let parse_module module_name =
+  let filename = top_level_filename module_name in
+  let (prog, _) = try_parse_file filename in
+  prog
+
+let assert_no_cycles = function
+  | [] -> ()
+  | [x]::ys -> ()
+  | (x::xs)::ys -> failwith ("Error -- cyclic dependencies: " ^ (String.concat ", " (x :: xs)))
+
+(*
+let print_external_deps prog =
+  let external_deps = find_external_refs prog in
+  printf "External dependencies:\n%s\n" (print_list external_deps)
+*)
+
+let unique_list xs =
+  StringSet.elements (StringSet.of_list xs)
+
 (* Traversal to find module import references in the current file *)
 let rec find_module_refs prefix init_seen_modules init_import_candidates init_binding_stack =
 object(self)
@@ -69,14 +98,6 @@ end
 let find_external_refs prog =
   StringSet.elements ((find_module_refs "" StringSet.empty StringSet.empty [])#program prog)#get_import_candidates
 
-let assert_no_cycles = function
-  | [] -> ()
-  | [x]::ys -> ()
-  | (x::xs)::ys -> failwith ("Error -- cyclic dependencies: " ^ (String.concat ", " (x :: xs)))
-
-let print_sorted_deps xs =
-  print_list (List.map print_list xs)
-
 let rec add_module_bindings deps dep_map =
   match deps with
     | [] -> []
@@ -91,17 +112,6 @@ let rec add_module_bindings deps dep_map =
         ), Sugartypes.dummy_position) :: (add_module_bindings ys dep_map)
     | _ -> failwith "Internal error: impossible pattern in add_module_bindings"
 
-let module_filename module_name =
-  (String.uncapitalize module_name) ^ ".links"
-
-let parse_file module_name =
-  let filename = module_filename module_name in
-  let (prog, _) = Parse.parse_file Parse.program filename in
-  prog
-
-let print_external_deps prog =
-  let external_deps = find_external_refs prog in
-  printf "External dependencies:\n%s\n" (print_list external_deps)
 
 let rec add_dependencies_inner module_name module_prog visited deps dep_map =
   if StringSet.mem module_name visited then (visited, [], dep_map) else
@@ -113,14 +123,13 @@ let rec add_dependencies_inner module_name module_prog visited deps dep_map =
   (* Next, run the dependency analysis on each one to get us an adjacency list *)
   List.fold_right (
     fun name (visited_acc, deps_acc, dep_map_acc) ->
-      let prog = parse_file name in
+      (* Given the top-level module name, try and parse wrt the paths *)
+      let prog = parse_module name in
       let (visited_acc', deps_acc', dep_map_acc') = add_dependencies_inner name prog visited_acc deps_acc dep_map_acc in
       (visited_acc', deps_acc @ deps_acc', dep_map_acc')
   ) ics (visited1, (module_name, ics) :: deps, dep_map1)
 
 
-let unique_list xs =
-  StringSet.elements (StringSet.of_list xs)
 
 (* Top-level function: given a module name + program, return a program with
  * all necessary files added to the binding list as top-level modules. *)

links.ml

@@ -429,6 +429,7 @@ let options : opt list =
 (*     (noshort, "broken-tests",        Some (run_tests Tests.broken_tests),                   None); *)
 (*     (noshort, "failing-tests",       Some (run_tests Tests.known_failures),                 None); *)
     (noshort, "pp",                  None,                             Some (Settings.set_value BS.pp));
+    (noshort, "path",                None,                             Some (fun str -> Settings.set_value BS.links_file_paths str));
     ]
 
 let file_list = ref []

loader.ml

@@ -43,8 +43,7 @@ let read_program filename : (envs * program) =
     the IR *)
 let read_file_source (nenv, tyenv) (filename:string) =
   let sugar, pos_context =
-    Parse.parse_file Parse.program filename  in
-  (* printf "Parsed AST: \n%s \n\n" (Sugartypes.Show_program.show sugar); *)
+    ModuleUtils.try_parse_file filename in
   let program, t, tenv = Frontend.Pipeline.program tyenv pos_context sugar in
   let globals, main, nenv =
     Sugartoir.desugar_program

moduleUtils.ml

@@ -33,3 +33,30 @@ let rec moduleInScopeInner seen_modules binding_stack module_name =
 let moduleInScope seen_modules binding_stack module_name =
   moduleInScopeInner seen_modules binding_stack module_name
 
+(* TODO: Unix-specific one for the moment, but no easy way to get this
+ * from OCaml Filename module... *)
+let path_sep = ":"
+
+let try_parse_file filename =
+  (* First, get the list of directories, with trailing slashes stripped *)
+  let poss_dirs =
+    let path_setting = Settings.get_value Basicsettings.links_file_paths in
+    let split_dirs = Str.split (Str.regexp path_sep) path_setting in
+    "" :: "." :: (List.map (fun path ->
+      let dir_sep = Filename.dir_sep in
+      if Filename.check_suffix path dir_sep then
+        Filename.chop_suffix path dir_sep
+      else
+        path) split_dirs) in
+
+  (* Loop through, trying to open the module with each path *)
+  let rec loop = (function
+    | [] -> failwith ("Could not find file " ^ filename)
+    | x :: xs ->
+        let candidate_filename =
+          if x = "" then filename else (x ^ Filename.dir_sep ^ filename) in
+        if Sys.file_exists candidate_filename then
+          Parse.parse_file Parse.program candidate_filename
+        else
+          loop xs) in
+  loop poss_dirs

moduleUtils.mli

@@ -12,4 +12,4 @@ val print_stack_node : binding_stack_node -> string
 val print_module_stack : binding_stack_node list -> string
 val moduleInScope : Utility.StringSet.t -> binding_stack_node list -> string -> string option
 val prefixWith : string -> string -> string
-
+val try_parse_file : string -> (Sugartypes.program * Parse.position_context)

test-harness

@@ -57,13 +57,13 @@ def check_expected(name, item, got, expected, errors):
     else:
         return True
 
-def evaluate(name, code, stdout='', stderr='', exit = '0', flags='-e', env = None, filemode='', extern_args='', ignore = None):
+def evaluate(name, code, stdout='', stderr='', exit = '0', flags='-e', env = None, filemode='', args='', ignore = None):
     if filemode.startswith('true') :
-        proc = Popen((links, code), stdout=PIPE, stderr=PIPE, env=env)
-    elif filemode.startswith('extern'):
-        proc = Popen((code, extern_args), stdout=PIPE, stderr=PIPE, env=env)
+        proc = Popen([links, code], stdout=PIPE, stderr=PIPE, env=env)
+    elif filemode.startswith('args'):
+        proc = Popen([links, args, code], stdout=PIPE, stderr=PIPE, env=env)
     else:
-        proc = Popen((links, flags, code), stdout=PIPE, stderr=PIPE, env=env)
+        proc = Popen([links, flags, code], stdout=PIPE, stderr=PIPE, env=env)
     passed = True
     errors = []
     for i in xrange(0, TIMEOUT*100):

tests/modules.tests

@@ -51,7 +51,7 @@ stderr : @.*
 exit : 1
 
 Module chasing
-./tests/modules/runmulti
-filemode : extern
-extern_args : moduleA.links
+./tests/modules/moduleA.links
+filemode : args
+args : --path=tests/modules
 stdout : "hello from c!" : String