blob: 17681f7f5475e5b3fddb34175a6b2d6efc430b36 (
plain)
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
|
%%================================
%% Definition of Utility Functions
%%================================
\makeatletter
\lispinterp{%
(\define \listQ (\lambda (\x) (\or (\pairQ \x) (\= () \x))))
(\define \procedureQ (\lambda (\x)
(\or (\funcQ \x) (\closureQ \x) (\envfuncQ \x) (\macroQ \x))))
(\define \atomQ (\lambda (\x)
(\and (\not (\pairQ \x)) (\not (\= () \x)) )))
(\define \map (\lambda (\f.\args)
(\lispif (\= () (\car \args)) ()
(\let ((\cars (\@inner@map \car \args)) (\cdrs (\@inner@map \cdr \args)))
(\cons (\apply \f \cars)
(\apply \map (\cons \f \cdrs)))))))
%% @inner@map : ('a -> 'b) -> 'a list -> 'b list
(\define \@inner@map
(\lambda (\f \l)
(\lispif (\= () \l) () (\cons (\f (\car \l)) (\@inner@map \f (\cdr \l))))))
%% not : bool -> bool
(\define \not (\lambda (\b) (\lispif \b /f /t)))
%% and : bool... -> bool
(\define \and
(\lambda \l
(\lispif (\= () \l)
/t
(\lispif (\car \l) (\apply \and (\cdr \l)) /f))))
%% or bool... -> bool
(\define \or
(\lambda \l
(\lispif (\= () \l)
/f
(\lispif (\car \l) /t (\apply \or (\cdr \l))))))
%% let bindings
(\defmacro \let
(\lambda (\binds \body)
(\lispif (\= \binds ())
\body
(\list \let (\cdr \binds) (\list \@let (\car (\car \binds)) (\car (\cdr (\car \binds))) \body)))))
(\defmacro \letM
(\lambda (\binds \body)
(\lispif (\= \binds ())
\body
(\list \letM (\cdr \binds) (\list \@mlet (\car (\car \binds)) (\car (\cdr (\car \binds))) \body)))))
% letrec
(\defmacro \letrec (\lambda (\binds \body) (\list \@letrec \binds \binds \body)))
(\defmacro \@letrec
(\lambda (\binds \save \body)
(\lispif (\= \binds ())
(\list \@@letrec \save \body)
(\list \@letrec (\cdr \binds) \save
(\list \begin
(\list \setB (\car (\car \binds)) (\car (\cdr (\car \binds))))
\body)))))
(\defmacro \@@letrec
(\lambda (\binds \body)
(\lispif (\= \binds ())
\body
(\list \@@letrec (\cdr \binds) (\list \@mlet (\car (\car \binds)) () \body)))))
% nth
(\define \nth (\lambda (\lst \n)
(\lispif (\= \n :0) (\car \lst) (\nth (\cdr \lst) (\- \n :1)))))
}
\makeatother
|
