diff --git a/mes.c b/mes.c index 777a55f9..121d76b1 100644 --- a/mes.c +++ b/mes.c @@ -165,6 +165,13 @@ set_cdr_x (scm *x, scm *e) { assert (x->type == PAIR); x->cdr = e; + return &scm_unspecified; +} + +scm * +set_x (scm *x, scm *e, scm *a) +{ + return set_cdr_x (assoc (x, a), e); } scm * @@ -477,6 +484,7 @@ lookup (char *x, scm *a) if (!strcmp (x, scm_lambda.name)) return &scm_lambda; if (!strcmp (x, scm_label.name)) return &scm_label; if (!strcmp (x, scm_nil.name)) return &scm_nil; + if (!strcmp (x, scm_symbol_set_x.name)) return &scm_symbol_set_x; #if QUASIQUOTE if (*x == '`') return &scm_symbol_quasiquote; diff --git a/scm.mes b/scm.mes index e9ddef52..6a38ce36 100755 --- a/scm.mes +++ b/scm.mes @@ -75,3 +75,20 @@ (#t (cond ((pair? else) (car else)) (#t *unspecified*))))) + +(define (unspecified-bindings bindings params) + (cond ((null? bindings) params) + (#t (unspecified-bindings + (cdr bindings) + (append params (cons (cons (caar bindings) '(*unspecified*)) '())))))) + +(define (letrec-setters bindings setters) + (cond ((null? bindings) setters) + (#t (letrec-setters (cdr bindings) + (append setters + (cons (cons 'set! (car bindings)) '())))))) + +(define-macro (letrec bindings . body) + (cons 'let (cons (unspecified-bindings bindings '()) + (append (letrec-setters bindings '()) + body))) ) diff --git a/test.mes b/test.mes index bf9dfacb..e231e268 100644 --- a/test.mes +++ b/test.mes @@ -144,4 +144,15 @@ (display (if (= 1 2) 'true 'false)) (newline) +(display 'factorial4=) +(display + (letrec ((factorial (lambda (n) + ;; (display 'factorial:) + ;; (display n) + ;; (newline) + (if (= n 1) 1 + (* n (factorial (- n 1))))))) + (factorial 4))) +(newline) + '()