mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 11:26:18 -04:00
give defstate
a parent type and allow anonymous behaviors inside (#715)
* give `defstate` a parent type and allow anonymous behaviors inside * add defstate type stack leak detection+correction, remove debug print
This commit is contained in:
parent
f3f32cca5b
commit
8ef73ee457
|
@ -37521,38 +37521,28 @@
|
||||||
|
|
||||||
;; - Types
|
;; - Types
|
||||||
|
|
||||||
; (deftype sun-iris-door (process-drawable)
|
(deftype sun-iris-door (process-drawable)
|
||||||
; ((timeout float :offset-assert 176)
|
((timeout float :offset-assert 176)
|
||||||
; (proximity? basic :offset-assert 180)
|
(proximity? basic :offset-assert 180)
|
||||||
; (directional-proximity? basic :offset-assert 184)
|
(directional-proximity? basic :offset-assert 184)
|
||||||
; (move-to? basic :offset-assert 188)
|
(move-to? basic :offset-assert 188)
|
||||||
; (locked-by-task? basic :offset-assert 192)
|
(locked-by-task? basic :offset-assert 192)
|
||||||
; (close-dist float :offset-assert 196)
|
(close-dist float :offset-assert 196)
|
||||||
; (open-dist float :offset-assert 200)
|
(open-dist float :offset-assert 200)
|
||||||
; (move-to-pos vector :inline :offset-assert 208)
|
(move-to-pos vector :inline :offset-assert 208)
|
||||||
; (outward-vec vector :inline :offset-assert 224)
|
(outward-vec vector :inline :offset-assert 224)
|
||||||
; (move-to-quat quaternion :inline :offset-assert 240)
|
(move-to-quat quaternion :inline :offset-assert 240)
|
||||||
; )
|
)
|
||||||
; :method-count-assert 22
|
:method-count-assert 22
|
||||||
; :size-assert #x100
|
:size-assert #x100
|
||||||
; :flag-assert #x1600900100
|
:heap-base #x90
|
||||||
; ;; inherited inspect of process-drawable
|
:flag-assert #x1600900100
|
||||||
; (:methods
|
;; inherited inspect of process-drawable
|
||||||
; (dummy-9 () none 9)
|
(:methods
|
||||||
; (dummy-10 () none 10)
|
(dummy-20 () none 20)
|
||||||
; (dummy-11 () none 11)
|
(dummy-21 () none 21)
|
||||||
; (dummy-12 () none 12)
|
)
|
||||||
; (dummy-13 () none 13)
|
)
|
||||||
; (dummy-14 () none 14)
|
|
||||||
; (dummy-15 () none 15)
|
|
||||||
; (dummy-16 () none 16)
|
|
||||||
; (dummy-17 () none 17)
|
|
||||||
; (dummy-18 () none 18)
|
|
||||||
; (dummy-19 () none 19)
|
|
||||||
; (dummy-20 () none 20)
|
|
||||||
; (dummy-21 () none 21)
|
|
||||||
; )
|
|
||||||
; )
|
|
||||||
|
|
||||||
;; - Functions
|
;; - Functions
|
||||||
|
|
||||||
|
@ -37561,10 +37551,10 @@
|
||||||
;; - Unknowns
|
;; - Unknowns
|
||||||
|
|
||||||
(define-extern *sun-iris-door-sg* skeleton-group)
|
(define-extern *sun-iris-door-sg* skeleton-group)
|
||||||
;;(define-extern sun-iris-door-open object) ;; unknown type
|
(define-extern sun-iris-door-open state)
|
||||||
;;(define-extern sun-iris-door-closed object) ;; unknown type
|
(define-extern sun-iris-door-closed state)
|
||||||
;;(define-extern sun-iris-door-opening object) ;; unknown type
|
(define-extern sun-iris-door-opening state)
|
||||||
;;(define-extern sun-iris-door-closing object) ;; unknown type
|
(define-extern sun-iris-door-closing state)
|
||||||
|
|
||||||
|
|
||||||
;; ----------------------
|
;; ----------------------
|
||||||
|
|
|
@ -91,7 +91,7 @@ The `state` system is used to control a process. Each process can be in a `stat
|
||||||
|
|
||||||
For example, we can create a simple test state like this:
|
For example, we can create a simple test state like this:
|
||||||
```
|
```
|
||||||
(defstate test-state
|
(defstate test-state (process)
|
||||||
:enter (lambda () (format #t "enter!~%"))
|
:enter (lambda () (format #t "enter!~%"))
|
||||||
:exit (lambda () (format #t "exit!~%"))
|
:exit (lambda () (format #t "exit!~%"))
|
||||||
:trans (lambda () (format #t "trans!~%"))
|
:trans (lambda () (format #t "trans!~%"))
|
||||||
|
|
|
@ -322,6 +322,12 @@
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(defmacro loop (&rest body)
|
||||||
|
"Loop this code forever."
|
||||||
|
`(while #t
|
||||||
|
,@body)
|
||||||
|
)
|
||||||
|
|
||||||
;; Backup some values, and restore after executing body.
|
;; Backup some values, and restore after executing body.
|
||||||
;; Non-dynamic (nonlocal jumps out of body will skip restore)
|
;; Non-dynamic (nonlocal jumps out of body will skip restore)
|
||||||
;; NOTE : GOAL protected defs in a FIFO manner (this is FILO/LIFO), this should be fixed at some point
|
;; NOTE : GOAL protected defs in a FIFO manner (this is FILO/LIFO), this should be fixed at some point
|
||||||
|
|
|
@ -31,6 +31,10 @@
|
||||||
`(if ,x #f #t)
|
`(if ,x #f #t)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(defsmacro unless (clause &rest body)
|
||||||
|
`(if (not ,clause) (begin ,@body) #f)
|
||||||
|
)
|
||||||
|
|
||||||
(desfun factorial (x)
|
(desfun factorial (x)
|
||||||
(if (= x 1)
|
(if (= x 1)
|
||||||
1
|
1
|
||||||
|
@ -71,6 +75,13 @@
|
||||||
(desfun third (x)
|
(desfun third (x)
|
||||||
(car (cddr x)))
|
(car (cddr x)))
|
||||||
|
|
||||||
|
(defsmacro push! (lst x)
|
||||||
|
`(set! ,lst (cons ,x ,lst))
|
||||||
|
)
|
||||||
|
(defsmacro pop! (lst)
|
||||||
|
`(set! ,lst (cdr ,lst))
|
||||||
|
)
|
||||||
|
|
||||||
(desfun apply (fun x)
|
(desfun apply (fun x)
|
||||||
(if (null? x)
|
(if (null? x)
|
||||||
'()
|
'()
|
||||||
|
@ -161,6 +172,10 @@
|
||||||
`(type? 'pair ,x)
|
`(type? 'pair ,x)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(defsmacro symbol? (x)
|
||||||
|
`(type? 'symbol ,x)
|
||||||
|
)
|
||||||
|
|
||||||
(defsmacro ferror (&rest args)
|
(defsmacro ferror (&rest args)
|
||||||
`(error (fmt #f ,@args))
|
`(error (fmt #f ,@args))
|
||||||
)
|
)
|
||||||
|
|
|
@ -576,9 +576,9 @@
|
||||||
"get the name of a process using a handle. #f is the result if the handle was invalid."
|
"get the name of a process using a handle. #f is the result if the handle was invalid."
|
||||||
|
|
||||||
(with-gensyms (proc)
|
(with-gensyms (proc)
|
||||||
`(let ((proc (handle->process ,handle)))
|
`(let ((,proc (handle->process ,handle)))
|
||||||
(if proc
|
(if ,proc
|
||||||
(-> proc name)
|
(-> ,proc name)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
|
@ -85,9 +85,17 @@ There are several ways to "go"
|
||||||
`(inspect-process-tree *active-pool* 0 0 ,detail)
|
`(inspect-process-tree *active-pool* 0 0 ,detail)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
;; use a compile-time list to keep track of the type of an anonymous behavior.
|
||||||
|
(seval (define *defstate-type-stack* '()))
|
||||||
|
(desfun def-state-check-behavior (beh-form beh-type)
|
||||||
|
"check if code block is an anonymous behavior. needed for anonymous behaviors on defstate."
|
||||||
|
|
||||||
;; define a state state
|
(when (and (pair? beh-form) (eq? (first beh-form) 'behavior))
|
||||||
(defmacro defstate (state-name
|
(push! *defstate-type-stack* beh-type)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(defmacro defstate (state-name parents
|
||||||
&key (event #f)
|
&key (event #f)
|
||||||
&key (enter #f)
|
&key (enter #f)
|
||||||
&key (trans #f)
|
&key (trans #f)
|
||||||
|
@ -95,46 +103,69 @@ There are several ways to "go"
|
||||||
&key (code #f)
|
&key (code #f)
|
||||||
&key (post #f)
|
&key (post #f)
|
||||||
)
|
)
|
||||||
`(begin
|
"Define a new state!"
|
||||||
(define ,state-name (new 'static 'state
|
|
||||||
:name (quote ,state-name)
|
(with-gensyms (new-state)
|
||||||
:next #f
|
(let ((defstate-type (first parents)))
|
||||||
:exit #f
|
(when (not (null? *defstate-type-stack*))
|
||||||
:code #f
|
(ferror "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}" *defstate-type-stack*)
|
||||||
:trans #f
|
)
|
||||||
:post #f
|
(set! *defstate-type-stack* '())
|
||||||
:enter #f
|
(def-state-check-behavior event defstate-type)
|
||||||
:event #f
|
(def-state-check-behavior enter defstate-type)
|
||||||
)
|
(def-state-check-behavior trans defstate-type)
|
||||||
|
(def-state-check-behavior exit defstate-type)
|
||||||
|
(def-state-check-behavior code defstate-type)
|
||||||
|
(def-state-check-behavior post defstate-type)
|
||||||
|
`(let ((,new-state (new 'static 'state
|
||||||
|
:name (quote ,state-name)
|
||||||
|
:next #f
|
||||||
|
:exit #f
|
||||||
|
:code #f
|
||||||
|
:trans #f
|
||||||
|
:post #f
|
||||||
|
:enter #f
|
||||||
|
:event #f
|
||||||
|
)
|
||||||
|
))
|
||||||
|
(define ,state-name ,new-state)
|
||||||
|
,(if event
|
||||||
|
`(set! (-> ,new-state event) ,event)
|
||||||
|
`(none)
|
||||||
|
)
|
||||||
|
,(if enter
|
||||||
|
`(set! (-> ,new-state enter) (the (function object object object object object object object) ,enter))
|
||||||
|
`(none)
|
||||||
|
)
|
||||||
|
,(if trans
|
||||||
|
`(set! (-> ,new-state trans) ,trans)
|
||||||
|
`(none)
|
||||||
|
)
|
||||||
|
,(if exit
|
||||||
|
`(set! (-> ,new-state exit) ,exit)
|
||||||
|
`(none)
|
||||||
|
)
|
||||||
|
,(if code
|
||||||
|
`(set! (-> ,new-state code) ,code)
|
||||||
|
`(none)
|
||||||
|
)
|
||||||
|
,(if post
|
||||||
|
`(set! (-> ,new-state post) ,post)
|
||||||
|
`(none)
|
||||||
|
)
|
||||||
|
)
|
||||||
)
|
)
|
||||||
,(if event
|
|
||||||
`(set! (-> ,state-name event) ,event)
|
|
||||||
`(none)
|
|
||||||
)
|
|
||||||
,(if enter
|
|
||||||
`(set! (-> ,state-name enter) (the (function object object object object object object object) ,enter))
|
|
||||||
`(none)
|
|
||||||
)
|
|
||||||
,(if trans
|
|
||||||
`(set! (-> ,state-name trans) ,trans)
|
|
||||||
`(none)
|
|
||||||
)
|
|
||||||
,(if exit
|
|
||||||
`(set! (-> ,state-name exit) ,exit)
|
|
||||||
`(none)
|
|
||||||
)
|
|
||||||
,(if code
|
|
||||||
`(set! (-> ,state-name code) ,code)
|
|
||||||
`(none)
|
|
||||||
)
|
|
||||||
,(if post
|
|
||||||
`(set! (-> ,state-name post) ,post)
|
|
||||||
`(none)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(defmacro behavior (bindings &rest body)
|
||||||
|
"Define an anonymous behavior for a process state. This may only be used inside a defstate!"
|
||||||
|
|
||||||
|
(let ((behavior-type (first *defstate-type-stack*)))
|
||||||
|
(pop! *defstate-type-stack*)
|
||||||
|
`(the-as (function object) (lambda :behavior ,behavior-type ,bindings ,@body))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
(defmethod new state
|
(defmethod new state
|
||||||
((allocation symbol)
|
((allocation symbol)
|
||||||
|
@ -351,8 +382,13 @@ There are several ways to "go"
|
||||||
|
|
||||||
(defun looping-code ()
|
(defun looping-code ()
|
||||||
"Loop."
|
"Loop."
|
||||||
(while #t
|
(loop
|
||||||
(suspend)
|
(suspend)
|
||||||
)
|
)
|
||||||
#f
|
#f
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -100,7 +100,7 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
(defstate die-state
|
(defstate die-state (process)
|
||||||
:enter (lambda () (format #t "enter die~%"))
|
:enter (lambda () (format #t "enter die~%"))
|
||||||
:exit (lambda () (format #t "exit die~%"))
|
:exit (lambda () (format #t "exit die~%"))
|
||||||
:code (lambda ()
|
:code (lambda ()
|
||||||
|
@ -144,13 +144,13 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
;; a state.
|
;; a state.
|
||||||
(defstate xmm-check-state
|
(defstate xmm-check-state (process)
|
||||||
:enter (lambda (x y z w) (format #t "enter check: ~D ~D ~D ~D~%" x y z w))
|
:enter (lambda (x y z w) (format #t "enter check: ~D ~D ~D ~D~%" x y z w))
|
||||||
:exit (lambda () (format #t "exit check~%"))
|
:exit (lambda () (format #t "exit check~%"))
|
||||||
:code xmm-check-code
|
:code xmm-check-code
|
||||||
)
|
)
|
||||||
|
|
||||||
(defstate xmm-wreck-state
|
(defstate xmm-wreck-state (process)
|
||||||
:enter (lambda (x y z w) (format #t "enter wreck: ~D ~D ~D ~D~%" x y z w))
|
:enter (lambda (x y z w) (format #t "enter wreck: ~D ~D ~D ~D~%" x y z w))
|
||||||
:exit (lambda () (format #t "exit wreck~%"))
|
:exit (lambda () (format #t "exit wreck~%"))
|
||||||
:code xmm-wreck-code
|
:code xmm-wreck-code
|
||||||
|
|
Loading…
Reference in a new issue