Skip to content

Commit bf058f1

Browse files
BowenFuBowenFu
authored
Fix filter. (#29)
* Fix filter. * Remvoe comment. * Remvoe comment. * macro define before usage. * macro define before usage. * Fix build. Co-authored-by: Bowen Fu <missing>
1 parent 366df02 commit bf058f1

File tree

3 files changed

+133
-89
lines changed

3 files changed

+133
-89
lines changed

‎core.lisp

Lines changed: 110 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -1,94 +1,10 @@
1-
(define atom?
2-
(lambda (x)
3-
(and (not (pair? x)) (not (null? x)))))
4-
5-
(define not
6-
(lambda (x)
7-
(if x false true)))
8-
9-
(define >
10-
(lambda (x y)
11-
(< y x)
12-
)
13-
)
14-
15-
(define <=
16-
(lambda (x y)
17-
(not (> x y))
18-
)
19-
)
20-
21-
(define >=
22-
(lambda (x y)
23-
(not (< x y))
24-
)
25-
)
26-
27-
(define
28-
(- . lst)
29-
(define rest (cdr lst))
30-
(if
31-
(cons? rest) (+ (car lst) (* -1 (car rest)))
32-
(* -1 (car lst))
33-
))
34-
35-
(define list (lambda args args))
36-
37-
(define list*
38-
(lambda args
39-
(define $f
40-
(lambda (xs)
41-
(if (cons? xs)
42-
(if (cons? (cdr xs))
43-
(cons (car xs) ($f (cdr xs)))
44-
(car xs))
45-
nil)))
46-
($f args)
47-
))
48-
49-
(define (caar args)
50-
(car (car args))
51-
)
52-
53-
(define (cadr args)
54-
(car (cdr args))
55-
)
56-
57-
(define (cdar args)
58-
(cdr (car args))
59-
)
60-
61-
(define (cddr args)
62-
(cdr (cdr args))
63-
)
64-
65-
(define (caddr args)
66-
(car (cdr (cdr args)))
67-
)
68-
69-
(define (cadar args)
70-
(car (cdr (car args)))
71-
)
72-
73-
(define (caadr args)
74-
(car (car (cdr args)))
75-
)
76-
77-
(define (map func lst)
78-
(if (null? lst)
79-
'()
80-
(cons (func (car lst)) (map func (cdr lst)))
81-
)
82-
)
83-
841
(define (len lst)
852
; (if (atom? lst) (error "Not a list when calling with len" lst) '())
863
(if (null? lst)
874
0
885
(+ 1 (len (cdr lst)))
896
)
907
)
91-
928
(define let (macro name-arg-param-pairs-body
939
(define arg-num (len name-arg-param-pairs-body))
9410
(if (= arg-num 2)
@@ -117,7 +33,7 @@
11733
(define recur (lambda (arg-param-pairs-internal)
11834
(if (cons? arg-param-pairs-internal)
11935
`((lambda (,(caar arg-param-pairs-internal)) ,(recur (cdr arg-param-pairs-internal))) ,(cadar arg-param-pairs-internal))
120-
`,body
36+
body
12137
)
12238
))
12339
(recur arg-param-pairs)
@@ -204,4 +120,112 @@
204120
)
205121
)
206122
(expand-clauses clauses)
207-
))
123+
))
124+
125+
(define atom?
126+
(lambda (x)
127+
(and (not (pair? x)) (not (null? x)))))
128+
129+
(define not
130+
(lambda (x)
131+
(if x false true)))
132+
133+
(define >
134+
(lambda (x y)
135+
(< y x)
136+
)
137+
)
138+
139+
(define <=
140+
(lambda (x y)
141+
(not (> x y))
142+
)
143+
)
144+
145+
(define >=
146+
(lambda (x y)
147+
(not (< x y))
148+
)
149+
)
150+
151+
(define
152+
(- . lst)
153+
(define rest (cdr lst))
154+
(if
155+
(cons? rest) (+ (car lst) (* -1 (car rest)))
156+
(* -1 (car lst))
157+
))
158+
159+
(define list (lambda args args))
160+
161+
(define list*
162+
(lambda args
163+
(define $f
164+
(lambda (xs)
165+
(if (cons? xs)
166+
(if (cons? (cdr xs))
167+
(cons (car xs) ($f (cdr xs)))
168+
(car xs))
169+
nil)))
170+
($f args)
171+
))
172+
173+
(define append
174+
(lambda (lhs rhs)
175+
(if (null? lhs)
176+
rhs
177+
(cons (car lhs) (append (cdr lhs) rhs))
178+
)
179+
)
180+
)
181+
182+
(define (caar args)
183+
(car (car args))
184+
)
185+
186+
(define (cadr args)
187+
(car (cdr args))
188+
)
189+
190+
(define (cdar args)
191+
(cdr (car args))
192+
)
193+
194+
(define (cddr args)
195+
(cdr (cdr args))
196+
)
197+
198+
(define (caddr args)
199+
(car (cdr (cdr args)))
200+
)
201+
202+
(define (cadar args)
203+
(car (cdr (car args)))
204+
)
205+
206+
(define (caadr args)
207+
(car (car (cdr args)))
208+
)
209+
210+
(define (map proc lst)
211+
(if (null? lst)
212+
'()
213+
(cons (proc (car lst)) (map proc (cdr lst)))
214+
)
215+
)
216+
217+
(define (filter pred lst)
218+
(if (null? lst)
219+
'()
220+
(let*
221+
((elem (car lst))
222+
(check-result (pred elem))
223+
(rest-result (filter pred (cdr lst))))
224+
(if check-result
225+
(cons elem rest-result)
226+
rest-result)
227+
)
228+
)
229+
)
230+
231+
(define (even num) (= (% num 2) 0))

