From e74965c7f4aaaa94f52b4b1a7ecaccebedd82337 Mon Sep 17 00:00:00 2001
From: unknown <Fabien@.(none)>
Date: Mon, 2 Feb 2009 19:00:25 +0100
Subject: [PATCH] IPC communication between processes through tmp files: avoids
 interferences caused by print() when using stdout as a channel

---
 src/compiler/metalua.mlua     | 27 +++-----------------
 src/compiler/mlc.mlua         |  6 ++---
 src/lib/metalua/mlc_xcall.lua | 48 +++++++++++++++++++++++++++++++++++
 src/lib/metalua/package2.lua  |  6 +++--
 4 files changed, 59 insertions(+), 28 deletions(-)
 create mode 100644 src/lib/metalua/mlc_xcall.lua

diff --git a/src/compiler/metalua.mlua b/src/compiler/metalua.mlua
index 8fe2c78..3647e43 100644
--- a/src/compiler/metalua.mlua
+++ b/src/compiler/metalua.mlua
@@ -4,7 +4,7 @@
 
 require 'metalua.compiler'
 require 'metalua.clopts'
-require 'serialize'
+require 'metalua.mlc_xcall'
 
 AST_COMPILE_ERROR_NUMBER        = -1
 RUNTIME_ERROR_NUMBER            = -3
@@ -12,25 +12,6 @@ BYTECODE_SYNTHESE_ERROR_NUMBER  = -100
 
 -{ extension 'match' }
 
-function spring_pcall (f, arg, name)
-   local pattern = 
-      [=[lua -l metalua.compiler -l serialize -e ]=]..
-      [=["print (serialize (%s ([[%s]], [[%s]])))"]=]
-   local cmd = string.format (pattern, f, arg, name)
-   --print ("Running the following process: " .. cmd)
-   local fd = io.popen (cmd)
-   local ast_src = fd:read '*a'
-   fd:close()
-   --print (data)
-   local ast_builder, msg = lua_loadstring(ast_src)
-   if not ast_builder then 
-      error ("can't compile data: "..msg) 
-      print (ast_src)
-   end
-   local ast = ast_builder()
-   return true, ast
-end
-
 local chunks  = { }
 local runargs = { }
 
@@ -153,10 +134,10 @@ local function main (...)
       local st, ast
       match x with
       | `Library{ l } -> st, ast = true, `Call{ `Id 'require', `String{ l } }
-      | `Literal{ e } -> st, ast = spring_pcall('mlc.ast_of_luastring', e, 'literal')
+      | `Literal{ e } -> st, ast = mlc_xcall.client_literal (e)
       | `File{ f } ->
-         st, ast = spring_pcall('mlc.ast_of_luafile', f, '@'..f)
-         -- Isolate each file in a separate fenv
+         st, ast = mlc_xcall.client_file (f)
+          -- Isolate each file in a separate fenv
          if st then
             ast = +{ function (...) -{ast} end (...)  }
             ast.source  = '@'..f -- TODO [EVE]
diff --git a/src/compiler/mlc.mlua b/src/compiler/mlc.mlua
index e488546..a3eeb6f 100644
--- a/src/compiler/mlc.mlua
+++ b/src/compiler/mlc.mlua
@@ -77,7 +77,7 @@ function mlc.convert (x, src_fmt, dst_fmt, name)
 
    if not name then name = '@'..x end
    local f, msg = io.open(x, "rb")
-   if not f then error(msg) end
+   if not f then error("While trying to open file '"..x.."': "..msg) end
    x = f:read'*a'
    f:close()
    
@@ -149,6 +149,8 @@ mlc.luacstring_of_function = string.dump
 
 lua_loadstring = loadstring
 local lua_loadstring = loadstring
+lua_loadfile = loadfile
+local lua_loadfile = loadfile
 
 function loadstring(str, name)
    if type(str) ~= 'string' then error 'string expected' end
@@ -190,5 +192,3 @@ function dofile(name)
    if not f then error(msg) end
    return f()
 end
-
-
diff --git a/src/lib/metalua/mlc_xcall.lua b/src/lib/metalua/mlc_xcall.lua
new file mode 100644
index 0000000..a93744f
--- /dev/null
+++ b/src/lib/metalua/mlc_xcall.lua
@@ -0,0 +1,48 @@
+-- lua -l mlc_xcall -e 'luafile_to_astfile ("/tmp/tmp12345.lua", "/tmp/tmp54321.ast")'
+-- lua -l mlc_xcall -e 'lua_to_astfile ("/tmp/tmp54321.ast")'
+
+mlc_xcall = { }
+
+function mlc_xcall.server (luafilename, astfilename)
+
+   -- We don't want these to be loaded when people only do client-side business
+   require 'metalua.compiler'
+   require 'serialize'
+
+   -- compile the content of luafile name in an AST, serialized in astfilename
+   local ast = mlc.luafile_to_ast (luafilename)
+   local out = io.open (astfilename, 'w')
+   out:write (serialize (ast))
+   out:close ()
+end
+
+function mlc_xcall.client_file (luafile)
+
+   --printf("\n\nmlc_xcall.client_file(%q)\n\n", luafile)
+
+   local tmpfilename = os.tmpname()
+   local cmd = string.format ([[lua -l metalua.mlc_xcall -e "mlc_xcall.server('%s', '%s')"]], 
+			      luafile :gsub ([[\]], [[\\]]), 
+			      tmpfilename :gsub([[\]], [[\\]]))
+
+   --printf("os.execute [[%s]]\n\n", cmd)
+
+   local ret = os.execute (cmd)
+   if ret~=0 then error "xcall failure. FIXME: transmit failure and backtrace" end
+   local ast = (lua_loadfile or loadfile) (tmpfilename) ()
+   os.remove(tmpfilename)
+   return true, ast
+end
+
+function mlc_xcall.client_literal (luasrc)
+   local srcfilename = os.tmpname()
+   local srcfile, msg = io.open (srcfilename, 'w')
+   if not srcfile then print(msg) end
+   srcfile :write (luasrc)
+   srcfile :close ()
+   local status, ast = mlc_xcall.client_file (srcfilename)
+   os.remove(srcfilename)
+   return status, ast
+end
+
+return mlc_xcall
\ No newline at end of file
diff --git a/src/lib/metalua/package2.lua b/src/lib/metalua/package2.lua
index 6940ef0..78912ac 100644
--- a/src/lib/metalua/package2.lua
+++ b/src/lib/metalua/package2.lua
@@ -75,9 +75,11 @@ function package.metalua_loader (name)
       local luastring = file:read '*a'
       file:close()
       return mlc.function_of_luastring (luastring, name)
-   else
+   else      
       file:close()
-      return spring_load (filename_or_msg)
+      require 'metalua.mlc_xcall'
+      local status, ast = mlc_xcall.client_file (filename_or_msg)
+      return mlc.function_of_ast(ast)
    end
 end
 
-- 
2.44.0