kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-11-10 12:47:45 +03:00
Code Issues Projects Releases Wiki Activity

Implement print_readably, completes step 4

Browse Source
This commit is contained in:
Iqbal Ansari 2016-08-19 17:11:21 +05:30 committed by Iqbal Ansari
parent dc1a9c479f
commit e7337b4cd0
4 changed files with 83 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
common_lisp/core.lisp
View File

@ -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)

37
common_lisp/printer.lisp
View File

@ -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 "#<function>")
(types:builtin-fn "#<builtin function>"))))

25
common_lisp/reader.lisp
View File

@ -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")))

20
common_lisp/utils.lisp Normal file
View File

@ -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)))