From 8468d5fbf5fcf7c0193ef26b1f8c091fefd5d9db Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 15 Jul 2013 14:41:07 +0200 Subject: Remove obsolete code. --- sb-eval2.lisp | 6 ------ 1 file changed, 6 deletions(-) (limited to 'sb-eval2.lisp') diff --git a/sb-eval2.lisp b/sb-eval2.lisp index 7fb09b2..6687ac3 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -5,8 +5,6 @@ (in-package "SB-EVAL2") -#+(or) -(setq SB-EXT:*EVALUATOR-MODE* :interpret) (defstruct (environment (:constructor make-environment (parent &optional (size 0) @@ -25,10 +23,6 @@ (defun lexical-with-nesting (lexical nesting) (make-lexical (lexical-name lexical) (lexical-offset lexical) nesting)) -(defstruct (box (:constructor make-box (value))) - value) -(defun unbox (box) (box-value box)) - (defstruct (context (:constructor make-context (&optional parent))) parent (levelp nil :type boolean) -- cgit v1.2.3 From 8419cf4459872884161f1a6834e27e77ab1ad662 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 15 Jul 2013 14:41:26 +0200 Subject: Add OPTIMIZE declamation. --- sb-eval2.lisp | 2 ++ 1 file changed, 2 insertions(+) (limited to 'sb-eval2.lisp') diff --git a/sb-eval2.lisp b/sb-eval2.lisp index 6687ac3..3ae5fb0 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -5,6 +5,8 @@ (in-package "SB-EVAL2") +;;(declaim (optimize (debug 3) (space 0) (speed 0) (safety 3) (compilation-speed 0))) +(declaim (optimize (debug 0) (space 0) (speed 3) (safety 0) (compilation-speed 0))) (defstruct (environment (:constructor make-environment (parent &optional (size 0) -- cgit v1.2.3 From ba4403aa5be2a280ee67842d71753933ed8e1be0 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 15 Jul 2013 14:53:17 +0200 Subject: Specialize LAMBDA. --- sb-eval2.lisp | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) (limited to 'sb-eval2.lisp') diff --git a/sb-eval2.lisp b/sb-eval2.lisp index 3ae5fb0..3d075f7 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -249,15 +249,27 @@ (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux morep more-context more-count) (sb-int:parse-lambda-list lambda-list) - (lambda (env) - (lambda (&rest args) - (declare (dynamic-extent args)) - ;; FIXME: non-simple lambda-lists - (let ((new-env (make-environment env n))) - (loop for i from 0 to n - for val in args - do (setf (environment-value new-env 0 i) val)) - (funcall body* new-env)))))))) + (if (< n 20) + (specialize m% n (loop for i from 0 below 20 collect i) + (let ((args (loop for i from 0 below m% + collect (gensym (format nil "ARG~D-" i))))) + `(lambda (env) + (lambda ,args + ;; FIXME: non-simple lambda-lists + (let ((new-env (make-environment env n))) + ,@(loop for i from 0 + for val in args + collect `(setf (environment-value new-env 0 ,i) ,val)) + (funcall body* new-env)))))) + (lambda (env) + (lambda (&rest args) + (declare (dynamic-extent args)) + ;; FIXME: non-simple lambda-lists + (let ((new-env (make-environment env n))) + (loop for i from 0 to n + for val in args + do (setf (environment-value new-env 0 i) val)) + (funcall body* new-env))))))))) (defun context->native-environment (context) ;;FIXME -- cgit v1.2.3