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

Display: If possible, show name of closure.

Browse source 
* module/mes/display.mes (display): Lookup closure's name and display it.
This commit is contained in:
Jan Nieuwenhuizen 2016-12-26 10:00:17 +01:00
parent 3d86df27c8
commit 5f8eedacec
3 changed files with 28 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lib.c
View file

@ -23,6 +23,13 @@ SCM cadr (SCM x) {return car (cdr (x));}
SCM cdar (SCM x) {return cdr (car (x));}
SCM cddr (SCM x) {return cdr (cdr (x));}
SCM
xassq (SCM x, SCM a) ///for speed in core only
{
while (a != cell_nil && x != CDAR (a)) a = CDR (a);
return a != cell_nil ? CAR (a) : cell_f;
}
SCM
length (SCM x)
{

7
mes.c
View file

@ -311,12 +311,7 @@ pairlis (SCM x, SCM y, SCM a)
SCM
assq (SCM x, SCM a)
{
while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f)
{
if (TYPE (a) == BROKEN_HEART || TYPE (CAR (a)) == BROKEN_HEART)
fprintf (stderr, "oops, broken heart\n");
a = CDR (a);
}
while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
return a != cell_nil ? car (a) : cell_f;
}

21
module/mes/display.mes
View file

@ -23,6 +23,22 @@
;;; Code:
(mes-use-module (mes scm))
;;(mes-use-module (mes srfi srfi-1))
(define (srfi-1:member x lst eq)
(if (null? lst) #f
(if (eq x (car lst)) lst
(srfi-1:member x (cdr lst) eq))))
(define (next-xassq x a)
(and=> (srfi-1:member x a (lambda (x e) (eq? x (cdr e))))
(lambda (a) (xassq x (cdr a)))))
(define (next-xassq2 x a)
(and=> (srfi-1:member x a (lambda (x e) (eq? x (cdr e))))
(lambda (a)
(and=> (srfi-1:member x (cdr a) (lambda (x e) (eq? x (cdr e))))
(lambda (a) (xassq x (cdr a)))))))
(define (display x . rest)
(let* ((port (if (null? rest) (current-output-port) (car rest)))
@ -64,7 +80,10 @@
(if name (display name)
(write-char x port)))))
((closure? x)
(display "#<procedure #f " port)
(display "#<procedure " port)
(let ((name (and=> (next-xassq2 x (current-module)) car)))
(display name port))
(display " " port)
(display (cadr (core:cdr x)) port)
(display ">" port))
((macro? x)