First draft of new Failure class

Test.pm

@@ -64,6 +64,7 @@ multi sub nok(Mu $cond) is export { nok($cond, ''); }
 
 
 multi sub is(Mu $got, Mu $expected, $desc) is export {
+    $got.defined; # Hack to deal with Failures
     my $test = $got eq $expected;
     proclaim(?$test, $desc);
     if !$test {

build/Makefile.in

@@ -114,6 +114,7 @@ BUILTINS_PIR = \
   src/builtins/Regex.pir \
   src/builtins/ContainerDeclarand.pir \
   src/builtins/Exception.pir \
+  src/builtins/Failure.pir \
   src/builtins/Signature.pir \
   src/builtins/Junction.pir \
   src/builtins/assign.pir \

src/builtins/Exception.pir

@@ -57,6 +57,12 @@ A Perl 6 Exception object.
     rethrow ex
 .end
 
+.sub 'throw' :method
+    .local pmc ex
+    ex = getattribute self, '$!exception'
+    throw ex
+.end
+
 .sub 'payload' :method
     .param pmc payload :optional
     .param int has_payload :opt_flag
@@ -70,12 +76,29 @@ A Perl 6 Exception object.
     .return (payload)
 .end
 
+.sub 'handled' :method
+    .param int handled :optional
+    .param int has_handled :opt_flag
+    .local pmc ex
+    ex = getattribute self, '$!exception'
+    unless has_handled goto no_handled
+    ex['handled'] = handled
+    .return (handled)
+  no_handled:
+    handled = ex['handled']
+    .return (handled)
+.end
+
 .sub 'perl' :method
     .return ('undef')
 .end
 
 
 .sub '' :vtable('get_string') :method
+    .tailcall self.'Str'()
+.end
+
+.sub 'Str' :method
     .local pmc exception
     exception = getattribute self, '$!exception'
     $S0 = exception['message']

src/builtins/Failure.pir

@@ -0,0 +1,123 @@
+=head1 TITLE
+
+Array - Perl 6 Exception class
+
+=head1 DESCRIPTION
+
+A Perl 6 Exception object.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+.namespace [ 'Failure' ]
+
+.sub '' :anon :init :load
+    .local pmc p6meta, failproto
+    p6meta = get_hll_global ['Mu'], '$!P6META'
+    failproto = p6meta.'new_class'('Failure', 'parent'=>'Any', 'attr'=>'$!ex', 'name'=>'Failure')
+    p6meta.'register'('Failure', 'protoobject'=>failproto)
+.end
+
+# IIUC we shouldn't need this... but Exception.new(:exception(...)) didn't work
+.sub 'new' :method
+    .param pmc ex
+    .local pmc e, c
+    c = self.'CREATE'('P6opaque')
+    e = self.'bless'(c)
+    setattribute e, '$!ex', ex
+    .return (e)
+.end
+
+.sub 'exception' :method
+    .param pmc ex :optional
+    .param int has_ex :opt_flag
+    unless has_ex goto get_ex
+    setattribute self, '$!ex', ex
+    .return (ex)
+  get_ex:
+    ex = getattribute self, '$!ex'
+    .return (ex)
+.end
+
+.sub 'perl' :method
+    $P0 = self.'exception'()
+    .tailcall $P0.'perl'()
+.end
+
+.sub 'maybefail' :method
+    $P0 = self.'exception'()
+    $I0 = $P0.'handled'()
+    if $I0 goto okay
+    $P0.'throw'()
+  okay:
+.end
+
+.sub '' :vtable('get_bool') :method
+    $I0 = self.'Bool'()
+    .return ($I0)
+.end
+
+.sub 'Bool' :method
+    $P0 = self.'exception'()
+    $P0.'handled'(1)
+    .return (0)
+.end
+
+.sub 'defined' :method
+    $P0 = self.'exception'()
+    $P0.'handled'(1)
+    .return (0)
+.end
+
+.sub '' :vtable('defined') :method
+    $I0 = self.'defined'()
+    .return ($I0)
+.end
+
+.sub '' :vtable('get_string') :method
+    $S0 = self.'Str'()
+    .return ($S0)
+.end
+
+.sub 'Str' :method
+    self.'maybefail'()
+    .local pmc ex
+    ex = getattribute self, '$!ex'
+    $S0 = ex
+    .return ($S0)
+.end
+
+.sub '' :vtable('get_number') :method
+    $S0 = self.'Num'()
+    .return ($S0)
+.end
+
+.sub 'Num' :method
+    self.'maybefail'()
+    $N0 = 0
+    .return ($N0)
+.end
+
+.sub '' :vtable('get_integer') :method
+    $S0 = self.'Int'()
+    .return ($S0)
+.end
+
+.sub 'Int' :method
+    self.'maybefail'()
+    $I0 = 0
+    .return ($I0)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:

src/builtins/control.pir

@@ -45,9 +45,18 @@ src/builtins/control.pir - control flow related functions
 .sub '&fail'
     .param pmc value :optional
     .param int has_value :opt_flag
-    .local pmc ex, failure
+    .local pmc ex, p6ex, failure
 
-    failure = get_hll_global 'Mu'
+    ex = root_new ['parrot';'Exception']
+    $P0 = get_hll_global 'Exception'
+    p6ex = $P0.'new'(ex)
+    unless has_value goto no_value
+    ex['payload'] = value
+    $S0 = value
+    ex['message'] = value
+  no_value:
+    $P0 = get_hll_global 'Failure'
+    failure = $P0.'new'(p6ex)
 
     ex = root_new ['parrot';'Exception']
     ex['payload'] = failure