Skip to content

Instantly share code, notes, and snippets.

@iamgreaser
Last active March 1, 2022 20:23
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save iamgreaser/4497a6d0ac0b8f70d74d6ea3ce169bdc to your computer and use it in GitHub Desktop.
Save iamgreaser/4497a6d0ac0b8f70d74d6ea3ce169bdc to your computer and use it in GitHub Desktop.
infix notation for common lisp - first reader macro attempt
;; vim: set sts=2 sw=2 et sm lisp :
(defvar *reading-a-list* nil)
(defun read-terminator (stream char)
(declare (ignore stream))
(error (format nil "unexpected ~S" char)))
(defun get-infix-precedence (symbol)
(case symbol
((+ -) 1)
((* /) 2)
(t nil)))
(defun walk-infix-list (list)
(block x
;; needs 3 args
(unless (nthcdr 1 list)
(return-from x list))
;(format t "has 3 args~%")
;; second arg must be a symbol
(unless (symbolp (nth 1 list))
(return-from x list))
;(format t "second arg is a symbol~%")
(let* ((precedence
(get-infix-precedence
(nth 1 list))))
;(format t "precedence ~a~%" precedence)
(unless precedence
(return-from x list))
(process-infix-list
`((,(nth 1 list)
,(nth 0 list)
,(nth 2 list))
,@(nthcdr 3 list))))))
(defun process-infix-list/walk (list)
(case (car list)
((let let*)
;(format t "let ~s~%" list)
`(,(nth 0 list)
,(mapcar
#'(lambda (x)
(if (consp x)
`(,(nth 0 x)
,(process-infix-list
(nth 1 x)))
x))
(nth 1 list))
,@(mapcar #'process-infix-list
(nthcdr 2 list))))
(t (walk-infix-list
(mapcar #'process-infix-list
list)))))
(defun process-infix-list (list)
(block x
(when *reading-a-list*
(return-from x list))
;(format t "process ~s~%" list)
(unless (consp list)
(return-from x list))
(let* ((list
(process-infix-list/walk list)))
;(format t "walked list ~s~%" list)
(if (and list
(not (cdr list)))
(progn
;(format t "descend list ~s~%" list)
(car list))
list))))
(defun read-infix-list (stream char)
(declare (ignore char))
;; Parse list as usual.
;(error "derp")
(process-infix-list
(do ((acc (list)))
((eql #\) (peek-char t stream t nil t))
(read-char stream t nil t)
(reverse acc))
(let* ((*reading-a-list* t))
(push (read stream t nil t) acc)))))
(progn
(set-macro-character #\( #'read-infix-list)
(set-macro-character #\) #'read-terminator)
(format t "Installed!~%"))
(format t "~a~%" (2 + 2))
(format t "~a~%" ((1 * 2) + (3 * 4) + (5 * 6)))
(format t "~a~%" (1 * 2 + 3 * 4))
(format t "~a~%" (let ((x 3)) x))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment