From 0867e99cc101570692ab6d3fab1df323509730bc Mon Sep 17 00:00:00 2001 From: John Lorentzson Date: Fri, 16 May 2025 21:00:05 +0200 Subject: [PATCH] Various messes --- wip-duuqnd/user-side-compiler/high-level.lisp | 4 +++- wip-duuqnd/user-side-compiler/transform.lisp | 11 +++++++---- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/wip-duuqnd/user-side-compiler/high-level.lisp b/wip-duuqnd/user-side-compiler/high-level.lisp index ad85311..982de76 100644 --- a/wip-duuqnd/user-side-compiler/high-level.lisp +++ b/wip-duuqnd/user-side-compiler/high-level.lisp @@ -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))) diff --git a/wip-duuqnd/user-side-compiler/transform.lisp b/wip-duuqnd/user-side-compiler/transform.lisp index 66325f6..99906e7 100644 --- a/wip-duuqnd/user-side-compiler/transform.lisp +++ b/wip-duuqnd/user-side-compiler/transform.lisp @@ -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))