rose-ash/spec/frames.sx

;; ==========================================================================
;; frames.sx — CEK machine frame types
;;
;; Defines the continuation frame types used by the explicit CEK evaluator.
;; Each frame represents a "what to do next" when a sub-evaluation completes.
;;
;; A CEK state is a dict:
;;   {:control expr       — expression being evaluated (or nil in continue phase)
;;    :env     env        — current environment
;;    :kont    list       — continuation: list of frames (stack, head = top)
;;    :phase   "eval"|"continue"
;;    :value   any}       — value produced (only in continue phase)
;;
;; Two-phase step function:
;;   step-eval:     control is expression → dispatch → push frame + new control
;;   step-continue: value produced → pop frame → dispatch → new state
;;
;; Terminal state: phase = "continue" and kont is empty → value is final result.
;; ==========================================================================


;; --------------------------------------------------------------------------
;; 1. CEK State constructors
;; --------------------------------------------------------------------------

(define make-cek-state
  (fn (control env kont)
    {:control control :env env :kont kont :phase "eval" :value nil}))

(define make-cek-value
  (fn (value env kont)
    {:control nil :env env :kont kont :phase "continue" :value value}))

(define cek-terminal?
  (fn (state)
    (and (= (get state "phase") "continue")
         (empty? (get state "kont")))))

(define cek-control  (fn (s) (get s "control")))
(define cek-env      (fn (s) (get s "env")))
(define cek-kont     (fn (s) (get s "kont")))
(define cek-phase    (fn (s) (get s "phase")))
(define cek-value    (fn (s) (get s "value")))


;; --------------------------------------------------------------------------
;; 2. Frame constructors
;; --------------------------------------------------------------------------
;; Each frame type is a dict with a "type" key and frame-specific data.

;; IfFrame: waiting for condition value
;; After condition evaluates, choose then or else branch
(define make-if-frame
  (fn (then-expr else-expr env)
    {:type "if" :then then-expr :else else-expr :env env}))

;; WhenFrame: waiting for condition value
;; If truthy, evaluate body exprs sequentially
(define make-when-frame
  (fn (body-exprs env)
    {:type "when" :body body-exprs :env env}))

;; BeginFrame: sequential evaluation
;; Remaining expressions to evaluate after current one
(define make-begin-frame
  (fn (remaining env)
    {:type "begin" :remaining remaining :env env}))

;; LetFrame: binding evaluation in progress
;; name = current binding name, remaining = remaining (name val) pairs
;; body = body expressions to evaluate after all bindings
(define make-let-frame
  (fn (name remaining body local)
    {:type "let" :name name :remaining remaining :body body :env local}))

;; DefineFrame: waiting for value to bind
(define make-define-frame
  (fn (name env has-effects effect-list)
    {:type "define" :name name :env env
     :has-effects has-effects :effect-list effect-list}))

;; SetFrame: waiting for value to assign
(define make-set-frame
  (fn (name env)
    {:type "set" :name name :env env}))

;; ArgFrame: evaluating function arguments
;; f = function value (already evaluated), evaled = already evaluated args
;; remaining = remaining arg expressions
(define make-arg-frame
  (fn (f evaled remaining env raw-args head-name)
    {:type "arg" :f f :evaled evaled :remaining remaining :env env
     :raw-args raw-args :head-name (or head-name nil)}))

;; CallFrame: about to call with fully evaluated args
(define make-call-frame
  (fn (f args env)
    {:type "call" :f f :args args :env env}))

;; CondFrame: evaluating cond clauses
(define make-cond-frame
  (fn (remaining env scheme?)
    {:type "cond" :remaining remaining :env env :scheme scheme?}))

;; CaseFrame: evaluating case clauses
(define make-case-frame
  (fn (match-val remaining env)
    {:type "case" :match-val match-val :remaining remaining :env env}))

;; ThreadFirstFrame: pipe threading
(define make-thread-frame
  (fn (remaining env)
    {:type "thread" :remaining remaining :env env}))

;; MapFrame: higher-order map/map-indexed in progress
(define make-map-frame
  (fn (f remaining results env)
    {:type "map" :f f :remaining remaining :results results :env env :indexed false}))

(define make-map-indexed-frame
  (fn (f remaining results env)
    {:type "map" :f f :remaining remaining :results results :env env :indexed true}))

;; FilterFrame: higher-order filter in progress
(define make-filter-frame
  (fn (f remaining results current-item env)
    {:type "filter" :f f :remaining remaining :results results
     :current-item current-item :env env}))

