Global.pm 2.31 KB
Newer Older
1
# Global variables, some to ease interdependency problems
2 3 4 5 6

package Global;

use warnings;
use strict;
7
use 5.014;
8
use Carp;
9

10 11
#use Debug;

12 13 14 15 16 17
use vars qw(@ISA @EXPORT);
use Exporter ();

my $debugfh = \*STDOUT;
BEGIN {
        @ISA = qw(Exporter);
18
        @EXPORT = qw($Nil $T $n_Symbol $n_Pair $n_Function $n_function $special
19
                     $builtin $function $n_last_eval_stats
20 21
                     $n_Quote error $Leval $andRest $Lambda $f_Princs
                     $n_last_error
22
                     $n_ARGS our $t_Symbol $t_Number $t_String $t_Pair
23
                     $t_Function $opt_stacktraces
24 25
                     $andOptional $n_Environment $n_parentenv
                     $n_root_environment $root_environment
26
                     $n_environment_level $n_env_name $eval_depth
27 28 29
            );
}

30 31 32
# depth of the eval stack
our $eval_depth = 0;

33
# some symbols
34 35 36 37 38
our $Nil;                               # the nil symbol
our $T;                                 # the t symbol
our $andRest;                           # the &rest token symbol
our $andOptional;                       # the &optional token symbol
our $Lambda;                            # the lambda symbol
39
our $builtin;
40
our $function;
41
our $root_environment;                  # symbol *root-environment*
42

43
# object types, all Symbols
44 45 46 47 48
our $t_Symbol;
our $t_Number;
our $t_String;
our $t_Pair;
our $t_Function;
49
our $t_Environment;
50

51 52 53 54 55 56
# a few symbol names
our $n_Symbol = 'Symbol';
our $n_Pair = 'Pair';
our $n_Function = 'Function';
our $n_function = 'function';
our $n_last_error = '*last-error*';
57
our $n_last_eval_stats = '*last-eval-stats*';
58
our $n_ARGS = '*ARGS*';
59 60
our $n_Environment = 'Environment';
our $n_root_environment = '*root-environment*';
61
our $n_env_name = '*env-name*';
62
our $n_parentenv = '*parent-environment*';
63
our $n_Quote = 'quote';
64

65 66
# global function (value set in Print init)
our $f_Princs;                          # the printer function
67

68
# global option variable(s)
69
our $opt_stacktraces = 0;               # print stacktraces with errors
70

71

72 73 74 75 76
# for some weird reason I cannot take a \&die reference
sub do_die {
        die(@_);
}

77
sub error {
78
        my ($msg, @data) = @_;
79
        my $reporter = $opt_stacktraces ? \&confess : \&do_die;
80
        @data = map {&$f_Princs($_)} @data;
81
        $msg .= "\n"  unless $msg =~ /\n$/;
82
        &$reporter(sprintf($msg, @data));
83
}
84

85
1;