1 ;;;;------------------------------------------------------------------
3 ;;;; Copyright (C) 2000-2005,
4 ;;;; Department of Computer Science, University of Tromso, Norway
6 ;;;; Filename: eval.lisp
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.
12 ;;;; $Id: eval.lisp,v 1.12 2007/03/11 21:18:40 ffjeld Exp $
14 ;;;;------------------------------------------------------------------
18 (defun in-package-form-p (form)
20 (string= '#:in-package
(car form
))))
22 (defun require-form-p (form)
24 (string= '#:require
(car form
))))
26 (defun provide-form-p (form)
28 (string= '#:provide
(car form
))))
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
)))
36 (or (third require-form
)
38 (string-downcase (symbol-name module
))
41 (defun movitzify-package-name (name)
42 (let ((name (string name
)))
43 (if (member name
'("cl" "common-lisp" "mop")
45 (concatenate 'string
(string '#:muerte.
) name
)
48 (defmacro with-retries-until-true
((name format-control
&rest format-arguments
) &body body
)
50 (with-simple-restart (,name
,format-control
,@format-arguments
)
51 (return (progn ,@body
)))))
53 (defun quote-form-p (x)
55 (or (eq 'cl
:quote
(first x
))
56 (eq 'muerte.cl
::quote
(first x
)))
59 (defun movitz-constantp (form &optional
(env nil
))
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
))))
67 (let* ((compiler-macro-function (movitz-compiler-macro-function (car form
) env
))
68 (compiler-macro-expansion (and compiler-macro-function
70 (funcall *movitz-macroexpand-hook
*
71 compiler-macro-function
74 (or (let ((form (translate-program form
:cl
:muerte.cl
)))
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
))
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.
95 ;;; (quote-form-p x)))
97 (defun eval-form (&rest args
)
98 (apply 'movitz-eval args
))
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
)))
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
)))))
108 (defun eval-form-or-error (form env error-value
)
109 (handler-case (eval-form form env
)
110 (error () error-value
)))
112 (defun eval-symbol (form env top-level-p
)
113 "3.1.2.1.1 Symbols as Forms"
114 (declare (ignore top-level-p
))
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
)))
121 ((movitz-constantp form env
)
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
))))
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
))
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
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
))
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
))
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)
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))))
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
)))))))
177 (defun eval-constant-compound (form env top-level-p
)
179 ((cl:quote muerte.cl
::quote
)
180 (eval-self-evaluating (second form
) env top-level-p
))
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
))
190 (mapcar (lambda (arg) (movitz-eval arg env nil
))
192 (t (error "Don't know how to compile constant compound form ~A" form
))))