[jackhill/mal.git] / common-lisp / src / step8_macros.lisp

(defpackage :mal
  (:use :common-lisp
        :types
        :env
        :reader
        :printer
        :core)
  (:import-from :cl-readline
                :readline
                :register-function)
  (:import-from :genhash
                :hashref
                :hashmap)
  (:import-from :utils
                :listify
                :getenv
                :common-prefix)
  (:export :main))

(in-package :mal)

(define-condition invalid-function (mal-runtime-exception)
  ((form :initarg :form :reader form)
   (context :initarg :context :reader context))
  (:report (lambda (condition stream)
             (format stream
                     "Invalid function '~a' provided while ~a"
                     (printer:pr-str (form condition))
                     (if (string= (context condition) "apply")
                         "applying"
                         "defining macro")))))


(defvar *repl-env* (env:create-mal-env))

(dolist (binding core:ns)
  (env:set-env *repl-env* (car binding) (cdr binding)))

(defvar mal-def! (make-mal-symbol "def!"))
(defvar mal-let* (make-mal-symbol "let*"))
(defvar mal-do (make-mal-symbol "do"))
(defvar mal-if (make-mal-symbol "if"))
(defvar mal-fn* (make-mal-symbol "fn*"))
(defvar mal-quote (make-mal-symbol "quote"))
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
(defvar mal-unquote (make-mal-symbol "unquote"))
(defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
(defvar mal-cons (make-mal-symbol "cons"))
(defvar mal-concat (make-mal-symbol "concat"))
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
(defvar mal-macroexpand (make-mal-symbol "macroexpand"))

(defun eval-sequence (sequence env)
  (map 'list
       (lambda (ast) (mal-eval ast env))
       (mal-data-value sequence)))

(defun eval-hash-map (hash-map env)
  (let ((hash-map-value (mal-data-value hash-map))
        (new-hash-table (make-mal-value-hash-table)))
    (genhash:hashmap (lambda (key value)
                       (setf (genhash:hashref (mal-eval key env) new-hash-table)
                             (mal-eval value env)))
                     hash-map-value)
    (make-mal-hash-map new-hash-table)))

(defun eval-ast (ast env)
  (switch-mal-type ast
    (types:symbol (env:get-env env ast))
    (types:list (eval-sequence ast env))
    (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env))))
    (types:hash-map (eval-hash-map ast env))
    (types:any ast)))

(defun is-pair (value)
  (and (or (mal-list-p value)
           (mal-vector-p value))
       (< 0 (length (mal-data-value value)))))

(defun quasiquote (ast)
  (if (not (is-pair ast))
      (make-mal-list (list mal-quote ast))
      (let ((forms (map 'list #'identity (mal-data-value ast))))
        (cond
          ((mal-data-value= mal-unquote (first forms))
           (second forms))

          ((and (is-pair (first forms))
                (mal-data-value= mal-splice-unquote
                                 (first (mal-data-value (first forms)))))
           (make-mal-list (list mal-concat
                                (second (mal-data-value (first forms)))
                                (quasiquote (make-mal-list (cdr forms))))))

          (t (make-mal-list (list mal-cons
                                  (quasiquote (first forms))
                                  (quasiquote (make-mal-list (cdr forms))))))))))

(defun is-macro-call (ast env)
  (when (mal-list-p ast)
    (let* ((func-symbol (first (mal-data-value ast)))
           (func (when (mal-symbol-p func-symbol)
                   (env:find-env env func-symbol))))
      (and func
           (mal-fn-p func)
           (cdr (assoc :is-macro (mal-data-attrs func)))))))

(defun mal-macroexpand (ast env)
  (loop
     while (is-macro-call ast env)
     do (let* ((forms (mal-data-value ast))
               (func (env:get-env env (first forms))))
          (setf ast (apply (mal-data-value func)
                           (cdr forms)))))
  ast)

(defun mal-read (string)
  (reader:read-str string))

