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
|
#include <u.h>
#include <libc.h>
#include <bio.h>
#include "apl9.h"
Datum *getquad(void);
int setquad(Datum);
Datum *getio(void);
int setio(Datum);
Datum *getpp(void);
int setpp(Datum);
QuadnameDef quadnames[] = {
{L"⎕", NameTag, getquad, setquad, nil, nil},
{L"⎕IO", NameTag, getio, setio, nil, nil},
{L"⎕PP", NameTag, getpp, setpp, nil, nil},
{nil, 0, nil, nil, nil, nil} /* MUST BE LAST */
};
Datum
quadnamedatum(QuadnameDef q)
{
Datum d;
d.tag = q.tag;
switch(q.tag){
case NameTag:
d.symbol = getsym(currentsymtab, q.name);
d.symbol->getfn = q.get;
d.symbol->setfn = q.set;
d.symbol->undefined = 0;
break;
case FunctionTag:
case MonadicOpTag:
case DyadicOpTag:
default:
print("Can't use quad names with type=%d\n", q.tag);
exits("quadname");
}
return d;
}
/* ⎕ */
Datum *
getquad(void)
{
Rune *input = prompt(L"⎕:\n\t");
Datum *result = evalline(input);
/* TODO check that the expression doesn't fail */
return result;
}
int
setquad(Datum new)
{
print("%S\n", ppdatum(new));
return 1;
}
/* ⎕IO */
Datum *
getio(void)
{
Datum *d = mallocz(sizeof(Datum), 1);
d->tag = ArrayTag;
d->array = mkscalarint(currentsymtab->io);
return d;
}
int
setio(Datum new)
{
if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || (new.array->intdata[0] != 0 && new.array->intdata[0] != 1)){
print("⎕IO: domain error\n");
return 0;
}else{
currentsymtab->io = new.array->intdata[0];
return 1;
}
}
/* ⎕PP */
Datum *
getpp(void)
{
Datum *d = mallocz(sizeof(Datum), 1);
d->tag = ArrayTag;
d->array = mkscalarint(printprecision);
return d;
}
int
setpp(Datum new)
{
if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || new.array->intdata[0] < 0){
print("⎕PP: domain error\n");
return 0;
}else{
printprecision = new.array->intdata[0];
return 1;
}
}
|