home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #1 / NN_1993_1.iso / spool / comp / lang / scheme / 2874 < prev    next >
Encoding:
Text File  |  1993-01-06  |  2.0 KB  |  66 lines
  1. Newsgroups: comp.lang.scheme
  2. Path: sparky!uunet!wupost!darwin.sura.net!mlb.semi.harris.com!travis.csd.harris.com!grouper!grouper!brent
  3. From: brent@ssd.csd.harris.com (Brent Benson)
  4. Subject: Re: How do I implement trace/untrace
  5. Organization: Harris Computer Systems
  6. Date: Wed, 6 Jan 1993 14:32:17 GMT
  7. Message-ID: <BRENT.93Jan6093217@rcx1.ssd.csd.harris.com>
  8. In-Reply-To: mtoy@mycool.asd.sgi.com's message of 6 Jan 93 01:18:06 GMT
  9. References: <1idc0eINNak2@fido.asd.sgi.com>
  10. Sender: news@grouper.mkt.csd.harris.com (Network News)
  11. Lines: 53
  12.  
  13. mtoy@mycool.asd.sgi.com (Michael Toy) writes:
  14.  
  15. > I am new to scheme and I am trying various small projects to explore
  16. > what can and can not be done.  One idea was to add a factility for
  17. > strict type checking, which would allow you to declare what the
  18. > legal types for a function were, and the type check would be
  19. > "inserted" into the procedure, similar to the way "trace" and
  20. > "untrace" work in some schemes.
  21.  
  22. Here's a simple version of what you're looking for.  (You need to use
  23. a macro if you don't like having to set! the result.)  As an exercise,
  24. write a similar procedure that also checks the types of the arguments.
  25.  
  26. ;;;
  27. ;;; Return a version of FUN that calls TYPE-PRED? on
  28. ;;; its return value and signals an error if the return
  29. ;;; type is incorrect.
  30. ;;;
  31. (define (type-check fun fun-name type-pred?)
  32.   (lambda args
  33.     (if (and (not (null? args))
  34.          (eq? (car args) 'un-type-check)
  35.          (null? (cdr args)))
  36.     fun
  37.     (let ((result (apply fun args)))
  38.       (if (type-pred? result)
  39.           result
  40.           (error "incorrect return type:" fun-name))))))
  41.           
  42. ;;;
  43. ;;; Return the original FUN.
  44. ;;;
  45. (define (un-type-check fun)
  46.   (fun 'un-type-check))
  47.  
  48. An example:
  49.  
  50. > (define (number-car l) (car l))
  51. > (set! number-car (type-check number-car 'number-car number?))
  52. > (number-car '(1 2 3))
  53. 1
  54. > (number-car '(a b c))
  55.  
  56. Error: incorrect return type:
  57.        number-car
  58. 1> 
  59. > (set! number-car (un-type-check number-car))
  60. > (number-car '(a b c))
  61. 'a
  62.  
  63. --
  64. Brent Benson                     
  65. Harris Computer Systems
  66.