(defun mal-eval (ast env)
  (loop
     do (setf ast (mal-macroexpand ast env))
     do (cond
          ((null ast) (return mal-nil))
          ((not (mal-list-p ast)) (return (eval-ast ast env)))
          ((zerop (length (mal-data-value ast))) (return ast))
          (t (let ((forms (mal-data-value ast)))
               (cond
                 ((mal-data-value= mal-quote (first forms))
                  (return (second forms)))

                 ((mal-data-value= mal-quasiquote (first forms))
                  (setf ast (quasiquote (second forms))))

                 ((mal-data-value= mal-macroexpand (first forms))
                  (return (mal-macroexpand (second forms) env)))

                 ((mal-data-value= mal-def! (first forms))
                  (return (env:set-env env (second forms) (mal-eval (third forms) env))))

                 ((mal-data-value= mal-defmacro! (first forms))
                  (let ((value (mal-eval (third forms) env)))
                    (return (if (mal-fn-p value)
                                (env:set-env env
                                             (second forms)
                                             (progn
                                               (setf (cdr (assoc :is-macro (mal-data-attrs value))) t)
                                               value))
                                (error 'invalid-function
                                       :form value
                                       :context "macro")))))

                 ((mal-data-value= mal-let* (first forms))
                  (let ((new-env (env:create-mal-env :parent env))
                        (bindings (utils:listify (mal-data-value (second forms)))))

                    (mapcar (lambda (binding)
                              (env:set-env new-env
                                           (car binding)
                                           (mal-eval (or (cdr binding)
                                                         mal-nil)
                                                     new-env)))
                            (loop
                               for (symbol value) on bindings
                               by #'cddr
                               collect (cons symbol value)))
                    (setf ast (third forms)
                          env new-env)))

                 ((mal-data-value= mal-do (first forms))
                  (mapc (lambda (form) (mal-eval form env))
                        (butlast (cdr forms)))
                  (setf ast (car (last forms))))

                 ((mal-data-value= mal-if (first forms))
                  (let ((predicate (mal-eval (second forms) env)))
                    (setf ast (if (or (mal-data-value= predicate mal-nil)
                                      (mal-data-value= predicate mal-false))
                                  (fourth forms)
                                  (third forms)))))

                 ((mal-data-value= mal-fn* (first forms))
                  (return (let ((arglist (second forms))
                                (body (third forms)))
                            (make-mal-fn (lambda (&rest args)
                                           (mal-eval body (env:create-mal-env :parent env
                                                                              :binds (listify (mal-data-value arglist))
                                                                              :exprs args)))
                                         :attrs (list (cons :params arglist)
                                                      (cons :ast body)
                                                      (cons :env env)
                                                      (cons :is-macro nil))))))

                 (t (let* ((evaluated-list (eval-ast ast env))
                           (function (car evaluated-list)))
                      ;; If first element is a mal function unwrap it
                      (cond ((mal-fn-p function)
                             (let* ((attrs (mal-data-attrs function)))
                               (setf ast (cdr (assoc :ast attrs))
                                     env (env:create-mal-env :parent (cdr (assoc :env attrs))
                                                             :binds (map 'list
                                                                         #'identity
                                                                         (mal-data-value (cdr (assoc :params attrs))))
                                                             :exprs (cdr evaluated-list)))))
                            ((mal-builtin-fn-p function)
                             (return (apply (mal-data-value function)
                                            (cdr evaluated-list))))
                            (t (error 'invalid-function
                                      :form function
                                      :context "apply")))))))))))

(defun mal-print (expression)
  (printer:pr-str expression))

(defun rep (string)
  (handler-case
      (mal-print (mal-eval (mal-read string) *repl-env*))
    (mal-error (condition)
      (format nil "~a" condition))
    (error (condition)
      (format nil "Internal error: ~a" condition))))

(env:set-env *repl-env*
             (make-mal-symbol "eval")
             (make-mal-builtin-fn (lambda (ast)
                                    (mal-eval ast *repl-env*))))

