src/lib/metalua/extension/trycatch.mlua

   1 -{ extension 'match' }
   2
   3 --------------------------------------------------------------------------------
   4 --
   5 -- TODO:
   6 --
   7 -- * Hygienize calls to pcall()
   8 --
   9 --------------------------------------------------------------------------------
  10
  11 -{ extension 'H' }
  12 -{ extension 'log' }
  13
  14 -- Get match parsers and builder, for catch cases handling:
  15 local match_alpha = require 'metalua.extension.match'
  16 local H = H:new{side='inside', alpha = match_alpha }
  17
  18 -- We'll need to track rogue return statements:
  19 require 'metalua.walk'
  20
  21 -- Put a block AST into a pcall():
  22 local mkpcall = |block| +{pcall(function() -{block} end)}
  23
  24 -- The statement builder:
  25 function trycatch_builder(x)
  26    --$log ("trycatch_builder", x, 'nohash', 60)
  27    local try_code, catch_cases, finally_code = unpack(x)
  28    local insert_return_catcher = false
  29
  30    -- Can't be hygienize automatically by the current version of H, as
  31    -- it must bridge from inside user code (hacjed return statements)
  32    -- to outside macro code.
  33    local caught_return = !mlp.gensym 'caught_return'
  34    local saved_args
  35
  36    !try_code; !(finally_code or { })
  37    -- FIXME: Am I sure there's no need to hygienize inside?
  38    --[[if catch_cases then
  39       for case in ivalues(catch_cases) do
  40          --$log(case,'nohash')
  41          local patterns, guard, block = unpack(case)
  42          ! block
  43       end
  44    end]]
  45
  46
  47    ----------------------------------------------------------------
  48    -- Returns in the try-block must be transformed:
  49    -- from the user's PoV, the code in the try-block isn't
  50    -- a function, therefore a return in it must not merely
  51    -- end the execution of the try block, but:
  52    --  * not cause any error to be caught;
  53    --  * let the finally-block be executed;
  54    --  * only then, let the enclosing function return with the
  55    --    appropraite values.
  56    -- The way to handle that is that any returned value is stored
  57    -- into the runtime variable caught_return, then a return with
  58    -- no value is sent, to stop the execution of the try-code.
  59    --
  60    -- Similarly, a return in a catch case code must not prevent
  61    -- the finally-code from being run.
  62    --
  63    -- This walker catches return statements and perform the relevant
  64    -- transformation into caught_return setting + empty return.
  65    --
  66    -- There is an insert_return_catcher compile-time flag, which
  67    -- allows to avoid inserting return-handling code in the result
  68    -- when not needed.
  69    ----------------------------------------------------------------
  70    local replace_returns_and_dots do
  71       local function f(x)
  72          match x with
  73          | `Return{...} ->
  74             insert_return_catcher = true
  75             -- Setvar's 'caught_return' code can't be hygienize by H currently.
  76             local setvar = `Set{ {caught_return}, { `Table{ unpack(x) } } }
  77             x <- { setvar; `Return }; x.tag = nil;
  78             --$log('transformed return stat:', x, 60)
  79             return 'break'
  80          | `Function{...} -> return 'break'
  81             -- inside this, returns would be the nested function's, not ours.
  82          | `Dots ->
  83             if not saved_args then saved_args = mlp.gensym 'args' end
  84             x <- `Call{ `Id 'unpack', saved_args }
  85          | _ -> -- pass
  86          end
  87       end
  88       local cfg = { stat = {down=f}, expr = {down=f} }
  89       replace_returns_and_dots = |x| walk.block(cfg, x)
  90    end
  91
  92    -- parse returns in the try-block:
  93    replace_returns_and_dots (try_code)
  94
  95    -- code handling the error catching process:
  96    local catch_result do
  97       if catch_cases and #catch_cases>0 then
  98          ----------------------------------------------------------
  99          -- Protect catch code against failures: they run in a pcall(), and
 100          -- the result is kept in catch_* vars so that it can be used to
 101          -- relaunch the error after the finally code has been executed.
 102          ----------------------------------------------------------
 103          for x in ivalues (catch_cases) do
 104             local case_code = x[3]
 105             -- handle rogue returns:
 106             replace_returns_and_dots (case_code)
 107             -- in case of error in the catch, we still need to run "finally":
 108             x[3] = +{block: catch_success, catch_error = -{mkpcall(case_code)}}
 109          end
 110          ----------------------------------------------------------
 111          -- Uncaught exceptions must not cause a mismatch,
 112          -- so we introduce a catch-all do-nothing last case:
 113          ----------------------------------------------------------
 114          table.insert (catch_cases, { { { `Id '_' } }, false, { } })
 115          catch_result = spmatch.match_builder{ {+{user_error}}, catch_cases }
 116       else
 117          catch_result = { }
 118       end
 119    end
 120
 121    ----------------------------------------------------------------
 122    -- Build the bits of code that will handle return statements
 123    -- in the user code (try-block and catch-blocks).
 124    ----------------------------------------------------------------
 125    local caught_return_init, caught_return_rethrow do
 126       if insert_return_catcher then
 127          caught_return_init    = `Local{{caught_return}}
 128          caught_return_rethrow =
 129             +{stat: if -{caught_return} then return unpack(-{caught_return}) end}
 130       else
 131          caught_return_init, caught_return_rethrow = { }, { }
 132       end
 133    end
 134
 135    local saved_args_init =
 136       saved_args and `Local{ {saved_args}, { `Table{`Dots} } } or { }
 137
 138    -- The finally code, to execute no matter what:
 139    local finally_result = finally_code or { }
 140
 141    -- And the whole statement, gluing all taht together:
 142    local result = +{stat:
 143       do
 144          -{ saved_args_init }
 145          -{ caught_return_init }
 146          local user_success,  user_error  = -{mkpcall(try_code)}
 147          local catch_success, catch_error = false, user_error
 148          if not user_success then -{catch_result} end
 149          -{finally_result}
 150          if not user_success and not catch_success then error(catch_error) end
 151          -{ caught_return_rethrow }
 152       end }
 153
 154    H(result)
 155
 156    return result
 157 end
 158
 159 function catch_case_builder(x)
 160    --$log ("catch_case_builder", x, 'nohash', 60)
 161    local patterns, guard, _, code = unpack(x)
 162    -- patterns ought to be a pattern_group, but each expression must
 163    -- be converted into a single-element pattern_seq.
 164    for i = 1, #patterns do patterns[i] = {patterns[i]} end
 165    return { patterns, guard, code }
 166 end
 167
 168 mlp.lexer:add{ 'try', 'catch', 'finally', '->' }
 169 mlp.block.terminators:add{ 'catch', 'finally' }
 170
 171 mlp.stat:add{
 172    'try',
 173    mlp.block,
 174    gg.onkeyword{ 'catch',
 175       gg.list{
 176          gg.sequence{
 177             mlp.expr_list,
 178             gg.onkeyword{ 'if', mlp.expr },
 179             gg.optkeyword 'then',
 180             mlp.block,
 181             builder = catch_case_builder },
 182          separators = 'catch' } },
 183    gg.onkeyword{ 'finally', mlp.block },
 184    'end',
 185    builder = trycatch_builder }
 186
 187 return H.alpha
 188
 189