home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pseudo-s / pseudo_2.lha / list.pso < prev    next >
Encoding:
Text File  |  1992-02-17  |  3.1 KB  |  98 lines
  1. ; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SCHEME-TRANSLATOR; -*-
  2.  
  3. ; This file was generated by Pseudoscheme 2.8a
  4. ;  running in Lucid Common Lisp 4.0.1
  5. ;  from file /amd/night/b/jar/pseudo/list.scm
  6.  
  7. (SCHI:BEGIN-TRANSLATED-FILE)
  8. (DEFUN .SOME
  9.        (PRED L)
  10.        (IF (NOT (NULL L))
  11.            (LET ((TEMP (FUNCALL PRED (CAR L))))
  12.              (IF (SCHI:TRUEP TEMP)
  13.                  TEMP
  14.                  (.SOME PRED (CDR L))))
  15.            SCHI:FALSE))
  16. (SCHI:SET-VALUE-FROM-FUNCTION '.SOME 'SCHEME::SOME)
  17. (DEFUN .EVERY
  18.        (PRED L)
  19.        (OR (NULL L)
  20.            (IF (SCHI:TRUEP (FUNCALL PRED (CAR L)))
  21.                (.EVERY PRED (CDR L))
  22.                SCHI:FALSE)))
  23. (SCHI:SET-VALUE-FROM-FUNCTION '.EVERY 'SCHEME::EVERY)
  24. (DEFUN RASSQ
  25.        (OBJ LST)
  26.        (IF (NULL LST)
  27.            SCHI:FALSE
  28.            (IF (EQ OBJ (CDAR LST))
  29.                (CAR LST)
  30.                (RASSQ OBJ (CDR LST)))))
  31. (SCHI:SET-VALUE-FROM-FUNCTION 'RASSQ 'SCHEME::RASSQ)
  32. (DEFUN FILTER
  33.        (PRED L)
  34.        (IF (NULL L)
  35.            'NIL
  36.            (IF (SCHI:TRUEP (FUNCALL PRED (CAR L)))
  37.                (CONS (CAR L)
  38.                      (FILTER PRED (CDR L)))
  39.                (FILTER PRED (CDR L)))))
  40. (SCHI:SET-VALUE-FROM-FUNCTION 'FILTER 'SCHEME::FILTER)
  41. (DEFUN RIGHT-REDUCE
  42.        (PROC LST .IDENTITY)
  43.        (IF (NULL LST)
  44.            .IDENTITY
  45.            (RIGHT-REDUCE PROC
  46.                          (CDR LST)
  47.                          (FUNCALL PROC (CAR LST) .IDENTITY))))
  48. (SCHI:SET-VALUE-FROM-FUNCTION 'RIGHT-REDUCE
  49.                               'SCHEME::RIGHT-REDUCE)
  50. (LOCALLY (DECLARE (SPECIAL .REDUCE RIGHT-REDUCE))
  51.          (SETQ .REDUCE RIGHT-REDUCE))
  52. (SCHI:SET-FUNCTION-FROM-VALUE '.REDUCE 'SCHEME::REDUCE)
  53. (DEFUN SETDIFFQ
  54.        (L1 L2)
  55.        (IF (NULL L2)
  56.            L1
  57.            (IF (NULL L1)
  58.                L1
  59.                (IF (MEMBER (CAR L1) L2 :TEST #'EQ)
  60.                    (SETDIFFQ (CDR L1) L2)
  61.                    (CONS (CAR L1)
  62.                          (SETDIFFQ (CDR L1) L2))))))
  63. (SCHI:SET-VALUE-FROM-FUNCTION 'SETDIFFQ
  64.                               'SCHEME::SETDIFFQ)
  65. (DEFUN UNIONQ
  66.        (L1 L2)
  67.        (IF (NULL L1)
  68.            L2
  69.            (IF (NULL L2)
  70.                L1
  71.                (IF (MEMBER (CAR L1) L2 :TEST #'EQ)
  72.                    (UNIONQ (CDR L1) L2)
  73.                    (CONS (CAR L1)
  74.                          (UNIONQ (CDR L1) L2))))))
  75. (SCHI:SET-VALUE-FROM-FUNCTION 'UNIONQ 'SCHEME::UNIONQ)
  76. (DEFUN INTERSECTQ
  77.        (L1 L2)
  78.        (IF (NULL L1)
  79.            L1
  80.            (IF (NULL L2)
  81.                L2
  82.                (IF (MEMBER (CAR L1) L2 :TEST #'EQ)
  83.                    (CONS (CAR L1)
  84.                          (INTERSECTQ (CDR L1) L2))
  85.                    (INTERSECTQ (CDR L1) L2)))))
  86. (SCHI:SET-VALUE-FROM-FUNCTION 'INTERSECTQ
  87.                               'SCHEME::INTERSECTQ)
  88. (DEFUN INTERSECTQ?
  89.        (L1 L2)
  90.        (IF (NOT (NULL L1))
  91.            (IF (NOT (NULL L2))
  92.                (OR (MEMBER (CAR L1) L2 :TEST #'EQ)
  93.                    (INTERSECTQ? (CDR L1) L2))
  94.                SCHI:FALSE)
  95.            SCHI:FALSE))
  96. (SCHI:SET-VALUE-FROM-FUNCTION 'INTERSECTQ?
  97.                               'SCHEME::INTERSECTQ?)
  98.