<commit_before>;; -*- lisp -*-

;; This file is part of STMX.
;; Copyright (c) 2013 <NAME>
;;
;; This library is free software: you can redistribute it and/or
;; modify it under the terms of the Lisp Lesser General Public License
;; (http://opensource.franz.com/preamble.html), known as the LLGPL.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty
;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;; See the Lisp Lesser General Public License for more details.


(in-package :stmx)

;(eval-always
;  (enable-pf-reader))


;;;; ** Defining

(defmacro transactional ((defclass class-name direct-superclasses direct-slots &rest class-options))
  "Define CLASS-NAME as a new transactional class.
Use this macro to wrap a normal DEFCLASS as follows:
\(TRANSACTIONAL (DEFCLASS class-name (superclasses) (slots) [options]))

The effect is the same as DEFCLASS, plus:
- by default, slots are transactional memory (implemented by TVARs)
- it inherits also from TRANSACTIONAL-OBJECT
- the metaclass is TRANSACTIONAL-CLASS"
  `(,defclass ,class-name ,(ensure-transactional-object-among-superclasses direct-superclasses)
     ,(adjust-transactional-slots-definitions direct-slots class-name direct-superclasses)
     ,@class-options
     #+stmx-must-disable-optimize-slot-access (:optimize-slot-access nil)
     (:metaclass transactional-class)))


(defmacro transaction ((defun-or-defmethod func-name args &body body))
  "Define FUNC-NAME as a new atomic function or method.
Use this macro to wrap a normal DEFUN or DEFMETHOD as follows:
\(TRANSACTION (DEFUN function-name (arguments) body))
or
\(TRANSACTION (DEFMETHOD function-name (arguments) body))

The effect is the same as DEFUN - or DEFMETHOD - plus:
- the BODY is wrapped inside (atomic ...)"
  `(,defun-or-defmethod ,func-name ,args
     (atomic :id ',func-name
             ,@(if (symbolp func-name)
                   ;; support (return-from ,func-name ...)
                   `((block ,func-name
                       ;; support (declare ...)
                       (let ()
                         ,@body)))
                   body))))



;;;; ** Running


(defmacro atomic (&rest body)
  "Main entry point for STMX.

Run BODY in a memory transaction. All changes to transactional memory
will be visible to other threads only after BODY returns normally (commits).<commit_msg>improved (transaction ...), now moves docstring and copies declarations from autogenerated lambda to actual function<commit_after>;; -*- lisp -*-

;; This file is part of STMX.
;; Copyright (c) 2013 <NAME>
;;
;; This library is free software: you can redistribute it and/or
;; modify it under the terms of the Lisp Lesser General Public License
;; (http://opensource.franz.com/preamble.html), known as the LLGPL.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty
;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;; See the Lisp Lesser General Public License for more details.


(in-package :stmx)

;(eval-always
;  (enable-pf-reader))


;;;; ** Defining

(defmacro transactional ((defclass class-name direct-superclasses direct-slots &rest class-options))
  "Define CLASS-NAME as a new transactional class.
Use this macro to wrap a normal DEFCLASS as follows:
\(TRANSACTIONAL (DEFCLASS class-name (superclasses) (slots) [options]))

The effect is the same as DEFCLASS, plus:
- by default, slots are transactional memory (implemented by TVARs)
- it inherits also from TRANSACTIONAL-OBJECT
- the metaclass is TRANSACTIONAL-CLASS"
  `(,defclass ,class-name ,(ensure-transactional-object-among-superclasses direct-superclasses)
     ,(adjust-transactional-slots-definitions direct-slots class-name direct-superclasses)
     ,@class-options
     #+stmx-must-disable-optimize-slot-access (:optimize-slot-access nil)
     (:metaclass transactional-class)))


(defmacro transaction ((defun-or-defmethod func-name args &body body))
  "Define FUNC-NAME as a new atomic function or method.
Use this macro to wrap a normal DEFUN or DEFMETHOD as follows:
\(TRANSACTION (DEFUN function-name (arguments) body))
or
\(TRANSACTION (DEFMETHOD function-name (arguments) body))

The effect is the same as DEFUN - or DEFMETHOD - plus:
- the BODY is wrapped inside (atomic ...)"
  `(,defun-or-defmethod ,func-name ,args
     ;; move docstring here
     ,@(when (and (stringp (first body)) (rest body))
             (list (pop body)))
     ;; also copy all declarations
     ,@(loop for form in body
          while (and (listp form) (eq 'declare (first form)))
          collect form)
     
     (atomic :id ',func-name
             ,@(if (symbolp func-name)
                   ;; support (return-from ,func-name ...)
                   `((block ,func-name
                       ;; support (declare ...)
                       (let ()
                         ,@body)))
                   body))))



;;;; ** Running


(defmacro atomic (&rest body)
  "Main entry point for STMX.

Run BODY in a memory transaction. All changes to transactional memory
will be visible to other threads only after BODY returns normally (commits).
{'fraction_non_alphanumeric': 0.1078544061302682, 'fraction_numerical': 0.0015325670498084292, 'mean_word_length': 3.180144115292234, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '604787', 'n_tokens_mistral': 1528, 'n_tokens_neox': 1444, 'n_words': 566}