-- Convert a tested term and a list of (pattern, statement) pairs
-- into a pattern-matching AST.
----------------------------------------------------------------------
-local function match_builder (tested_terms_list, cases)
+function match_builder (x)
+
+ local tested_terms_list, cases = unpack(x)
local local_vars = { }
local var = |n| `Id{ "$v" .. n }
mlp.lexer:add{ "match", "with", "->" }
mlp.block.terminators:add "|"
+-- Output-format:
+-- match_cases_list := list of patterns_with_block
+-- patterns_with_block := { list of patterns, guard?, block }
+-- pattern := mlp.expr
+-- guard? := mlp.expr | false
+match_cases_list_parser = gg.list{ name = "match cases list",
+ gg.sequence{ name = "match case",
+ gg.list{ name = "match case patterns list",
+ primary = mlp.expr_list,
+ separators = "|",
+ terminators = { "->", "if" } },
+ gg.onkeyword{ "if", mlp.expr, consume = true },
+ "->",
+ mlp.block },
+ separators = "|",
+ terminators = "end" }
+
mlp.stat:add{ name = "match statement",
- "match", mlp.expr_list, "with",
- gg.optkeyword "|",
- gg.list{ name = "match cases list",
- primary = gg.sequence{ name = "match case",
- gg.list{ name = "patterns",
- primary = mlp.expr_list,
- separators = "|",
- terminators = { "->", "if" } },
- gg.onkeyword{ "if", mlp.expr, consume = true },
- "->",
- mlp.block },
- separators = "|",
- terminators = "end" },
+ "match",
+ mlp.expr_list,
+ "with", gg.optkeyword "|",
+ match_cases_list_parser,
"end",
- builder = |x| match_builder (x[1], x[3]) }
+ builder = |x| match_builder{ x[1], x[3] } }
--- /dev/null
+-{ extension 'match' }\r
+\r
+-- This deserves to go to the library\r
+-{ block:\r
+ require 'dollar'\r
+ function mlp.macros.log(...)\r
+ local acc = `Do{ }\r
+ for i in ivalues{...} do\r
+ local name\r
+ match i with \r
+ | `Id{n} -> name = n \r
+ | _ -> name = table.tostring(i, 'nohash')\r
+ end\r
+ table.insert(acc, +{printf("log: %s = %s",\r
+ -{`String{name}},\r
+ table.tostring(-{i}, 80, 'nohash'))})\r
+ end\r
+ return acc\r
+ end }\r
+\r
+\r
+-- Get match parsers and builder, for catch cases handling:\r
+require 'extension-compiler.match' \r
+\r
+-- We'll need to track rogue return statements:\r
+require 'walk'\r
+\r
+-- Put a block AST into a pcall():\r
+local mkpcall = |block| +{pcall(function() -{block} end)}\r
+\r
+-- The statement builder:\r
+function trycatch_builder(x)\r
+ local try_code, catch_cases, finally_code = unpack(x)\r
+ local insert_return_catcher = false\r
+\r
+ --$log(try_code, catch_cases, finally_code)\r
+\r
+ ----------------------------------------------------------------\r
+ -- Returns in the try-block must be transformed:\r
+ -- from the user's PoV, the code in the try-block isn't \r
+ -- a function, therefore a return in it must not merely\r
+ -- end the execution of the try block, but:\r
+ -- * not cause any error to be caught;\r
+ -- * let the finally-block be executed;\r
+ -- * only then, let the enclosing function return with the\r
+ -- appropraite values.\r
+ -- The way to handle that is that any returned value is stored \r
+ -- into the runtime variable caught_return, then a return with\r
+ -- no value is sent, to stop the execution of the try-code.\r
+ --\r
+ -- Similarly, a return in a catch case code must not prevent\r
+ -- the finally-code from being run.\r
+ --\r
+ -- This walker catches return statements and perform the relevant\r
+ -- transformation into caught_return setting + empty return.\r
+ --\r
+ -- There is an insert_return_catcher compile-time flag, which\r
+ -- allows to avoid inserting return-handling code in the result\r
+ -- when not needed.\r
+ ----------------------------------------------------------------\r
+ local replace_returns do\r
+ local cfg = { stat = { } }\r
+ function cfg.stat.down(x)\r
+ match x with \r
+ | `Return{...} -> \r
+ insert_return_catcher = true\r
+ local setvar = \r
+ +{stat:caught_return = -{ `Table{ unpack(x) } } }\r
+ x.tag = nil\r
+ x <- { setvar; `Return }\r
+ return 'break'\r
+ | `Function{...} -> return 'break' \r
+ -- inside this, returns would be the function's, not ours.\r
+ | _ -> -- pass\r
+ end\r
+ end\r
+ replace_returns = |x| walk.block(cfg, x)\r
+ end\r
+\r
+ -- parse returns in the try-block:\r
+ replace_returns (try_code)\r
+\r
+ -- code handling the error catching process:\r
+ local catch_result do\r
+ if catch_cases then\r
+ ----------------------------------------------------------\r
+ -- Protect catch code against failures: they run in a pcall(), and\r
+ -- the result is kept in catch_* vars so that it can be used to\r
+ -- relaunch the error after the finally code has been executed.\r
+ ----------------------------------------------------------\r
+ for x in ivalues (catch_cases) do\r
+ local case_code = x[3]\r
+ -- handle rogue returns:\r
+ replace_returns (case_code)\r
+ -- in case of error in the catch, we still need to run "finally":\r
+ x[3] = +{block: catch_success, catch_error = -{mkpcall(case_code)}}\r
+ end\r
+ ----------------------------------------------------------\r
+ -- Uncaught exceptions must not cause a mismatch,\r
+ -- so we introduce a catch-all do-nothing last case:\r
+ ----------------------------------------------------------\r
+ table.insert (catch_cases, { { { `Id '_' } }, false, { } }) \r
+ catch_result = match_builder{ {+{user_error}}, catch_cases }\r
+ else\r
+ catch_result = { }\r
+ end\r
+ end\r
+\r
+ ----------------------------------------------------------------\r
+ -- Build the bits of code that will handle return statements\r
+ -- in the user code (try-block and catch-blocks).\r
+ ----------------------------------------------------------------\r
+ local caught_return_init, caught_return_rethrow do\r
+ if insert_return_catcher then\r
+ caught_return_init = +{stat: local caught_return }\r
+ caught_return_rethrow =\r
+ +{stat: if caught_return then return unpack(caught_return) end}\r
+ else\r
+ caught_return_init, caught_return_rethrow = { }, { }\r
+ end\r
+ end\r
+\r
+ -- The finally code, to execute no matter what:\r
+ local finally_result = finally_code or { }\r
+\r
+ -- And the whole statement, gluing all taht together:\r
+ local result = +{stat: \r
+ do\r
+ -{ caught_return_init }\r
+ local user_success, user_error = -{mkpcall(try_code)}\r
+ local catch_success, catch_error = false, user_error\r
+ if not user_success then -{catch_result} end\r
+ -{finally_result}\r
+ if not user_success and not catch_success then error(catch_error) end \r
+ -{ caught_return_rethrow }\r
+ end }\r
+ return result\r
+end\r
+\r
+mlp.lexer:add{ 'try', 'catch', 'finally', '->' }\r
+mlp.block.terminators:add{ 'catch', 'finally' }\r
+table.insert(match_cases_list_parser.terminators, 'finally')\r
+\r
+mlp.stat:add{\r
+ 'try', \r
+ mlp.block, \r
+ gg.onkeyword{ 'catch', match_cases_list_parser },\r
+ gg.onkeyword{ 'finally', mlp.block },\r
+ 'end',\r
+ builder = trycatch_builder }\r
+\r
+\r
+\r
--- /dev/null
+-{ extension 'trycatch' }
+
+
+----------------------------------------------------------------------
+print "1) no error"
+try
+ print(" Hi")
+end
+
+
+----------------------------------------------------------------------
+print "2) caught error"
+try
+ error "some_error"
+catch x ->
+ printf(" Successfully caught %q", x)
+end
+
+
+----------------------------------------------------------------------
+print "3) no error, with a finally"
+try
+ print " Hi"
+finally
+ print " Finally OK"
+end
+
+
+----------------------------------------------------------------------
+print "4) error, with a finally"
+try
+ print " Hi"
+ error "bang"
+catch "bang" ->
+ -- nothing
+finally
+ print " Finally OK"
+end
+
+
+----------------------------------------------------------------------
+print "5) nested catchers"
+try
+ try
+ error "some_error"
+ catch "some_other_error" ->
+ assert (false, "mismatch, this must not happen")
+ end
+catch "some_error"/x ->
+ printf(" Successfully caught %q across a try that didn't catch", x)
+| x ->
+ assert (false, "We shouldn't reach this catch-all")
+end
+
+
+----------------------------------------------------------------------
+print "6) nested catchers, with a 'finally in the inner one"
+try
+ try
+ error "some_error"
+ catch "some_other_error" ->
+ assert (false, "mismatch, this must not happen")
+ finally
+ print " Leaving the inner try-catch"
+ end
+catch "some_error"/x ->
+ printf(" Successfully caught %q across a try that didn't catch", x)
+| x ->
+ assert (false, "We shouldn't reach this catch-all")
+end
+
+
+----------------------------------------------------------------------
+print "7) 'finally' intercepts a return from a function"
+function f()
+ try
+ print " into f:"
+ return "F_RESULT"
+ assert (false, "I'll never go there")
+ catch _ ->
+ assert (false, "No exception should be thrown")
+ finally
+ print " I do the finally before leaving f()"
+ end
+end
+local fr = f()
+printf(" f returned %q", fr)
+
+
+----------------------------------------------------------------------
+print "*) done."
projects / metalua.git / commitdiff