‎sample/CMakeLists.txt

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -169,4 +169,7 @@ do_test(test_or_5 "(or (and #f 'x) \"2\" 1)" "2")
169169
do_test(test_recursive_and "(and 1 (and 2 (and 3 4)))" "4")
170170
do_test(test_recursive_and "(or (or 2 (and 3 4) (and 5 6)))" "2")
171171

172-
do_test(test_map "(map - '(1 2 3))" "\\\\(-1 -2 -3\\\\)")
172+
do_test(test_map "(map - '(1 2 3))" "\\\\(-1 -2 -3\\\\)")
173+
174+
do_test(test_append "(append '(1 2) '(3 4))" "\\\\(1 2 3 4\\\\)")
175+
do_test(test_filter "(filter even '(1 2 3 4))" "\\\\(2 4\\\\)")

‎sample/loop.cpp

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
#include <numeric>
44
#include <fstream>
55
#include <filesystem>
6+
#include <cmath>
67
namespace fs = std::filesystem;
78

89
#define DEBUG 0
@@ -74,14 +75,29 @@ auto isPairOp = [](std::vector<std::shared_ptr<Expr>> const& args)
7475
return result ? true_() : false_();
7576
};
7677

78+
auto modOp = [](std::vector<std::shared_ptr<Expr>> const& args)
79+
{
80+
ASSERT(args.size() == 2);
81+
auto lhsNum = dynamic_cast<Number*>(args.at(0).get());
82+
ASSERT(lhsNum);
83+
auto lhsD = lhsNum->get();
84+
auto rhsNum = dynamic_cast<Number*>(args.at(1).get());
85+
ASSERT(rhsNum);
86+
auto rhsD = rhsNum->get();
87+
ASSERT(std::trunc(lhsD) == lhsD);
88+
ASSERT(std::trunc(rhsD) == rhsD);
89+
double result = static_cast<int32_t>(lhsD) % static_cast<int32_t>(rhsD);
90+
return ExprPtr{new Number{result}};
91+
};
92+
7793
auto isEqOp = [](std::vector<std::shared_ptr<Expr>> const& args)
7894
{
7995
ASSERT(args.size() == 2);
8096
return (args.at(0) == args.at(1) || (args.at(0)->equalTo(args.at(1)))) ? true_() : false_();
8197
};
8298

8399
template <typename Func>
84-
constexpr auto numOp(Func func)
100+
constexpr auto numBinOp(Func func)
85101
{
86102
return [func](std::vector<std::shared_ptr<Expr> > const &args)
87103
{
@@ -96,7 +112,7 @@ constexpr auto numOp(Func func)
96112
};
97113
}
98114

99-
constexpr auto lessOp = numOp(std::less<>());
115+
constexpr auto lessOp = numBinOp(std::less<>());
100116

101117
auto mulOp = [](std::vector<std::shared_ptr<Expr>> const& args)
102118
{
@@ -144,6 +160,7 @@ auto setUpEnvironment()
144160
initialEnv->defineVariable("null?", ExprPtr{new PrimitiveProcedure{isNullOp}});
145161
initialEnv->defineVariable("pair?", ExprPtr{new PrimitiveProcedure{isPairOp}});
146162
initialEnv->defineVariable("eq?", ExprPtr{new PrimitiveProcedure{isEqOp}});
163+
initialEnv->defineVariable("%", ExprPtr{new PrimitiveProcedure{modOp}});
147164
initialEnv->defineVariable("=", ExprPtr{new PrimitiveProcedure{isEqOp}});
148165
initialEnv->defineVariable("<", ExprPtr{new PrimitiveProcedure{lessOp}});
149166
initialEnv->defineVariable("+", ExprPtr{new PrimitiveProcedure{addOp}});

0 commit comments

Comments
 (0)