Skip to content

Commit

Permalink
varjo.import: Replace optima with trivia
Browse files Browse the repository at this point in the history
As mentioned in
https://github.com/fare/fare-quasiquote
"trivia's predecessors optima and fare-matcher used to be supported, but both have long been deprecated."

Solves
cbaggers#240
varjo.import build failure

http://report.quicklisp.org/2020-12-19/failure-report/varjo.html#varjo.import
; caught ERROR:
;   during macroexpansion of (MATCH FORM (# X) ...). Use *BREAK-ON-SIGNALS* to intercept.
;    Non-linear pattern: (STRUCTURE FARE-QUASIQUOTE::LIST* (FARE-QUASIQUOTE::QUOTE LET*) (A A) (FARE-QUASIQUOTE::LIST* (AND (STRUCTURE FARE-QUASIQUOTE::QUOTE (LET* LET*)) B C)) (D D))
  • Loading branch information
Yan committed Dec 21, 2020
1 parent 800dfa5 commit ace9c74
Show file tree
Hide file tree
Showing 3 changed files with 17 additions and 18 deletions.
32 changes: 16 additions & 16 deletions import/import.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@
(defmacro assert-match (pattern arg &body body)
(with-gensyms (form)
`(let ((,form ,arg))
(optima.extra:if-match ,pattern ,form
(trivia:if-match ,pattern ,form
(progn ,@body)
(error "Match Assertion Failure:~%~%Pattern: ~s~%Form: ~s"
',pattern ,form)))))
Expand All @@ -41,7 +41,7 @@
(defun import-shader (shader-stage-glsl)
(let* ((glsl shader-stage-glsl)
(ast (parse glsl)))
(match ast
(trivia:match ast
;;
(`(shader ,@body)
(post-process (mapcar #'import-shader-body-element body)))
Expand All @@ -52,7 +52,7 @@
(defun import-glsl-function (function-glsl)
(let* ((glsl function-glsl)
(ast (parse glsl)))
(match ast
(trivia:match ast
;;
(`(shader ,@body)
(post-process-func (mapcar #'import-shader-body-element body)))
Expand Down Expand Up @@ -80,9 +80,9 @@
`(:defun-g ,name ,args ,@body))))))

(defun code-cleaner (form)
(match form
((guard x (constantp x)) x)
((guard x (symbolp x)) x)
(trivia:match form
((trivia:guard x (constantp x)) x)
((trivia:guard x (symbolp x)) x)
(`(let ,@a) (code-cleaner `(let* ,@a)))
(`(let* (,@a) (let* (,@b) ,@c) ,@d)
(code-cleaner `(let* (,@a ,@b) ,@c ,@d)))
Expand All @@ -109,7 +109,7 @@
(`(,@a) (mapcar #'code-cleaner a))))

(defun post-process (forms)
(labels ((func (x) (match x (`(%label ,@rest) rest))))
(labels ((func (x) (trivia:match x (`(%label ,@rest) rest))))
(let* ((forms (remove nil forms))
(funcs (remove nil (mapcar #'func forms)))
(main (find :main funcs :key #'first :test #'string=))
Expand All @@ -126,7 +126,7 @@
version)))))

(defun import-shader-body-element (body)
(match body
(trivia:match body
;;
(`(preprocessor-directive ,directive)
(import-directive directive))
Expand Down Expand Up @@ -169,7 +169,7 @@
:initial-value nil)))

(defun import-statement (accum form)
(match form
(trivia:match form
(`(variable-declaration ,@decl) (import-variable-declaration decl accum))
(_ (if accum
`(progn
Expand All @@ -192,7 +192,7 @@
,body-form))))

(defun import-initializer (initializer)
(ematch initializer
(trivia:ematch initializer
(`(,id ,array-specifier ,form)
array-specifier ;; {TODO} HACK!
(list (import-var-identifier id)
Expand All @@ -208,8 +208,8 @@
;; binary operators
((bin-op-form-p form) (import-binary-operator form))
;; other
(t (match form
((guard x (stringp x))
(t (trivia:match form
((trivia:guard x (stringp x))
(import-var-identifier x))
(`(return ,form)
;;`(varjo::%return ,(import-form form))
Expand Down Expand Up @@ -279,7 +279,7 @@
,(import-form then))))

(defun import-assignment (form)
(ematch form
(trivia:ematch form
(`(,id := ,expr)
`(setf ,(import-form id) ,(import-form expr)))
(`(,id :+= ,expr)
Expand All @@ -303,7 +303,7 @@
'<SKIPPED>)

(defun import-function-arg (arg)
(ematch arg
(trivia:ematch arg
(`((type-specifier ,type) ,name)
(list (import-var-identifier name)
(import-type type)))
Expand Down Expand Up @@ -398,8 +398,8 @@
str))))

(defun import-field (primary args)
(match args
((guard `(,field-name) (swizzle-p field-name))
(trivia:match args
((trivia:guard `(,field-name) (swizzle-p field-name))
(import-swizzle primary field-name))
(`(,field-name)
(import-field-access primary field-name))
Expand Down
2 changes: 1 addition & 1 deletion import/package.lisp
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
(uiop:define-package #:varjo.import
(:use #:cl :varjo :optima :named-readtables
(:use #:cl :varjo :named-readtables
:glsl-toolkit :rtg-math)
(:import-from :alexandria :with-gensyms)
(:import-from :varjo :dbind)
Expand Down
1 change: 0 additions & 1 deletion varjo.import.asd
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@
:serial t
:depends-on (#:varjo
#:glsl-toolkit
#:optima
#:fare-quasiquote-extras
#:rtg-math.vari
#:split-sequence)
Expand Down

0 comments on commit ace9c74

Please sign in to comment.