From e7337b4cd01ab27fbb556e099882573fb74a2741 Mon Sep 17 00:00:00 2001 From: Iqbal Ansari Date: Fri, 19 Aug 2016 17:11:21 +0530 Subject: [PATCH] Implement print_readably, completes step 4 --- common_lisp/core.lisp | 37 ++++++++++++++++++++++++++++++++----- common_lisp/printer.lisp | 37 ++++++++++++++++++++++++------------- common_lisp/reader.lisp | 25 +++++++------------------ common_lisp/utils.lisp | 20 ++++++++++++++++++++ 4 files changed, 83 insertions(+), 36 deletions(-) create mode 100644 common_lisp/utils.lisp diff --git a/common_lisp/core.lisp b/common_lisp/core.lisp index c6b03c25..e9ee10c7 100644 --- a/common_lisp/core.lisp +++ b/common_lisp/core.lisp @@ -1,7 +1,8 @@ -(load "types") +(require "types") +(require "printer") (defpackage :core - (:use :common-lisp :types) + (:use :common-lisp :types :printer) (:export :ns)) (in-package :core) @@ -24,9 +25,35 @@ (types:make-mal-builtin-fn (lambda (value1 value2) (types:apply-unwrapped-values '/ value1 value2)))) - (cons (types:make-mal-symbol '|list|) - (types:make-mal-builtin-fn (lambda (&rest values) - (make-mal-list values)))) + (cons (types:make-mal-symbol '|prn|) + (types:make-mal-builtin-fn (lambda (&rest strings) + (write-line (format nil + "~{~a~^ ~}" + (mapcar (lambda (string) (printer:pr-str string t)) + strings))) + (types:make-mal-nil nil)))) + + (cons (types:make-mal-symbol '|println|) + (types:make-mal-builtin-fn (lambda (&rest strings) + (write-line (format nil + "~{~a~^ ~}" + (mapcar (lambda (string) (printer:pr-str string nil)) + strings))) + (types:make-mal-nil nil)))) + + (cons (types:make-mal-symbol '|pr-str|) + (types:make-mal-builtin-fn (lambda (&rest strings) + (types:make-mal-string (format nil + "~{~a~^ ~}" + (mapcar (lambda (string) (printer:pr-str string t)) + strings)))))) + + (cons (types:make-mal-symbol '|str|) + (types:make-mal-builtin-fn (lambda (&rest strings) + (types:make-mal-string (format nil + "~{~a~}" + (mapcar (lambda (string) (printer:pr-str string nil)) + strings)))))) (cons (types:make-mal-symbol '|list?|) (types:make-mal-builtin-fn (lambda (value) diff --git a/common_lisp/printer.lisp b/common_lisp/printer.lisp index 18a3c1cc..15c0e65f 100644 --- a/common_lisp/printer.lisp +++ b/common_lisp/printer.lisp @@ -1,46 +1,57 @@ (require "types") +(require "utils") (defpackage :printer - (:use :common-lisp :types) + (:use :common-lisp :utils :types) (:export :pr-str)) (in-package :printer) -(defun pr-mal-sequence (start-delimiter sequence end-delimiter) +(defun pr-mal-sequence (start-delimiter sequence end-delimiter &optional (print-readably t)) (concatenate 'string start-delimiter (format nil - "~{~A~^ ~}" - (map 'list #'pr-str (types:mal-value sequence))) + "~{~a~^ ~}" + (map 'list (lambda (value) + (pr-str value print-readably)) + (types:mal-value sequence))) end-delimiter)) -(defun pr-mal-hash-map (hash-map) +(defun pr-mal-hash-map (hash-map &optional (print-readably t)) (let ((hash-map-value (types:mal-value hash-map))) (concatenate 'string "{" (format nil - "~{~A~^ ~}" + "~{~a~^ ~}" (mapcar (lambda (key-value) (format nil "~a ~a" - (pr-str (car key-value)) - (pr-str (cdr key-value)))) + (pr-str (car key-value) print-readably) + (pr-str (cdr key-value) print-readably))) (loop for key being the hash-keys of hash-map-value collect (cons key (gethash key hash-map-value))))) "}"))) -(defun pr-str (ast) +(defun pr-string (ast &optional (print-readably t)) + (if print-readably + (utils:replace-all (prin1-to-string (types:mal-value ast)) + " +" + "\\n") + (types:mal-value ast))) + +(defun pr-str (ast &optional (print-readably t)) (when ast (switch-mal-type ast (types:number (format nil "~d" (types:mal-value ast))) (types:boolean (if (types:mal-value ast) "true" "false")) (types:nil "nil") - (types:string (format nil "~s" (types:mal-value ast))) + (types:string (pr-string ast print-readably)) (types:symbol (format nil "~a" (types:mal-value ast))) (types:keyword (format nil ":~a" (types:mal-value ast))) - (types:list (pr-mal-sequence "(" ast ")")) - (types:vector (pr-mal-sequence "[" ast "]")) - (types:hash-map (pr-mal-hash-map ast)) + (types:list (pr-mal-sequence "(" ast ")" print-readably)) + (types:vector (pr-mal-sequence "[" ast "]" print-readably)) + (types:hash-map (pr-mal-hash-map ast print-readably)) (types:fn "#") (types:builtin-fn "#")))) diff --git a/common_lisp/reader.lisp b/common_lisp/reader.lisp index e34b6bec..82d3b639 100644 --- a/common_lisp/reader.lisp +++ b/common_lisp/reader.lisp @@ -1,7 +1,8 @@ (require "types") +(require "utils") (defpackage :reader - (:use :regexp :common-lisp :types) + (:use :common-lisp :regexp :utils :types) (:export :read-str :eof)) @@ -23,26 +24,14 @@ "EOF encountered while reading ~a" (context condition))))) -(defun replace-all (string part replacement &key (test #'char=)) -"Returns a new string in which all the occurences of the part -is replaced with replacement." - (with-output-to-string (out) - (loop with part-length = (length part) - for old-pos = 0 then (+ pos part-length) - for pos = (search part string - :start2 old-pos - :test test) - do (write-string string out - :start old-pos - :end (or pos (length string))) - when pos do (write-string replacement out) - while pos))) - (defun parse-string (token) (if (and (> (length token) 1) (regexp:match *string-re* token)) - (read-from-string (replace-all token "\\n" " -")) + (progn + (read-from-string (utils:replace-all token + "\\n" + " +"))) ;; A bit inaccurate (error 'eof :context "string"))) diff --git a/common_lisp/utils.lisp b/common_lisp/utils.lisp new file mode 100644 index 00000000..0ba81e70 --- /dev/null +++ b/common_lisp/utils.lisp @@ -0,0 +1,20 @@ +(defpackage :utils + (:use :common-lisp) + (:export :replace-all)) + +(in-package :utils) + +(defun replace-all (string part replacement &key (test #'char=)) + "Returns a new string in which all the occurences of the part +is replaced with replacement." + (with-output-to-string (out) + (loop with part-length = (length part) + for old-pos = 0 then (+ pos part-length) + for pos = (search part string + :start2 old-pos + :test test) + do (write-string string out + :start old-pos + :end (or pos (length string))) + when pos do (write-string replacement out) + while pos)))