Imports (no infixes yet; does not work because of the GC duplicate symbols)

regression/x86only/Makefile

@@ -7,7 +7,7 @@ RC=../../src/rc.opt
 check: $(TESTS)
 
 $(TESTS): %: %.expr
-	@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff -u $@.log orig/$@.log
+	@RC_RUNTIME=../../runtime $(RC) -I . $< && cat $@.input | ./$@ > $@.log && diff -u $@.log orig/$@.log
 
 clean:
 	rm -f test*.log *.s *~ $(TESTS)

regression/x86only/orig/test005.log

@@ -0,0 +1 @@
+called with this one

regression/x86only/test001.expr

@@ -1,5 +1,3 @@
-external fun printf ();
-
 fun insert (tree, value) {
   case tree of
     Empty -> return Node (value, Empty, Empty)

regression/x86only/test002.expr

@@ -1,5 +1,3 @@
-external fun printf ();
-
 fun collect_ints_acc (v, tail) {
   local i;
   

regression/x86only/test003.expr

@@ -1,5 +1,3 @@
-external fun printf ();
-
 local lists = [
  {},
  {1, 2, 3, 4},

regression/x86only/test004.expr

@@ -1,5 +1,3 @@
-external fun printf ();
-
 fun hd (l) {
   case l of
     h : _ -> return h

regression/x86only/test005.expr

@@ -0,0 +1,5 @@
+public fun from_test005 (s) {
+  printf ("called with %s\n", s)
+}
+
+from_test005 ("this one")

regression/x86only/test005.input

@@ -0,0 +1 @@
+0

regression/x86only/test006.expr

@@ -0,0 +1,3 @@
+import test005;
+
+from_test005 ("that one")

regression/x86only/test006.input

@@ -0,0 +1 @@
+0

runtime/Std.i

@@ -0,0 +1,3 @@
+F,printf;
+F,read;
+F,write;

src/Driver.ml

@@ -8,7 +8,7 @@ let parse infile =
     "while"; "do"; "od";
     "repeat"; "until";
     "for";
-    "fun"; "local"; "public"; "external"; "return"; 
+    "fun"; "local"; "public"; "external"; "return"; "import"; 
     "length";
     "string";
     "case"; "of"; "esac"; "when";
@@ -30,7 +30,7 @@ let parse infile =
        ] s
      end
     )
-    (ostap (!(Language.parse Language.Infix.default)  -EOF))
+    (ostap (p:!(Language.parse Language.Infix.default) -EOF))
 
 exception Commandline_error of string
   
@@ -40,7 +40,7 @@ class options args =
   object (self)
     val i      = ref 1
     val infile = ref (None : string option)
-    val paths  = ref ([] : string list)
+    val paths  = ref [try Sys.getenv "RC_RUNTIME" with _ -> "../runtime"]
     val mode   = ref (`Default : [`Default | `Eval | `SM | `Compile ])
     val help   = ref false
     initializer
@@ -89,12 +89,6 @@ class options args =
 let main =
   (*  try*)
     let cmd = new options Sys.argv in
-  
-    (*let interpret  = Sys.argv.(1) = "-i"  in
-    let stack      = Sys.argv.(1) = "-s"  in
-    let to_compile = not (interpret || stack) in
-    let infile     = Sys.argv.(if not to_compile then 2 else 1) in
-     *)
     match (try parse cmd#get_infile with Language.Semantic_error msg -> `Fail msg) with
     | `Ok prog ->
        (match cmd#get_mode with
@@ -114,7 +108,7 @@ let main =
 	   let output =
 	     if cmd#get_mode = `Eval
 	     then Language.eval prog input
-	     else SM.run (SM.compile prog) input
+	     else SM.run (SM.compile cmd prog) input
 	   in
 	   List.iter (fun i -> Printf.printf "%d\n" i) output 
        )

src/Language.ml

@@ -837,10 +837,68 @@ module Definition =
 
   end
 
-(* The top-level definitions *)
+module Interface =
+  struct
     
-(* The top-level syntax category is a pair of definition list and statement (program body) *)
+    (* Generates an interface file. *)
-type t = Definition.t list * Expr.t
+    let gen (imps, p) =
+      let buf = Buffer.create 256 in
+      let append str = Buffer.add_string buf str in
+      List.iter (fun i -> append "I,"; append i; append ";\n") imps;
+      (match p with
+       | Expr.Scope (decls, _) ->
+          List.iter
+            (function
+             | (name, (`Public, item)) | (name, (`PublicExtern, item))  ->
+                (match item with
+                 | `Fun _      -> append "F,"; append name; append ";\n"
+                 | `Variable _ -> append "V,"; append name; append ";\n"
+                )
+             | _ -> ()
+            )
+            decls;
+       | _ -> ());  
+      Buffer.contents buf
+      
+    (* Read an interface file *)
+    let read fname =
+      let ostap (
+              funspec: "F" "," i:IDENT ";" {`Fun i};
+              varspec: "V" "," i:IDENT ";" {`Variable i};
+              import : "I" "," i:IDENT ";" {`Import i};
+              interface: (funspec | varspec | import)*
+            )
+      in
+      try
+        let s = Util.read fname in
+        (match Util.parse (object
+                             inherit Matcher.t s
+                             inherit Util.Lexers.ident [] s
+                             inherit Util.Lexers.skip  [Matcher.Skip.whitespaces " \t\n"] s
+                           end)             
+                          (ostap (interface -EOF))
+         with
+         | `Ok intfs -> Some intfs
+         | `Fail er  -> invalid_arg (Printf.sprintf "malformed interface file '%s': %s" fname er)
+        )
+      with Sys_error _ -> None                        
+
+    let find import paths =
+      let rec inner = function
+      | [] -> None
+      | p::paths ->
+         (match read (Filename.concat p (import ^ ".i")) with
+          | None   -> inner paths
+          | Some i -> Some (p, i)
+         )
+      in
+      match inner paths with
+      | Some (path, intfs) -> path, intfs
+      | None               -> invalid_arg (Printf.sprintf "could not find an interface file for import '%s'" import)
+
+  end
+  
+(* The top-level definitions *)
 
 (* Top-level evaluator
 
@@ -848,15 +906,16 @@ type t = Definition.t list * Expr.t
 
    Takes a program and its input stream, and returns the output stream
 *)
-let eval expr i =
+let eval (_, expr) i =
   let _, _, o, _ = Expr.eval (State.empty, i, [], []) Skip expr in
   o
 
 (* Top-level parser *)
 ostap (
+  imports: is:(%"import" !(Util.list (ostap (LIDENT))) -";")* {List.flatten is};
   parse[infix]:
-    <(d, infix')> : definitions[infix] expr:!(Expr.parse definitions infix' Expr.Void)? {
+    is:imports <(d, infix')> : definitions[infix] expr:!(Expr.parse definitions infix' Expr.Void)? {
-      Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e)
+      is, Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e)
     };
   definitions[infix]:
     <(def, infix')> : !(Definition.parse infix Expr.basic definitions) <(defs, infix'')> : definitions[infix'] {

src/SM.ml

@@ -333,7 +333,7 @@ let rec propagate_acc (Item (p, fds, up) as item) name =
            }}, fds, up'), Value.Access index       
   | other -> item, other
 
-class env =
+class env cmd imports =
 object (self : 'self)
   val label_index  = 0
   val scope_index  = 0
@@ -342,6 +342,25 @@ object (self : 'self)
   val fundefs      = Top []
   val decls        = []
 
+  method private import_imports =
+    let paths = cmd#get_include_paths in
+    let env = List.fold_left
+                (fun env import ->
+                   let _, intfs = Interface.find import paths in
+                   List.fold_left
+                     (fun env -> function
+                      | `Variable name -> env#add_name     name `Extern true
+                      | `Fun name      -> env#add_fun_name name `Extern 
+                      | _              -> env
+                     )
+                     env
+                     intfs
+                )
+                self
+                ("Std" :: imports)
+    in
+    env
+
   method global_scope = scope_index = 0
                       
   method get_label = (label @@ string_of_int label_index), {< label_index = label_index + 1 >}
@@ -360,25 +379,22 @@ object (self : 'self)
       ) @@
     List.filter (function (_, `Local) -> false | _ -> true) decls
     
-  method push_scope = {<    
+  method push_scope =
+    match scope.st with
+    | State.I ->
+       {<
          scope_index = scope_index + 1;
          scope       = {
              scope with
-        st = match scope.st with
+             st = State.G ([], State.undefined)
-             | State.I ->
+         }
-                State.G (Builtin.names,
+       >} # import_imports
-                         List.fold_left
+      
-                           (fun s (name, value) ->
-                             let name' =
-                               match name.[0] with
-                               | '.' -> name
-                               | _   -> "L" ^ name
-                             in
-                             State.bind name (Value.Fun name') s)
-                           State.undefined
-                           (Builtin.bindings ()))
     | _ ->
-                State.L ([], State.undefined, scope.st)
+       {< scope_index = scope_index + 1;
+          scope       = {
+              scope with
+              st = State.L ([], State.undefined, scope.st)
             }
        >}
 
@@ -446,7 +462,7 @@ object (self : 'self)
                        | State.I ->
                           invalid_arg "uninitialized scope"
                        | State.G (names, s)    ->
-                          State.G (check_name_and_add names name mut, State.bind name (Value.Global name) s)
+                          State.G ((match m with `Extern | `PublicExtern -> names | _ -> check_name_and_add names name mut), State.bind name (Value.Global name) s)
                        | State.L (names, s, p) ->
                           self#check_scope m name;
                           State.L (check_name_and_add names name mut, State.bind name (Value.Local scope.local_index) s, p)
@@ -466,7 +482,7 @@ object (self : 'self)
       | State.I ->
          invalid_arg "uninitialized scope"
       | State.G (names, s) ->
-         State.G (check_name_and_add names name false, State.bind name (Value.Fun name') s)
+         State.G ((match m with `Extern | `PublicExtern -> names | _ -> check_name_and_add names name false), State.bind name (Value.Fun name') s)
       | State.L (names, s, p) ->
          self#check_scope m name;
          State.L (check_name_and_add names name false, State.bind name (Value.Fun name') s, p)        
@@ -514,7 +530,7 @@ object (self : 'self)
                  
 end
   
-let compile p =
+let compile cmd (imports, p) =
   let rec pattern env lfalse = function
   | Pattern.Wildcard        -> env, false, [DROP]
   | Pattern.Named   (_, p)  -> pattern env lfalse p
@@ -736,7 +752,7 @@ let compile p =
        let env, code = compile_fundef env def in
        compile_fundefs (acc @ code) env
   in
-  let env             = new env in
+  let env             = new env cmd imports in
   let lend, env       = env#get_label in
   let env, flag, code = compile_expr lend env p in
   let code            = if flag then code @ [LABEL lend] else code in

src/X86.ml

@@ -649,8 +649,8 @@ class env prg =
 (* Generates an assembler text for a program: first compiles the program into
    the stack code, then generates x86 assember code, then prints the assembler file
 *)
-let genasm prog =
+let genasm cmd prog =
-  let sm        = SM.compile prog in
+  let sm        = SM.compile cmd prog in
   let env, code = compile (new env sm) sm in
   let gc_start, gc_end = "__gc_data_start", "__gc_data_end" in
   let globals =
@@ -671,14 +671,38 @@ let genasm prog =
 
 (* Builds a program: generates the assembler file and compiles it with the gcc toolchain *)
 let build cmd prog =
+  let find_objects imports paths =
+    let module S = Set.Make (String) in
+    let rec iterate acc s = function
+    | []              -> acc
+    | import::imports -> 
+       if S.mem import s
+       then iterate acc s imports
+       else
+         let path, intfs = Interface.find import paths in         
+         iterate
+           ((import ^ ".o") :: acc)
+           (S.add import s)
+           ((List.map (function `Import name -> name | _ -> invalid_arg "must not happen") @@
+             List.filter (function `Import _ -> true | _ -> false) intfs) @
+             imports)
+    in
+    iterate [] S.empty imports
+  in
   let name = Filename.chop_suffix cmd#get_infile ".expr" in
   let outf = open_out (Printf.sprintf "%s.s" name) in
-  Printf.fprintf outf "%s" (genasm prog);
+  Printf.fprintf outf "%s" (genasm cmd prog);
+  close_out outf;
+  let outf = open_out (Printf.sprintf "%s.i" name) in
+  Printf.fprintf outf "%s" (Interface.gen prog);
   close_out outf; 
   let inc = try Sys.getenv "RC_RUNTIME" with _ -> "../runtime" in
   match cmd#get_mode with
   | `Default ->
-     Sys.command (Printf.sprintf "gcc -g -m32 -o %s %s.s %s/runtime.a" name name inc)
+     let objs = find_objects (fst prog) cmd#get_include_paths in
+     let buf  = Buffer.create 255 in
+     List.iter (fun o -> Buffer.add_string buf o; Buffer.add_string buf " ") objs;
+     Sys.command (Printf.sprintf "gcc -g -m32 -o %s %s.s %s %s/runtime.a" name name (Buffer.contents buf) inc)
   | `Compile ->
      Sys.command (Printf.sprintf "gcc -g -m32 -c %s.s" name)
   | _ -> invalid_arg "must not happen"