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