perfume/setup.prfm at master · mitchan0321/perfume · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
#
# set built-in classes.
#
if {defvar? @BUILT-IN-CLASSES}
else: {
    defvar @BUILT-IN-CLASSES [dict];
    $@BUILT-IN-CLASSES set Block <t>;
    $@BUILT-IN-CLASSES set Coro <t>;
    $@BUILT-IN-CLASSES set Dict <t>;
    $@BUILT-IN-CLASSES set File <t>;
    $@BUILT-IN-CLASSES set Functions <t>;
    $@BUILT-IN-CLASSES set Integer <t>;
    $@BUILT-IN-CLASSES set List <t>;
    $@BUILT-IN-CLASSES set Bool <t>;
    $@BUILT-IN-CLASSES set Object <t>;
    $@BUILT-IN-CLASSES set Real <t>;
    $@BUILT-IN-CLASSES set RQuote <t>;
    $@BUILT-IN-CLASSES set String <t>;
    $@BUILT-IN-CLASSES set Vector <t>;
    $@BUILT-IN-CLASSES set Bulk <t>;
    $@BUILT-IN-CLASSES set Container <t>;
};

#
# load current setup.prfm file if exist.
#
if {and [file exists? "./setup.prfm"] [! [defvar? _ONCE_]]}
then: {
    defvar _ONCE_ <t>;
    load "./setup.prfm";
    return;
};

#
# set interactive mode indicator.
#
if {[$ARGV len] <= 1}
then: {
    defvar INTERACTIVE <t>;
};

#
# setup standard I/O File objects, stdin/stdout/stderr
#
defvar stdin [new File];
$stdin set! 0 mode: i;

defvar stdout [new File];
$stdout set! 1 mode: o;
$stdout set-newline <t>;

defvar stderr [new File];
$stderr set! 2 mode: o;
$stderr set-newline <t>;

defvar INFILE "-";
defvar OUTFILE "-";

#
# create regex cache
#
defvar @REGEX_CACHE [dict];

#
# show start message
#
if {defvar? INTERACTIVE}
then: {
    println "Welcome to Perfume World!!";
    println "perfume language interpreter version " $VERSION ".";
};

load [[$LIB_PATH item] . "/util.prfm"];

defun unknown (*) {
    set __unknown_cmd__ [$* item];
    set __unknown_param__ [$* next];

    $LIB_PATH each do: {| __unknown_d__ |
        try {unset __unknown_f__; alias up: 1 __fname__ __unknown_f__};
        set __unknown_f__ [$__unknown_d__ . "/" $__unknown_cmd__ ".prfm"];
        if {and [file exists? $__unknown_f__] [file read? $__unknown_f__]}
        then: {
            uplevel {try {load $__fname__} catch: {}; unset __fname__};
            if {! [sid $__unknown_cmd__]} then: {
                continue;
            };
            return [call $__unknown_cmd__ $__unknown_param__];
        };
    };
    throw ErrNoFunction ["No such function, '" . $__unknown_cmd__ "'."];
};

#
# users customize file $HOME/.perfume read.
#
if {file exists? [$ENV,"HOME" . "/.perfume"]}
then: {
    try {
        load [$ENV,"HOME" . "/.perfume"];
    }
    catch: {| e |
        println "Error at read '$HOME/.perfume', " [$e cdr] ".";
    };
};

Integer method init (i) {
    if {integer? $i} else: {
        throw ErrBadType "Type error."
    };
    sets @primitive $i;
};

Real method init (i) {
    if {real? $i} else: {
        throw ErrBadType "Type error."
    };
    sets @primitive $i;
};

String method init (i) {
    if {string? $i} else: {
        throw ErrBadType "Type error."
    };
    sets @primitive $i;
};

RQuote method init (i) {
    if {rquote? $i} else: {
        throw ErrBadType "Type error."
    };
    sets @primitive $i;
};

true;

#eof