home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pseudo-s / pseudo_2.lha / expr.pso < prev    next >
Encoding:
Text File  |  1992-02-17  |  11.8 KB  |  267 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/expr.scm
  6.  
  7. (SCHI:BEGIN-TRANSLATED-FILE)
  8. (DEFUN LITERAL?
  9.        (X)
  10.        (OR (NUMBERP X)
  11.            (SIMPLE-STRING-P X)
  12.            (SCHI:BOOLEANP X)
  13.            (SCHI:TRUE? (CHARACTERP X))))
  14. (SCHI:SET-VALUE-FROM-FUNCTION 'LITERAL?
  15.                               'SCHEME::LITERAL?)
  16. (SCHI:AT-TOP-LEVEL
  17.   (LOCALLY (DECLARE (SPECIAL SYNTAX-CHECKERS
  18.                              NUMBER-OF-CLASSES))
  19.            (SETQ SYNTAX-CHECKERS (MAKE-VECTOR NUMBER-OF-CLASSES
  20.                                               #'(LAMBDA (FORM) FORM SCHI:TRUE)))
  21.                  ))
  22. (SCHI:SET-FUNCTION-FROM-VALUE 'SYNTAX-CHECKERS
  23.                               'SCHEME::SYNTAX-CHECKERS)
  24. (DEFUN DEFINE-SYNTAX-CHECKER
  25.        (CLASS PROC)
  26.        (DECLARE (SPECIAL SYNTAX-CHECKERS))
  27.        (SETF (SVREF SYNTAX-CHECKERS CLASS)
  28.              PROC)
  29.        SCHI:UNSPECIFIED)
  30. (SCHI:SET-VALUE-FROM-FUNCTION 'DEFINE-SYNTAX-CHECKER
  31.                               'SCHEME::DEFINE-SYNTAX-CHECKER)
  32. (DEFUN CHECK-SPECIAL-FORM-SYNTAX
  33.        (CLASS FORM)
  34.        (DECLARE (SPECIAL SYNTAX-CHECKERS))
  35.        (FUNCALL (SVREF SYNTAX-CHECKERS CLASS)
  36.                 FORM))
  37. (SCHI:SET-VALUE-FROM-FUNCTION 'CHECK-SPECIAL-FORM-SYNTAX
  38.                               'SCHEME::CHECK-SPECIAL-FORM-SYNTAX)
  39. (LOCALLY (DECLARE (SPECIAL LET-SYNTAX-FORM-DSPECS))
  40.          (SETQ LET-SYNTAX-FORM-DSPECS #'CADR))
  41. (SCHI:SET-FUNCTION-FROM-VALUE 'LET-SYNTAX-FORM-DSPECS
  42.                               'SCHEME::LET-SYNTAX-FORM-DSPECS)
  43. (LOCALLY (DECLARE (SPECIAL LET-SYNTAX-FORM-BODY))
  44.          (SETQ LET-SYNTAX-FORM-BODY #'CADDR))
  45. (SCHI:SET-FUNCTION-FROM-VALUE 'LET-SYNTAX-FORM-BODY
  46.                               'SCHEME::LET-SYNTAX-FORM-BODY)
  47. (SCHI:AT-TOP-LEVEL
  48.   (LOCALLY (DECLARE (SPECIAL CHECK-SYNTAX-SPEC
  49.                              CLASS/LET-SYNTAX))
  50.            (DEFINE-SYNTAX-CHECKER CLASS/LET-SYNTAX
  51.                                   #'(LAMBDA (.EXP)
  52.                                      (IF (= (CAREFUL-LENGTH .EXP) 3)
  53.                                       (CAREFUL-EVERY CHECK-SYNTAX-SPEC
  54.                                        (CADR .EXP))
  55.                                       SCHI:FALSE)))))
  56. (LOCALLY (DECLARE (SPECIAL LETREC-SYNTAX-FORM-DSPECS
  57.                            LET-SYNTAX-FORM-DSPECS))
  58.          (SETQ LETREC-SYNTAX-FORM-DSPECS LET-SYNTAX-FORM-DSPECS))
  59. (SCHI:SET-FUNCTION-FROM-VALUE 'LETREC-SYNTAX-FORM-DSPECS
  60.                               'SCHEME::LETREC-SYNTAX-FORM-DSPECS)
  61. (LOCALLY (DECLARE (SPECIAL LETREC-SYNTAX-FORM-BODY
  62.                            LET-SYNTAX-FORM-BODY))
  63.          (SETQ LETREC-SYNTAX-FORM-BODY LET-SYNTAX-FORM-BODY))
  64. (SCHI:SET-FUNCTION-FROM-VALUE 'LETREC-SYNTAX-FORM-BODY
  65.                               'SCHEME::LETREC-SYNTAX-FORM-BODY)
  66. (SCHI:AT-TOP-LEVEL
  67.   (LOCALLY (DECLARE (SPECIAL CHECK-SYNTAX-SPEC
  68.                              CLASS/LETREC-SYNTAX))
  69.            (DEFINE-SYNTAX-CHECKER CLASS/LETREC-SYNTAX
  70.                                   #'(LAMBDA (.EXP)
  71.                                      (IF (= (CAREFUL-LENGTH .EXP) 3)
  72.                                       (CAREFUL-EVERY CHECK-SYNTAX-SPEC
  73.                                        (CADR .EXP))
  74.                                       SCHI:FALSE)))))
  75. (LOCALLY (DECLARE (SPECIAL SYNTAX-SPEC-NAME))
  76.          (SETQ SYNTAX-SPEC-NAME #'CAR))
  77. (SCHI:SET-FUNCTION-FROM-VALUE 'SYNTAX-SPEC-NAME
  78.                               'SCHEME::SYNTAX-SPEC-NAME)
  79. (LOCALLY (DECLARE (SPECIAL SYNTAX-SPEC-FORM))
  80.          (SETQ SYNTAX-SPEC-FORM #'CADR))
  81. (SCHI:SET-FUNCTION-FROM-VALUE 'SYNTAX-SPEC-FORM
  82.                               'SCHEME::SYNTAX-SPEC-FORM)
  83. (DEFUN CHECK-SYNTAX-SPEC
  84.        (SYNTAX-SPEC)
  85.        (IF (= (CAREFUL-LENGTH SYNTAX-SPEC)
  86.               2)
  87.            (NAME? (SYNTAX-SPEC-NAME SYNTAX-SPEC))
  88.            SCHI:FALSE))
  89. (SCHI:SET-VALUE-FROM-FUNCTION 'CHECK-SYNTAX-SPEC
  90.                               'SCHEME::CHECK-SYNTAX-SPEC)
  91. (LOCALLY (DECLARE (SPECIAL DEFINE-SYNTAX-SYNTAX-SPEC))
  92.          (SETQ DEFINE-SYNTAX-SYNTAX-SPEC #'CDR))
  93. (SCHI:SET-FUNCTION-FROM-VALUE 'DEFINE-SYNTAX-SYNTAX-SPEC
  94.                               'SCHEME::DEFINE-SYNTAX-SYNTAX-SPEC)
  95. (SCHI:AT-TOP-LEVEL
  96.   (LOCALLY (DECLARE (SPECIAL CLASS/DEFINE-SYNTAX))
  97.            (DEFINE-SYNTAX-CHECKER CLASS/DEFINE-SYNTAX
  98.                                   #'(LAMBDA (FORM)
  99.                                      (CHECK-SYNTAX-SPEC (CDR FORM))))))
  100. (LOCALLY (DECLARE (SPECIAL BEGIN-FORM-STATEMENTS))
  101.          (SETQ BEGIN-FORM-STATEMENTS #'CDR))
  102. (SCHI:SET-FUNCTION-FROM-VALUE 'BEGIN-FORM-STATEMENTS
  103.                               'SCHEME::BEGIN-FORM-STATEMENTS)
  104. (SCHI:AT-TOP-LEVEL
  105.   (LOCALLY (DECLARE (SPECIAL CLASS/BEGIN))
  106.            (DEFINE-SYNTAX-CHECKER CLASS/BEGIN
  107.                                   #'(LAMBDA (FORM)
  108.                                      (SCHI:TRUE? (>= (CAREFUL-LENGTH FORM) 1))))))
  109. (LOCALLY (DECLARE (SPECIAL APPLICATION-FORM-PROCEDURE))
  110.          (SETQ APPLICATION-FORM-PROCEDURE #'CAR))
  111. (SCHI:SET-FUNCTION-FROM-VALUE 'APPLICATION-FORM-PROCEDURE
  112.                               'SCHEME::APPLICATION-FORM-PROCEDURE)
  113. (LOCALLY (DECLARE (SPECIAL APPLICATION-FORM-ARGUMENTS))
  114.          (SETQ APPLICATION-FORM-ARGUMENTS #'CDR))
  115. (SCHI:SET-FUNCTION-FROM-VALUE 'APPLICATION-FORM-ARGUMENTS
  116.                               'SCHEME::APPLICATION-FORM-ARGUMENTS)
  117. (LOCALLY (DECLARE (SPECIAL LAMBDA-FORM-FORMALS))
  118.          (SETQ LAMBDA-FORM-FORMALS #'CADR))
  119. (SCHI:SET-FUNCTION-FROM-VALUE 'LAMBDA-FORM-FORMALS
  120.                               'SCHEME::LAMBDA-FORM-FORMALS)
  121. (LOCALLY (DECLARE (SPECIAL LAMBDA-FORM-BODY))
  122.          (SETQ LAMBDA-FORM-BODY #'CDDR))
  123. (SCHI:SET-FUNCTION-FROM-VALUE 'LAMBDA-FORM-BODY
  124.                               'SCHEME::LAMBDA-FORM-BODY)
  125. (SCHI:AT-TOP-LEVEL
  126.   (LOCALLY (DECLARE (SPECIAL CLASS/LAMBDA))
  127.            (DEFINE-SYNTAX-CHECKER CLASS/LAMBDA
  128.                                   #'(LAMBDA (.EXP)
  129.                                      (IF (>= (CAREFUL-LENGTH .EXP) 3)
  130.                                       (CHECK-FORMALS
  131.                                        (LAMBDA-FORM-FORMALS .EXP))
  132.                                       SCHI:FALSE)))))
  133. (DEFUN CHECK-FORMALS
  134.        (FORMALS)
  135.        (OR (NULL FORMALS)
  136.            (LET ((TEMP (NAME? FORMALS)))
  137.              (IF (SCHI:TRUEP TEMP)
  138.                  TEMP
  139.                  (IF (SCHI:TRUEP (NAME? (CAR FORMALS)))
  140.                      (CHECK-FORMALS (CDR FORMALS))
  141.                      SCHI:FALSE)))))
  142. (SCHI:SET-VALUE-FROM-FUNCTION 'CHECK-FORMALS
  143.                               'SCHEME::CHECK-FORMALS)
  144. (LOCALLY (DECLARE (SPECIAL LETREC-FORM-BSPECS))
  145.          (SETQ LETREC-FORM-BSPECS #'CADR))
  146. (SCHI:SET-FUNCTION-FROM-VALUE 'LETREC-FORM-BSPECS
  147.                               'SCHEME::LETREC-FORM-BSPECS)
  148. (LOCALLY (DECLARE (SPECIAL LETREC-FORM-BODY))
  149.          (SETQ LETREC-FORM-BODY #'CDDR))
  150. (SCHI:SET-FUNCTION-FROM-VALUE 'LETREC-FORM-BODY
  151.                               'SCHEME::LETREC-FORM-BODY)
  152. (SCHI:AT-TOP-LEVEL
  153.   (LOCALLY (DECLARE (SPECIAL CLASS/LETREC))
  154.            (DEFINE-SYNTAX-CHECKER CLASS/LETREC
  155.                                   #'(LAMBDA (.EXP)
  156.                                      (IF (>= (CAREFUL-LENGTH .EXP) 3)
  157.                                       (CAREFUL-EVERY
  158.                                        #'(LAMBDA (SYNTAX-SPEC)
  159.                                           (IF
  160.                                            (= (CAREFUL-LENGTH SYNTAX-SPEC) 2)
  161.                                            (NAME?
  162.                                             (SYNTAX-SPEC-NAME SYNTAX-SPEC))
  163.                                            SCHI:FALSE))
  164.                                        (LETREC-FORM-BSPECS .EXP))
  165.                                       SCHI:FALSE)))))
  166. (LOCALLY (DECLARE (SPECIAL QUOTE-FORM-TEXT))
  167.          (SETQ QUOTE-FORM-TEXT #'CADR))
  168. (SCHI:SET-FUNCTION-FROM-VALUE 'QUOTE-FORM-TEXT
  169.                               'SCHEME::QUOTE-FORM-TEXT)
  170. (SCHI:AT-TOP-LEVEL
  171.   (LOCALLY (DECLARE (SPECIAL CLASS/QUOTE))
  172.            (DEFINE-SYNTAX-CHECKER CLASS/QUOTE
  173.                                   #'(LAMBDA (.EXP)
  174.                                      (SCHI:TRUE? (= (CAREFUL-LENGTH .EXP) 2))))))
  175. (LOCALLY (DECLARE (SPECIAL IF-FORM-TEST))
  176.          (SETQ IF-FORM-TEST #'CADR))
  177. (SCHI:SET-FUNCTION-FROM-VALUE 'IF-FORM-TEST
  178.                               'SCHEME::IF-FORM-TEST)
  179. (LOCALLY (DECLARE (SPECIAL IF-FORM-CONSEQUENT))
  180.          (SETQ IF-FORM-CONSEQUENT #'CADDR))
  181. (SCHI:SET-FUNCTION-FROM-VALUE 'IF-FORM-CONSEQUENT
  182.                               'SCHEME::IF-FORM-CONSEQUENT)
  183. (DEFUN IF-FORM-ALTERNATE?
  184.        (.EXP)
  185.        (SCHI:TRUE? (NOT (NULL (CDDDR .EXP)))))
  186. (SCHI:SET-VALUE-FROM-FUNCTION 'IF-FORM-ALTERNATE?
  187.                               'SCHEME::IF-FORM-ALTERNATE?)
  188. (LOCALLY (DECLARE (SPECIAL IF-FORM-ALTERNATE))
  189.          (SETQ IF-FORM-ALTERNATE #'CADDDR))
  190. (SCHI:SET-FUNCTION-FROM-VALUE 'IF-FORM-ALTERNATE
  191.                               'SCHEME::IF-FORM-ALTERNATE)
  192. (SCHI:AT-TOP-LEVEL
  193.   (LOCALLY (DECLARE (SPECIAL CLASS/IF))
  194.            (DEFINE-SYNTAX-CHECKER CLASS/IF
  195.                                   #'(LAMBDA (.EXP)
  196.                                      (LET ((LEN (CAREFUL-LENGTH .EXP)))
  197.                                       (OR (= LEN 3) (SCHI:TRUE? (= LEN 4))))))))
  198. (LOCALLY (DECLARE (SPECIAL SET!-FORM-LHS))
  199.          (SETQ SET!-FORM-LHS #'CADR))
  200. (SCHI:SET-FUNCTION-FROM-VALUE 'SET!-FORM-LHS
  201.                               'SCHEME::SET!-FORM-LHS)
  202. (LOCALLY (DECLARE (SPECIAL SET!-FORM-RHS))
  203.          (SETQ SET!-FORM-RHS #'CADDR))
  204. (SCHI:SET-FUNCTION-FROM-VALUE 'SET!-FORM-RHS
  205.                               'SCHEME::SET!-FORM-RHS)
  206. (SCHI:AT-TOP-LEVEL
  207.   (LOCALLY (DECLARE (SPECIAL CLASS/SET!))
  208.            (DEFINE-SYNTAX-CHECKER CLASS/SET!
  209.                                   #'(LAMBDA (.EXP)
  210.                                      (IF (= (CAREFUL-LENGTH .EXP) 3)
  211.                                       (NAME? (CADR .EXP)) SCHI:FALSE)))))
  212. (SCHI:AT-TOP-LEVEL
  213.   (LOCALLY (DECLARE (SPECIAL CLASS/DEFINE))
  214.            (DEFINE-SYNTAX-CHECKER CLASS/DEFINE
  215.                                   #'(LAMBDA (FORM)
  216.                                      (IF (CONSP (CDR FORM))
  217.                                       (LET ((PAT (CADR FORM)))
  218.                                        (IF (SCHI:TRUEP (NAME? PAT))
  219.                                         (SCHI:TRUE?
  220.                                          (= (CAREFUL-LENGTH FORM) 3))
  221.                                         (IF (CONSP PAT)
  222.                                          (IF
  223.                                           (SCHI:TRUEP
  224.                                            (CHECK-FORMALS (CDR PAT)))
  225.                                           (SCHI:TRUE?
  226.                                            (>= (CAREFUL-LENGTH FORM) 3))
  227.                                           SCHI:FALSE)
  228.                                          SCHI:FALSE)))
  229.                                       SCHI:FALSE)))))
  230. (DEFUN DEFINE-FORM-LHS
  231.        (FORM)
  232.        (LET ((PAT (CADR FORM)))
  233.          (IF (CONSP PAT)
  234.              (CAR PAT)
  235.              PAT)))
  236. (SCHI:SET-VALUE-FROM-FUNCTION 'DEFINE-FORM-LHS
  237.                               'SCHEME::DEFINE-FORM-LHS)
  238. (DEFUN DEFINE-FORM-RHS
  239.        (FORM)
  240.        (LET ((PAT (CADR FORM)))
  241.          (IF (CONSP PAT)
  242.              (CONS 'SCHEME::LAMBDA
  243.                    (CONS (CDR PAT) (CDDR FORM)))
  244.              (CADDR FORM))))
  245. (SCHI:SET-VALUE-FROM-FUNCTION 'DEFINE-FORM-RHS
  246.                               'SCHEME::DEFINE-FORM-RHS)
  247. (DEFUN CAREFUL-LENGTH
  248.        (L)
  249.        (IF (NULL L)
  250.            0
  251.            (IF (CONSP L)
  252.                (+ 1 (CAREFUL-LENGTH (CDR L)))
  253.                -1)))
  254. (SCHI:SET-VALUE-FROM-FUNCTION 'CAREFUL-LENGTH
  255.                               'SCHEME::CAREFUL-LENGTH)
  256. (DEFUN CAREFUL-EVERY
  257.        (PRED L)
  258.        (IF (NULL L)
  259.            SCHI:TRUE
  260.            (IF (CONSP L)
  261.                (IF (SCHI:TRUEP (FUNCALL PRED (CAR L)))
  262.                    (CAREFUL-EVERY PRED (CDR L))
  263.                    SCHI:FALSE)
  264.                SCHI:FALSE)))
  265. (SCHI:SET-VALUE-FROM-FUNCTION 'CAREFUL-EVERY
  266.                               'SCHEME::CAREFUL-EVERY)
  267.