Stacken/c64-livecoding
6
0
Fork 0
Code Issues1 Pull requests Projects Releases Packages Wiki Activity Actions

Various messes

Browse source
This commit is contained in:
John Lorentzson 2025-05-16 21:00:05 +02:00
parent 5d0f4b4767
commit 0867e99cc1
2 changed files with 10 additions and 5 deletions
wip-duuqnd/user-side-compiler
high-level.lisptransform.lisp

4
wip-duuqnd/user-side-compiler/high-level.lisp
View file

@ -31,7 +31,9 @@
(produce-instruction 'inst-lda-absolute (make-offset-label *varvec* (ref-index ref))))
(defclass node ()
((%next :accessor next :accessor normal-next :initform nil)))
((%next :accessor next :accessor normal-next :initform nil
:initarg :next)
(%source :accessor source :initarg :source :initform nil)))
(defmethod generate-code :before ((node node))
(produce-comment (format nil "~A" node)))

11
wip-duuqnd/user-side-compiler/transform.lisp
View file

@ -14,9 +14,9 @@
(equal (c2mop:eql-specializer-object (second specs))
(class-name to-class)))))
(defun direct-transform-exists-p (from-class to-class)
(defun direct-transform-exists-p (from-class to-type)
(some (lambda (m)
(transform-matches-p m from-class to-class))
(transform-matches-p m (find-class from-class) to-type))
(c2mop:generic-function-methods #'%direct-transform)))
(defun transformations-from (from-type)
@ -39,7 +39,7 @@ and NIL if no path exists."
(cond ((eql :end-of-node current-type)
(pop backlinks)
(pop stack))
((direct-transform-exists-p (find-class current-type) to-class)
((direct-transform-exists-p current-type to-class)
(if (eql current-type from-type)
(setf path t)
(setf path (nreverse (cons current-type backlinks)))))
@ -54,7 +54,10 @@ and NIL if no path exists."
(defun transform (obj to-type)
"When a valid transformation exists, it returns an object of type TO-TYPE
that has been somehow created using OBJ as a starting point."
(let ((path (transform-path (type-of obj) to-type)))
(let* ((from-type (case (type-of obj)
((bit number integer fixnum) 'integer)
(t (type-of obj))))
(path (transform-path from-type to-type)))
(if (listp path)
(loop :for intermediate :in path
:do (setf obj (%direct-transform obj intermediate))