;; ReduceFrame: higher-order reduce in progress
(define make-reduce-frame
  (fn (f remaining env)
    {:type "reduce" :f f :remaining remaining :env env}))

;; ForEachFrame: higher-order for-each in progress
(define make-for-each-frame
  (fn (f remaining env)
    {:type "for-each" :f f :remaining remaining :env env}))

;; SomeFrame: higher-order some (short-circuit on first truthy)
(define make-some-frame
  (fn (f remaining env)
    {:type "some" :f f :remaining remaining :env env}))

;; EveryFrame: higher-order every? (short-circuit on first falsy)
(define make-every-frame
  (fn (f remaining env)
    {:type "every" :f f :remaining remaining :env env}))

;; ScopeFrame: scope-pop! when frame pops
(define make-scope-frame
  (fn (name remaining env)
    {:type "scope" :name name :remaining remaining :env env}))

;; ResetFrame: delimiter for shift/reset continuations
(define make-reset-frame
  (fn (env)
    {:type "reset" :env env}))

;; DictFrame: evaluating dict values
(define make-dict-frame
  (fn (remaining results env)
    {:type "dict" :remaining remaining :results results :env env}))

;; AndFrame: short-circuit and
(define make-and-frame
  (fn (remaining env)
    {:type "and" :remaining remaining :env env}))

;; OrFrame: short-circuit or
(define make-or-frame
  (fn (remaining env)
    {:type "or" :remaining remaining :env env}))

;; QuasiquoteFrame (not a real frame — QQ is handled specially)

;; DynamicWindFrame: phases of dynamic-wind
(define make-dynamic-wind-frame
  (fn (phase body-thunk after-thunk env)
    {:type "dynamic-wind" :phase phase
     :body-thunk body-thunk :after-thunk after-thunk :env env}))

;; ReactiveResetFrame: delimiter for reactive deref-as-shift
;; Carries an update-fn that gets called with new values on re-render.
(define make-reactive-reset-frame
  (fn (env update-fn first-render?)
    {:type "reactive-reset" :env env :update-fn update-fn
     :first-render first-render?}))

;; DerefFrame: awaiting evaluation of deref's argument
(define make-deref-frame
  (fn (env)
    {:type "deref" :env env}))


;; --------------------------------------------------------------------------
;; 3. Frame accessors
;; --------------------------------------------------------------------------

(define frame-type (fn (f) (get f "type")))


;; --------------------------------------------------------------------------
;; 4. Continuation operations
;; --------------------------------------------------------------------------

(define kont-push
  (fn (frame kont) (cons frame kont)))

(define kont-top
  (fn (kont) (first kont)))

(define kont-pop
  (fn (kont) (rest kont)))

(define kont-empty?
  (fn (kont) (empty? kont)))


;; --------------------------------------------------------------------------
;; 5. CEK shift/reset support
;; --------------------------------------------------------------------------
;; shift captures all frames up to the nearest ResetFrame.
;; reset pushes a ResetFrame.

(define kont-capture-to-reset
  (fn (kont)
    ;; Returns (captured-frames remaining-kont).
    ;; captured-frames: frames from top up to (not including) ResetFrame.
    ;; remaining-kont: frames after ResetFrame.
    ;; Stops at either "reset" or "reactive-reset" frames.
    (define scan
      (fn (k captured)
        (if (empty? k)
          (error "shift without enclosing reset")
          (let ((frame (first k)))
            (if (or (= (frame-type frame) "reset")
                    (= (frame-type frame) "reactive-reset"))
              (list captured (rest k))
              (scan (rest k) (append captured (list frame))))))))
    (scan kont (list))))

;; Check if a ReactiveResetFrame exists anywhere in the continuation
(define has-reactive-reset-frame?
  (fn (kont)
    (if (empty? kont) false
      (if (= (frame-type (first kont)) "reactive-reset") true
        (has-reactive-reset-frame? (rest kont))))))

;; Capture frames up to nearest ReactiveResetFrame.
;; Returns (captured-frames, reset-frame, remaining-kont).
(define kont-capture-to-reactive-reset
  (fn (kont)
    (define scan
      (fn (k captured)
        (if (empty? k)
          (error "reactive deref without enclosing reactive-reset")
          (let ((frame (first k)))
            (if (= (frame-type frame) "reactive-reset")
              (list captured frame (rest k))
              (scan (rest k) (append captured (list frame))))))))
    (scan kont (list))))