home *** CD-ROM | disk | FTP | other *** search
/ Mac Mania 2 / MacMania 2.toast / Demo's / Tools&Utilities / Programming / HELP language 1.4 / Help Files / Miscellaneous / Multiple Values < prev    next >
Encoding:
Text File  |  1992-12-28  |  1.1 KB  |  42 lines  |  [TEXT/Help]
  1. {••• Are Multiple Values useful ?…… Let's emulate them with conses •••}
  2.  
  3. ;;; the Common-Lisp values form
  4. (define (mret | l) l)
  5.  
  6. ;;; To apply a multiple function on a multiple value, 
  7. ;;; returns a… multiple value :-\
  8.  
  9. (define (retfrom v | l)
  10.   (retfrom2 v l))
  11.  
  12. (define (retfrom2 v l)
  13.    (cond (null? l) ()
  14.          (cons ((0 l) (0 v))(retfrom2 (-1 v) (-1 l)))))
  15.  
  16. ;;; A small Test 
  17. ;;; count: Counts the number of occ. of a and b in l in one pass
  18.     
  19. ;;; A first classical example with 2 bags: nca and ncb
  20. ;;; to get a terminal recursion
  21.     
  22. (define (count a b l nca ncb)
  23.   (cond (null? l) (list nca ncb)
  24.         (=? a (0 l)) (count a b (-1 l) (1+ nca) ncb)
  25.         (=? b (0 l)) (count a b (-1 l) nca (1+ ncb))
  26.         (count a b (-1 l) nca ncb)))
  27.  
  28. (count 1 2 '(1 1 2 2 3 1 2 1 5 4 1) 0 0)
  29. { = (5 3) }
  30.  
  31. ;;; The two bags are now hidden in the multiple values
  32. ;;; looks more pretty !
  33.     
  34. (define (count2 a b l)
  35.   (cond (null? l) (mret 0 0)
  36.         (=? a (0 l)) (retfrom (count2 a b (-1 l)) 1+ I)
  37.         (=? b (0 l)) (retfrom (count2 a b (-1 l)) I 1+)
  38.         (count2 a b (-1 l))))
  39.        
  40. (count2 1 2 '(1 1 2 2 3 1 2 1 5 4 1))
  41. { = (5 3) }
  42.