lib/metalua/extension/trycatch.mlua - ldt/org.eclipse.metalua - Git at Google

 -------------------------------------------------------------------------------
 -- Copyright (c) 2006-2013 Fabien Fleutot and others.
 --
 -- All rights reserved.
 --
 -- This program and the accompanying materials are made available
 -- under the terms of the Eclipse Public License v1.0 which
 -- accompanies this distribution, and is available at
 -- http://www.eclipse.org/legal/epl-v10.html
 --
 -- This program and the accompanying materials are also made available
 -- under the terms of the MIT public license which accompanies this
 -- distribution, and is available at http://www.lua.org/license.html
 --
 -- Contributors:
 --     Fabien Fleutot - API and implementation
 --
 -------------------------------------------------------------------------------

 -{ extension 'match' }

 --------------------------------------------------------------------------------
 --
 -- TODO:
 --
 -- * Hygienize calls to pcall()
 --
 --------------------------------------------------------------------------------

 -{ extension 'H' }
 -{ extension 'log' }

 -- Get match parsers and builder, for catch cases handling:
 local match_alpha = require 'metalua.extension.match'
 local H = H:new{side='inside', alpha = match_alpha }

 -- We'll need to track rogue return statements:
 require 'metalua.walk'

 -- Put a block AST into a pcall():
 local mkpcall = |block| +{pcall(function() -{block} end)}

 -- The statement builder:
 function trycatch_builder(x)
    --$log ("trycatch_builder", x, 'nohash', 60)
    local try_code, catch_cases, finally_code = unpack(x)
    local insert_return_catcher = false

    -- Can't be hygienize automatically by the current version of H, as
    -- it must bridge from inside user code (hacjed return statements)
    -- to outside macro code.
    local caught_return = !mlp.gensym 'caught_return'
    local saved_args

    !try_code; !(finally_code or { })
    -- FIXME: Am I sure there's no need to hygienize inside?
    --[[if catch_cases then
       for case in ivalues(catch_cases) do
          --$log(case,'nohash')
          local patterns, guard, block = unpack(case)
          ! block
       end
    end]]


    ----------------------------------------------------------------
    -- Returns in the try-block must be transformed:
    -- from the user's PoV, the code in the try-block isn't
    -- a function, therefore a return in it must not merely
    -- end the execution of the try block, but:
    --  * not cause any error to be caught;
    --  * let the finally-block be executed;
    --  * only then, let the enclosing function return with the
    --    appropraite values.
    -- The way to handle that is that any returned value is stored
    -- into the runtime variable caught_return, then a return with
    -- no value is sent, to stop the execution of the try-code.
    --
    -- Similarly, a return in a catch case code must not prevent
    -- the finally-code from being run.
    --
    -- This walker catches return statements and perform the relevant
    -- transformation into caught_return setting + empty return.
    --
    -- There is an insert_return_catcher compile-time flag, which
    -- allows to avoid inserting return-handling code in the result
    -- when not needed.
    ----------------------------------------------------------------
    local replace_returns_and_dots do
       local function f(x)
          match x with
          | `Return{...} ->
             insert_return_catcher = true
             -- Setvar's 'caught_return' code can't be hygienize by H currently.
             local setvar = `Set{ {caught_return}, { `Table{ unpack(x) } } }
             x <- { setvar; `Return }; x.tag = nil;
             --$log('transformed return stat:', x, 60)
             return 'break'
          | `Function{...} -> return 'break'
             -- inside this, returns would be the nested function's, not ours.
          | `Dots ->
             if not saved_args then saved_args = mlp.gensym 'args' end
             x <- `Call{ `Id 'unpack', saved_args }
          | _ -> -- pass
          end
       end
       local cfg = { stat = {down=f}, expr = {down=f} }
       replace_returns_and_dots = |x| walk.block(cfg, x)
    end

    -- parse returns in the try-block:
    replace_returns_and_dots (try_code)

    -- code handling the error catching process:
    local catch_result do
       if catch_cases and #catch_cases>0 then
          ----------------------------------------------------------
          -- Protect catch code against failures: they run in a pcall(), and
          -- the result is kept in catch_* vars so that it can be used to
          -- relaunch the error after the finally code has been executed.
          ----------------------------------------------------------
          for x in ivalues (catch_cases) do
             local case_code = x[3]
             -- handle rogue returns:
             replace_returns_and_dots (case_code)
             -- in case of error in the catch, we still need to run "finally":
             x[3] = +{block: catch_success, catch_error = -{mkpcall(case_code)}}
          end
          ----------------------------------------------------------
          -- Uncaught exceptions must not cause a mismatch,
          -- so we introduce a catch-all do-nothing last case:
          ----------------------------------------------------------
          table.insert (catch_cases, { { { `Id '_' } }, false, { } })
          catch_result = spmatch.match_builder{ {+{user_error}}, catch_cases }
       else
          catch_result = { }
       end
    end

    ----------------------------------------------------------------
    -- Build the bits of code that will handle return statements
    -- in the user code (try-block and catch-blocks).
    ----------------------------------------------------------------
    local caught_return_init, caught_return_rethrow do
       if insert_return_catcher then
          caught_return_init    = `Local{{caught_return}}
          caught_return_rethrow =
             +{stat: if -{caught_return} then return unpack(-{caught_return}) end}
       else
          caught_return_init, caught_return_rethrow = { }, { }
       end
    end

    local saved_args_init =
       saved_args and `Local{ {saved_args}, { `Table{`Dots} } } or { }

    -- The finally code, to execute no matter what:
    local finally_result = finally_code or { }

    -- And the whole statement, gluing all taht together:
    local result = +{stat:
       do
          -{ saved_args_init }
          -{ caught_return_init }
          local user_success,  user_error  = -{mkpcall(try_code)}
          local catch_success, catch_error = false, user_error
          if not user_success then -{catch_result} end
          -{finally_result}
          if not user_success and not catch_success then error(catch_error) end
          -{ caught_return_rethrow }
       end }

    H(result)

    return result
 end

 function catch_case_builder(x)
    --$log ("catch_case_builder", x, 'nohash', 60)
    local patterns, guard, _, code = unpack(x)
    -- patterns ought to be a pattern_group, but each expression must
    -- be converted into a single-element pattern_seq.
    for i = 1, #patterns do patterns[i] = {patterns[i]} end
    return { patterns, guard, code }
 end

 mlp.lexer:add{ 'try', 'catch', 'finally', '->' }
 mlp.block.terminators:add{ 'catch', 'finally' }

 mlp.stat:add{
    'try',
    mlp.block,
    gg.onkeyword{ 'catch',
       gg.list{
          gg.sequence{
             mlp.expr_list,
             gg.onkeyword{ 'if', mlp.expr },
             gg.optkeyword 'then',
             mlp.block,
             builder = catch_case_builder },
          separators = 'catch' } },
    gg.onkeyword{ 'finally', mlp.block },
    'end',
    builder = trycatch_builder }

 return H.alpha
	-------------------------------------------------------------------------------
	-- Copyright (c) 2006-2013 Fabien Fleutot and others.
	--
	-- All rights reserved.
	--
	-- This program and the accompanying materials are made available
	-- under the terms of the Eclipse Public License v1.0 which
	-- accompanies this distribution, and is available at
	-- http://www.eclipse.org/legal/epl-v10.html
	--
	-- This program and the accompanying materials are also made available
	-- under the terms of the MIT public license which accompanies this
	-- distribution, and is available at http://www.lua.org/license.html
	--
	-- Contributors:
	-- Fabien Fleutot - API and implementation
	--
	-------------------------------------------------------------------------------

	-{ extension 'match' }

	--------------------------------------------------------------------------------
	--
	-- TODO:
	--
	-- * Hygienize calls to pcall()
	--
	--------------------------------------------------------------------------------

	-{ extension 'H' }
	-{ extension 'log' }

	-- Get match parsers and builder, for catch cases handling:
	local match_alpha = require 'metalua.extension.match'
	local H = H:new{side='inside', alpha = match_alpha }

	-- We'll need to track rogue return statements:
	require 'metalua.walk'

	-- Put a block AST into a pcall():
	local mkpcall = \|block\| +{pcall(function() -{block} end)}

	-- The statement builder:
	function trycatch_builder(x)
	--$log ("trycatch_builder", x, 'nohash', 60)
	local try_code, catch_cases, finally_code = unpack(x)
	local insert_return_catcher = false

	-- Can't be hygienize automatically by the current version of H, as
	-- it must bridge from inside user code (hacjed return statements)
	-- to outside macro code.
	local caught_return = !mlp.gensym 'caught_return'
	local saved_args

	!try_code; !(finally_code or { })
	-- FIXME: Am I sure there's no need to hygienize inside?
	--[[if catch_cases then
	for case in ivalues(catch_cases) do
	--$log(case,'nohash')
	local patterns, guard, block = unpack(case)
	! block
	end
	end]]


	----------------------------------------------------------------
	-- Returns in the try-block must be transformed:
	-- from the user's PoV, the code in the try-block isn't
	-- a function, therefore a return in it must not merely
	-- end the execution of the try block, but:
	-- * not cause any error to be caught;
	-- * let the finally-block be executed;
	-- * only then, let the enclosing function return with the
	-- appropraite values.
	-- The way to handle that is that any returned value is stored
	-- into the runtime variable caught_return, then a return with
	-- no value is sent, to stop the execution of the try-code.
	--
	-- Similarly, a return in a catch case code must not prevent
	-- the finally-code from being run.
	--
	-- This walker catches return statements and perform the relevant
	-- transformation into caught_return setting + empty return.
	--
	-- There is an insert_return_catcher compile-time flag, which
	-- allows to avoid inserting return-handling code in the result
	-- when not needed.
	----------------------------------------------------------------
	local replace_returns_and_dots do
	local function f(x)
	match x with
	\| `Return{...} ->
	insert_return_catcher = true
	-- Setvar's 'caught_return' code can't be hygienize by H currently.
	local setvar = `Set{ {caught_return}, { `Table{ unpack(x) } } }
	x <- { setvar; `Return }; x.tag = nil;
	--$log('transformed return stat:', x, 60)
	return 'break'
	\| `Function{...} -> return 'break'
	-- inside this, returns would be the nested function's, not ours.
	\| `Dots ->
	if not saved_args then saved_args = mlp.gensym 'args' end
	x <- `Call{ `Id 'unpack', saved_args }
	\| _ -> -- pass
	end
	end
	local cfg = { stat = {down=f}, expr = {down=f} }
	replace_returns_and_dots = \|x\| walk.block(cfg, x)
	end

	-- parse returns in the try-block:
	replace_returns_and_dots (try_code)

	-- code handling the error catching process:
	local catch_result do
	if catch_cases and #catch_cases>0 then
	----------------------------------------------------------
	-- Protect catch code against failures: they run in a pcall(), and
	-- the result is kept in catch_* vars so that it can be used to
	-- relaunch the error after the finally code has been executed.
	----------------------------------------------------------
	for x in ivalues (catch_cases) do
	local case_code = x[3]
	-- handle rogue returns:
	replace_returns_and_dots (case_code)
	-- in case of error in the catch, we still need to run "finally":
	x[3] = +{block: catch_success, catch_error = -{mkpcall(case_code)}}
	end
	----------------------------------------------------------
	-- Uncaught exceptions must not cause a mismatch,
	-- so we introduce a catch-all do-nothing last case:
	----------------------------------------------------------
	table.insert (catch_cases, { { { `Id '_' } }, false, { } })
	catch_result = spmatch.match_builder{ {+{user_error}}, catch_cases }
	else
	catch_result = { }
	end
	end

	----------------------------------------------------------------
	-- Build the bits of code that will handle return statements
	-- in the user code (try-block and catch-blocks).
	----------------------------------------------------------------
	local caught_return_init, caught_return_rethrow do
	if insert_return_catcher then
	caught_return_init = `Local{{caught_return}}
	caught_return_rethrow =
	+{stat: if -{caught_return} then return unpack(-{caught_return}) end}
	else
	caught_return_init, caught_return_rethrow = { }, { }
	end
	end

	local saved_args_init =
	saved_args and `Local{ {saved_args}, { `Table{`Dots} } } or { }

	-- The finally code, to execute no matter what:
	local finally_result = finally_code or { }

	-- And the whole statement, gluing all taht together:
	local result = +{stat:
	do
	-{ saved_args_init }
	-{ caught_return_init }
	local user_success, user_error = -{mkpcall(try_code)}
	local catch_success, catch_error = false, user_error
	if not user_success then -{catch_result} end
	-{finally_result}
	if not user_success and not catch_success then error(catch_error) end
	-{ caught_return_rethrow }
	end }

	H(result)

	return result
	end

	function catch_case_builder(x)
	--$log ("catch_case_builder", x, 'nohash', 60)
	local patterns, guard, _, code = unpack(x)
	-- patterns ought to be a pattern_group, but each expression must
	-- be converted into a single-element pattern_seq.
	for i = 1, #patterns do patterns[i] = {patterns[i]} end
	return { patterns, guard, code }
	end

	mlp.lexer:add{ 'try', 'catch', 'finally', '->' }
	mlp.block.terminators:add{ 'catch', 'finally' }

	mlp.stat:add{
	'try',
	mlp.block,
	gg.onkeyword{ 'catch',
	gg.list{
	gg.sequence{
	mlp.expr_list,
	gg.onkeyword{ 'if', mlp.expr },
	gg.optkeyword 'then',
	mlp.block,
	builder = catch_case_builder },
	separators = 'catch' } },
	gg.onkeyword{ 'finally', mlp.block },
	'end',
	builder = trycatch_builder }

	return H.alpha