eval.lisp

   1 ;;;;------------------------------------------------------------------
   2 ;;;;
   3 ;;;;    Copyright (C) 2000-2005,
   4 ;;;;    Department of Computer Science, University of Tromso, Norway
   5 ;;;;
   6 ;;;; Filename:      eval.lisp
   7 ;;;; Description:
   8 ;;;; Author:        Frode Vatvedt Fjeld <frodef@acm.org>
   9 ;;;; Created at:    Thu Nov  2 17:45:05 2000
  10 ;;;; Distribution:  See the accompanying file COPYING.
  11 ;;;;
  12 ;;;; $Id: eval.lisp,v 1.12 2007/03/11 21:18:40 ffjeld Exp $
  13 ;;;;
  14 ;;;;------------------------------------------------------------------
  15
  16 (in-package movitz)
  17
  18 (defun in-package-form-p (form)
  19   (and (consp form)
  20        (string= '#:in-package (car form))))
  21
  22 (defun require-form-p (form)
  23   (and (consp form)
  24        (string= '#:require (car form))))
  25
  26 (defun provide-form-p (form)
  27   (and (consp form)
  28        (string= '#:provide (car form))))
  29
  30 (defun movitz-module-path (require-form)
  31   "Given a require form, return the path of the file that is expected ~
  32    to provide that module."
  33   (let ((module (second require-form)))
  34     (concatenate 'string
  35       "losp/"
  36       (or (third require-form)
  37           (concatenate 'string
  38             (string-downcase (symbol-name module))
  39             ".lisp")))))
  40
  41 (defun movitzify-package-name (name)
  42   (let ((name (string name)))
  43     (if (member name '("cl" "common-lisp" "mop")
  44                 :test #'string-equal)
  45         (concatenate 'string (string '#:muerte.) name)
  46       name)))
  47
  48 (defmacro with-retries-until-true ((name format-control &rest format-arguments) &body body)
  49   `(do () (nil)
  50      (with-simple-restart (,name ,format-control ,@format-arguments)
  51        (return (progn ,@body)))))
  52
  53 (defun quote-form-p (x)
  54   (and (consp x)
  55        (or (eq 'cl:quote (first x))
  56            (eq 'muerte.cl::quote (first x)))
  57        t))
  58
  59 (defun movitz-constantp (form &optional (env nil))
  60   (typecase form
  61     (keyword t)
  62     (symbol
  63      (let ((form (translate-program form :cl :muerte.cl)))
  64        (or (movitz-env-get form 'constantp nil env)
  65            (typep (movitz-binding form env) 'constant-object-binding))))
  66     (cons
  67      (let* ((compiler-macro-function (movitz-compiler-macro-function (car form) env))
  68             (compiler-macro-expansion (and compiler-macro-function
  69                                            (handler-case
  70                                                (funcall *movitz-macroexpand-hook*
  71                                                         compiler-macro-function
  72                                                         form env)
  73                                              (error () form)))))
  74        (or (let ((form (translate-program form :cl :muerte.cl)))
  75              (case (car form)
  76                ((muerte.cl:quote) t)
  77                ((muerte.cl:not)
  78                 (movitz-constantp (second form)))
  79                ((muerte.cl:+ muerte.cl:- muerte.cl:* muerte.cl:coerce)
  80                 (every (lambda (sub-form)
  81                          (movitz-constantp sub-form env))
  82                        (cdr form)))))
  83            (and compiler-macro-function
  84                 (not (movitz-env-get (car form) 'notinline nil env))
  85                 (not (eq form compiler-macro-expansion))
  86                 (movitz-constantp compiler-macro-expansion env)))))
  87     (t t)))                             ; anything else is self-evaluating.
  88
  89
  90 ;;;(defun isconst (x)
  91 ;;;  (or (integerp x)
  92 ;;;      (stringp x)
  93 ;;;      (eq t x)
  94 ;;;      (eq nil x)
  95 ;;;      (quote-form-p x)))
  96
  97 (defun eval-form (&rest args)
  98   (apply 'movitz-eval args))
  99
 100 (defun movitz-eval (form &optional env top-level-p)
 101   "3.1.2.1 Form Evaluation"
 102   (let ((form (translate-program form :cl :muerte.cl)))
 103     (typecase form
 104       (symbol (eval-symbol form env top-level-p))
 105       (cons   (eval-cons form env top-level-p))
 106       (t      (eval-self-evaluating form env top-level-p)))))
 107
 108 (defun eval-form-or-error (form env error-value)
 109   (handler-case (eval-form form env)
 110     (error () error-value)))
 111
 112 (defun eval-symbol (form env top-level-p)
 113   "3.1.2.1.1 Symbols as Forms"
 114   (declare (ignore top-level-p))
 115   (cond
 116    ((keywordp form)
 117     (eval-self-evaluating form env top-level-p))
 118    ((typep (movitz-binding form env) 'constant-object-binding)
 119     (translate-program (movitz-print (constant-object (movitz-binding form env)))
 120                        :cl :muerte.cl))
 121    ((movitz-constantp form env)
 122     (symbol-value form))
 123 ;;;   ((movitz-lexical-binding form env)
 124 ;;;    (eval-lexical-variable form env top-level-p))
 125    (t (error "Don't know how to eval symbol-form ~S" form))))
 126
 127 (defun eval-self-evaluating (form env top-level-p)
 128   "3.1.2.1.3 Self-Evaluating Objects"
 129   (declare (ignore env top-level-p))
 130   form)
 131
 132 (defun eval-cons (form env top-level-p)
 133   "3.1.2.1.2 Conses as Forms"
 134   (let* ((operator (car form))
 135          (compiler-macro-function (movitz-compiler-macro-function operator env))
 136          (compiler-macro-expansion (and compiler-macro-function
 137                                         (funcall *movitz-macroexpand-hook*
 138                                                  compiler-macro-function
 139                                                  form env))))
 140     (cond
 141 ;;;     ((movitz-constantp form env)
 142 ;;;      (eval-constant-compound form env top-level-p))
 143      ((member operator '(cl:quote muerte.cl::quote))
 144       (eval-self-evaluating (second form) env top-level-p))
 145      ((member operator '(muerte.cl::not))
 146       (not (eval-form (second form) env nil)))
 147      ((member operator '(muerte.cl:+ muerte.cl:- muerte.cl:*))
 148       (apply (translate-program (car form) :muerte.cl :cl)
 149              (mapcar (lambda (sub-form)
 150                        (movitz-eval sub-form env nil))
 151                      (cdr form))))
 152      ((member operator '(muerte.cl:coerce muerte.cl:make-hash-table))
 153       (apply (translate-program operator :muerte.cl :cl)
 154              (mapcar (lambda (arg)
 155                        (translate-program (movitz-eval arg env nil) :muerte.cl :cl))
 156                      (cdr form))))
 157      ((and compiler-macro-function
 158            (not (movitz-env-get (car form) 'notinline nil env))
 159            (not (eq form compiler-macro-expansion)))
 160       (movitz-eval compiler-macro-expansion env top-level-p))
 161 ;;;     ((lambda-form-p form)
 162 ;;;      (eval-lambda-form form env top-level-p))
 163 ;;;     ((symbolp operator)
 164 ;;;      (cond
 165 ;;;       ((movitz-special-operator-p operator)
 166 ;;;     (eval-special-operator form env top-level-p))
 167 ;;;       ((movitz-macro-function operator env)
 168 ;;;     (eval-macro-form form env top-level-p))
 169 ;;;       (t (eval-apply-symbol form env top-level-p))))
 170      (t (case (car form)
 171           (muerte.cl::function
 172            (if (symbolp (second form))
 173                (movitz-env-symbol-function (second form) env)
 174              (error "Don't know how to eval function form ~A." form)))
 175           (t (error "Don't know how to eval compound form ~A" form)))))))
 176
 177 (defun eval-constant-compound (form env top-level-p)
 178   (case (car form)
 179    ((cl:quote muerte.cl::quote)
 180     (eval-self-evaluating (second form) env top-level-p))
 181    (muerte.cl::not
 182     (not (eval-form (second form) env nil)))
 183    ((muerte.cl:+ muerte.cl:- muerte.cl:*)
 184     (apply (translate-program (car form) :muerte.cl :cl)
 185            (mapcar (lambda (sub-form)
 186                      (movitz-eval sub-form env nil))
 187                    (cdr form))))
 188    ((muerte.cl:coerce)
 189     (apply #'coerce
 190            (mapcar (lambda (arg) (movitz-eval arg env nil))
 191                    (cdr form))))
 192    (t (error "Don't know how to compile constant compound form ~A" form))))