conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

added trace-define

This commit is contained in:
Abdulaziz Ghuloum 2006-12-05 13:28:23 -05:00
parent 80c8ca7a5c
commit d9915f371b
5 changed files with 32 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lib/.vimview/~=+Work=+ikarus-scheme=+lib=+libcompile.ss=
View File

@ -1,6 +1,5 @@
let s:so_save = &so | let s:siso_save = &siso | set so=0 siso=0 let s:so_save = &so | let s:siso_save = &siso | set so=0 siso=0
argglobal argglobal
setlocal noarabic
setlocal autoindent setlocal autoindent
setlocal autoread setlocal autoread
setlocal nobinary setlocal nobinary
@ -49,7 +48,6 @@ setlocal indentexpr=
setlocal indentkeys=0{,0},:,0#,!^F,o,O,e setlocal indentkeys=0{,0},:,0#,!^F,o,O,e
setlocal noinfercase setlocal noinfercase
setlocal iskeyword=33,35-39,42-58,60-90,94,95,97-122,126,_ setlocal iskeyword=33,35-39,42-58,60-90,94,95,97-122,126,_
setlocal keymap=
setlocal keywordprg= setlocal keywordprg=
setlocal nolinebreak setlocal nolinebreak
setlocal lisp setlocal lisp
@ -67,8 +65,6 @@ setlocal nopreserveindent
setlocal nopreviewwindow setlocal nopreviewwindow
setlocal quoteescape=\\ setlocal quoteescape=\\
setlocal noreadonly setlocal noreadonly
setlocal norightleft
setlocal rightleftcmd=search
setlocal noscrollbind setlocal noscrollbind
setlocal shiftwidth=2 setlocal shiftwidth=2
setlocal noshortname setlocal noshortname
@ -183,11 +179,11 @@ normal zc
normal zc normal zc
3951 3951
normal zc normal zc
let s:l = 3951 - ((1463 * winheight(0) + 17) / 35) let s:l = 1 - ((0 * winheight(0) + 10) / 20)
if s:l < 1 | let s:l = 1 | endif if s:l < 1 | let s:l = 1 | endif
exe s:l exe s:l
normal! zt normal! zt
3951 1
normal! 0 normal! 0
let &so = s:so_save | let &siso = s:siso_save let &so = s:so_save | let &siso = s:siso_save
doautoall SessionLoadPost doautoall SessionLoadPost

BIN
lib/ikarus.boot
View File

Binary file not shown.

18
lib/libtrace.ss
View File

@ -87,3 +87,21 @@
(primitive-set! 'untrace-symbol! untrace-symbol!)) (primitive-set! 'untrace-symbol! untrace-symbol!))
#!eof
Try:
(trace-define fact
(lambda (n)
(if (zero? n)
1
(* n (fact (sub1 n))))))
(fact 5)
(trace-define (fact n m)
(cond
[(zero? n) m]
[else (fact (sub1 n) (* n m))]))
(fact 5 1)

2
lib/makefile.ss
View File

@ -26,7 +26,7 @@
syntax-case syntax-rules module $module import $import import-only syntax-case syntax-rules module $module import $import import-only
syntax quasisyntax unsyntax unsyntax-splicing datum syntax quasisyntax unsyntax unsyntax-splicing datum
let let* let-values cond case define-record or and when unless do let let* let-values cond case define-record or and when unless do
include parameterize trace untrace trace-lambda)) include parameterize trace untrace trace-lambda trace-define))

11
lib/psyntax-7.1.ss
View File

@ -4710,3 +4710,14 @@
[(_ name args body body* ...) [(_ name args body body* ...)
#'(make-traced-procedure 'name (lambda args body body* ...))]))) #'(make-traced-procedure 'name (lambda args body body* ...))])))
(define-syntax trace-define
(lambda (x)
(syntax-case x ()
[(_ (id . args) b b* ...)
#'(define id
(make-traced-procedure 'id
(lambda args b b* ...)))]
[(_ id value)
#'(define id
(make-traced-procedure 'id value))])))