(rep "(def! not (fn* (a) (if a false true)))")
(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")

(defvar *use-readline-p* nil)

(defun complete-toplevel-symbols (input &rest ignored)
  (declare (ignorable ignored))

  (let (candidates)
    (loop for key being the hash-keys of (env:mal-env-bindings *repl-env*)
       when (let ((pos (search input key))) (and pos (zerop pos)))
       do (push key candidates))

    (if (= 1 (length candidates))
        (cons (car candidates) candidates)
        (cons (apply #'utils:common-prefix candidates) candidates))))

(defun raw-input (prompt)
  (format *standard-output* prompt)
  (force-output *standard-output*)
  (read-line *standard-input* nil))

(defun mal-readline (prompt)
  (if *use-readline-p*
      (rl:readline :prompt prompt :add-history t :novelty-check #'string/=)
      (raw-input prompt)))

(defun mal-writeline (string)
  (when string
    (write-line string)
    (force-output *standard-output*)))

(defun repl ()
  (loop do (let ((line (mal-readline "user> ")))
             (if line
                 (mal-writeline (rep line))
                 (return)))))

(defun run-file (file)
  (rep (format nil "(load-file \"~a\")" file)))

(defun main (&optional (argv nil argv-provided-p))

  (setf *use-readline-p* (not (or (string= (utils:getenv "PERL_RL") "false")
                                  (string= (utils:getenv "TERM") "dumb"))))

  ;; In GNU CLISP's batch mode the standard-input seems to be set to some sort
  ;; of input string-stream, this interacts wierdly with the PERL_RL enviroment
  ;; variable which the test runner sets causing `read-line' on *standard-input*
  ;; to fail with an empty stream error. The following reinitializes the
  ;; standard streams
  ;;
  ;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html
  #+clisp (setf *standard-input* (ext:make-stream :input)
                *standard-output* (ext:make-stream :output :buffered t)
                *error-output* (ext:make-stream :error :buffered t))

  ;; CCL fails with a error while registering completion function
  ;; See also https://github.com/mrkkrp/cl-readline/issues/5
  #-ccl (rl:register-function :complete #'complete-toplevel-symbols)

  (let ((args (if argv-provided-p
                  argv
                  (cdr (utils:raw-command-line-arguments)))))
    (env:set-env *repl-env*
                 (make-mal-symbol "*ARGV*")
                 (make-mal-list (mapcar #'make-mal-string (cdr args))))
    (if (null args)
        (repl)
        (run-file (car args)))))

;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
;;; image containing foreign libraries is restored. The extra messages cause the
;;; MAL testcases to fail

#+cmucl (progn
          (defvar *old-standard-output* *standard-output*
            "Keep track of current value standard output, this is restored after image restore completes")

          (defun muffle-output ()
            (setf *standard-output* (make-broadcast-stream)))

          (defun restore-output ()
            (setf *standard-output* *old-standard-output*))

          (pushnew #'muffle-output ext:*after-save-initializations*)
          (setf ext:*after-save-initializations*
                (append ext:*after-save-initializations* (list #'restore-output))))
Commit	Line	Data
c8ac1eda IA	1	(defpackage :mal
	2	(:use :common-lisp
	3	:types
	4	:env
	5	:reader
	6	:printer
0795349b	7	:core)
774d5cf8 IA	8	(:import-from :cl-readline
	9	:readline
	10	:register-function)
0795349b IA	11	(:import-from :genhash
	12	:hashref
	13	:hashmap)
	14	(:import-from :utils
	15	:listify
774d5cf8 IA	16	:getenv
774d5cf8 IA	17	:common-prefix)
c8ac1eda IA	18	(:export :main))
	19
	20	(in-package :mal)
	21
baa3c3af	22	(define-condition invalid-function (mal-runtime-exception)
c8ac1eda IA	23	((form :initarg :form :reader form)
	24	(context :initarg :context :reader context))
	25	(:report (lambda (condition stream)
	26	(format stream
	27	"Invalid function '~a' provided while ~a"
	28	(printer:pr-str (form condition))
	29	(if (string= (context condition) "apply")
	30	"applying"
	31	"defining macro")))))
	32
	33
	34	(defvar repl-env (env:create-mal-env))
	35
	36	(dolist (binding core:ns)
baa3c3af	37	(env:set-env repl-env (car binding) (cdr binding)))
c8ac1eda IA	38
	39	(defvar mal-def! (make-mal-symbol "def!"))
	40	(defvar mal-let* (make-mal-symbol "let*"))
	41	(defvar mal-do (make-mal-symbol "do"))
	42	(defvar mal-if (make-mal-symbol "if"))
	43	(defvar mal-fn* (make-mal-symbol "fn*"))
	44	(defvar mal-quote (make-mal-symbol "quote"))
	45	(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
	46	(defvar mal-unquote (make-mal-symbol "unquote"))
	47	(defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
	48	(defvar mal-cons (make-mal-symbol "cons"))
	49	(defvar mal-concat (make-mal-symbol "concat"))
	50	(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
	51	(defvar mal-macroexpand (make-mal-symbol "macroexpand"))
	52
	53	(defun eval-sequence (sequence env)
	54	(map 'list
	55	(lambda (ast) (mal-eval ast env))
baa3c3af	56	(mal-data-value sequence)))
c8ac1eda IA	57
c8ac1eda IA	58	(defun eval-hash-map (hash-map env)
baa3c3af IA	59	(let ((hash-map-value (mal-data-value hash-map))
baa3c3af IA	60	(new-hash-table (make-mal-value-hash-table)))
c8ac1eda IA	61	(genhash:hashmap (lambda (key value)
	62	(setf (genhash:hashref (mal-eval key env) new-hash-table)
	63	(mal-eval value env)))
	64	hash-map-value)
baa3c3af	65	(make-mal-hash-map new-hash-table)))
c8ac1eda IA	66
	67	(defun eval-ast (ast env)
	68	(switch-mal-type ast
	69	(types:symbol (env:get-env env ast))
	70	(types:list (eval-sequence ast env))
	71	(types:vector (make-mal-vector (apply 'vector (eval-sequence ast env))))
	72	(types:hash-map (eval-hash-map ast env))
	73	(types:any ast)))
	74
	75	(defun is-pair (value)
	76	(and (or (mal-list-p value)
	77	(mal-vector-p value))
baa3c3af	78	(< 0 (length (mal-data-value value)))))
c8ac1eda IA	79
	80	(defun quasiquote (ast)
	81	(if (not (is-pair ast))
baa3c3af IA	82	(make-mal-list (list mal-quote ast))
baa3c3af IA	83	(let ((forms (map 'list #'identity (mal-data-value ast))))
c8ac1eda	84	(cond
baa3c3af	85	((mal-data-value= mal-unquote (first forms))
c8ac1eda IA	86	(second forms))
	87
	88	((and (is-pair (first forms))
baa3c3af IA	89	(mal-data-value= mal-splice-unquote
	90	(first (mal-data-value (first forms)))))
	91	(make-mal-list (list mal-concat
	92	(second (mal-data-value (first forms)))
	93	(quasiquote (make-mal-list (cdr forms))))))
c8ac1eda	94
baa3c3af IA	95	(t (make-mal-list (list mal-cons
	96	(quasiquote (first forms))
	97	(quasiquote (make-mal-list (cdr forms))))))))))
c8ac1eda IA	98
c8ac1eda IA	99	(defun is-macro-call (ast env)
baa3c3af IA	100	(when (mal-list-p ast)
	101	(let* ((func-symbol (first (mal-data-value ast)))
	102	(func (when (mal-symbol-p func-symbol)
c8ac1eda IA	103	(env:find-env env func-symbol))))
c8ac1eda IA	104	(and func
baa3c3af	105	(mal-fn-p func)
85657c96	106	(cdr (assoc :is-macro (mal-data-attrs func)))))))
c8ac1eda IA	107
	108	(defun mal-macroexpand (ast env)
	109	(loop
	110	while (is-macro-call ast env)
baa3c3af	111	do (let* ((forms (mal-data-value ast))
c8ac1eda	112	(func (env:get-env env (first forms))))
baa3c3af	113	(setf ast (apply (mal-data-value func)
c8ac1eda IA	114	(cdr forms)))))
	115	ast)
	116
	117	(defun mal-read (string)
	118	(reader:read-str string))
	119
	120	(defun mal-eval (ast env)
	121	(loop
	122	do (setf ast (mal-macroexpand ast env))
	123	do (cond
baa3c3af IA	124	((null ast) (return mal-nil))
	125	((not (mal-list-p ast)) (return (eval-ast ast env)))
	126	((zerop (length (mal-data-value ast))) (return ast))
	127	(t (let ((forms (mal-data-value ast)))
c8ac1eda	128	(cond
baa3c3af	129	((mal-data-value= mal-quote (first forms))
c8ac1eda IA	130	(return (second forms)))
c8ac1eda IA	131
baa3c3af	132	((mal-data-value= mal-quasiquote (first forms))
c8ac1eda IA	133	(setf ast (quasiquote (second forms))))
c8ac1eda IA	134
baa3c3af	135	((mal-data-value= mal-macroexpand (first forms))
c8ac1eda IA	136	(return (mal-macroexpand (second forms) env)))
c8ac1eda IA	137
baa3c3af	138	((mal-data-value= mal-def! (first forms))
c8ac1eda IA	139	(return (env:set-env env (second forms) (mal-eval (third forms) env))))
c8ac1eda IA	140
baa3c3af	141	((mal-data-value= mal-defmacro! (first forms))
c8ac1eda	142	(let ((value (mal-eval (third forms) env)))
baa3c3af	143	(return (if (mal-fn-p value)
c8ac1eda IA	144	(env:set-env env
	145	(second forms)
	146	(progn
85657c96	147	(setf (cdr (assoc :is-macro (mal-data-attrs value))) t)
c8ac1eda IA	148	value))
	149	(error 'invalid-function
	150	:form value
	151	:context "macro")))))
	152
baa3c3af	153	((mal-data-value= mal-let* (first forms))
c8ac1eda	154	(let ((new-env (env:create-mal-env :parent env))
baa3c3af	155	(bindings (utils:listify (mal-data-value (second forms)))))
c8ac1eda IA	156
	157	(mapcar (lambda (binding)
	158	(env:set-env new-env
	159	(car binding)
	160	(mal-eval (or (cdr binding)
baa3c3af	161	mal-nil)
c8ac1eda IA	162	new-env)))
	163	(loop
	164	for (symbol value) on bindings
	165	by #'cddr
	166	collect (cons symbol value)))
	167	(setf ast (third forms)
	168	env new-env)))
	169
baa3c3af	170	((mal-data-value= mal-do (first forms))
c8ac1eda IA	171	(mapc (lambda (form) (mal-eval form env))
	172	(butlast (cdr forms)))
	173	(setf ast (car (last forms))))
	174
baa3c3af	175	((mal-data-value= mal-if (first forms))
c8ac1eda	176	(let ((predicate (mal-eval (second forms) env)))
baa3c3af IA	177	(setf ast (if (or (mal-data-value= predicate mal-nil)
baa3c3af IA	178	(mal-data-value= predicate mal-false))
c8ac1eda IA	179	(fourth forms)
	180	(third forms)))))
	181
baa3c3af	182	((mal-data-value= mal-fn* (first forms))
c8ac1eda IA	183	(return (let ((arglist (second forms))
c8ac1eda IA	184	(body (third forms)))
baa3c3af IA	185	(make-mal-fn (lambda (&rest args)
	186	(mal-eval body (env:create-mal-env :parent env
	187	:binds (listify (mal-data-value arglist))
	188	:exprs args)))
85657c96 VS	189	:attrs (list (cons :params arglist)
	190	(cons :ast body)
	191	(cons :env env)
	192	(cons :is-macro nil))))))
c8ac1eda IA	193
	194	(t (let* ((evaluated-list (eval-ast ast env))
	195	(function (car evaluated-list)))
	196	;; If first element is a mal function unwrap it
baa3c3af IA	197	(cond ((mal-fn-p function)
baa3c3af IA	198	(let* ((attrs (mal-data-attrs function)))
85657c96 VS	199	(setf ast (cdr (assoc :ast attrs))
85657c96 VS	200	env (env:create-mal-env :parent (cdr (assoc :env attrs))
c8ac1eda IA	201	:binds (map 'list
c8ac1eda IA	202	#'identity
85657c96	203	(mal-data-value (cdr (assoc :params attrs))))
c8ac1eda	204	:exprs (cdr evaluated-list)))))
baa3c3af IA	205	((mal-builtin-fn-p function)
baa3c3af IA	206	(return (apply (mal-data-value function)
c8ac1eda IA	207	(cdr evaluated-list))))
	208	(t (error 'invalid-function
	209	:form function
	210	:context "apply")))))))))))
	211
	212	(defun mal-print (expression)
	213	(printer:pr-str expression))
	214
	215	(defun rep (string)
	216	(handler-case
baa3c3af IA	217	(mal-print (mal-eval (mal-read string) repl-env))
	218	(mal-error (condition)
	219	(format nil "~a" condition))
c8ac1eda	220	(error (condition)
baa3c3af	221	(format nil "Internal error: ~a" condition))))
c8ac1eda IA	222
c8ac1eda IA	223	(env:set-env repl-env
baa3c3af IA	224	(make-mal-symbol "eval")
	225	(make-mal-builtin-fn (lambda (ast)
	226	(mal-eval ast repl-env))))
c8ac1eda IA	227
	228	(rep "(def! not (fn* (a) (if a false true)))")
	229	(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
	230	(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
	231	(rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))")
	232
	233	(defvar use-readline-p nil)
	234
774d5cf8 IA	235	(defun complete-toplevel-symbols (input &rest ignored)
	236	(declare (ignorable ignored))
	237
	238	(let (candidates)
	239	(loop for key being the hash-keys of (env:mal-env-bindings repl-env)
	240	when (let ((pos (search input key))) (and pos (zerop pos)))
	241	do (push key candidates))
	242
	243	(if (= 1 (length candidates))
	244	(cons (car candidates) candidates)
	245	(cons (apply #'utils:common-prefix candidates) candidates))))
	246
c8ac1eda IA	247	(defun raw-input (prompt)
	248	(format standard-output prompt)
	249	(force-output standard-output)
	250	(read-line standard-input nil))
	251
	252	(defun mal-readline (prompt)
	253	(if use-readline-p
774d5cf8	254	(rl:readline :prompt prompt :add-history t :novelty-check #'string/=)
c8ac1eda IA	255	(raw-input prompt)))
	256
	257	(defun mal-writeline (string)
	258	(when string
	259	(write-line string)
	260	(force-output standard-output)))
	261
	262	(defun repl ()
	263	(loop do (let ((line (mal-readline "user> ")))
	264	(if line
	265	(mal-writeline (rep line))
	266	(return)))))
	267
	268	(defun run-file (file)
	269	(rep (format nil "(load-file \"~a\")" file)))
	270
	271	(defun main (&optional (argv nil argv-provided-p))
89676a9f	272
0795349b IA	273	(setf use-readline-p (not (or (string= (utils:getenv "PERL_RL") "false")
0795349b IA	274	(string= (utils:getenv "TERM") "dumb"))))
c8ac1eda	275
89676a9f IA	276	;; In GNU CLISP's batch mode the standard-input seems to be set to some sort
	277	;; of input string-stream, this interacts wierdly with the PERL_RL enviroment
	278	;; variable which the test runner sets causing `read-line' on standard-input
	279	;; to fail with an empty stream error. The following reinitializes the
	280	;; standard streams
	281	;;
	282	;; See http://www.gnu.org/software/clisp/impnotes/streams-interactive.html
	283	#+clisp (setf standard-input (ext:make-stream :input)
	284	standard-output (ext:make-stream :output :buffered t)
	285	error-output (ext:make-stream :error :buffered t))
	286
774d5cf8 IA	287	;; CCL fails with a error while registering completion function
	288	;; See also https://github.com/mrkkrp/cl-readline/issues/5
	289	#-ccl (rl:register-function :complete #'complete-toplevel-symbols)
	290
c8ac1eda IA	291	(let ((args (if argv-provided-p
	292	argv
	293	(cdr (utils:raw-command-line-arguments)))))
	294	(env:set-env repl-env
baa3c3af	295	(make-mal-symbol "ARGV")
8202dbf8	296	(make-mal-list (mapcar #'make-mal-string (cdr args))))
c8ac1eda IA	297	(if (null args)
	298	(repl)
	299	(run-file (car args)))))
033f64c4 IA	300
	301	;;; Workaround for CMUCL's printing of "Reloaded library ... " messages when an
	302	;;; image containing foreign libraries is restored. The extra messages cause the
	303	;;; MAL testcases to fail
	304
	305	#+cmucl (progn
	306	(defvar old-standard-output standard-output
	307	"Keep track of current value standard output, this is restored after image restore completes")
	308
	309	(defun muffle-output ()
	310	(setf standard-output (make-broadcast-stream)))
	311
	312	(defun restore-output ()
	313	(setf standard-output old-standard-output))
	314
	315	(pushnew #'muffle-output ext:after-save-initializations)
	316	(setf ext:after-save-initializations
	317	(append ext:after-save-initializations (list #'restore-output))))