:reader
:printer
:core)
+ (:import-from :cl-readline
+ :readline
+ :register-function)
(:import-from :genhash
:hashref
:hashmap)
(:import-from :utils
:listify
- :getenv)
+ :getenv
+ :common-prefix)
(:export :main))
(in-package :mal)
(defvar *repl-env* (env:create-mal-env))
(dolist (binding core:ns)
- (env:set-env *repl-env*
- (car binding)
- (cdr binding)))
+ (env:set-env *repl-env* (car binding) (cdr binding)))
(defvar mal-def! (make-mal-symbol "def!"))
(defvar mal-let* (make-mal-symbol "let*"))
(mal-data-value sequence)))
(defun eval-hash-map (hash-map env)
- (let ((hash-map-value (types:mal-data-value hash-map))
- (new-hash-table (types:make-mal-value-hash-table)))
+ (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)
- (types:make-mal-hash-map new-hash-table)))
+ (make-mal-hash-map new-hash-table)))
(defun eval-ast (ast env)
(switch-mal-type ast
(defun is-pair (value)
(and (or (mal-list-p value)
(mal-vector-p value))
- (< 0 (length (types:mal-data-value value)))))
+ (< 0 (length (mal-data-value value)))))
(defun quasiquote (ast)
(if (not (is-pair ast))
- (types:make-mal-list (list mal-quote 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))
((and (is-pair (first forms))
(mal-data-value= mal-splice-unquote
- (first (mal-data-value (first forms)))))
- (types:make-mal-list (list mal-concat
- (second (mal-data-value (first forms)))
- (quasiquote (make-mal-list (cdr forms))))))
+ (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 (types:make-mal-list (list mal-cons
- (quasiquote (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 mal-read (string)
(reader:read-str string))
(defun mal-eval (ast env)
(loop
do (cond
- ((null ast) (return types:mal-nil))
- ((not (types:mal-list-p ast)) (return (eval-ast ast env)))
+ ((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-let* (first forms))
(let ((new-env (env:create-mal-env :parent env))
- (bindings (utils:listify (types:mal-data-value (second forms)))))
+ (bindings (utils:listify (mal-data-value (second forms)))))
(mapcar (lambda (binding)
(env:set-env new-env
(car binding)
(mal-eval (or (cdr binding)
- types:mal-nil)
+ mal-nil)
new-env)))
(loop
for (symbol value) on bindings
((mal-data-value= mal-if (first forms))
(let ((predicate (mal-eval (second forms) env)))
- (setf ast (if (or (mal-data-value= predicate types:mal-nil)
- (mal-data-value= predicate types:mal-false))
+ (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)))
- (types:make-mal-fn (lambda (&rest args)
- (mal-eval body (env:create-mal-env :parent env
- :binds (map 'list
- #'identity
- (mal-data-value arglist))
- :exprs args)))
- :attrs (list (cons 'params arglist)
- (cons 'ast body)
- (cons 'env env))))))
+ (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))))))
(t (let* ((evaluated-list (eval-ast ast env))
(function (car evaluated-list)))
;; If first element is a mal function unwrap it
- (if (not (types:mal-fn-p function))
+ (if (not (mal-fn-p function))
(return (apply (mal-data-value function)
(cdr evaluated-list)))
- (let* ((attrs (types:mal-data-attrs 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
(defun rep (string)
(handler-case
- (mal-print (mal-eval (mal-read string)
- *repl-env*))
+ (mal-print (mal-eval (mal-read string) *repl-env*))
(error (condition)
- (format nil
- "~a"
- condition))))
+ (format nil "~a" condition))))
(env:set-env *repl-env*
- (types:make-mal-symbol "eval")
- (types:make-mal-builtin-fn (lambda (ast)
- (mal-eval ast *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) \")\")))))")
(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*)
(defun mal-readline (prompt)
(if *use-readline-p*
- (cl-readline:readline :prompt prompt
- :add-history t
- :novelty-check (lambda (old new)
- (not (string= old new))))
+ (rl:readline :prompt prompt :add-history t :novelty-check #'string/=)
(raw-input prompt)))
(defun mal-writeline (string)
*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*
- (types:make-mal-symbol "*ARGV*")
- (types:wrap-value (cdr args) :listp t))
+ (make-mal-symbol "*ARGV*")
+ (make-mal-list (mapcar #'make-mal-string (cdr args))))
(if (null args)
(repl)
(run-file (car args)))))
HCoop / jackhill / mal.git / blobdiff