New Pretty Printer (#994)

* begin work on improved pretty printer

* update ref

* finish pretty printer

* force line break for defstate
This commit is contained in:
water111
2021-12-04 16:06:01 -05:00
committed by GitHub
parent e69266bc95
commit dbc266c00b
362 changed files with 203258 additions and 275281 deletions
+190 -261
View File
@@ -101,14 +101,14 @@
;; definition for method 2 of type connection
(defmethod print connection ((obj connection))
(format
#t
"#<connection (~A ~A ~A ~A) @ #x~X>"
(-> obj param0)
(-> obj param1)
(-> obj param2)
(-> obj param3)
obj
)
#t
"#<connection (~A ~A ~A ~A) @ #x~X>"
(-> obj param0)
(-> obj param1)
(-> obj param2)
(-> obj param3)
obj
)
obj
)
@@ -116,10 +116,10 @@
;; INFO: Return type mismatch pointer vs engine.
(defmethod get-engine connection ((obj connection))
(while (-> (the-as connectable obj) prev0)
(nop!)
(nop!)
(set! obj (the-as connection (-> (the-as connectable obj) prev0)))
)
(nop!)
(nop!)
(set! obj (the-as connection (-> (the-as connectable obj) prev0)))
)
(the-as engine (&+ (the-as pointer obj) -28))
)
@@ -127,19 +127,19 @@
;; INFO: Return type mismatch pointer vs process.
(defmethod get-process connection ((obj connection))
(while (-> (the-as connectable obj) prev1)
(nop!)
(nop!)
(set! obj (the-as connection (-> (the-as connectable obj) prev1)))
)
(nop!)
(nop!)
(set! obj (the-as connection (-> (the-as connectable obj) prev1)))
)
(the-as process (&+ (the-as pointer obj) -92))
)
;; definition for method 11 of type connection
(defmethod belongs-to-engine? connection ((obj connection) (arg0 engine))
(and
(< (the-as int arg0) (the-as int obj))
(< (the-as int obj) (the-as int (-> arg0 data (-> arg0 allocated-length))))
)
(< (the-as int arg0) (the-as int obj))
(< (the-as int obj) (the-as int (-> arg0 data (-> arg0 allocated-length))))
)
)
;; definition for method 21 of type engine
@@ -158,86 +158,47 @@
)
;; definition for method 0 of type engine
(defmethod
new
engine
((allocation symbol) (type-to-make type) (name basic) (length int))
(let
((obj
(the-as
object
(object-new
allocation
type-to-make
(the-as int (+ (-> type-to-make size) (* (+ length -1) 32)))
)
(defmethod new engine ((allocation symbol) (type-to-make type) (name basic) (length int))
(let ((obj (the-as
object
(object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ length -1) 32))))
)
)
)
(set! (-> (the-as engine obj) allocated-length) length)
(set! (-> (the-as engine obj) length) 0)
(set! (-> (the-as engine obj) name) name)
(set! (-> (the-as engine obj) alive-list next0) (-> (the-as engine obj) alive-list-end))
(set! (-> (the-as engine obj) alive-list prev0) #f)
(set! (-> (the-as engine obj) alive-list next1) #f)
(set! (-> (the-as engine obj) alive-list prev1) #f)
(set! (-> (the-as engine obj) alive-list-end next0) #f)
(set! (-> (the-as engine obj) alive-list-end prev0) (-> (the-as engine obj) alive-list))
(set! (-> (the-as engine obj) alive-list-end next1) #f)
(set! (-> (the-as engine obj) alive-list-end prev1) #f)
(set! (-> (the-as engine obj) dead-list next0) (the-as connectable (-> (the-as engine obj) data)))
(set! (-> (the-as engine obj) dead-list prev0) #f)
(set! (-> (the-as engine obj) dead-list next1) #f)
(set! (-> (the-as engine obj) dead-list prev1) #f)
(set! (-> (the-as engine obj) dead-list-end next0) #f)
(set! (-> (the-as engine obj) dead-list-end prev0) (-> (the-as engine obj) data (+ length -1)))
(set! (-> (the-as engine obj) dead-list-end next1) #f)
(set! (-> (the-as engine obj) dead-list-end prev1) #f)
(set! (-> (the-as engine obj) data 0 prev0) (-> (the-as engine obj) dead-list))
(set! (-> (the-as engine obj) data 0 next0) (the-as connectable (&+ (the-as pointer obj) 124)))
(let ((idx-to-link 1)
(end-idx (+ length -2))
)
(while (>= end-idx idx-to-link)
(set! (-> (the-as engine obj) data idx-to-link prev0) (-> (the-as engine obj) data (+ idx-to-link -1)))
(set! (-> (the-as engine obj) data idx-to-link next0) (-> (the-as engine obj) data (+ idx-to-link 1)))
(+! idx-to-link 1)
)
)
)
(set! (-> (the-as engine obj) data (+ length -1) prev0) (-> (the-as engine obj) data (+ length -2)))
(set! (-> (the-as engine obj) data (+ length -1) next0) (-> (the-as engine obj) dead-list-end))
(the-as engine obj)
)
(set! (-> (the-as engine obj) allocated-length) length)
(set! (-> (the-as engine obj) length) 0)
(set! (-> (the-as engine obj) name) name)
(set!
(-> (the-as engine obj) alive-list next0)
(-> (the-as engine obj) alive-list-end)
)
(set! (-> (the-as engine obj) alive-list prev0) #f)
(set! (-> (the-as engine obj) alive-list next1) #f)
(set! (-> (the-as engine obj) alive-list prev1) #f)
(set! (-> (the-as engine obj) alive-list-end next0) #f)
(set!
(-> (the-as engine obj) alive-list-end prev0)
(-> (the-as engine obj) alive-list)
)
(set! (-> (the-as engine obj) alive-list-end next1) #f)
(set! (-> (the-as engine obj) alive-list-end prev1) #f)
(set!
(-> (the-as engine obj) dead-list next0)
(the-as connectable (-> (the-as engine obj) data))
)
(set! (-> (the-as engine obj) dead-list prev0) #f)
(set! (-> (the-as engine obj) dead-list next1) #f)
(set! (-> (the-as engine obj) dead-list prev1) #f)
(set! (-> (the-as engine obj) dead-list-end next0) #f)
(set!
(-> (the-as engine obj) dead-list-end prev0)
(-> (the-as engine obj) data (+ length -1))
)
(set! (-> (the-as engine obj) dead-list-end next1) #f)
(set! (-> (the-as engine obj) dead-list-end prev1) #f)
(set!
(-> (the-as engine obj) data 0 prev0)
(-> (the-as engine obj) dead-list)
)
(set!
(-> (the-as engine obj) data 0 next0)
(the-as connectable (&+ (the-as pointer obj) 124))
)
(let ((idx-to-link 1)
(end-idx (+ length -2))
)
(while (>= end-idx idx-to-link)
(set!
(-> (the-as engine obj) data idx-to-link prev0)
(-> (the-as engine obj) data (+ idx-to-link -1))
)
(set!
(-> (the-as engine obj) data idx-to-link next0)
(-> (the-as engine obj) data (+ idx-to-link 1))
)
(+! idx-to-link 1)
)
)
(set!
(-> (the-as engine obj) data (+ length -1) prev0)
(-> (the-as engine obj) data (+ length -2))
)
(set!
(-> (the-as engine obj) data (+ length -1) next0)
(-> (the-as engine obj) dead-list-end)
)
(the-as engine obj)
)
)
;; definition for method 2 of type engine
@@ -255,28 +216,28 @@
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Talive-list:~%")
(let ((s5-0 *print-column*))
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj alive-list))
(set! *print-column* s5-0)
)
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj alive-list))
(set! *print-column* s5-0)
)
(format #t "~Talive-list-end:~%")
(let ((s5-1 *print-column*))
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj alive-list-end))
(set! *print-column* s5-1)
)
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj alive-list-end))
(set! *print-column* s5-1)
)
(format #t "~Tdead-list:~%")
(let ((s5-2 *print-column*))
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj dead-list))
(set! *print-column* s5-2)
)
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj dead-list))
(set! *print-column* s5-2)
)
(format #t "~Tdead-list-end:~%")
(let ((s5-3 *print-column*))
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj dead-list-end))
(set! *print-column* s5-3)
)
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj dead-list-end))
(set! *print-column* s5-3)
)
(format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data))
obj
)
@@ -293,33 +254,27 @@
)
;; definition for method 10 of type engine
(defmethod
apply-to-connections
engine
((obj engine) (f (function connectable none)))
(defmethod apply-to-connections engine ((obj engine) (f (function connectable none)))
(let* ((current (-> obj alive-list next0))
(next (-> current next0))
)
(while (!= current (-> obj alive-list-end))
(f current)
(set! current next)
(set! next (-> next next0))
(while (!= current (-> obj alive-list-end))
(f current)
(set! current next)
(set! next (-> next next0))
)
)
)
0
)
;; definition for method 11 of type engine
(defmethod
apply-to-connections-reverse
engine
((obj engine) (f (function connectable none)))
(defmethod apply-to-connections-reverse engine ((obj engine) (f (function connectable none)))
(let ((iter (-> obj alive-list-end prev0)))
(while (!= iter (-> obj alive-list))
(f iter)
(set! iter (-> iter prev0))
(while (!= iter (-> obj alive-list))
(f iter)
(set! iter (-> iter prev0))
)
)
)
0
)
@@ -327,180 +282,154 @@
(defmethod execute-connections engine ((obj engine) (arg0 object))
(set! (-> obj engine-time) (-> *display* real-frame-counter))
(let ((ct (the-as connection (-> obj alive-list-end prev0))))
(while (!= ct (-> obj alive-list))
((the-as (function basic basic basic object object) (-> ct param0))
(-> ct param1)
(-> ct param2)
(-> ct param3)
arg0
)
(set! ct (the-as connection (-> ct prev0)))
(while (!= ct (-> obj alive-list))
((the-as (function basic basic basic object object) (-> ct param0))
(-> ct param1)
(-> ct param2)
(-> ct param3)
arg0
)
(set! ct (the-as connection (-> ct prev0)))
)
)
)
0
)
;; definition for method 13 of type engine
(defmethod
execute-connections-and-move-to-dead
engine
((obj engine) (arg0 object))
(defmethod execute-connections-and-move-to-dead engine ((obj engine) (arg0 object))
(set! (-> obj engine-time) (-> *display* real-frame-counter))
(let ((ct (the-as connection (-> obj alive-list-end prev0))))
(while (!= ct (-> obj alive-list))
(let
((result
((the-as (function basic basic basic object object) (-> ct param0))
(-> ct param1)
(-> ct param2)
(-> ct param3)
arg0
(while (!= ct (-> obj alive-list))
(let ((result ((the-as (function basic basic basic object object) (-> ct param0))
(-> ct param1)
(-> ct param2)
(-> ct param3)
arg0
)
)
)
(set! ct (the-as connection (-> ct prev0)))
(if (= result 'dead)
((method-of-type connection move-to-dead) (the-as connection (-> ct next0)))
)
)
)
)
(set! ct (the-as connection (-> ct prev0)))
(if (= result 'dead)
((method-of-type connection move-to-dead)
(the-as connection (-> ct next0))
)
)
)
)
)
0
)
;; definition for method 14 of type engine
(defmethod execute-connections-if-needed engine ((obj engine) (arg0 object))
(if (!= (-> *display* real-frame-counter) (-> obj engine-time))
(execute-connections obj arg0)
)
(execute-connections obj arg0)
)
0
)
;; definition for function connection-process-apply
(defun connection-process-apply ((proc process) (func (function object none)))
(when proc
(let ((iter (-> proc connection-list next1)))
(while iter
(func iter)
(set! iter (-> iter next1))
)
(let ((iter (-> proc connection-list next1)))
(while iter
(func iter)
(set! iter (-> iter next1))
)
)
#f
)
#f
)
)
;; definition for method 9 of type engine
(defmethod inspect-all-connections engine ((obj engine))
(apply-to-connections
obj
(the-as (function connectable none) (method-of-type connection inspect))
)
(apply-to-connections obj (the-as (function connectable none) (method-of-type connection inspect)))
obj
)
;; definition for method 15 of type engine
(defmethod
add-connection
engine
((obj engine)
(proc process)
(func object)
(p1 object)
(p2 object)
(p3 object)
)
(defmethod add-connection engine ((obj engine) (proc process) (func object) (p1 object) (p2 object) (p3 object))
(let ((con (the-as connection (-> obj dead-list next0))))
(when (not (or (not proc) (= con (-> obj dead-list-end))))
(set! (-> con param0) (the-as basic func))
(set! (-> con param1) (the-as basic p1))
(set! (-> con param2) (the-as basic p2))
(set! (-> con param3) (the-as basic p3))
(set! (-> obj dead-list next0) (-> con next0))
(set! (-> con next0 prev0) (-> obj dead-list))
(set! (-> con next0) (-> obj alive-list next0))
(set! (-> con next0 prev0) con)
(set! (-> con prev0) (-> obj alive-list))
(set! (-> obj alive-list next0) con)
(set! (-> con next1) (-> proc connection-list next1))
(if (-> con next1)
(set! (-> con next1 prev1) con)
)
(set! (-> con prev1) (-> proc connection-list))
(set! (-> proc connection-list next1) con)
(+! (-> obj length) 1)
con
(when (not (or (not proc) (= con (-> obj dead-list-end))))
(set! (-> con param0) (the-as basic func))
(set! (-> con param1) (the-as basic p1))
(set! (-> con param2) (the-as basic p2))
(set! (-> con param3) (the-as basic p3))
(set! (-> obj dead-list next0) (-> con next0))
(set! (-> con next0 prev0) (-> obj dead-list))
(set! (-> con next0) (-> obj alive-list next0))
(set! (-> con next0 prev0) con)
(set! (-> con prev0) (-> obj alive-list))
(set! (-> obj alive-list next0) con)
(set! (-> con next1) (-> proc connection-list next1))
(if (-> con next1)
(set! (-> con next1 prev1) con)
)
(set! (-> con prev1) (-> proc connection-list))
(set! (-> proc connection-list next1) con)
(+! (-> obj length) 1)
con
)
)
)
)
;; definition for method 13 of type connection
(defmethod move-to-dead connection ((obj connection))
(let ((v1-1 (get-engine obj)))
(set! (-> obj prev0 next0) (-> obj next0))
(set! (-> obj next0 prev0) (-> obj prev0))
(set! (-> obj prev1 next1) (-> obj next1))
(if (-> obj next1)
(set! (-> obj next1 prev1) (-> obj prev1))
(set! (-> obj prev0 next0) (-> obj next0))
(set! (-> obj next0 prev0) (-> obj prev0))
(set! (-> obj prev1 next1) (-> obj next1))
(if (-> obj next1)
(set! (-> obj next1 prev1) (-> obj prev1))
)
(set! (-> obj next0) (-> v1-1 dead-list next0))
(set! (-> obj next0 prev0) obj)
(set! (-> obj prev0) (-> v1-1 dead-list))
(set! (-> v1-1 dead-list next0) obj)
(+! (-> v1-1 length) -1)
)
(set! (-> obj next0) (-> v1-1 dead-list next0))
(set! (-> obj next0 prev0) obj)
(set! (-> obj prev0) (-> v1-1 dead-list))
(set! (-> v1-1 dead-list next0) obj)
(+! (-> v1-1 length) -1)
)
obj
)
;; definition for function process-disconnect
(defun process-disconnect ((arg0 process))
(when arg0
(let ((gp-0 (-> arg0 connection-list next1)))
(while gp-0
((method-of-type connection move-to-dead) (the-as connection gp-0))
(set! gp-0 (-> gp-0 next1))
)
(let ((gp-0 (-> arg0 connection-list next1)))
(while gp-0
((method-of-type connection move-to-dead) (the-as connection gp-0))
(set! gp-0 (-> gp-0 next1))
)
)
)
)
0
)
;; definition for method 16 of type engine
(defmethod remove-from-process engine ((obj engine) (arg0 process))
(when arg0
(let ((s5-0 (-> arg0 connection-list next1)))
(while s5-0
(if
((method-of-type connection belongs-to-engine?)
(the-as connection s5-0)
obj
)
((method-of-type connection move-to-dead) (the-as connection s5-0))
(let ((s5-0 (-> arg0 connection-list next1)))
(while s5-0
(if ((method-of-type connection belongs-to-engine?) (the-as connection s5-0) obj)
((method-of-type connection move-to-dead) (the-as connection s5-0))
)
(set! s5-0 (-> s5-0 next1))
)
)
(set! s5-0 (-> s5-0 next1))
)
)
)
0
)
;; definition for method 17 of type engine
(defmethod
remove-matching
engine
((obj engine) (arg0 (function connection engine symbol)))
(defmethod remove-matching engine ((obj engine) (arg0 (function connection engine symbol)))
(let* ((s4-0 (-> obj alive-list next0))
(s3-0 (-> s4-0 next0))
)
(while (!= s4-0 (-> obj alive-list-end))
(if (arg0 (the-as connection s4-0) obj)
((method-of-type connection move-to-dead) (the-as connection s4-0))
)
(set! s4-0 s3-0)
(set! s3-0 (-> s3-0 next0))
(while (!= s4-0 (-> obj alive-list-end))
(if (arg0 (the-as connection s4-0) obj)
((method-of-type connection move-to-dead) (the-as connection s4-0))
)
(set! s4-0 s3-0)
(set! s3-0 (-> s3-0 next0))
)
)
)
0
)
@@ -509,12 +438,12 @@
(let* ((a0-1 (-> obj alive-list next0))
(s5-0 (-> a0-1 next0))
)
(while (!= a0-1 (-> obj alive-list-end))
((method-of-type connection move-to-dead) (the-as connection a0-1))
(set! a0-1 s5-0)
(set! s5-0 (-> s5-0 next0))
(while (!= a0-1 (-> obj alive-list-end))
((method-of-type connection move-to-dead) (the-as connection a0-1))
(set! a0-1 s5-0)
(set! s5-0 (-> s5-0 next0))
)
)
)
0
)
@@ -523,14 +452,14 @@
(let* ((current (-> obj alive-list next0))
(next (-> current next0))
)
(while (!= current (-> obj alive-list-end))
(if (= (-> (the-as connection current) param1) p1-value)
((method-of-type connection move-to-dead) (the-as connection current))
)
(set! current next)
(set! next (-> next next0))
(while (!= current (-> obj alive-list-end))
(if (= (-> (the-as connection current) param1) p1-value)
((method-of-type connection move-to-dead) (the-as connection current))
)
(set! current next)
(set! next (-> next next0))
)
)
)
0
)
@@ -539,13 +468,13 @@
(let* ((current (-> obj alive-list next0))
(next (-> current next0))
)
(while (!= current (-> obj alive-list-end))
(if (= (-> (the-as connection current) param2) p2-value)
((method-of-type connection move-to-dead) (the-as connection current))
)
(set! current next)
(set! next (-> next next0))
(while (!= current (-> obj alive-list-end))
(if (= (-> (the-as connection current) param2) p2-value)
((method-of-type connection move-to-dead) (the-as connection current))
)
(set! current next)
(set! next (-> next next0))
)
)
)
0
)
+1 -4
View File
@@ -5,10 +5,7 @@
(define *background-draw-engine* (new 'global 'engine 'draw 10))
;; definition for symbol *matrix-engine*, type (array handle)
(define
*matrix-engine*
(the-as (array handle) (new 'global 'boxed-array handle 1024))
)
(define *matrix-engine* (the-as (array handle) (new 'global 'boxed-array handle 1024)))
;; failed to figure out what this is:
(set! (-> *matrix-engine* length) 0)