Skip to content

Commit 22a28cc

Browse files
BowenFuBowenFu
authored
Support named let. (#27)
Co-authored-by: Bowen Fu <missing>
1 parent 8d197c1 commit 22a28cc

File tree

5 files changed

+59
-14
lines changed

5 files changed

+59
-14
lines changed

‎core.lisp

Lines changed: 46 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -63,12 +63,34 @@
6363
)
6464
)
6565

66-
(define let (macro (arg-param-pairs body)
67-
(define let->combination (lambda (arg-param-pairs-internal)
68-
(define args (map car arg-param-pairs-internal))
69-
(define params (map cadr arg-param-pairs-internal))
70-
`((lambda ,args (begin ,body)) ,@params)))
71-
(let->combination arg-param-pairs)
66+
(define (len lst)
67+
; (if (atom? lst) (error "Not a list when calling with len" lst) '())
68+
(if (null? lst)
69+
0
70+
(+ 1 (len (cdr lst)))
71+
)
72+
)
73+
74+
(define let (macro name-arg-param-pairs-body
75+
(define arg-num (len name-arg-param-pairs-body))
76+
(if (= arg-num 2)
77+
(begin
78+
(define arg-param-pairs (car name-arg-param-pairs-body))
79+
(define body (cdr name-arg-param-pairs-body))
80+
(define let->combination (lambda (arg-param-pairs-internal)
81+
(define args (map car arg-param-pairs-internal))
82+
(define params (map cadr arg-param-pairs-internal))
83+
`((lambda ,args (begin ,@body)) ,@params)))
84+
(let->combination arg-param-pairs))
85+
(begin
86+
(define name (car name-arg-param-pairs-body))
87+
(define arg-param-pairs (cadr name-arg-param-pairs-body))
88+
(define body (cddr name-arg-param-pairs-body))
89+
(define let->combination (lambda (arg-param-pairs-internal)
90+
(define args (map car arg-param-pairs-internal))
91+
(define params (map cadr arg-param-pairs-internal))
92+
`(begin (define ,name (lambda ,args (begin ,@body))) (,name ,@params))))
93+
(let->combination arg-param-pairs)))
7294
)
7395
)
7496

@@ -140,9 +162,24 @@
140162
`(begin ,@(cdr first))
141163
(error "ELSE clause isn't last -- COND->IF" clauses)
142164
)
143-
`(if ,(car first)
144-
(begin ,@(cdr first))
145-
,(expand-clauses rest)
165+
(if (null? (cddr first))
166+
`(if ,(car first)
167+
(begin ,@(cdr first))
168+
,(expand-clauses rest)
169+
)
170+
(if (eq? '=> (cadr first))
171+
`(begin
172+
(define check-result ,(car first))
173+
(if check-result
174+
(,(caddr first) check-result)
175+
,(expand-clauses rest)
176+
)
177+
)
178+
`(if ,(car first)
179+
(begin ,@(cdr first))
180+
,(expand-clauses rest)
181+
)
182+
)
146183
)
147184
)
148185
)

‎include/lisp/evaluator.h

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -448,7 +448,14 @@ class Sequence final : public Expr
448448
}
449449
std::string toString() const override
450450
{
451-
return "Sequence";
451+
std::ostringstream o;
452+
o << "(Sequence:";
453+
for (auto const& e : mActions)
454+
{
455+
o << " " << e->toString();
456+
}
457+
o << ")";
458+
return o.str();
452459
}
453460
};
454461

‎sample/CMakeLists.txt

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,9 @@ do_test(test_eq8 "(eq? (list 2) (list 2))" true)
3434

3535
do_test(test_define_proc "(define (x) 2) (x)" 2)
3636
do_test(test_cond1 "(define x #t) (cond (x 1) (else 2))" 1)
37-
do_test(test_cond2 "(define x #f) (cond (x 1) (else 2))" 2)
37+
do_test(test_cond2 "(define x #f) (cond (x (print x) 1) (else 2))" 2)
38+
do_test(test_cond3 "(define x 1) (cond (x (print x) 1) (else 2))" 1)
39+
do_test(test_cond4 "(define x 1) (cond (x => -) (else 2))" -1)
3840

3941
do_test(test_string1
4042
"
@@ -141,6 +143,7 @@ do_test(test_list "(list 1 2)" "(1 2)")
141143
do_test(test_list_star "(list* 1 2)" "(1 . 2)")
142144

143145
do_test(test_let "(define x -1)(let ((x 1)(y (- x))) (+ y x))" "2")
146+
do_test(test_named_let "(define (fib n) (let fib-iter ((a 1)(b 0)(count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) (fib 3)" "2")
144147
do_test(test_let* "(define x -1)(let* ((x 1)(y (- x))) (+ y x))" "0")
145148

146149
do_test(test_quasiquote_nested "`(1 `,(+ 1 ,(+ 2 3)) 4)" "\\\\(1 \\\\(\\\\'quasiquote \\\\(\\\\'unquote \\\\(\\\\'\\\\+ 1 5\\\\)\\\\)\\\\) 4\\\\)")

‎sample/loop.cpp

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -142,8 +142,6 @@ auto setUpEnvironment()
142142

143143
initialEnv->defineVariable("true", true_());
144144
initialEnv->defineVariable("false", false_());
145-
initialEnv->defineVariable("#t", true_());
146-
initialEnv->defineVariable("#f", false_());
147145
initialEnv->defineVariable("nil", nil());
148146
return initialEnv;
149147
}

‎test/lisp/test.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -473,7 +473,7 @@ TEST(Parser, Application2)
473473

474474
TEST(Parser, begin2)
475475
{
476-
std::initializer_list<std::pair<std::string, std::string> > expected = {{"Sequence", "2"}};
476+
std::initializer_list<std::pair<std::string, std::string> > expected = {{"(Sequence: 1 2)", "2"}};
477477

478478
Lexer lex("(begin 1 2)");
479479
MetaParser p(lex);

0 commit comments

Comments
 (0)