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
|
||||
|
||||
; (deftype sun-iris-door (process-drawable)
|
||||
; ((timeout float :offset-assert 176)
|
||||
; (proximity? basic :offset-assert 180)
|
||||
; (directional-proximity? basic :offset-assert 184)
|
||||
; (move-to? basic :offset-assert 188)
|
||||
; (locked-by-task? basic :offset-assert 192)
|
||||
; (close-dist float :offset-assert 196)
|
||||
; (open-dist float :offset-assert 200)
|
||||
; (move-to-pos vector :inline :offset-assert 208)
|
||||
; (outward-vec vector :inline :offset-assert 224)
|
||||
; (move-to-quat quaternion :inline :offset-assert 240)
|
||||
; )
|
||||
; :method-count-assert 22
|
||||
; :size-assert #x100
|
||||
; :flag-assert #x1600900100
|
||||
; ;; inherited inspect of process-drawable
|
||||
; (:methods
|
||||
; (dummy-9 () none 9)
|
||||
; (dummy-10 () none 10)
|
||||
; (dummy-11 () none 11)
|
||||
; (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)
|
||||
; )
|
||||
; )
|
||||
(deftype sun-iris-door (process-drawable)
|
||||
((timeout float :offset-assert 176)
|
||||
(proximity? basic :offset-assert 180)
|
||||
(directional-proximity? basic :offset-assert 184)
|
||||
(move-to? basic :offset-assert 188)
|
||||
(locked-by-task? basic :offset-assert 192)
|
||||
(close-dist float :offset-assert 196)
|
||||
(open-dist float :offset-assert 200)
|
||||
(move-to-pos vector :inline :offset-assert 208)
|
||||
(outward-vec vector :inline :offset-assert 224)
|
||||
(move-to-quat quaternion :inline :offset-assert 240)
|
||||
)
|
||||
:method-count-assert 22
|
||||
:size-assert #x100
|
||||
:heap-base #x90
|
||||
:flag-assert #x1600900100
|
||||
;; inherited inspect of process-drawable
|
||||
(:methods
|
||||
(dummy-20 () none 20)
|
||||
(dummy-21 () none 21)
|
||||
)
|
||||
)
|
||||
|
||||
;; - Functions
|
||||
|
||||
|
@ -37561,10 +37551,10 @@
|
|||
;; - Unknowns
|
||||
|
||||
(define-extern *sun-iris-door-sg* skeleton-group)
|
||||
;;(define-extern sun-iris-door-open object) ;; unknown type
|
||||
;;(define-extern sun-iris-door-closed object) ;; unknown type
|
||||
;;(define-extern sun-iris-door-opening object) ;; unknown type
|
||||
;;(define-extern sun-iris-door-closing object) ;; unknown type
|
||||
(define-extern sun-iris-door-open state)
|
||||
(define-extern sun-iris-door-closed state)
|
||||
(define-extern sun-iris-door-opening state)
|
||||
(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:
|
||||
```
|
||||
(defstate test-state
|
||||
(defstate test-state (process)
|
||||
:enter (lambda () (format #t "enter!~%"))
|
||||
:exit (lambda () (format #t "exit!~%"))
|
||||
: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.
|
||||
;; 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
|
||||
|
|
|
@ -31,6 +31,10 @@
|
|||
`(if ,x #f #t)
|
||||
)
|
||||
|
||||
(defsmacro unless (clause &rest body)
|
||||
`(if (not ,clause) (begin ,@body) #f)
|
||||
)
|
||||
|
||||
(desfun factorial (x)
|
||||
(if (= x 1)
|
||||
1
|
||||
|
@ -71,6 +75,13 @@
|
|||
(desfun third (x)
|
||||
(car (cddr x)))
|
||||
|
||||
(defsmacro push! (lst x)
|
||||
`(set! ,lst (cons ,x ,lst))
|
||||
)
|
||||
(defsmacro pop! (lst)
|
||||
`(set! ,lst (cdr ,lst))
|
||||
)
|
||||
|
||||
(desfun apply (fun x)
|
||||
(if (null? x)
|
||||
'()
|
||||
|
@ -161,6 +172,10 @@
|
|||
`(type? 'pair ,x)
|
||||
)
|
||||
|
||||
(defsmacro symbol? (x)
|
||||
`(type? 'symbol ,x)
|
||||
)
|
||||
|
||||
(defsmacro ferror (&rest 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."
|
||||
|
||||
(with-gensyms (proc)
|
||||
`(let ((proc (handle->process ,handle)))
|
||||
(if proc
|
||||
(-> proc name)
|
||||
`(let ((,proc (handle->process ,handle)))
|
||||
(if ,proc
|
||||
(-> ,proc name)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
|
|
@ -85,9 +85,17 @@ There are several ways to "go"
|
|||
`(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
|
||||
(defmacro defstate (state-name
|
||||
(when (and (pair? beh-form) (eq? (first beh-form) 'behavior))
|
||||
(push! *defstate-type-stack* beh-type)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro defstate (state-name parents
|
||||
&key (event #f)
|
||||
&key (enter #f)
|
||||
&key (trans #f)
|
||||
|
@ -95,8 +103,21 @@ There are several ways to "go"
|
|||
&key (code #f)
|
||||
&key (post #f)
|
||||
)
|
||||
`(begin
|
||||
(define ,state-name (new 'static 'state
|
||||
"Define a new state!"
|
||||
|
||||
(with-gensyms (new-state)
|
||||
(let ((defstate-type (first parents)))
|
||||
(when (not (null? *defstate-type-stack*))
|
||||
(ferror "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}" *defstate-type-stack*)
|
||||
)
|
||||
(set! *defstate-type-stack* '())
|
||||
(def-state-check-behavior event defstate-type)
|
||||
(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
|
||||
|
@ -106,35 +127,45 @@ There are several ways to "go"
|
|||
:enter #f
|
||||
:event #f
|
||||
)
|
||||
)
|
||||
))
|
||||
(define ,state-name ,new-state)
|
||||
,(if event
|
||||
`(set! (-> ,state-name event) ,event)
|
||||
`(set! (-> ,new-state event) ,event)
|
||||
`(none)
|
||||
)
|
||||
,(if enter
|
||||
`(set! (-> ,state-name enter) (the (function object object object object object object object) ,enter))
|
||||
`(set! (-> ,new-state enter) (the (function object object object object object object object) ,enter))
|
||||
`(none)
|
||||
)
|
||||
,(if trans
|
||||
`(set! (-> ,state-name trans) ,trans)
|
||||
`(set! (-> ,new-state trans) ,trans)
|
||||
`(none)
|
||||
)
|
||||
,(if exit
|
||||
`(set! (-> ,state-name exit) ,exit)
|
||||
`(set! (-> ,new-state exit) ,exit)
|
||||
`(none)
|
||||
)
|
||||
,(if code
|
||||
`(set! (-> ,state-name code) ,code)
|
||||
`(set! (-> ,new-state code) ,code)
|
||||
`(none)
|
||||
)
|
||||
,(if post
|
||||
`(set! (-> ,state-name post) ,post)
|
||||
`(set! (-> ,new-state 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
|
||||
((allocation symbol)
|
||||
|
@ -351,8 +382,13 @@ There are several ways to "go"
|
|||
|
||||
(defun looping-code ()
|
||||
"Loop."
|
||||
(while #t
|
||||
(loop
|
||||
(suspend)
|
||||
)
|
||||
#f
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -100,7 +100,7 @@
|
|||
)
|
||||
|
||||
|
||||
(defstate die-state
|
||||
(defstate die-state (process)
|
||||
:enter (lambda () (format #t "enter die~%"))
|
||||
:exit (lambda () (format #t "exit die~%"))
|
||||
:code (lambda ()
|
||||
|
@ -144,13 +144,13 @@
|
|||
)
|
||||
|
||||
;; 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))
|
||||
:exit (lambda () (format #t "exit check~%"))
|
||||
: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))
|
||||
:exit (lambda () (format #t "exit wreck~%"))
|
||||
:code xmm-wreck-code
|
||||
|
|
Loading…
Reference in a new issue