diff --git a/src/cmp/cmpfun.lsp b/src/cmp/cmpfun.lsp index c60a671d2..467832965 100644 --- a/src/cmp/cmpfun.lsp +++ b/src/cmp/cmpfun.lsp @@ -305,8 +305,8 @@ (put-sysprop 'apply 'C1 'c1apply) -(put-sysprop 'rplaca 'C1 'c1rplaca) -(put-sysprop 'rplaca 'C2 'c2rplaca) +;(put-sysprop 'rplaca 'C1 'c1rplaca) +;(put-sysprop 'rplaca 'C2 'c2rplaca) (put-sysprop 'rplacd 'C1 'c1rplacd) (put-sysprop 'rplacd 'C2 'c2rplacd) diff --git a/src/cmp/cmpopt-cons.lsp b/src/cmp/cmpopt-cons.lsp new file mode 100644 index 000000000..7c392a39b --- /dev/null +++ b/src/cmp/cmpopt-cons.lsp @@ -0,0 +1,52 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*- +;;;; +;;;; CMPOPT-CONS Optimization of CONS functions +;;;; +;;;; Copyright (c) 2010, Juan Jose Garcia-Ripoll +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Library General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2 of the License, or (at your option) any later version. +;;;; +;;;; See file '../Copyright' for full details. + +(in-package "COMPILER") + +(defun expand-simple-optimizer (values arg-types inline-form env) + `(ffi:c-inline ,(if (policy-assume-right-type env) + values + (loop for v in values + for value-and-type in arg-types + collect (if (consp value-and-type) + `(assert-type-if-known ,v ,(second value-and-type)) + v))) + ,@inline-form)) + +(defun simple-optimizer-function (name args inline-form) + (si::put-sysprop + name 'si::compiler-macro + (if (every #'symbolp args) + #'(lambda (whole env) + (if (policy-inline-accessors env) + `(ffi:c-inline ,(rest whole) ,@inline-form) + whole)) + #'(lambda (whole env) + (if (policy-inline-accessors env) + (expand-simple-optimizer (rest whole) args inline-form env) + whole))))) + +;;; +;;; RPLACA / RPLACD +;;; + +(defmacro define-simple-optimizer (name args &rest inline-form) + `(simple-optimizer-function ',name ',args ',inline-form)) + +(define-simple-optimizer rplaca ((c cons) value) + (:object :object) :object + "ECL_CONS_CAR(#0)=#1" :one-liner t) + +(define-simple-optimizer rplacd ((c cons) value) + (:object :object) :object + "ECL_CONS_CDR(#0)=#1" :one-liner t) diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in index e62863819..6d98461d6 100644 --- a/src/cmp/load.lsp.in +++ b/src/cmp/load.lsp.in @@ -45,6 +45,7 @@ "src:cmp;cmpnum.lsp" "src:cmp;cmpname.lsp" "src:cmp;cmpopt.lsp" + "src:cmp;cmpopt-cons.lsp" "src:cmp;cmpprop.lsp" "src:cmp;cmpclos.lsp" "src:cmp;cmpstructures.lsp"