-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathlspbasic.pas
142 lines (114 loc) · 3.51 KB
/
lspbasic.pas
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
138
139
140
141
142
(*----------------------------------------------------------------------------*)
(* Author: Joachim Pimiskern, 1994-2004 *)
(*----------------------------------------------------------------------------*)
unit lspbasic;
{$O+,F+}
interface
uses
sysutils,
lspglobl;
function LspCar (p: pNode): pNode;
function LspCdr (p: pNode): pNode;
function LspCaar (p: pNode): pNode;
function LspCadr (p: pNode): pNode;
function LspCdar (p: pNode): pNode;
function LspCddr (p: pNode): pNode;
function LspCaadr (p: pNode): pNode;
function LspCadar (p: pNode): pNode;
function LspCaddr (p: pNode): pNode;
function LspCdddr (p: pNode): pNode;
function LspCaddar(p: pNode): pNode;
function LspCadddr(p: pNode): pNode;
function LspLast (p: pNode): pNode;
implementation
uses
strng,
lsppredi, lsperr;
(*----------------------------------------------------------------------------*)
(* Das erste Element einer Liste liefern. *)
(*----------------------------------------------------------------------------*)
function LspCar(p: pNode): pNode;
begin
if (p = nil) then
result := nil
else
begin
if (p^.typ = cLspList) then
result := p^.CarVal
else
raise ELispException.Create('ErrListExpected','CAR');
end;
end;
(*----------------------------------------------------------------------------*)
(* Die Restliste liefern, nachdem das erste Element entfernt wurde. *)
(*----------------------------------------------------------------------------*)
function LspCdr(p: pNode): pNode;
begin
if (p <> nil) then
begin
if (p^.typ = cLspList) then
result := p^.CdrVal
else
raise ELispException.Create('ErrListExpected','CDR');
end
else
result := nil;
end;
(*----------------------------------------------------------------------------*)
(* Einen Zeiger auf die letzte Cons-Zelle einer Liste liefern *)
(*----------------------------------------------------------------------------*)
function LspLast(p: pNode): pNode;
var laeufer: pNode;
begin
if (not LspListp(p)) then
raise ELispException.Create('ErrListExpected','LAST');
laeufer := p;
while (LspCdr(laeufer) <> nil) do
laeufer := LspCdr(laeufer);
result := laeufer;
end;
(*----------------------------------------------------------------------------*)
(* Ein paar Variationen von Car und Cdr. *)
(*----------------------------------------------------------------------------*)
function LspCaar(p: pNode): pNode;
begin
result := LspCar(LspCar(p));
end;
function LspCdar(p: pNode): pNode;
begin
result := LspCdr(LspCar(p));
end;
function LspCadr(p: pNode): pNode;
begin
result := LspCar(LspCdr(p));
end;
function LspCddr(p: pNode): pNode;
begin
result := LspCdr(LspCdr(p));
end;
function LspCaadr(p: pNode): pNode;
begin
result := LspCar(LspCar(LspCdr(p)));
end;
function LspCadar(p: pNode): pNode;
begin
result := LspCar(LspCdr(LspCar(p)));
end;
function LspCaddr(p: pNode): pNode;
begin
result := LspCar(LspCdr(LspCdr(p)));
end;
function LspCdddr(p: pNode): pNode;
begin
result := LspCdr(LspCdr(LspCdr(p)));
end;
function LspCaddar(p: pNode): pNode;
begin
result := LspCar(LspCdr(LspCdr(LspCar(p))));
end;
function LspCadddr(p: pNode): pNode;
begin
result := LspCar(LspCdr(LspCdr(LspCdr(p))));
end;
end.