artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Remove evcon (Sorry John).

Browse source 
* mes.c (evcon): Remove, remove callers.
* base0-if.mes (cond): Rename from disabled-cond.
This commit is contained in:
Jan Nieuwenhuizen 2016-10-15 11:56:18 +02:00
parent 83970245e5
commit bd2b81755a
2 changed files with 9 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
base0-if.mes
View file

@ -20,21 +20,21 @@
(define (cons* x . rest)
(define (loop rest)
(if (null? (cdr rest)) (car rest) ;; IF
(if (null? (cdr rest)) (car rest)
(cons (car rest) (loop (cdr rest)))))
(loop (cons x rest)))
(define-macro disabled-cond ;; using evcon: 50% speedup (cond in syntax.mes)
(define-macro cond
(lambda clauses
(if (null? clauses) *unspecified* ;; IF
(if (null? (cdr clauses)) ;; IF
(list 'if (car (car clauses)) ;; IF
(if (null? clauses) *unspecified*
(if (null? (cdr clauses))
(list 'if (car (car clauses))
(cons* 'begin (car (car clauses)) (cdr (car clauses)))
*unspecified*)
(if (eq? (car (cadr clauses)) 'else) ;; IF
(list 'if (car (car clauses)) ;; IF
(if (eq? (car (cadr clauses)) 'else)
(list 'if (car (car clauses))
(cons* 'begin (car (car clauses)) (cdr (car clauses)))
(cons* 'begin *unspecified* (cdr (cadr clauses))))
(list 'if (car (car clauses)) ;; IF
(list 'if (car (car clauses))
(cons* 'begin (car (car clauses)) (cdr (car clauses)))
(cons* 'cond (cdr clauses)))))))) ;; IF
(cons* 'cond (cdr clauses))))))))

31
mes.c
View file

@ -38,7 +38,6 @@
#define DEBUG 0
#define STATIC_PRIMITIVES 1 // 8x speedup for mescc
#define BUILTIN_QUASIQUOTE 1 // 6x speedup for mescc
#define COND 1 // 30% speedup for mescc
#define MES_FULL 1
enum type {CHAR, MACRO, NUMBER, PAIR, STRING, SYMBOL, VALUES, VECTOR,
@ -314,26 +313,6 @@ assq (scm *x, scm *a)
|| x->type == FUNCTIONn) \
? &scm_t : &scm_f)
#if COND
scm *
evcon (scm *c, scm *a) // internal
{
if (c == &scm_nil) return &scm_unspecified;
scm *clause = car (c);
scm *expr = eval_env (car (clause), a);
if (expr != &scm_f) {
if (cdr (clause) == &scm_nil)
return expr;
if (cddr (clause) == &scm_nil)
return eval_env (cadr (clause), a);
eval_env (cadr (clause), a);
return evcon (cons (cons (&scm_t, cddr (clause)), &scm_nil), a);
}
return evcon (cdr (c), a);
}
#endif // COND
scm *
evlis (scm *m, scm *a)
{
@ -408,10 +387,6 @@ eval_env (scm *e, scm *a)
return make_closure (cadr (e), cddr (e), assq (&symbol_closure, a));
if (e->car == &symbol_closure)
return e;
#if COND
if (e->car == &symbol_cond)
return evcon (e->cdr, a);
#endif // COND
if (e->car == &symbol_if)
return if_env (cdr (e), a);
if (e->car == &symbol_define)
@ -547,9 +522,6 @@ internal_symbol_p (scm *x)
|| x == &symbol_circ
|| x == &symbol_lambda
|| x == &symbol_begin
#if COND
|| x == &symbol_cond
#endif // COND
|| x == &symbol_if
|| x == &symbol_sc_expand
@ -1454,9 +1426,6 @@ mes_primitives () // internal
{
primitives = cons (&scm_eval_env, primitives);
primitives = cons (&scm_apply_env, primitives);
#if 0 //COND
primitives = cons (&scm_evcon, primitives);
#endif
primitives = cons (&scm_string_p, primitives);
primitives = cons (&scm_symbol_p, primitives);