use
5.010;
use
vars
qw($VERSION $STRING_VERSION @ISA $DEBUG)
;
$VERSION
=
'2.103_004'
;
$STRING_VERSION
=
$VERSION
;
$VERSION
=
eval
$VERSION
;
$DEBUG
= 0;
$Marpa::R2::USING_XS
= 1;
$Marpa::R2::USING_PP
= 0;
$Marpa::R2::LIBMARPA_FILE
=
'[built-in]'
;
LOAD_EXPLICIT_LIBRARY: {
last
LOAD_EXPLICIT_LIBRARY
if
not
$ENV
{
'MARPA_AUTHOR_TEST'
};
my
$file
=
$ENV
{MARPA_LIBRARY};
last
LOAD_EXPLICIT_LIBRARY
if
not
$file
;
my
$bs
=
$file
;
$bs
=~ s/(\.\w+)?(;\d*)?$/\.bs/;
if
(-s
$bs
) {
eval
{
do
$bs
; };
warn
"$bs: $@\n"
if
$@;
}
my
$bootname
=
"marpa_g_new"
;
@DynaLoader::dl_require_symbols
= (
$bootname
);
my
$libref
= dl_load_file(
$file
, 0) or
do
{
Carp::croak(
"Can't load libmarpa library: '$file'"
. dl_error());
};
push
(
@DynaLoader::dl_librefs
,
$libref
);
my
@unresolved
= dl_undef_symbols();
if
(
@unresolved
) {
Carp::carp(
"Undefined symbols present after loading $file: @unresolved\n"
);
}
dl_find_symbol(
$libref
,
$bootname
) or
do
{
Carp::croak(
"Can't find '$bootname' symbol in $file\n"
);
};
push
(
@DynaLoader::dl_shared_objects
,
$file
);
$Marpa::R2::LIBMARPA_FILE
=
$file
;
}
XSLoader::load(
'Marpa::R2'
,
$Marpa::R2::STRING_VERSION
);
if
( not
$ENV
{
'MARPA_AUTHOR_TEST'
} ) {
$Marpa::R2::DEBUG
= 0;
}
else
{
Marpa::R2::Thin::debug_level_set(1);
$Marpa::R2::DEBUG
= 1;
}
sub
version_ok {
my
(
$sub_module_version
) =
@_
;
return
'not defined'
if
not
defined
$sub_module_version
;
return
"$sub_module_version does not match Marpa::R2::VERSION "
.
$VERSION
if
$sub_module_version
!=
$VERSION
;
return
;
}
my
@error_names
= Marpa::R2::Thin::error_names();
for
(
my
$error
= 0;
$error
<=
$#error_names
; ) {
my
$current_error
=
$error
;
(
my
$name
=
$error_names
[
$error
] ) =~ s/\A MARPA_ERR_//xms;
no
strict
'refs'
;
*{
"Marpa::R2::Error::$name"
} = \
$current_error
;
my
$dummy
=
eval
q{$}
.
'Marpa::R2::Error::'
.
$name
;
$error
++;
}
my
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::Internal::VERSION
) )
and
die
'Marpa::R2::Internal::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::Grammar::VERSION
) )
and
die
'Marpa::R2::Grammar::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::Recognizer::VERSION
) )
and
die
'Marpa::R2::Recognizer::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::Value::VERSION
) )
and
die
'Marpa::R2::Value::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::MetaG::VERSION
) )
and
die
'Marpa::R2::MetaG::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::Scanless::G::VERSION
) )
and
die
'Marpa::R2::Scanless::G::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::Scanless::R::VERSION
) )
and
die
'Marpa::R2::Scanless::R::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::MetaAST::VERSION
) )
and
die
'Marpa::R2::MetaAST::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::Stuifzand::VERSION
) )
and
die
'Marpa::R2::Stuifzand::VERSION '
,
$version_result
;
(
$version_result
= version_ok(
$Marpa::R2::ASF::VERSION
) )
and
die
'Marpa::R2::ASF::VERSION '
,
$version_result
;
sub
Marpa::R2::exception {
my
$exception
=
join
q{}
,
@_
;
$exception
=~ s/ \n* \z /\n/xms;
die
(
$exception
)
if
$Marpa::R2::JUST_DIE
;
CALLER:
for
(
my
$i
= 0; 1;
$i
++) {
my
(
$package
) =
caller
(
$i
);
last
CALLER
if
not
$package
;
last
CALLER
if
not
'Marpa::R2::'
eq
substr
$package
, 0, 11;
$Carp::Internal
{
$package
} = 1;
}
Carp::croak(
$exception
,
q{Marpa::R2 exception}
);
}
q{""}
=>
sub
{
my
(
$self
) =
@_
;
return
$self
->{message} //
$self
->{fallback_message};
},
fallback
=> 1
);
sub
new {
my
(
$class
,
@hash_ref_args
) =
@_
;
my
%x_object
= ();
for
my
$hash_ref_arg
(
@hash_ref_args
) {
if
(
ref
$hash_ref_arg
ne
"HASH"
) {
my
$ref_type
=
ref
$hash_ref_arg
;
my
$ref_desc
=
$ref_type
?
"ref to $ref_type"
:
"not a ref"
;
die
"Internal error: args to Marpa::R2::Internal::X->new is $ref_desc -- it should be hash ref"
;
}
$x_object
{
$_
} =
$hash_ref_arg
->{
$_
}
for
keys
%{
$hash_ref_arg
};
}
my
$name
=
$x_object
{name};
die
(
"Internal error: an excepion must have a name"
)
if
not
$name
;
$x_object
{fallback_message} =
qq{Exception "$name" thrown}
;
return
bless
\
%x_object
,
$class
;
}
sub
name {
my
(
$self
) =
@_
;
return
$self
->{name};
}
1;