From 20f2fc6edd723862a72097ce4db0a14dbd731c9a Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 26 Aug 2024 13:28:46 +0200 Subject: [PATCH 1/5] elisp: fix new tests, byte-compile, various improvements The original motivation is to fix the new (= nil ()) and core_apply_accepts_macros tests. Improve speed and warnings with byte compilation. mal/core.el: Wrap core functions during the loop in main, instead of writing the conversion in each line of core-ns. Use apply built-in concatenation of last argument. Move handling of metadata to types.el. mal/env.el: Represent environments as cons cells instead of vectors. mal/func.el: Merged into types.el, it is not a special case anymore. mal/printer.el: Add macro case. Define a pr-join helper for sequences and core.el. mal/reader.el: Rename the tokens local variable in reader.el (compiler warning). mal/types.el: Use type-specific accessors returning nil for the wrong type (structural pattern matching would be better, but is too slow). Represent native types directly when possible, and inline some trivial accessors. Use dedicated records instead of vectors. Implement metadata only when required. Represent keywords as strings (easyer, no counterpart). run: Run byte-compiled version. steps: Backport good ideas from stepA to step1, reducing the diff between steps for future maintenance. Implement 'do with a simple iteration (without map and butlast). Make the repl-env local to main (compiler warning). Make the code more idiomatic * prefer loop over recursion (search in environments) * declare variable and reassign them when convenient (exit of the TCO loop) * car cdr cadr and so on instead of nth * remove various vector <-> list conversions. --- impls/elisp/Makefile | 6 + impls/elisp/mal/core.el | 361 +++++++++++++++++--------------- impls/elisp/mal/env.el | 37 ++-- impls/elisp/mal/func.el | 25 --- impls/elisp/mal/printer.el | 63 +++--- impls/elisp/mal/reader.el | 12 +- impls/elisp/mal/types.el | 116 +++++++--- impls/elisp/run | 5 +- impls/elisp/step0_repl.el | 22 +- impls/elisp/step1_read_print.el | 54 ++--- impls/elisp/step2_eval.el | 106 +++++----- impls/elisp/step3_env.el | 139 ++++++------ impls/elisp/step4_if_fn_do.el | 188 +++++++++-------- impls/elisp/step5_tco.el | 220 ++++++++++--------- impls/elisp/step6_file.el | 198 +++++++++--------- impls/elisp/step7_quote.el | 240 ++++++++++----------- impls/elisp/step8_macros.el | 223 ++++++++++---------- impls/elisp/step9_try.el | 241 +++++++++++---------- impls/elisp/stepA_mal.el | 245 +++++++++++----------- 19 files changed, 1274 insertions(+), 1227 deletions(-) delete mode 100644 impls/elisp/mal/func.el diff --git a/impls/elisp/Makefile b/impls/elisp/Makefile index 7af3113c71..18ed09c8f5 100644 --- a/impls/elisp/Makefile +++ b/impls/elisp/Makefile @@ -1,3 +1,9 @@ all: + emacs -Q --batch -L . --eval '(byte-recompile-directory "." 0)' + +# For debugging, it is sometimes useful to attempt a run without byte compation. +nocompile: clean + exec emacs -Q --batch -L . --eval "(setq text-quoting-style 'straight)" --load stepA_mal.el clean: + rm -f *.elc *~ mal/*.elc mal/*~ diff --git a/impls/elisp/mal/core.el b/impls/elisp/mal/core.el index f079bc4009..da16eb3ab2 100644 --- a/impls/elisp/mal/core.el +++ b/impls/elisp/mal/core.el @@ -1,27 +1,30 @@ -(require 'cl-lib) +(require 'seq) +(require 'mal/types) -(defun mal-seq-p (mal-object) - (memq (mal-type mal-object) '(list vector))) - -(defun mal-listify (mal-object) - (cl-ecase (mal-type mal-object) - (list (mal-value mal-object)) - (vector (append (mal-value mal-object) nil)))) +(defun mal-boolean (value) (if value mal-true mal-false)) (defun mal-= (a b) - (cl-case (mal-type a) - ((list vector) (and (mal-seq-p b) - (mal-seq-= (mal-listify a) (mal-listify b)))) - (map (and (mal-map-p b) - (mal-map-= (mal-value a) (mal-value b)))) - (t (equal (mal-value a) (mal-value b))))) + (let (va vb) + (cond + ((or (setq va (mal-seq-value a)) (mal-list-p a)) + (and (or (setq vb (mal-seq-value b)) (mal-list-p b)) + (mal-seq-= va vb))) + ((setq va (mal-number-value a)) (equal va (mal-number-value b))) + ((setq va (mal-string-value a)) (equal va (mal-string-value b))) + ((setq va (mal-symbol-value a)) (eq va (mal-symbol-value b))) + ((setq va (mal-keyword-value a)) (equal va (mal-keyword-value b))) + ((setq va (mal-map-value a)) (and (setq vb (mal-map-value b)) + (mal-map-= va vb))) + (t (eq a b))))) (defun mal-seq-= (a b) - (if a - (and b - (mal-= (car a) (car b)) - (mal-seq-= (cdr a) (cdr b))) - (null b))) + (let* ((len (seq-length a)) + (res (= len (seq-length b)))) + (while (and res (< 0 len)) + (setq len (1- len)) + (unless (mal-= (seq-elt a len) (seq-elt b len)) + (setq res nil))) + res)) (defun mal-map-= (a b) (when (= (hash-table-count a) @@ -39,14 +42,15 @@ (define-hash-table-test 'mal-= 'mal-= 'sxhash) (defun mal-conj (seq &rest args) - (let ((value (mal-value seq))) - (cl-ecase (mal-type seq) - (vector - (mal-vector (vconcat (append (append value nil) args)))) - (list - (while args - (push (pop args) value)) - (mal-list value))))) + (let (value) + (cond + ((setq value (mal-vector-value seq)) + (mal-vector (vconcat value args))) + ((setq value (mal-list-value seq)) + (mal-list (append (reverse args) value))) + ((mal-list-p seq) + (mal-list (reverse args))) + (t (error "seq: bad type"))))) (defun elisp-to-mal (arg) (cond @@ -59,7 +63,7 @@ ((stringp arg) (mal-string arg)) ((keywordp arg) - (mal-keyword arg)) + (mal-keyword (symbol-name arg))) ((symbolp arg) (mal-symbol arg)) ((consp arg) @@ -77,158 +81,181 @@ ;; represent anything else as printed arg (mal-string (format "%S" arg))))) -(defvar core-ns - `((+ . ,(mal-fn (lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))))) - (- . ,(mal-fn (lambda (a b) (mal-number (- (mal-value a) (mal-value b)))))) - (* . ,(mal-fn (lambda (a b) (mal-number (* (mal-value a) (mal-value b)))))) - (/ . ,(mal-fn (lambda (a b) (mal-number (/ (mal-value a) (mal-value b)))))) +(defconst core-ns + '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) + (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) + (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) + (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))) - (< . ,(mal-fn (lambda (a b) (if (< (mal-value a) (mal-value b)) mal-true mal-false)))) - (<= . ,(mal-fn (lambda (a b) (if (<= (mal-value a) (mal-value b)) mal-true mal-false)))) - (> . ,(mal-fn (lambda (a b) (if (> (mal-value a) (mal-value b)) mal-true mal-false)))) - (>= . ,(mal-fn (lambda (a b) (if (>= (mal-value a) (mal-value b)) mal-true mal-false)))) + (< . (lambda (a b) (mal-boolean (< (mal-number-value a) (mal-number-value b))))) + (<= . (lambda (a b) (mal-boolean (<= (mal-number-value a) (mal-number-value b))))) + (> . (lambda (a b) (mal-boolean (> (mal-number-value a) (mal-number-value b))))) + (>= . (lambda (a b) (mal-boolean (>= (mal-number-value a) (mal-number-value b))))) - (= . ,(mal-fn (lambda (a b) (if (mal-= a b) mal-true mal-false)))) + (= . (lambda (a b) (mal-boolean (mal-= a b)))) - (list . ,(mal-fn (lambda (&rest args) (mal-list args)))) - (list? . ,(mal-fn (lambda (mal-object) (if (mal-list-p mal-object) mal-true mal-false)))) - (empty? . ,(mal-fn (lambda (seq) (if (zerop (length (mal-value seq))) mal-true mal-false)))) - (count . ,(mal-fn (lambda (seq) (mal-number (if (mal-seq-p seq) (length (mal-value seq)) 0))))) + (list . (lambda (&rest args) (mal-list args))) + (list? . (lambda (mal-object) (mal-boolean (mal-list-p mal-object)))) + (empty? . (lambda (seq) (mal-boolean (seq-empty-p (mal-seq-value seq))))) + (count . (lambda (seq) (mal-number (length (mal-seq-value seq))))) - (pr-str . ,(mal-fn (lambda (&rest args) (mal-string (mapconcat (lambda (item) (pr-str item t)) args " "))))) - (str . ,(mal-fn (lambda (&rest args) (mal-string (mapconcat 'pr-str args ""))))) - (prn . ,(mal-fn (lambda (&rest args) (println (mapconcat (lambda (item) (pr-str item t)) args " ")) mal-nil))) - (println . ,(mal-fn (lambda (&rest args) (println (mapconcat 'pr-str args " ")) mal-nil))) + (pr-str . (lambda (&rest args) (mal-string (pr-join args t " ")))) + (str . (lambda (&rest args) (mal-string (pr-join args nil "")))) + (prn . (lambda (&rest args) + (println (pr-join args t " ")) + mal-nil)) + (println . (lambda (&rest args) + (println (pr-join args nil " ")) + mal-nil)) - (read-string . ,(mal-fn (lambda (input) (read-str (mal-value input))))) - (slurp . ,(mal-fn (lambda (file) + (read-string . (lambda (input) (read-str (mal-string-value input)))) + (slurp . (lambda (file) (with-temp-buffer - (insert-file-contents-literally (mal-value file)) - (mal-string (buffer-string)))))) - - (atom . ,(mal-fn (lambda (arg) (mal-atom arg)))) - (atom? . ,(mal-fn (lambda (mal-object) (if (mal-atom-p mal-object) mal-true mal-false)))) - (deref . ,(mal-fn (lambda (atom) (mal-value atom)))) - (reset! . ,(mal-fn (lambda (atom value) (setf (aref atom 1) value)))) - (swap! . ,(mal-fn (lambda (atom fn &rest args) - (let* ((fn* (if (mal-func-p fn) (mal-func-fn fn) fn)) - (args* (cons (mal-value atom) args)) - (value (apply (mal-value fn*) args*))) - (setf (aref atom 1) value))))) - - (vec . ,(mal-fn (lambda (seq) (if (mal-vector-p seq) seq (mal-vector (mal-value seq)))))) - (cons . ,(mal-fn (lambda (arg list) (mal-list (cons arg (mal-listify list)))))) - (concat . ,(mal-fn (lambda (&rest lists) - (let ((lists* (mapcar (lambda (item) (mal-listify item)) lists))) - (mal-list (apply 'append lists*)))))) - - (nth . ,(mal-fn (lambda (seq index) - (let ((i (mal-value index)) - (list (mal-listify seq))) - (or (nth i list) - (error "Args out of range: %s, %d" (pr-str seq) i)))))) - (first . ,(mal-fn (lambda (seq) - (if (mal-nil-p seq) + (insert-file-contents-literally (mal-string-value file)) + (mal-string (buffer-string))))) + + (atom . mal-atom) + (atom? . (lambda (mal-object) (mal-boolean (mal-atom-value mal-object)))) + (deref . mal-atom-value) + (reset! . (lambda (atom value) + (mal-reset atom value) + value)) + (swap! . (lambda (atom fn &rest args) + (let ((value (apply (or (mal-func-value fn) + (mal-fn-core-value fn)) + (mal-atom-value atom) + args))) + (mal-reset atom value) + value))) + + (vec . (lambda (seq) + (if (mal-vector-value seq) + seq + (mal-vector (seq-into (mal-list-value seq) 'vector))))) + (cons . (lambda (arg seq) + (let ((value (mal-vector-value seq))) + (mal-list (cons arg (if value + (seq-into value 'list) + (mal-list-value seq))))))) + (concat . (lambda (&rest lists) + (mal-list (seq-mapcat 'mal-seq-value lists 'list)))) + + (nth . (lambda (seq index) + (let ((list (mal-seq-value seq)) + (i (mal-number-value index))) + ;; seq-elt returns nil for a list and a bad index + (or (seq-elt (mal-seq-value seq) (mal-number-value index)) + (error "Args out of range: %s, %d" (pr-str seq t) i))))) + + (first . (lambda (seq) + (let ((value (mal-seq-value seq))) + (if (seq-empty-p value) mal-nil - (or (car (mal-listify seq)) mal-nil))))) - (rest . ,(mal-fn (lambda (seq) (mal-list (unless (mal-nil-p seq) (cdr (mal-listify seq))))))) - - (throw . ,(mal-fn (lambda (mal-object) (signal 'mal-custom (list mal-object))))) - - (apply . ,(mal-fn (lambda (fn &rest args) - (let* ((butlast (butlast args)) - (last (mal-listify (car (last args)))) - (fn* (if (mal-func-p fn) (mal-func-fn fn) fn)) - (args* (append butlast last))) - (apply (mal-value fn*) args*))))) - (map . ,(mal-fn (lambda (fn seq) - (let ((fn* (if (mal-func-p fn) (mal-func-fn fn) fn))) - (mal-list (mapcar (mal-value fn*) (mal-value seq))))))) - - (nil? . ,(mal-fn (lambda (arg) (if (mal-nil-p arg) mal-true mal-false)))) - (true? . ,(mal-fn (lambda (arg) (if (mal-true-p arg) mal-true mal-false)))) - (false? . ,(mal-fn (lambda (arg) (if (mal-false-p arg) mal-true mal-false)))) - - (number? . ,(mal-fn (lambda (arg) (if (mal-number-p arg) mal-true mal-false)))) - (symbol? . ,(mal-fn (lambda (arg) (if (mal-symbol-p arg) mal-true mal-false)))) - (keyword? . ,(mal-fn (lambda (arg) (if (mal-keyword-p arg) mal-true mal-false)))) - (string? . ,(mal-fn (lambda (arg) (if (mal-string-p arg) mal-true mal-false)))) - (vector? . ,(mal-fn (lambda (arg) (if (mal-vector-p arg) mal-true mal-false)))) - (map? . ,(mal-fn (lambda (arg) (if (mal-map-p arg) mal-true mal-false)))) - - (symbol . ,(mal-fn (lambda (string) (mal-symbol (intern (mal-value string)))))) - (keyword . ,(mal-fn (lambda (x) (if (mal-keyword-p x) x (mal-keyword (intern (concat ":" (mal-value x)))))))) - (vector . ,(mal-fn (lambda (&rest args) (mal-vector (vconcat args))))) - (hash-map . ,(mal-fn (lambda (&rest args) + (seq-first value))))) + (rest . (lambda (seq) + (let ((value(mal-vector-value seq))) + (mal-list (cdr (if value + (seq-into value 'list) + (mal-list-value seq))))))) + + (throw . (lambda (mal-object) (signal 'mal-custom (list mal-object)))) + + (apply . (lambda (fn &rest args) + (let ((butlast (butlast args)) + (last (mal-seq-value (car (last args)))) + (fn* (or (mal-func-value fn) + (mal-fn-core-value fn) + (mal-macro-value fn)))) + (apply fn* (seq-concatenate 'list butlast last))))) + (map . (lambda (fn seq) + (mal-list (mapcar (or (mal-func-value fn) (mal-fn-core-value fn)) + (mal-seq-value seq))))) + + (nil? . (lambda (arg) (mal-boolean (eq mal-nil arg)))) + (true? . (lambda (arg) (mal-boolean (eq mal-true arg)))) + (false? . (lambda (arg) (mal-boolean (eq mal-false arg)))) + + (number? . (lambda (arg) (mal-boolean (mal-number-value arg)))) + (symbol? . (lambda (arg) (mal-boolean (mal-symbol-value arg)))) + (keyword? . (lambda (arg) (mal-boolean (mal-keyword-value arg)))) + (string? . (lambda (arg) (mal-boolean (mal-string-value arg)))) + (vector? . (lambda (arg) (mal-boolean (mal-vector-value arg)))) + (map? . (lambda (arg) (mal-boolean (mal-map-value arg)))) + + (symbol . (lambda (string) (mal-symbol (intern (mal-string-value string))))) + (keyword . (lambda (x) + (let ((value (mal-string-value x))) + (if value + (mal-keyword (concat ":" value)) + x)))) + + (vector . (lambda (&rest args) (mal-vector (seq-into args 'vector)))) + (hash-map . (lambda (&rest args) (let ((map (make-hash-table :test 'mal-=))) (while args (puthash (pop args) (pop args) map)) - (mal-map map))))) - - (sequential? . ,(mal-fn (lambda (mal-object) (if (mal-seq-p mal-object) mal-true mal-false)))) - (fn? . ,(mal-fn (lambda (arg) (if (or (mal-fn-p arg) - (and (mal-func-p arg) - (not (mal-func-macro-p arg)))) - mal-true - mal-false)))) - (macro? . ,(mal-fn (lambda (arg) (if (and (mal-func-p arg) - (mal-func-macro-p arg)) - mal-true - mal-false)))) - - (get . ,(mal-fn (lambda (map key) (if (mal-map-p map) (or (gethash key (mal-value map)) mal-nil) mal-nil)))) - (contains? . ,(mal-fn (lambda (map key) (if (gethash key (mal-value map)) mal-true mal-false)))) - (assoc . ,(mal-fn (lambda (map &rest args) - (let ((map* (copy-hash-table (mal-value map)))) + (mal-map map)))) + + (sequential? . (lambda (mal-object) + (mal-boolean (or (mal-list-p mal-object) + (mal-vector-value mal-object))))) + (fn? . (lambda (arg) (mal-boolean (or (mal-fn-core-value arg) + (mal-func-value arg))))) + (macro? . (lambda (arg) (mal-boolean (mal-macro-value arg)))) + + (get . (lambda (map key) + (or (let ((value (mal-map-value map))) + (when value + (gethash key value))) + mal-nil))) + (contains? . (lambda (map key) + (mal-boolean (gethash key (mal-map-value map))))) + (assoc . (lambda (map &rest args) + (let ((map* (copy-hash-table (mal-map-value map)))) (while args (puthash (pop args) (pop args) map*)) - (mal-map map*))))) - (dissoc . ,(mal-fn (lambda (map &rest args) - (let ((map* (copy-hash-table (mal-value map)))) - (while args - (remhash (pop args) map*)) - (mal-map map*))))) - (keys . ,(mal-fn (lambda (map) (let (keys) - (maphash (lambda (key value) (push key keys)) - (mal-value map)) - (mal-list keys))))) - (vals . ,(mal-fn (lambda (map) (let (vals) - (maphash (lambda (key value) (push value vals)) - (mal-value map)) - (mal-list vals))))) - - (readline . ,(mal-fn (lambda (prompt) - (let ((ret (readln (mal-value prompt)))) - (if ret - (mal-string ret) - mal-nil))))) - - (meta . ,(mal-fn (lambda (mal-object) (or (mal-meta mal-object) mal-nil)))) - (with-meta . ,(mal-fn (lambda (mal-object meta) - (let ((mal-object* (copy-sequence mal-object))) - (setf (aref mal-object* 2) meta) - mal-object*)))) - - (time-ms . ,(mal-fn (lambda () (mal-number (floor (* (float-time) 1000)))))) - - (conj . ,(mal-fn 'mal-conj)) - (seq . ,(mal-fn (lambda (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) + (mal-map map*)))) + (dissoc . (lambda (map &rest args) + (let ((map* (copy-hash-table (mal-map-value map)))) + (dolist (k args) + (remhash k map*)) + (mal-map map*)))) + (keys . (lambda (map) (let (keys) + (maphash (lambda (key _value) (push key keys)) + (mal-map-value map)) + (mal-list keys)))) + (vals . (lambda (map) (let (vals) + (maphash (lambda (_key value) (push value vals)) + (mal-map-value map)) + (mal-list vals)))) + + (readline . (lambda (prompt) + (or (mal-string (readln (mal-string-value prompt))) + mal-nil))) + + (meta . mal-meta) + (with-meta . with-meta) + + (time-ms . (lambda () (mal-number (floor (* (float-time) 1000))))) + + (conj . mal-conj) + (seq . (lambda (mal-object) + (let (value) + (or (cond - ((or (eq type 'list) (eq type 'vector)) - (if (and value (not (zerop (length value)))) - (mal-list (mal-listify mal-object)) - mal-nil)) - ((eq type 'string) - (if (not (zerop (length value))) - (mal-list (mapcar (lambda (item) (mal-string (char-to-string item))) - (append value nil))) - mal-nil)) - (t - mal-nil)))))) - - (elisp-eval . ,(mal-fn (lambda (string) (elisp-to-mal (eval (read (mal-value string))))))) + ((setq value (mal-list-value mal-object)) + mal-object) + ((and (setq value (mal-vector-value mal-object)) + (not (seq-empty-p value))) + (mal-list (seq-into value 'list))) + ((and (setq value (mal-string-value mal-object)) + (not (seq-empty-p value))) + (mal-list (mapcar (lambda (item) (mal-string (char-to-string item))) + value)))) + mal-nil)))) + + (elisp-eval . (lambda (string) + (elisp-to-mal (eval (read (mal-string-value string)))))) )) (provide 'mal/core) diff --git a/impls/elisp/mal/env.el b/impls/elisp/mal/env.el index 94f6d3e717..4500e37a25 100644 --- a/impls/elisp/mal/env.el +++ b/impls/elisp/mal/env.el @@ -1,28 +1,27 @@ +(require 'mal/types) + +;; An env is represented by an elisp list of hash-tables. In other words +;; * car: a hash-table +;; * cdr: the outer environment or () +;; Keys are elisp symbols. + (defun mal-env (&optional outer binds exprs) - (let ((env (vector 'env (vector (make-hash-table :test 'eq) outer)))) - (while binds - (let ((key (pop binds))) - (if (eq key '&) - (let ((key (pop binds)) - (value (mal-list exprs))) - (mal-env-set env key value) - (setq binds nil - exprs nil)) - (let ((value (pop exprs))) - (mal-env-set env key value))))) + (let ((env (cons (make-hash-table :test 'eq) outer)) + key) + (while (setq key (pop binds)) + (if (eq key '&) + (mal-env-set env (pop binds) (mal-list exprs)) + (mal-env-set env key (pop exprs)))) env)) (defun mal-env-set (env key value) - (let ((data (aref (aref env 1) 0))) + (let ((data (car env))) (puthash key value data))) (defun mal-env-get (env key) - (let* ((data (aref (aref env 1) 0)) - (value (gethash key data))) - (or value - (let ((outer (aref (aref env 1) 1))) - (if outer - (mal-env-get outer key) - nil))))) + (let (value) + (while (and (not (setq value (gethash key (pop env)))) + env)) + value)) (provide 'mal/env) diff --git a/impls/elisp/mal/func.el b/impls/elisp/mal/func.el deleted file mode 100644 index 8e4547ffda..0000000000 --- a/impls/elisp/mal/func.el +++ /dev/null @@ -1,25 +0,0 @@ -(defun mal-func (ast params env fn) - (vector 'func (vector ast params env fn nil) nil)) - -(defun mal-macro (mal-func) - (let ((v (aref mal-func 1))) - (vector 'func - (vector (aref v 0) (aref v 1) (aref v 2) (aref v 3) t) - nil))) - -(defun mal-func-ast (mal-func) - (aref (aref mal-func 1) 0)) - -(defun mal-func-params (mal-func) - (aref (aref mal-func 1) 1)) - -(defun mal-func-env (mal-func) - (aref (aref mal-func 1) 2)) - -(defun mal-func-fn (mal-func) - (aref (aref mal-func 1) 3)) - -(defun mal-func-macro-p (mal-func) - (aref (aref mal-func 1) 4)) - -(provide 'mal/func) diff --git a/impls/elisp/mal/printer.el b/impls/elisp/mal/printer.el index 6e09f23cef..46d2f97c11 100644 --- a/impls/elisp/mal/printer.el +++ b/impls/elisp/mal/printer.el @@ -1,59 +1,60 @@ -(require 'cl-lib) +(require 'mal/types) -(defun pr-str (form &optional print-readably) - (let ((value (mal-value form))) - (cl-ecase (mal-type form) - ('nil +(defun pr-str (form print-readably) + (let (value) + (cond + ((eq mal-nil form) "nil") - (true + ((eq mal-true form) "true") - (false + ((eq mal-false form) "false") - (number + ((setq value (mal-number-value form)) (number-to-string value)) - (string + ((setq value (mal-string-value form)) (if print-readably (let ((print-escape-newlines t)) (prin1-to-string value)) value)) - ((symbol keyword) + ((setq value (mal-symbol-value form)) (symbol-name value)) - (list + ((setq value (mal-keyword-value form)) + value) + ((setq value (mal-list-value form)) (pr-list value print-readably)) - (vector + ((mal-list-p form) + "()") + ((setq value (mal-vector-value form)) (pr-vector value print-readably)) - (map + ((setq value (mal-map-value form)) (pr-map value print-readably)) - (fn - "#") - (func - "#") - (atom - (format "(atom %s)" (pr-str value print-readably)))))) + ((or (mal-fn-core-value form) (mal-func-value form)) + "#") + ((mal-macro-value form) + "#") + ((setq value (mal-atom-value form)) + (format "(atom %s)" (pr-str value print-readably))) + (t (error "pr-str: unknown type: %s" form))))) (defun pr-list (form print-readably) - (let ((items (mapconcat - (lambda (item) (pr-str item print-readably)) - form " "))) + (let ((items (pr-join form print-readably " "))) (concat "(" items ")"))) (defun pr-vector (form print-readably) - (let ((items (mapconcat - (lambda (item) (pr-str item print-readably)) - (append form nil) " "))) + (let ((items (pr-join form print-readably " "))) (concat "[" items "]"))) (defun pr-map (form print-readably) (let (pairs) (maphash (lambda (key value) - (push (cons (pr-str key print-readably) - (pr-str value print-readably)) - pairs)) + (push value pairs) + (push key pairs)) form) - (let ((items (mapconcat - (lambda (item) (concat (car item) " " (cdr item))) - (nreverse pairs) " "))) + (let ((items (pr-join pairs print-readably " "))) (concat "{" items "}")))) +(defun pr-join (forms print-readably separator) + (mapconcat (lambda (item) (pr-str item print-readably)) forms separator)) + (provide 'mal/printer) diff --git a/impls/elisp/mal/reader.el b/impls/elisp/mal/reader.el index c8b92835fc..8253cd98f1 100644 --- a/impls/elisp/mal/reader.el +++ b/impls/elisp/mal/reader.el @@ -1,20 +1,20 @@ -(require 'cl-lib) +(require 'mal/types) ;; HACK: `text-quoting-style' prettifies quotes in error messages on ;; Emacs 25, but no longer does from 26 upwards... (when (= emacs-major-version 25) (setq text-quoting-style 'grave)) -(defvar tokens nil) +(defvar reader--tokens nil) (defun peek () - (car tokens)) + (car reader--tokens)) (defun next () - (pop tokens)) + (pop reader--tokens)) (defun read-str (input) - (setq tokens (tokenizer input)) + (setq reader--tokens (tokenizer input)) (read-form)) (defun tokenizer (input) @@ -149,7 +149,7 @@ (mal-string (read token)) (signal 'unterminated-sequence '(string)))) ((= (aref token 0) ?:) - (mal-keyword (intern token))) + (mal-keyword token)) (t ;; assume anything else is a symbol (mal-symbol (intern token)))) diff --git a/impls/elisp/mal/types.el b/impls/elisp/mal/types.el index e87e41c8d6..deba03a46c 100644 --- a/impls/elisp/mal/types.el +++ b/impls/elisp/mal/types.el @@ -1,45 +1,95 @@ -;;; general accessors +;; Structural pattern matching is ideal, but too slow for MAL. -(defun mal-type (mal-object) - (aref mal-object 0)) - -(defun mal-value (mal-object) - (aref mal-object 1)) - -(defun mal-meta (mal-object) - (aref mal-object 2)) - -;;; objects +;; So we use a mal-foo-value getter that returns nil in case of bad +;; type (or if a list is empty, unfortunately). (defmacro mal-object (name) (let ((constructor (intern (format "mal-%s" name))) - (predicate (intern (format "mal-%s-p" name)))) + (accessor (intern (format "mal-%s-value" name)))) `(progn - (defun ,constructor (&optional value meta) - (vector ',name value meta)) - (defun ,predicate (arg) - (and (vectorp arg) (eq (aref arg 0) ',name)))))) - -(mal-object nil) -(mal-object true) -(mal-object false) - -(defvar mal-nil (mal-nil)) -(defvar mal-true (mal-true 'true)) -(defvar mal-false (mal-false 'false)) - -(mal-object number) -(mal-object string) -(mal-object symbol) + (defsubst ,constructor (value) + (record ',name value)) + (defun ,accessor (arg) + (and (recordp arg) + (eq (aref arg 0) ',name) + (aref arg 1)))))) + +(defconst mal-nil #&8"n") +(defconst mal-false #&8"f") +(defconst mal-true #&8"t") + +(defsubst mal-number (elisp-number) elisp-number) +(defsubst mal-number-value (obj) (and (numberp obj) obj)) + +(defsubst mal-symbol (elisp-symbol) elisp-symbol) +;; A nil result means either 'not a symbol' or 'the nil symbol'. +(defsubst mal-symbol-value (obj) (and (symbolp obj)obj)) + +(defsubst mal-string (elisp-string) elisp-string) +(defsubst mal-string-value (obj) (and (stringp obj) obj)) + +;; In elisp, keywords are symbols. Using them would cause confusion, +;; or at least make mal-symbol-value more complex, for little benefit. +;; The wrapped value is an elisp string including the initial colon. (mal-object keyword) -(mal-object list) -(mal-object vector) -(mal-object map) +;; Use the native type when possible, but #s(type value meta ...) for +;; the empty list or when metadata is present. + +(defsubst mal-vector (elisp-vector) elisp-vector) +(defun mal-vector-value (obj) + (if (vectorp obj) + obj + (and (recordp obj) (eq (aref obj 0) 'vector) (aref obj 1)))) + +(defsubst mal-map (elisp-hash-table) elisp-hash-table) +(defun mal-map-value (obj) + (if (hash-table-p obj) + obj + (and (recordp obj) (eq (aref obj 0) 'map) (aref obj 1)))) + +(defconst mal-empty-list #s(list nil)) +(defsubst mal-list (elisp-list) (or elisp-list mal-empty-list)) +;; A nil result means either 'not a list' or 'empty list'. +(defun mal-list-value (obj) + (if (listp obj) obj + (and (recordp obj) (eq (aref obj 0) 'list) (aref obj 1)))) +(defun mal-list-p (obj) + (or (listp obj) + (and (recordp obj) (eq (aref obj 0) 'list)))) + +;; A nil result means either 'not a list' or 'empty list'. +(defun mal-seq-value (arg) (or (mal-vector-value arg) (mal-list-value arg))) (mal-object atom) -(mal-object fn) -(mal-object func) +(defun mal-reset (atom value) (setf (aref atom 1) value)) + +(mal-object fn-core) +(mal-object macro) + +;; Function created by fn*. +(defsubst mal-func (value body params env) + (record 'func value body params env)) +(defun mal-func-value ( obj) + (and (recordp obj) (eq (aref obj 0) 'func) (aref obj 1))) +(defsubst mal-func-body (obj) (aref obj 2)) +(defsubst mal-func-params (obj) (aref obj 3)) +(defsubst mal-func-env (obj) (aref obj 4)) + +(defun with-meta (obj meta) + (cond + ((vectorp obj) (record 'vector obj meta)) + ((hash-table-p obj) (record 'map obj meta)) + ((listp obj) (record 'list obj meta)) + ((< (length obj) 4) (record (aref obj 0) (aref obj 1) meta)) + (t (record (aref obj 0) (aref obj 1) + (aref obj 2) (aref obj 3) + (aref obj 4) meta)))) + +(defun mal-meta (obj) + (if (and (recordp obj) (member (length obj) '(3 6))) + (aref obj (1- (length obj))) + mal-nil)) ;;; regex diff --git a/impls/elisp/run b/impls/elisp/run index c68e97bf93..cb0387403c 100755 --- a/impls/elisp/run +++ b/impls/elisp/run @@ -1,2 +1,3 @@ -#!/bin/bash -exec emacs -Q --batch -L $(dirname $0) --eval "(setq text-quoting-style 'straight)" --load $(dirname $0)/${STEP:-stepA_mal}.el "${@}" +#!/bin/sh +dir=$(dirname $0) +exec emacs -Q --batch -L $dir --eval "(setq text-quoting-style 'straight)" --load $dir/${STEP:-stepA_mal}.elc "${@}" diff --git a/impls/elisp/step0_repl.el b/impls/elisp/step0_repl.el index 49bc0a78d9..c8cadfcf9c 100644 --- a/impls/elisp/step0_repl.el +++ b/impls/elisp/step0_repl.el @@ -7,24 +7,24 @@ (defun PRINT (input) input) +(defun rep (input) + (PRINT (EVAL (READ input)))) + (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) (defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (println input) - (setq eof t) - ;; print final newline - (terpri)))))) + (let (input) + (while (setq input (readln "user> ")) + (println (rep input))) + ;; print final newline + (terpri))) (main) diff --git a/impls/elisp/step1_read_print.el b/impls/elisp/step1_read_print.el index 2e109a00da..a3f93ed67f 100644 --- a/impls/elisp/step1_read_print.el +++ b/impls/elisp/step1_read_print.el @@ -1,7 +1,11 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) (require 'mal/types) (require 'mal/reader) (require 'mal/printer) + (defun READ (input) (read-str input)) @@ -19,33 +23,33 @@ (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + (defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (princ (format "Expected '%c', got EOF\n" - (cl-case (cadr err) - (string ?\") - (list ?\)) - (vector ?\]) - (map ?}))))) - (error ; catch-all - (println (error-message-string err)) - (backtrace))) - (setq eof t) - ;; print final newline - (terpri)))))) + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input)))) + ;; print final newline + (terpri))) (main) diff --git a/impls/elisp/step2_eval.el b/impls/elisp/step2_eval.el index 6b76b75d7b..b069f71705 100644 --- a/impls/elisp/step2_eval.el +++ b/impls/elisp/step2_eval.el @@ -1,46 +1,43 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) (require 'mal/types) (require 'mal/reader) (require 'mal/printer) -(defvar repl-env (make-hash-table :test 'eq)) -(puthash '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))) repl-env) -(puthash '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b)))) repl-env) -(puthash '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b)))) repl-env) -(puthash '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b)))) repl-env) (defun READ (input) (read-str input)) (defun EVAL (ast env) - ;; (println "EVAL: %s\n" (PRINT ast)) - (cl-case (mal-type ast) - (list - (let ((a (mal-value ast))) - (if a - (let* ((fn (EVAL (car a) env)) - (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) - (apply fn args)) - ast))) - (symbol - (let ((definition (gethash (mal-value ast) env))) - (or definition (error "Definition not found")))) - (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + (let (a) + + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cond + + ((setq a (mal-list-value ast)) + (let ((fn* (mal-fn-core-value (EVAL (car a) env))) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) + (apply fn* args))) + ((setq a (mal-symbol-value ast)) + (or (gethash a env) (error "'%s' not found" a))) + ((setq a (mal-vector-value ast)) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast))) + ast)))) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) @@ -48,33 +45,44 @@ (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + (defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (princ (format "Expected '%c', got EOF\n" - (cl-case (cadr err) - (string ?\") - (list ?\)) - (vector ?\]) - (map ?}))))) - (error ; catch-all - (println (error-message-string err)) - (backtrace))) - (setq eof t) - ;; print final newline - (terpri)))))) + (defvar repl-env (make-hash-table :test 'eq)) + + (dolist (binding + '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) + (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) + (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) + (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))))) + (let ((symbol (car binding)) + (fn (cdr binding))) + (puthash symbol (mal-fn-core fn) repl-env))) + + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri))) (main) diff --git a/impls/elisp/step3_env.el b/impls/elisp/step3_env.el index a003e55144..91d7f79114 100644 --- a/impls/elisp/step3_env.el +++ b/impls/elisp/step3_env.el @@ -1,71 +1,66 @@ +;; -*- lexical-binding: t; -*- + +(require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) -(defvar repl-env (mal-env)) -(mal-env-set repl-env '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b))))) -(mal-env-set repl-env '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b))))) -(mal-env-set repl-env '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b))))) -(mal-env-set repl-env '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b))))) (defun READ (input) (read-str input)) (defun EVAL (ast env) - (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) - (if (and dbgeval - (not (member (mal-type dbgeval) '(false nil)))) - (println "EVAL: %s\n" (PRINT ast)))) - - (cl-case (mal-type ast) - (list - (let* ((a (mal-value ast)) - (a1 (cadr a)) - (a2 (nth 2 a))) - (if a - (cl-case (mal-value (car a)) + (let (a) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) (def! - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (mal-env-set env identifier value))) + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (mal-env-set env identifier value))) (let* - (let* ((env* (mal-env env)) - (a1* (mal-value a1)) - (bindings (if (vectorp a1*) (append a1* nil) a1*)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) (EVAL form env*))) (t ;; not a special form - (let ((fn (EVAL (car a) env)) + (let ((fn* (mal-fn-core-value (EVAL (car a) env))) (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) - (apply fn args)))) - ast))) - (symbol - (let ((key (mal-value ast))) - (or (mal-env-get env key) - (error "'%s' not found" key)))) - (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + (apply fn* args))))) + ((setq a (mal-symbol-value ast)) + (or (mal-env-get env a) (error "'%s' not found" a))) + ((setq a (mal-vector-value ast)) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast))) + ast)))) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) (defun readln (prompt) @@ -73,32 +68,44 @@ (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + (defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (princ (format "Expected '%c', got EOF\n" - (cl-case (cadr err) - (string ?\") - (list ?\)) - (vector ?\]) - (map ?}))))) - (error ; catch-all - (println (error-message-string err)))) - (setq eof t) - ;; print final newline - (terpri)))))) + (defvar repl-env (mal-env)) + + (dolist (binding + '((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b))))) + (- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b))))) + (* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b))))) + (/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b))))))) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri))) (main) diff --git a/impls/elisp/step4_if_fn_do.el b/impls/elisp/step4_if_fn_do.el index d0a9f96072..0dce5e9b2c 100644 --- a/impls/elisp/step4_if_fn_do.el +++ b/impls/elisp/step4_if_fn_do.el @@ -1,134 +1,138 @@ ;; -*- lexical-binding: t; -*- +(require 'cl-lib) (require 'mal/types) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - (defun READ (input) (read-str input)) (defun EVAL (ast env) - (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) - (if (and dbgeval - (not (member (mal-type dbgeval) '(false nil)))) - (println "EVAL: %s\n" (PRINT ast)))) - - (cl-case (mal-type ast) - (list - (let* ((a (mal-value ast)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (if a - (cl-case (mal-value (car a)) + (let (a) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) + (println "EVAL: %s\n" (PRINT ast)))) + + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) (def! - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (mal-env-set env identifier value))) + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (mal-env-set env identifier value))) (let* - (let ((env* (mal-env env)) - (bindings (mal-listify a1)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) (EVAL form env*))) (do - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (mapcar (lambda (item) (EVAL item env)) butlast) - (EVAL last env))) + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (EVAL (car a) env)) (if - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (EVAL then env) - (if else - (EVAL else env) - mal-nil)))) + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (EVAL (cadddr a) env) + mal-nil) + (EVAL (caddr a) env)))) (fn* - (let ((binds (mapcar 'mal-value (mal-value a1))) - (body a2)) - (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env))) (t ;; not a special form - (let ((fn* (mal-value (EVAL (car a) env))) - (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) - (apply fn* args)))) - ast))) - (symbol - (let ((key (mal-value ast))) - (or (mal-env-get env key) - (error "'%s' not found" key)))) - (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((mal-func-value fn) + (EVAL (mal-func-body fn) + (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)))) + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (apply fn* (mapcar (lambda (x) (EVAL x env)) args))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (or (mal-env-get env a) (error "'%s' not found" a))) + ((setq a (mal-vector-value ast)) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a)))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast))) + ast)))) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) -(rep "(def! not (fn* (a) (if a false true)))") - (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + (defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (princ (format "Expected '%c', got EOF\n" - (cl-case (cadr err) - (string ?\") - (list ?\)) - (vector ?\]) - (map ?}))))) - (error ; catch-all - (println (error-message-string err)))) - (setq eof t) - ;; print final newline - (terpri)))))) + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri))) (main) diff --git a/impls/elisp/step5_tco.el b/impls/elisp/step5_tco.el index 2acffcff0d..b2b121acda 100644 --- a/impls/elisp/step5_tco.el +++ b/impls/elisp/step5_tco.el @@ -1,150 +1,146 @@ ;; -*- lexical-binding: t; -*- -(setq debug-on-error t) +(require 'cl-lib) (require 'mal/types) -(require 'mal/func) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - (defun READ (input) (read-str input)) (defun EVAL (ast env) - (catch 'return - (while t + (let (return a) + (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) - (if (and dbgeval - (not (member (mal-type dbgeval) '(false nil)))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) - (cl-case (mal-type ast) - - (list - (let* ((a (mal-value ast)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (unless a (throw 'return ast)) - (cl-case (mal-value (car a)) - (def! - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - (let* - (let ((env* (mal-env env)) - (bindings (mal-listify a1)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - (do - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (mapcar (lambda (item) (EVAL item env)) butlast) - (setq ast last))) ; TCO - (if - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) - (fn* - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let ((fn (EVAL (car a) env)) - (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))) - (symbol - (let ((key (mal-value ast))) - (throw 'return (or (mal-env-get env key) - (error "'%s' not found" key))))) - (vector - (throw 'return + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast)))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (throw 'return (mal-map map)))) + (setq return (mal-map map)))) (t ;; return as is - (throw 'return ast)))))) + (setq return ast)))) + + ;; End of the TCO loop + return)) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) -(rep "(def! not (fn* (a) (if a false true)))") - (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) +(defmacro with-error-handling (&rest body) + `(condition-case err + (progn ,@body) + (end-of-token-stream + ;; empty input, carry on + ) + (unterminated-sequence + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) + (error ; catch-all + (println (error-message-string err))))) + (defun main () - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input - (condition-case err - (println (rep input)) - (end-of-token-stream - ;; empty input, carry on - ) - (unterminated-sequence - (princ (format "Expected '%c', got EOF\n" - (cl-case (cadr err) - (string ?\") - (list ?\)) - (vector ?\]) - (map ?}))))) - (error ; catch-all - (println (error-message-string err)))) - (setq eof t) - ;; print final newline - (terpri)))))) + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + + (let (input) + (while (setq input (readln "user> ")) + (with-error-handling + (println (rep input repl-env)))) + ;; print final newline + (terpri))) (main) diff --git a/impls/elisp/step6_file.el b/impls/elisp/step6_file.el index 4c4ea269b8..9ba8b9c3c3 100644 --- a/impls/elisp/step6_file.el +++ b/impls/elisp/step6_file.el @@ -1,130 +1,113 @@ ;; -*- lexical-binding: t; -*- +(require 'cl-lib) (require 'mal/types) -(require 'mal/func) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - (defun READ (input) (read-str input)) (defun EVAL (ast env) - (catch 'return - (while t + (let (return a) + (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) - (if (and dbgeval - (not (member (mal-type dbgeval) '(false nil)))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) - (cl-case (mal-type ast) - - (list - (let* ((a (mal-value ast)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (unless a (throw 'return ast)) - (cl-case (mal-value (car a)) - (def! - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - (let* - (let ((env* (mal-env env)) - (bindings (mal-listify a1)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - (do - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (mapcar (lambda (item) (EVAL item env)) butlast) - (setq ast last))) ; TCO - (if - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) - (fn* - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let ((fn (EVAL (car a) env)) - (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))) - (symbol - (let ((key (mal-value ast))) - (throw 'return (or (mal-env-get env key) - (error "'%s' not found" key))))) - (vector - (throw 'return + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast)))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (throw 'return (mal-map map)))) + (setq return (mal-map map)))) (t ;; return as is - (throw 'return ast)))))) + (setq return ast)))) -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + ;; End of the TCO loop + return)) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") - (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) (defmacro with-error-handling (&rest body) @@ -144,17 +127,28 @@ (println (error-message-string err))))) (defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + (if argv (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (while (setq input (readln "user> ")) (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) (main) diff --git a/impls/elisp/step7_quote.el b/impls/elisp/step7_quote.el index 4ec792c137..9bf20f7a11 100644 --- a/impls/elisp/step7_quote.el +++ b/impls/elisp/step7_quote.el @@ -2,159 +2,140 @@ (require 'cl-lib) (require 'mal/types) -(require 'mal/func) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun starts-with-p (ast sym) - (let ((l (mal-value ast))) - (and l - (let ((s (car l))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))))) - (defun qq-reducer (elt acc) - (mal-list (if (and (mal-list-p elt) - (starts-with-p elt 'splice-unquote)) - (list (mal-symbol 'concat) (cadr (mal-value elt)) acc) - (list (mal-symbol 'cons) (quasiquote elt) acc)))) + (let ((value (mal-list-value elt))) + (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) + (list (mal-symbol 'concat) (cadr value) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc))))) (defun qq-iter (elts) (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) (defun quasiquote (ast) - (cl-case (mal-type ast) - (list (if (starts-with-p ast 'unquote) - (cadr (mal-value ast)) - (qq-iter (mal-value ast)))) - (vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast))))) - ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) - (t ast))) + (let (value) + (cond + ((setq value (mal-list-value ast)) ; not empty + (if (eq 'unquote (mal-symbol-value (car value))) + (cadr value) + (qq-iter value))) + ((setq value (mal-vector-value ast)) + (mal-list (list (mal-symbol 'vec) (qq-iter value)))) + ((or (mal-map-value ast) + (mal-symbol-value ast)) + (mal-list (list (mal-symbol 'quote) ast))) + (t ; including the empty list case + ast)))) (defun READ (input) (read-str input)) (defun EVAL (ast env) - (catch 'return - (while t + (let (return a) + (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) - (if (and dbgeval - (not (member (mal-type dbgeval) '(false nil)))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) - (cl-case (mal-type ast) - - (list - (let* ((a (mal-value ast)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (unless a (throw 'return ast)) - (cl-case (mal-value (car a)) - (def! - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) - (let* - (let ((env* (mal-env env)) - (bindings (mal-listify a1)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) - (setq env env* - ast form))) ; TCO - (quote - (throw 'return a1)) - (quasiquote - (setq ast (quasiquote a1))) ; TCO - (do - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (mapcar (lambda (item) (EVAL item env)) butlast) - (setq ast last))) ; TCO - (if - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) - (fn* - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn - (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) - (t - ;; not a special form - (let ((fn (EVAL (car a) env)) - (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) - (if (mal-func-p fn) - (let ((env* (mal-env (mal-func-env fn) - (mal-func-params fn) - args))) - (setq env env* - ast (mal-func-ast fn))) ; TCO - ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))) - (symbol - (let ((key (mal-value ast))) - (throw 'return (or (mal-env-get env key) - (error "'%s' not found" key))))) - (vector - (throw 'return + (cond + + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) + (def! + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) + (setq env env* + ast form))) ; TCO + (quote + (setq return (cadr a))) + (quasiquote + (setq ast (quasiquote (cadr a)))) ; TCO + (do + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO + (if + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO + (fn* + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func + (lambda (&rest args) + (EVAL body (mal-env env binds args))) + body binds env)))) + (t + ;; not a special form + (let ((fn (EVAL (car a) env)) + (args (cdr a)) + fn*) + (cond + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) + (mal-func-params fn) + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) + ;; built-in function + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast)))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (throw 'return (mal-map map)))) + (setq return (mal-map map)))) (t ;; return as is - (throw 'return ast)))))) + (setq return ast)))) -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + ;; End of the TCO loop + return)) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") - (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) (defmacro with-error-handling (&rest body) @@ -174,17 +155,28 @@ (println (error-message-string err))))) (defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + (if argv (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (while (setq input (readln "user> ")) (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) (main) diff --git a/impls/elisp/step8_macros.el b/impls/elisp/step8_macros.el index 04c442dbcb..7d63ef624e 100644 --- a/impls/elisp/step8_macros.el +++ b/impls/elisp/step8_macros.el @@ -2,167 +2,146 @@ (require 'cl-lib) (require 'mal/types) -(require 'mal/func) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun starts-with-p (ast sym) - (let ((l (mal-value ast))) - (and l - (let ((s (car l))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))))) - (defun qq-reducer (elt acc) - (mal-list (if (and (mal-list-p elt) - (starts-with-p elt 'splice-unquote)) - (list (mal-symbol 'concat) (cadr (mal-value elt)) acc) - (list (mal-symbol 'cons) (quasiquote elt) acc)))) + (let ((value (mal-list-value elt))) + (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) + (list (mal-symbol 'concat) (cadr value) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc))))) (defun qq-iter (elts) (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) (defun quasiquote (ast) - (cl-case (mal-type ast) - (list (if (starts-with-p ast 'unquote) - (cadr (mal-value ast)) - (qq-iter (mal-value ast)))) - (vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast))))) - ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) - (t ast))) + (let (value) + (cond + ((setq value (mal-list-value ast)) ; not empty + (if (eq 'unquote (mal-symbol-value (car value))) + (cadr value) + (qq-iter value))) + ((setq value (mal-vector-value ast)) + (mal-list (list (mal-symbol 'vec) (qq-iter value)))) + ((or (mal-map-value ast) + (mal-symbol-value ast)) + (mal-list (list (mal-symbol 'quote) ast))) + (t ; including the empty list case + ast)))) (defun READ (input) (read-str input)) (defun EVAL (ast env) - (catch 'return - (while t + (let (return a) + (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) - (if (and dbgeval - (not (member (mal-type dbgeval) '(false nil)))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) - (cl-case (mal-type ast) + (cond - (list - (let* ((a (mal-value ast)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (unless a (throw 'return ast)) - (cl-case (mal-value (car a)) + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) (def! - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) (let* - (let ((env* (mal-env env)) - (bindings (mal-listify a1)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) (setq env env* ast form))) ; TCO (quote - (throw 'return a1)) + (setq return (cadr a))) (quasiquote - (setq ast (quasiquote a1))) ; TCO + (setq ast (quasiquote (cadr a)))) ; TCO (defmacro! - (let ((identifier (mal-value a1)) - (value (mal-macro (EVAL a2 env)))) - (throw 'return (mal-env-set env identifier value)))) + (let ((identifier (mal-symbol-value (cadr a))) + (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) + (setq return (mal-env-set env identifier value)))) (do - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (mapcar (lambda (item) (EVAL item env)) butlast) - (setq ast last))) ; TCO + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO (if - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO (fn* - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) + (EVAL body (mal-env env binds args))) + body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) - (args (cdr a))) - (if (mal-func-p fn) - (if (mal-func-macro-p fn) - (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO - (let ((env* (mal-env (mal-func-env fn) + (args (cdr a)) + fn*) + (cond + ((setq fn* (mal-macro-value fn)) + (setq ast (apply fn* args))) ; TCO + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) (mal-func-params fn) - (mapcar (lambda (x) (EVAL x env)) args)))) - (setq env env* - ast (mal-func-ast fn)))) ; TCO + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) - args)))))))))) - (symbol - (let ((key (mal-value ast))) - (throw 'return (or (mal-env-get env key) - (error "'%s' not found" key))))) - (vector - (throw 'return + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast)))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (throw 'return (mal-map map)))) + (setq return (mal-map map)))) (t ;; return as is - (throw 'return ast)))))) + (setq return ast)))) -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + ;; End of the TCO loop + return)) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") -(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)))))))") - (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) (defmacro with-error-handling (&rest body) @@ -182,17 +161,31 @@ (println (error-message-string err))))) (defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + (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)))))))" repl-env) + (if argv (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (while (setq input (readln "user> ")) (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) (main) diff --git a/impls/elisp/step9_try.el b/impls/elisp/step9_try.el index b381dd4070..2677282d1d 100644 --- a/impls/elisp/step9_try.el +++ b/impls/elisp/step9_try.el @@ -2,183 +2,164 @@ (require 'cl-lib) (require 'mal/types) -(require 'mal/func) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun starts-with-p (ast sym) - (let ((l (mal-value ast))) - (and l - (let ((s (car l))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))))) - (defun qq-reducer (elt acc) - (mal-list (if (and (mal-list-p elt) - (starts-with-p elt 'splice-unquote)) - (list (mal-symbol 'concat) (cadr (mal-value elt)) acc) - (list (mal-symbol 'cons) (quasiquote elt) acc)))) + (let ((value (mal-list-value elt))) + (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) + (list (mal-symbol 'concat) (cadr value) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc))))) (defun qq-iter (elts) (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) (defun quasiquote (ast) - (cl-case (mal-type ast) - (list (if (starts-with-p ast 'unquote) - (cadr (mal-value ast)) - (qq-iter (mal-value ast)))) - (vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast))))) - ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) - (t ast))) + (let (value) + (cond + ((setq value (mal-list-value ast)) ; not empty + (if (eq 'unquote (mal-symbol-value (car value))) + (cadr value) + (qq-iter value))) + ((setq value (mal-vector-value ast)) + (mal-list (list (mal-symbol 'vec) (qq-iter value)))) + ((or (mal-map-value ast) + (mal-symbol-value ast)) + (mal-list (list (mal-symbol 'quote) ast))) + (t ; including the empty list case + ast)))) (defun READ (input) (read-str input)) (defun EVAL (ast env) - (catch 'return - (while t + (let (return a) + (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) - (if (and dbgeval - (not (member (mal-type dbgeval) '(false nil)))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) - (cl-case (mal-type ast) + (cond - (list - (let* ((a (mal-value ast)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (unless a (throw 'return ast)) - (cl-case (mal-value (car a)) + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) (def! - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) (let* - (let ((env* (mal-env env)) - (bindings (mal-listify a1)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) (setq env env* ast form))) ; TCO (quote - (throw 'return a1)) + (setq return (cadr a))) (quasiquote - (setq ast (quasiquote a1))) ; TCO + (setq ast (quasiquote (cadr a)))) ; TCO (defmacro! - (let ((identifier (mal-value a1)) - (value (mal-macro (EVAL a2 env)))) - (throw 'return (mal-env-set env identifier value)))) + (let ((identifier (mal-symbol-value (cadr a))) + (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) + (setq return (mal-env-set env identifier value)))) (try* + (if (cddr a) (condition-case err - (throw 'return (EVAL a1 env)) + (setq return (EVAL (cadr a) env)) (error - (if (and a2 (eq (mal-value (car (mal-value a2))) 'catch*)) - (let* ((a2* (mal-value a2)) - (identifier (mal-value (cadr a2*))) - (form (nth 2 a2*)) + (let* ((a2* (mal-list-value (caddr a))) + (identifier (mal-symbol-value (cadr a2*))) + (form (caddr a2*)) (err* (if (eq (car err) 'mal-custom) ;; throw (cadr err) ;; normal error (mal-string (error-message-string err)))) - (env* (mal-env env (list identifier) (list err*)))) - (throw 'return (EVAL form env*))) - (signal (car err) (cdr err)))))) + (env* (mal-env env))) + (mal-env-set env* identifier err*) + (setq env env* + ast form)))) ; TCO + (setq ast (cadr a)))) ; TCO (do - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (mapcar (lambda (item) (EVAL item env)) butlast) - (setq ast last))) ; TCO + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO (if - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO (fn* - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) + (EVAL body (mal-env env binds args))) + body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) - (args (cdr a))) - (if (mal-func-p fn) - (if (mal-func-macro-p fn) - (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO - (let ((env* (mal-env (mal-func-env fn) + (args (cdr a)) + fn*) + (cond + ((setq fn* (mal-macro-value fn)) + (setq ast (apply fn* args))) ; TCO + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) (mal-func-params fn) - (mapcar (lambda (x) (EVAL x env)) args)))) - (setq env env* - ast (mal-func-ast fn)))) ; TCO + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) - args)))))))))) - (symbol - (let ((key (mal-value ast))) - (throw 'return (or (mal-env-get env key) - (error "'%s' not found" key))))) - (vector - (throw 'return + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast)))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (throw 'return (mal-map map)))) + (setq return (mal-map map)))) (t ;; return as is - (throw 'return ast)))))) + (setq return ast)))) -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + ;; End of the TCO loop + return)) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") -(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)))))))") - (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) (defmacro with-error-handling (&rest body) @@ -198,17 +179,31 @@ (println (error-message-string err))))) (defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + (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)))))))" repl-env) + (if argv (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (while (not eof) - (let ((input (readln "user> "))) - (if input + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (while (setq input (readln "user> ")) (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) (main) diff --git a/impls/elisp/stepA_mal.el b/impls/elisp/stepA_mal.el index 5ceb4d6dcd..534471f530 100644 --- a/impls/elisp/stepA_mal.el +++ b/impls/elisp/stepA_mal.el @@ -2,184 +2,164 @@ (require 'cl-lib) (require 'mal/types) -(require 'mal/func) (require 'mal/env) (require 'mal/reader) (require 'mal/printer) (require 'mal/core) -(defvar repl-env (mal-env)) - -(dolist (binding core-ns) - (let ((symbol (car binding)) - (fn (cdr binding))) - (mal-env-set repl-env symbol fn))) - -(defun starts-with-p (ast sym) - (let ((l (mal-value ast))) - (and l - (let ((s (car l))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))))) - (defun qq-reducer (elt acc) - (mal-list (if (and (mal-list-p elt) - (starts-with-p elt 'splice-unquote)) - (list (mal-symbol 'concat) (cadr (mal-value elt)) acc) - (list (mal-symbol 'cons) (quasiquote elt) acc)))) + (let ((value (mal-list-value elt))) + (mal-list (if (eq 'splice-unquote (mal-symbol-value (car value))) + (list (mal-symbol 'concat) (cadr value) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc))))) (defun qq-iter (elts) (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) (defun quasiquote (ast) - (cl-case (mal-type ast) - (list (if (starts-with-p ast 'unquote) - (cadr (mal-value ast)) - (qq-iter (mal-value ast)))) - (vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast))))) - ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) - (t ast))) + (let (value) + (cond + ((setq value (mal-list-value ast)) ; not empty + (if (eq 'unquote (mal-symbol-value (car value))) + (cadr value) + (qq-iter value))) + ((setq value (mal-vector-value ast)) + (mal-list (list (mal-symbol 'vec) (qq-iter value)))) + ((or (mal-map-value ast) + (mal-symbol-value ast)) + (mal-list (list (mal-symbol 'quote) ast))) + (t ; including the empty list case + ast)))) (defun READ (input) (read-str input)) (defun EVAL (ast env) - (catch 'return - (while t + (let (return a) + (while (not return) (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) - (if (and dbgeval - (not (member (mal-type dbgeval) '(false nil)))) + (if (not (memq dbgeval (list nil mal-nil mal-false))) (println "EVAL: %s\n" (PRINT ast)))) - (cl-case (mal-type ast) + (cond - (list - (let* ((a (mal-value ast)) - (a1 (cadr a)) - (a2 (nth 2 a)) - (a3 (nth 3 a))) - (unless a (throw 'return ast)) - (cl-case (mal-value (car a)) + ((setq a (mal-list-value ast)) + (cl-case (mal-symbol-value (car a)) (def! - (let ((identifier (mal-value a1)) - (value (EVAL a2 env))) - (throw 'return (mal-env-set env identifier value)))) + (let ((identifier (mal-symbol-value (cadr a))) + (value (EVAL (caddr a) env))) + (setq return (mal-env-set env identifier value)))) (let* - (let ((env* (mal-env env)) - (bindings (mal-listify a1)) - (form a2)) - (while bindings - (let ((key (mal-value (pop bindings))) - (value (EVAL (pop bindings) env*))) - (mal-env-set env* key value))) + (let ((env* (mal-env env)) + (bindings (mal-seq-value (cadr a))) + (form (caddr a)) + key) + (seq-do (lambda (current) + (if key + (let ((value (EVAL current env*))) + (mal-env-set env* key value) + (setq key nil)) + (setq key (mal-symbol-value current)))) + bindings) (setq env env* ast form))) ; TCO (quote - (throw 'return a1)) + (setq return (cadr a))) (quasiquote - (setq ast (quasiquote a1))) ; TCO + (setq ast (quasiquote (cadr a)))) ; TCO (defmacro! - (let ((identifier (mal-value a1)) - (value (mal-macro (EVAL a2 env)))) - (throw 'return (mal-env-set env identifier value)))) + (let ((identifier (mal-symbol-value (cadr a))) + (value (mal-macro (mal-func-value (EVAL (caddr a) env))))) + (setq return (mal-env-set env identifier value)))) (try* + (if (cddr a) (condition-case err - (throw 'return (EVAL a1 env)) + (setq return (EVAL (cadr a) env)) (error - (if (and a2 (eq (mal-value (car (mal-value a2))) 'catch*)) - (let* ((a2* (mal-value a2)) - (identifier (mal-value (cadr a2*))) - (form (nth 2 a2*)) + (let* ((a2* (mal-list-value (caddr a))) + (identifier (mal-symbol-value (cadr a2*))) + (form (caddr a2*)) (err* (if (eq (car err) 'mal-custom) ;; throw (cadr err) ;; normal error (mal-string (error-message-string err)))) - (env* (mal-env env (list identifier) (list err*)))) - (throw 'return (EVAL form env*))) - (signal (car err) (cdr err)))))) + (env* (mal-env env))) + (mal-env-set env* identifier err*) + (setq env env* + ast form)))) ; TCO + (setq ast (cadr a)))) ; TCO (do - (let* ((a0... (cdr a)) - (butlast (butlast a0...)) - (last (car (last a0...)))) - (mapcar (lambda (item) (EVAL item env)) butlast) - (setq ast last))) ; TCO + (setq a (cdr a)) ; skip 'do + (while (cdr a) + (EVAL (pop a) env)) + (setq ast (car a))) ; TCO (if - (let* ((condition (EVAL a1 env)) - (condition-type (mal-type condition)) - (then a2) - (else a3)) - (if (and (not (eq condition-type 'false)) - (not (eq condition-type 'nil))) - (setq ast then) ; TCO - (if else - (setq ast else) ; TCO - (throw 'return mal-nil))))) + (let ((condition (EVAL (cadr a) env))) + (if (memq condition (list mal-nil mal-false)) + (if (cdddr a) + (setq ast (cadddr a)) ; TCO + (setq return mal-nil)) + (setq ast (caddr a))))) ; TCO (fn* - (let* ((binds (mapcar 'mal-value (mal-value a1))) - (body a2) - (fn (mal-fn + (let ((binds (mapcar 'mal-symbol-value (mal-seq-value (cadr a)))) + (body (caddr a))) + (setq return (mal-func (lambda (&rest args) - (let ((env* (mal-env env binds args))) - (EVAL body env*)))))) - (throw 'return (mal-func body binds env fn)))) + (EVAL body (mal-env env binds args))) + body binds env)))) (t ;; not a special form (let ((fn (EVAL (car a) env)) - (args (cdr a))) - (if (mal-func-p fn) - (if (mal-func-macro-p fn) - (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO - (let ((env* (mal-env (mal-func-env fn) + (args (cdr a)) + fn*) + (cond + ((setq fn* (mal-macro-value fn)) + (setq ast (apply fn* args))) ; TCO + ((mal-func-value fn) + (setq env (mal-env (mal-func-env fn) (mal-func-params fn) - (mapcar (lambda (x) (EVAL x env)) args)))) - (setq env env* - ast (mal-func-ast fn)))) ; TCO + (mapcar (lambda (x) (EVAL x env)) args)) + ast (mal-func-body fn))) ; TCO + ((setq fn* (mal-fn-core-value fn)) ;; built-in function - (let ((fn* (mal-value fn))) - (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) - args)))))))))) - (symbol - (let ((key (mal-value ast))) - (throw 'return (or (mal-env-get env key) - (error "'%s' not found" key))))) - (vector - (throw 'return + (setq return (apply fn* (mapcar (lambda (x) (EVAL x env)) args)))) + (t (error "cannot apply %s" (PRINT ast)))))))) + ((setq a (mal-symbol-value ast)) + (setq return (or (mal-env-get env a) + (error "'%s' not found" a)))) + ((setq a (mal-vector-value ast)) + (setq return (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) - (mal-value ast)))))) - (map - (let ((map (copy-hash-table (mal-value ast)))) + a))))) + ((setq a (mal-map-value ast)) + (let ((map (copy-hash-table a))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (throw 'return (mal-map map)))) + (setq return (mal-map map)))) (t ;; return as is - (throw 'return ast)))))) + (setq return ast)))) -(mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) -(mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) -(mal-env-set repl-env '*host-language* (mal-string "elisp")) + ;; End of the TCO loop + return)) (defun PRINT (input) (pr-str input t)) -(defun rep (input) +(defun rep (input repl-env) (PRINT (EVAL (READ input) repl-env))) -(rep "(def! not (fn* (a) (if a false true)))") -(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") -(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)))))))") - (defun readln (prompt) ;; C-d throws an error (ignore-errors (read-from-minibuffer prompt))) (defun println (format-string &rest args) - (if (not args) - (princ format-string) - (princ (apply 'format format-string args))) + (princ (if args + (apply 'format format-string args) + format-string)) (terpri)) (defmacro with-error-handling (&rest body) @@ -199,18 +179,33 @@ (println (error-message-string err))))) (defun main () + (defvar repl-env (mal-env)) + + (dolist (binding core-ns) + (let ((symbol (car binding)) + (fn (cdr binding))) + (mal-env-set repl-env symbol (mal-fn-core fn)))) + + (mal-env-set repl-env 'eval (mal-fn-core (byte-compile (lambda (form) (EVAL form repl-env))))) + (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) + (mal-env-set repl-env '*host-language* (mal-string "elisp")) + + (rep "(def! not (fn* (a) (if a false true)))" repl-env) + (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) + \"\nnil)\")))))" repl-env) + (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)))))))" repl-env) + (if argv (with-error-handling - (rep (format "(load-file \"%s\")" (car argv)))) - (let (eof) - (rep "(println (str \"Mal [\" *host-language* \"]\"))") - (while (not eof) - (let ((input (readln "user> "))) - (if input + (rep (format "(load-file \"%s\")" (car argv)) repl-env)) + (let (input) + (rep "(println (str \"Mal [\" *host-language* \"]\"))" repl-env) + (while (setq input (readln "user> ")) (with-error-handling - (println (rep input))) - (setq eof t) - ;; print final newline - (terpri))))))) + (println (rep input repl-env)))) + ;; print final newline + (terpri)))) (main) From dd14d8e8ae812e1537a018717342940d45f9d1bf Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 26 Aug 2024 13:55:30 +0200 Subject: [PATCH 2/5] elisp: require a recent emacs version --- impls/elisp/Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/elisp/Dockerfile b/impls/elisp/Dockerfile index 0085431a6b..e9b8ba0c21 100644 --- a/impls/elisp/Dockerfile +++ b/impls/elisp/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:20.04 +FROM ubuntu:24.04 MAINTAINER Joel Martin ########################################################## From 13a38f07bd40c2ee0c28cb592c3187629ac5a461 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 24 Aug 2024 14:22:35 +0200 Subject: [PATCH 3/5] powershell: merge eval-ast and fix a few tests Fix (false? 1) and (true? 0). Change the type of the env.{find,get,set} key to a raw string. Merge eval-ast into EVAL. Implement DEBUG-EVAL. Prevent defmacro! from mutating the original function. --- impls/powershell/core.psm1 | 4 +- impls/powershell/env.psm1 | 8 +-- impls/powershell/run | 2 +- impls/powershell/step2_eval.ps1 | 17 +++---- impls/powershell/step3_env.ps1 | 39 ++++++++------- impls/powershell/step4_if_fn_do.ps1 | 38 +++++++++------ impls/powershell/step5_tco.ps1 | 43 ++++++++-------- impls/powershell/step6_file.ps1 | 47 +++++++++--------- impls/powershell/step7_quote.ps1 | 50 +++++++++---------- impls/powershell/step8_macros.ps1 | 76 +++++++++++------------------ impls/powershell/step9_try.ps1 | 76 +++++++++++------------------ impls/powershell/stepA_mal.ps1 | 76 +++++++++++------------------ 12 files changed, 216 insertions(+), 260 deletions(-) diff --git a/impls/powershell/core.psm1 b/impls/powershell/core.psm1 index 9fbd1ce24c..fee0ca9b71 100644 --- a/impls/powershell/core.psm1 +++ b/impls/powershell/core.psm1 @@ -109,8 +109,8 @@ $core_ns = @{ "throw" = Get-Command mal_throw; "nil?" = { param($a); $a -eq $null }; - "true?" = { param($a); $a -eq $true }; - "false?" = { param($a); $a -eq $false }; + "true?" = { param($a); $a -is [Boolean] -and $a -eq $true }; + "false?" = { param($a); $a -is [Boolean] -and $a -eq $false }; "number?" = { param($a); $a -is [int32] }; "string?" = { param($a); string? $a }; "symbol" = Get-Command new-symbol; diff --git a/impls/powershell/env.psm1 b/impls/powershell/env.psm1 index deb10fd563..60d90abe80 100644 --- a/impls/powershell/env.psm1 +++ b/impls/powershell/env.psm1 @@ -27,12 +27,12 @@ Class Env { } [Object] set($key, $value) { - $this.data[$key.value] = $value + $this.data[$key] = $value return $value } [Env] find($key) { - if ($this.data.Contains($key.value)) { + if ($this.data.Contains($key)) { return $this } elseif ($this.outer -ne $null) { return $this.outer.find($key) @@ -44,9 +44,9 @@ Class Env { [Object] get($key) { $e = $this.find($key) if ($e -ne $null) { - return $e.data[$key.value] + return $e.data[$key] } else { - throw "'$($key.value)' not found" + throw "'$($key)' not found" } } } diff --git a/impls/powershell/run b/impls/powershell/run index 4a52cc6ac3..7adde42817 100755 --- a/impls/powershell/run +++ b/impls/powershell/run @@ -1,2 +1,2 @@ -#!/bin/bash +#!/bin/sh exec powershell $(dirname $0)/${STEP:-stepA_mal}.ps1 "${@}" diff --git a/impls/powershell/step2_eval.ps1 b/impls/powershell/step2_eval.ps1 index 175659ff7f..fda5246c32 100644 --- a/impls/powershell/step2_eval.ps1 +++ b/impls/powershell/step2_eval.ps1 @@ -10,11 +10,13 @@ function READ([String] $str) { } # EVAL -function eval_ast($ast, $env) { +function EVAL($ast, $env) { + # Write-Host "EVAL: $(pr_str $ast)" + if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { "Symbol" { return $env[$ast.value] } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -25,18 +27,11 @@ function eval_ast($ast, $env) { } default { return $ast } } -} -function EVAL($ast, $env) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) return &$f @fargs } diff --git a/impls/powershell/step3_env.ps1 b/impls/powershell/step3_env.ps1 index 251105a2fa..a1df5c9da5 100644 --- a/impls/powershell/step3_env.ps1 +++ b/impls/powershell/step3_env.ps1 @@ -11,11 +11,21 @@ function READ([String] $str) { } # EVAL -function eval_ast($ast, $env) { +function EVAL($ast, $env) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { - "Symbol" { return $env.get($ast) } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -26,31 +36,24 @@ function eval_ast($ast, $env) { } default { return $ast } } -} -function EVAL($ast, $env) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { - return $env.set($a1, (EVAL $a2 $env)) + return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { - $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env)) + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } return EVAL $a2 $let_env } default { - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) return &$f @fargs } } @@ -63,10 +66,10 @@ function PRINT($exp) { # REPL $repl_env = new-env -$_ = $repl_env.set((new-symbol "+"), { param($a, $b); $a + $b }) -$_ = $repl_env.set((new-symbol "-"), { param($a, $b); $a - $b }) -$_ = $repl_env.set((new-symbol "*"), { param($a, $b); $a * $b }) -$_ = $repl_env.set((new-symbol "/"), { param($a, $b); $a / $b }) +$_ = $repl_env.set("+", { param($a, $b); $a + $b }) +$_ = $repl_env.set("-", { param($a, $b); $a - $b }) +$_ = $repl_env.set("*", { param($a, $b); $a * $b }) +$_ = $repl_env.set("/", { param($a, $b); $a / $b }) function REP([String] $str) { return PRINT (EVAL (READ $str) $repl_env) diff --git a/impls/powershell/step4_if_fn_do.ps1 b/impls/powershell/step4_if_fn_do.ps1 index c75fbcb4db..06cdeff179 100644 --- a/impls/powershell/step4_if_fn_do.ps1 +++ b/impls/powershell/step4_if_fn_do.ps1 @@ -12,11 +12,21 @@ function READ([String] $str) { } # EVAL -function eval_ast($ast, $env) { +function EVAL($ast, $env) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { - "Symbol" { return $env.get($ast) } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -27,30 +37,26 @@ function eval_ast($ast, $env) { } default { return $ast } } -} -function EVAL($ast, $env) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { - return $env.set($a1, (EVAL $a2 $env)) + return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { - $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env)) + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } return EVAL $a2 $let_env } "do" { - return (eval_ast $ast.rest() $env).last() + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) + } + return (EVAL $ast.values[$i] $env) } "if" { $cond = (EVAL $a1 $env) @@ -69,8 +75,8 @@ function EVAL($ast, $env) { }.GetNewClosure() } default { - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) return &$f @fargs } } @@ -90,7 +96,7 @@ function REP([String] $str) { # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { - $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value) + $_ = $repl_env.set($kv.Key, $kv.Value) } # core.mal: defined using the language itself diff --git a/impls/powershell/step5_tco.ps1 b/impls/powershell/step5_tco.ps1 index 88166bcf1b..23466680a6 100644 --- a/impls/powershell/step5_tco.ps1 +++ b/impls/powershell/step5_tco.ps1 @@ -12,11 +12,23 @@ function READ([String] $str) { } # EVAL -function eval_ast($ast, $env) { +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { - "Symbol" { return $env.get($ast) } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -27,36 +39,27 @@ function eval_ast($ast, $env) { } default { return $ast } } -} -function EVAL($ast, $env) { - while ($true) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { - return $env.set($a1, (EVAL $a2 $env)) + return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { - $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env)) + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO } "do" { - if ($ast.values.Count -gt 2) { - $middle = new-list $ast.values[1..($ast.values.Count-2)] - $_ = eval_ast $middle $env + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) } - $ast = $ast.last() # TCO + $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) @@ -76,8 +79,8 @@ function EVAL($ast, $env) { return new-malfunc $a2 $a1.values $env $fn } default { - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO @@ -103,7 +106,7 @@ function REP([String] $str) { # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { - $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value) + $_ = $repl_env.set($kv.Key, $kv.Value) } # core.mal: defined using the language itself diff --git a/impls/powershell/step6_file.ps1 b/impls/powershell/step6_file.ps1 index 57b1397f62..5ea6951dbf 100644 --- a/impls/powershell/step6_file.ps1 +++ b/impls/powershell/step6_file.ps1 @@ -12,11 +12,23 @@ function READ([String] $str) { } # EVAL -function eval_ast($ast, $env) { +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { - "Symbol" { return $env.get($ast) } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -27,36 +39,27 @@ function eval_ast($ast, $env) { } default { return $ast } } -} -function EVAL($ast, $env) { - while ($true) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { - return $env.set($a1, (EVAL $a2 $env)) + return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { - $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env)) + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO } "do" { - if ($ast.values.Count -gt 2) { - $middle = new-list $ast.values[1..($ast.values.Count-2)] - $_ = eval_ast $middle $env + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) } - $ast = $ast.last() # TCO + $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) @@ -76,8 +79,8 @@ function EVAL($ast, $env) { return new-malfunc $a2 $a1.values $env $fn } default { - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO @@ -103,10 +106,10 @@ function REP([String] $str) { # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { - $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value) + $_ = $repl_env.set($kv.Key, $kv.Value) } -$_ = $repl_env.set((new-symbol "eval"), { param($a); (EVAL $a $repl_env) }) -$_ = $repl_env.set((new-symbol "*ARGV*"), (new-list $args[1..$args.Count])) +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') diff --git a/impls/powershell/step7_quote.ps1 b/impls/powershell/step7_quote.ps1 index 3bc3c01f74..6a52bc60e4 100644 --- a/impls/powershell/step7_quote.ps1 +++ b/impls/powershell/step7_quote.ps1 @@ -48,11 +48,23 @@ function quasiquote($ast) { } } -function eval_ast($ast, $env) { +function EVAL($ast, $env) { + + while ($true) { + + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } + } + if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { - "Symbol" { return $env.get($ast) } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -63,26 +75,18 @@ function eval_ast($ast, $env) { } default { return $ast } } -} -function EVAL($ast, $env) { - while ($true) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { - return $env.set($a1, (EVAL $a2 $env)) + return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { - $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env)) + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO @@ -90,18 +94,14 @@ function EVAL($ast, $env) { "quote" { return $a1 } - "quasiquoteexpand" { - return (quasiquote $a1) - } "quasiquote" { $ast = quasiquote $a1 } "do" { - if ($ast.values.Count -gt 2) { - $middle = new-list $ast.values[1..($ast.values.Count-2)] - $_ = eval_ast $middle $env + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) } - $ast = $ast.last() # TCO + $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) @@ -121,8 +121,8 @@ function EVAL($ast, $env) { return new-malfunc $a2 $a1.values $env $fn } default { - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO @@ -148,10 +148,10 @@ function REP([String] $str) { # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { - $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value) + $_ = $repl_env.set($kv.Key, $kv.Value) } -$_ = $repl_env.set((new-symbol "eval"), { param($a); (EVAL $a $repl_env) }) -$_ = $repl_env.set((new-symbol "*ARGV*"), (new-list $args[1..$args.Count])) +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') diff --git a/impls/powershell/step8_macros.ps1 b/impls/powershell/step8_macros.ps1 index f7d9a9cee3..b32e0dcc29 100644 --- a/impls/powershell/step8_macros.ps1 +++ b/impls/powershell/step8_macros.ps1 @@ -48,27 +48,23 @@ function quasiquote($ast) { } } -function macro?($ast, $env) { - return (list? $ast) -and - (symbol? $ast.nth(0)) -and - $env.find($ast.nth(0)) -and - $env.get($ast.nth(0)).macro -} +function EVAL($ast, $env) { + + while ($true) { -function macroexpand($ast, $env) { - while (macro? $ast $env) { - $mac = $env.get($ast.nth(0)).fn - $margs = $ast.rest().values - $ast = &$mac @margs + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } } - return $ast -} -function eval_ast($ast, $env) { if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { - "Symbol" { return $env.get($ast) } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -79,31 +75,18 @@ function eval_ast($ast, $env) { } default { return $ast } } -} - -function EVAL($ast, $env) { - while ($true) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } - $ast = (macroexpand $ast $env) - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { - return $env.set($a1, (EVAL $a2 $env)) + return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { - $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env)) + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO @@ -111,26 +94,20 @@ function EVAL($ast, $env) { "quote" { return $a1 } - "quasiquoteexpand" { - return (quasiquote $a1) - } "quasiquote" { $ast = quasiquote $a1 } "defmacro!" { $m = EVAL $a2 $env + $m = $m.copy() $m.macro = $true - return $env.set($a1, $m) - } - "macroexpand" { - return (macroexpand $a1 $env) + return $env.set($a1.value, $m) } "do" { - if ($ast.values.Count -gt 2) { - $middle = new-list $ast.values[1..($ast.values.Count-2)] - $_ = eval_ast $middle $env + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) } - $ast = $ast.last() # TCO + $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) @@ -150,8 +127,13 @@ function EVAL($ast, $env) { return new-malfunc $a2 $a1.values $env $fn } default { - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values) + if ($f.macro) { + $ast = &$f.fn @fargs # TCO + continue + } + $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO @@ -177,10 +159,10 @@ function REP([String] $str) { # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { - $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value) + $_ = $repl_env.set($kv.Key, $kv.Value) } -$_ = $repl_env.set((new-symbol "eval"), { param($a); (EVAL $a $repl_env) }) -$_ = $repl_env.set((new-symbol "*ARGV*"), (new-list $args[1..$args.Count])) +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') diff --git a/impls/powershell/step9_try.ps1 b/impls/powershell/step9_try.ps1 index 8c771285f9..648614ed4b 100644 --- a/impls/powershell/step9_try.ps1 +++ b/impls/powershell/step9_try.ps1 @@ -48,27 +48,23 @@ function quasiquote($ast) { } } -function macro?($ast, $env) { - return (list? $ast) -and - (symbol? $ast.nth(0)) -and - $env.find($ast.nth(0)) -and - $env.get($ast.nth(0)).macro -} +function EVAL($ast, $env) { + + while ($true) { -function macroexpand($ast, $env) { - while (macro? $ast $env) { - $mac = $env.get($ast.nth(0)).fn - $margs = $ast.rest().values - $ast = &$mac @margs + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } } - return $ast -} -function eval_ast($ast, $env) { if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { - "Symbol" { return $env.get($ast) } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -79,31 +75,18 @@ function eval_ast($ast, $env) { } default { return $ast } } -} - -function EVAL($ast, $env) { - while ($true) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } - $ast = (macroexpand $ast $env) - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { - return $env.set($a1, (EVAL $a2 $env)) + return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { - $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env)) + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO @@ -111,19 +94,14 @@ function EVAL($ast, $env) { "quote" { return $a1 } - "quasiquoteexpand" { - return (quasiquote $a1) - } "quasiquote" { $ast = quasiquote $a1 } "defmacro!" { $m = EVAL $a2 $env + $m = $m.copy() $m.macro = $true - return $env.set($a1, $m) - } - "macroexpand" { - return (macroexpand $a1 $env) + return $env.set($a1.value, $m) } "try*" { try { @@ -142,11 +120,10 @@ function EVAL($ast, $env) { } } "do" { - if ($ast.values.Count -gt 2) { - $middle = new-list $ast.values[1..($ast.values.Count-2)] - $_ = eval_ast $middle $env + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) } - $ast = $ast.last() # TCO + $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) @@ -166,8 +143,13 @@ function EVAL($ast, $env) { return new-malfunc $a2 $a1.values $env $fn } default { - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values) + if ($f.macro) { + $ast = &$f.fn @fargs # TCO + continue + } + $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO @@ -193,10 +175,10 @@ function REP([String] $str) { # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { - $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value) + $_ = $repl_env.set($kv.Key, $kv.Value) } -$_ = $repl_env.set((new-symbol "eval"), { param($a); (EVAL $a $repl_env) }) -$_ = $repl_env.set((new-symbol "*ARGV*"), (new-list $args[1..$args.Count])) +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! not (fn* (a) (if a false true)))') diff --git a/impls/powershell/stepA_mal.ps1 b/impls/powershell/stepA_mal.ps1 index bdbb856e19..ec7fb5331f 100644 --- a/impls/powershell/stepA_mal.ps1 +++ b/impls/powershell/stepA_mal.ps1 @@ -48,27 +48,23 @@ function quasiquote($ast) { } } -function macro?($ast, $env) { - return (list? $ast) -and - (symbol? $ast.nth(0)) -and - $env.find($ast.nth(0)) -and - $env.get($ast.nth(0)).macro -} +function EVAL($ast, $env) { + + while ($true) { -function macroexpand($ast, $env) { - while (macro? $ast $env) { - $mac = $env.get($ast.nth(0)).fn - $margs = $ast.rest().values - $ast = &$mac @margs + $dbgeval_env = ($env.find("DEBUG-EVAL")) + if ($dbgeval_env -ne $null) { + $dbgeval = $dbgeval_env.get("DEBUG-EVAL") + if ($dbgeval -ne $null -and + -not ($dbgeval -is [Boolean] -and $dbgeval -eq $false)) { + Write-Host "EVAL: $(pr_str $ast)" + } } - return $ast -} -function eval_ast($ast, $env) { if ($ast -eq $null) { return $ast } switch ($ast.GetType().Name) { - "Symbol" { return $env.get($ast) } - "List" { return new-list @($ast.values | ForEach-Object { EVAL $_ $env }) } + "Symbol" { return $env.get($ast.value) } + "List" { } # continue after the switch "Vector" { return new-vector @($ast.values | ForEach-Object { EVAL $_ $env }) } "HashMap" { $hm = new-hashmap @() @@ -79,31 +75,18 @@ function eval_ast($ast, $env) { } default { return $ast } } -} - -function EVAL($ast, $env) { - while ($true) { - # Write-Host "EVAL: $(pr_str $ast)" - if ($ast -eq $null) { return $ast } - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } - $ast = (macroexpand $ast $env) - if (-not (list? $ast)) { - return (eval_ast $ast $env) - } if (empty? $ast) { return $ast } $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2) switch -casesensitive ($a0.value) { "def!" { - return $env.set($a1, (EVAL $a2 $env)) + return $env.set($a1.value, (EVAL $a2 $env)) } "let*" { $let_env = new-env $env for ($i=0; $i -lt $a1.values.Count; $i+=2) { - $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env)) + $_ = $let_env.set($a1.nth($i).value, (EVAL $a1.nth(($i+1)) $let_env)) } $env = $let_env $ast = $a2 # TCO @@ -111,19 +94,14 @@ function EVAL($ast, $env) { "quote" { return $a1 } - "quasiquoteexpand" { - return (quasiquote $a1) - } "quasiquote" { $ast = quasiquote $a1 } "defmacro!" { $m = EVAL $a2 $env + $m = $m.copy() $m.macro = $true - return $env.set($a1, $m) - } - "macroexpand" { - return (macroexpand $a1 $env) + return $env.set($a1.value, $m) } "try*" { try { @@ -142,11 +120,10 @@ function EVAL($ast, $env) { } } "do" { - if ($ast.values.Count -gt 2) { - $middle = new-list $ast.values[1..($ast.values.Count-2)] - $_ = eval_ast $middle $env + for ($i=1; $i -lt ($ast.values.Count - 1); $i+=1) { + $_ = (EVAL $ast.values[$i] $env) } - $ast = $ast.last() # TCO + $ast = $ast.values[$i] # TCO } "if" { $cond = (EVAL $a1 $env) @@ -166,8 +143,13 @@ function EVAL($ast, $env) { return new-malfunc $a2 $a1.values $env $fn } default { - $el = (eval_ast $ast $env) - $f, $fargs = $el.first(), $el.rest().values + $f = ( EVAL $ast.first() $env ) + $fargs = @($ast.rest().values) + if ($f.macro) { + $ast = &$f.fn @fargs # TCO + continue + } + $fargs = @($fargs | ForEach-Object { EVAL $_ $env }) if (malfunc? $f) { $env = (new-env $f.env $f.params $fargs) $ast = $f.ast # TCO @@ -193,10 +175,10 @@ function REP([String] $str) { # core.EXT: defined using PowerShell foreach ($kv in $core_ns.GetEnumerator()) { - $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value) + $_ = $repl_env.set($kv.Key, $kv.Value) } -$_ = $repl_env.set((new-symbol "eval"), { param($a); (EVAL $a $repl_env) }) -$_ = $repl_env.set((new-symbol "*ARGV*"), (new-list $args[1..$args.Count])) +$_ = $repl_env.set("eval", { param($a); (EVAL $a $repl_env) }) +$_ = $repl_env.set("*ARGV*", (new-list $args[1..$args.Count])) # core.mal: defined using the language itself $_ = REP('(def! *host-language* "powershell")') From 0cf67241bb8e93da359e8564f9f64e241462232a Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 26 Aug 2024 19:31:26 +0200 Subject: [PATCH 4/5] powershell: select Ubuntu 16.04 Docker image --- impls/powershell/Dockerfile | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/impls/powershell/Dockerfile b/impls/powershell/Dockerfile index f4649a6172..b2027b1fb0 100644 --- a/impls/powershell/Dockerfile +++ b/impls/powershell/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +FROM ubuntu:16.04 MAINTAINER Joel Martin ########################################################## @@ -26,11 +26,8 @@ RUN apt-get -y install libunwind8 libicu52 #RUN apt-get -y install libunwind8 libicu55 # For dist packaging -RUN curl -L -O https://github.com/PowerShell/PowerShell/releases/download/v6.0.0-alpha.9/powershell_6.0.0-alpha.9-1ubuntu1.14.04.1_amd64.deb && \ - dpkg -i powershell_6.0.0-alpha.9-1ubuntu1.14.04.1_amd64.deb && \ - rm powershell_6.0.0-alpha.9-1ubuntu1.14.04.1_amd64.deb -#RUN curl -L -O https://github.com/PowerShell/PowerShell/releases/download/v6.0.0-alpha.9/powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \ -# dpkg -i powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \ -# rm powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb +RUN curl -L -O https://github.com/PowerShell/PowerShell/releases/download/v6.0.0-alpha.9/powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \ + dpkg -i powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \ + rm powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb ENV HOME=/mal From 934708ea3499e7de21742f443465123e302d432b Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Mon, 26 Aug 2024 13:04:46 -0500 Subject: [PATCH 5/5] Update Dockerfile --- impls/powershell/Dockerfile | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/impls/powershell/Dockerfile b/impls/powershell/Dockerfile index b2027b1fb0..1ecddb9d35 100644 --- a/impls/powershell/Dockerfile +++ b/impls/powershell/Dockerfile @@ -22,8 +22,7 @@ WORKDIR /mal ########################################################## # Nothing additional needed for python -RUN apt-get -y install libunwind8 libicu52 -#RUN apt-get -y install libunwind8 libicu55 +RUN apt-get -y install libunwind8 libicu55 # For dist packaging RUN curl -L -O https://github.com/PowerShell/PowerShell/releases/download/v6.0.0-alpha.9/powershell_6.0.0-alpha.9-1ubuntu1.16.04.1_amd64.deb && \