<commit_before>;;; Eval-bot --- An IRC bot for CL eval and help

;; Copyright (C) 2012 <NAME> <<EMAIL>>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program 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 GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this program. If not, see
;; <http://www.gnu.org/licenses/>.

(cl:defpackage #:sandbox-pkg)
(cl:in-package #:sandbox-pkg)

(cl:declaim (cl:optimize (cl:safety 3)))

;;; Helpers for defining, importing and exporting

(cl:defmacro import-export-symbols (cl:&body symbols)
  `(cl:loop :for symbol :in ',symbols
            :do
            (cl:shadowing-import (cl:list symbol))
            (cl:export (cl:list symbol))))

(cl:defmacro sdefparameter (name initial-value)
  `(cl:progn
     (cl:export (cl:list ',name))
     (cl:defparameter ,name ,initial-value)))

(cl:defmacro sdefun (name lambda-list cl:&body body)
  `(cl:progn
     (cl:setf (cl:get ',name :sandbox-locked) cl:t)
     (cl:export (cl:list ',name))
     (cl:defun ,name ,lambda-list ,@body)))

(cl:defmacro sdefmacro (name lambda-list cl:&body body)
  `(cl:progn
     (cl:setf (cl:get ',name :sandbox-locked) cl:t)
     (cl:export (cl:list ',name))
     (cl:defmacro ,name ,lambda-list ,@body)))

(cl:defmacro disabled-features (cl:&body symbols)
  `(cl:loop :for symbol :in ',symbols
            :do
            (cl:setf (cl:get symbol :sandbox-locked) cl:t)
            (cl:export (cl:list symbol))
            (cl:let ((name (cl:symbol-name symbol)))

              (cl:setf (cl:macro-function symbol)
                       (cl:lambda (cl:&rest ignored)
                         (cl:declare (cl:ignore ignored))
                         `(cl:error 'sandbox-impl:disabled-feature
                                    :name ,name))

                       (cl:symbol-function symbol)
                       (cl:lambda (cl:&rest ignored)
                         (cl:declare (cl:ignore ignored))
                         (cl:error 'sandbox-impl:disabled-feature
                                   :name name)))

              (cl:eval `(cl:defsetf ,symbol (cl:&rest ignored) ()
                          (cl:declare (cl:ignore ignored))
                          `(cl:error 'sandbox-impl:disabled-feature
                                     :name ,,name))))))

;;; General

#+sbcl
(import-export-symbols                  ;SB-IMPL package is locked.
  sb-impl::backq-list sb-impl::backq-list* sb-impl::backq-append
  sb-impl::backq-cons sb-impl::backq-nconc sb-impl::backq-vector)

(import-export-symbols
  cl:&allow-other-keys cl:&aux cl:&body cl:&environment cl:&key cl:&optional
  cl:&rest cl:&whole)

;;; The Evaluation and Compilation Dictionary

(import-export-symbols
  cl:lambda cl:quote cl:special-operator-p cl:constantp)

(disabled-features
  compile eval-when load-time-value compiler-macro-function
  define-compiler-macro macro-function macroexpand
  macroexpand-1 define-symbol-macro symbol-macrolet proclaim declaim
  the declare locally)

(sdefun eval (form)
  (cl:values-list (sandbox-impl:translate-form
                   (cl:multiple-value-list
                    (cl:eval (sandbox-impl:translate-form form))))))

(sdefmacro defmacro (name lambda-list cl:&body body)
  (cl:if (cl:get name :sandbox-locked)
         (cl:error 'cl:package-error :package cl:nil)
         `(cl:defmacro ,name ,lambda-list ,@body)))

;;; The Types and Classes Dictionary

(import-export-symbols
  cl:nil cl:boolean cl:function cl:compiled-function cl:generic-function
  cl:standard-generic-function cl:class cl:built-in-class cl:structure-class
  cl:standard-class cl:method cl:standard-method cl:structure-object
  cl:standard-object cl:method-combination cl:t cl:satisfies
  ;; cl:member  Also a function. Imported later.
  cl:not cl:and cl:or cl:values cl:eql cl:coerce cl:subtypep cl:type-of
  cl:typep cl:type-error-datum cl:type-error-expected-type)

(disabled-features
  deftype)

;;; The Data and Control Flow Dictionary

(import-export-symbols
  cl:apply cl:fboundp cl:flet cl:labels cl:macrolet cl:funcall cl:function
  cl:functionp cl:compiled-function-p cl:call-arguments-limit
  cl:lambda-list-keywords cl:lambda-parameters-limit cl:defparameter cl:defvar
  cl:destructuring-bind cl:let cl:let* cl:progv cl:setq cl:psetq cl:block
  cl:catch cl:go cl:return-from cl:return cl:tagbody cl:throw
  cl:nil cl:not cl:t cl:eq cl:eql cl:equal cl:equalp
  cl:identity cl:complement cl:constantly cl:every cl:some cl:notevery
  cl:notany cl:and cl:cond cl:if cl:or cl:when cl:unless cl:case cl:ccase
  cl:ecase cl:typecase cl:ctypecase cl:etypecase cl:multiple-value-bind
  cl:multiple-value-list cl:multiple-value-prog1 cl:multiple-value-setq
  cl:values cl:values-list cl:multiple-values-limit cl:nth-value cl:prog
  cl:prog* cl:prog1 cl:prog2 cl:progn cl:setf cl:psetf cl:shiftf cl:rotatef)

(disabled-features
  fdefinition fmakunbound function-lambda-expression
  defconstant define-modify-macro defsetf define-setf-expander
  get-setf-expansion unwind-protect)

(sdefmacro defun (name lambda-list cl:&body body)
  (cl:if (cl:or (cl:and (cl:symbolp name)
                        (cl:get name :sandbox-locked))
                (cl:and (cl:consp name)
                        (cl:eql (cl:first name) 'cl:setf)
                        (cl:get (cl:second name) :sandbox-locked)))
         (cl:error 'cl:package-error :package cl:nil)
         `(cl:defun ,name ,lambda-list ,@body)))

;;; The Iteration Dictionary

(import-export-symbols
  cl:do cl:do* cl:dotimes cl:dolist)

(disabled-features
  loop)

;;; The Objects Dictionary

(import-export-symbols
  cl:class-of)

(disabled-features
  function-keywords ensure-generic-function allocate-instance
  reinitialize-instance shared-initialize
  update-instance-for-different-class update-instance-for-redefined-class
  change-class slot-boundp slot-exists-p slot-makunbound slot-missing<commit_msg>Disable CATCH and THROW; they can trigger an SBCL bug<commit_after>;;; Eval-bot --- An IRC bot for CL eval and help

;; Copyright (C) 2012 <NAME> <<EMAIL>>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program 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 GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this program. If not, see
;; <http://www.gnu.org/licenses/>.

(cl:defpackage #:sandbox-pkg)
(cl:in-package #:sandbox-pkg)

(cl:declaim (cl:optimize (cl:safety 3)))

;;; Helpers for defining, importing and exporting

(cl:defmacro import-export-symbols (cl:&body symbols)
  `(cl:loop :for symbol :in ',symbols
            :do
            (cl:shadowing-import (cl:list symbol))
            (cl:export (cl:list symbol))))

(cl:defmacro sdefparameter (name initial-value)
  `(cl:progn
     (cl:export (cl:list ',name))
     (cl:defparameter ,name ,initial-value)))

(cl:defmacro sdefun (name lambda-list cl:&body body)
  `(cl:progn
     (cl:setf (cl:get ',name :sandbox-locked) cl:t)
     (cl:export (cl:list ',name))
     (cl:defun ,name ,lambda-list ,@body)))

(cl:defmacro sdefmacro (name lambda-list cl:&body body)
  `(cl:progn
     (cl:setf (cl:get ',name :sandbox-locked) cl:t)
     (cl:export (cl:list ',name))
     (cl:defmacro ,name ,lambda-list ,@body)))

(cl:defmacro disabled-features (cl:&body symbols)
  `(cl:loop :for symbol :in ',symbols
            :do
            (cl:setf (cl:get symbol :sandbox-locked) cl:t)
            (cl:export (cl:list symbol))
            (cl:let ((name (cl:symbol-name symbol)))

              (cl:setf (cl:macro-function symbol)
                       (cl:lambda (cl:&rest ignored)
                         (cl:declare (cl:ignore ignored))
                         `(cl:error 'sandbox-impl:disabled-feature
                                    :name ,name))

                       (cl:symbol-function symbol)
                       (cl:lambda (cl:&rest ignored)
                         (cl:declare (cl:ignore ignored))
                         (cl:error 'sandbox-impl:disabled-feature
                                   :name name)))

              (cl:eval `(cl:defsetf ,symbol (cl:&rest ignored) ()
                          (cl:declare (cl:ignore ignored))
                          `(cl:error 'sandbox-impl:disabled-feature
                                     :name ,,name))))))

;;; General

#+sbcl
(import-export-symbols                  ;SB-IMPL package is locked.
  sb-impl::backq-list sb-impl::backq-list* sb-impl::backq-append
  sb-impl::backq-cons sb-impl::backq-nconc sb-impl::backq-vector)

(import-export-symbols
  cl:&allow-other-keys cl:&aux cl:&body cl:&environment cl:&key cl:&optional
  cl:&rest cl:&whole)

;;; The Evaluation and Compilation Dictionary

(import-export-symbols
  cl:lambda cl:quote cl:special-operator-p cl:constantp)

(disabled-features
  compile eval-when load-time-value compiler-macro-function
  define-compiler-macro macro-function macroexpand
  macroexpand-1 define-symbol-macro symbol-macrolet proclaim declaim
  the declare locally)

(sdefun eval (form)
  (cl:values-list (sandbox-impl:translate-form
                   (cl:multiple-value-list
                    (cl:eval (sandbox-impl:translate-form form))))))

(sdefmacro defmacro (name lambda-list cl:&body body)
  (cl:if (cl:get name :sandbox-locked)
         (cl:error 'cl:package-error :package cl:nil)
         `(cl:defmacro ,name ,lambda-list ,@body)))

;;; The Types and Classes Dictionary

(import-export-symbols
  cl:nil cl:boolean cl:function cl:compiled-function cl:generic-function
  cl:standard-generic-function cl:class cl:built-in-class cl:structure-class
  cl:standard-class cl:method cl:standard-method cl:structure-object
  cl:standard-object cl:method-combination cl:t cl:satisfies
  ;; cl:member  Also a function. Imported later.
  cl:not cl:and cl:or cl:values cl:eql cl:coerce cl:subtypep cl:type-of
  cl:typep cl:type-error-datum cl:type-error-expected-type)

(disabled-features
  deftype)

;;; The Data and Control Flow Dictionary

(import-export-symbols
  cl:apply cl:fboundp cl:flet cl:labels cl:macrolet cl:funcall cl:function
  cl:functionp cl:compiled-function-p cl:call-arguments-limit
  cl:lambda-list-keywords cl:lambda-parameters-limit cl:defparameter cl:defvar
  cl:destructuring-bind cl:let cl:let* cl:progv cl:setq cl:psetq cl:block
  cl:go cl:return-from cl:return cl:tagbody
  cl:nil cl:not cl:t cl:eq cl:eql cl:equal cl:equalp
  cl:identity cl:complement cl:constantly cl:every cl:some cl:notevery
  cl:notany cl:and cl:cond cl:if cl:or cl:when cl:unless cl:case cl:ccase
  cl:ecase cl:typecase cl:ctypecase cl:etypecase cl:multiple-value-bind
  cl:multiple-value-list cl:multiple-value-prog1 cl:multiple-value-setq
  cl:values cl:values-list cl:multiple-values-limit cl:nth-value cl:prog
  cl:prog* cl:prog1 cl:prog2 cl:progn cl:setf cl:psetf cl:shiftf cl:rotatef)

(disabled-features
  fdefinition fmakunbound function-lambda-expression
  defconstant define-modify-macro defsetf define-setf-expander
  get-setf-expansion unwind-protect catch throw)

(sdefmacro defun (name lambda-list cl:&body body)
  (cl:if (cl:or (cl:and (cl:symbolp name)
                        (cl:get name :sandbox-locked))
                (cl:and (cl:consp name)
                        (cl:eql (cl:first name) 'cl:setf)
                        (cl:get (cl:second name) :sandbox-locked)))
         (cl:error 'cl:package-error :package cl:nil)
         `(cl:defun ,name ,lambda-list ,@body)))

;;; The Iteration Dictionary

(import-export-symbols
  cl:do cl:do* cl:dotimes cl:dolist)

(disabled-features
  loop)

;;; The Objects Dictionary

(import-export-symbols
  cl:class-of)

(disabled-features
  function-keywords ensure-generic-function allocate-instance
  reinitialize-instance shared-initialize
  update-instance-for-different-class update-instance-for-redefined-class
  change-class slot-boundp slot-exists-p slot-makunbound slot-missing
{'fraction_non_alphanumeric': 0.12389729048519219, 'fraction_numerical': 0.001575299306868305, 'mean_word_length': 3.187664907651715, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2592199', 'n_tokens_mistral': 4224, 'n_tokens_neox': 4019, 'n_words': 1048}