(module action-util mzscheme

  (require (lib "plt-match.ss")
           "action.ss"
           "pool.ss"
           "require.ss")
  (require-contracts)
  (require-equiv)
  (require-mz:class)

  (define action=?
    (make-equiv (add-equiv-rule/leaf handle? handle=? default-equiv-rules)))

  (define initial-stack-frame
    (make-stack-frame 0 #f #f))

  (define (action-source action)
    (stack-frame-control (action-control-in action)))

  (define (action-target action)
    (cond
     [(new? action) (new-object action)]
     [(call? action) (call-receiver action)]
     [(return? action) (stack-frame-control (action-control-out action))]
     [(get? action) (get-receiver action)]
     [(set? action) (set-receiver action)]
     [(inspect? action) (inspect-receiver action)]))

  (define (spec->action pool prev spec)
    (let* ([time (if prev (+ (action-timestamp prev) 1) 0)]
           [frame (if prev (action-control-out prev) initial-stack-frame)])
      (match spec
        [(list 'new object fields)
         (make-new time frame frame
                   (pool-lookup pool object)
                   (map (match-lambda
                          [`(,name ,value)
                           (list name (pool-lookup pool value))])
                        fields))]
        [(list 'call receiver method args)
         (let* ([obj (pool-lookup pool receiver)])
           (make-call time frame (make-stack-frame (+ time 1) obj frame)
                      obj method
                      (map (lambda (arg) (pool-lookup pool arg)) args)))]
        [(list 'return returned-values)
         (make-return time frame (stack-frame-previous frame)
                      (map (lambda (value) (pool-lookup pool value))
                           returned-values))]
        [(list 'get receiver field)
         (make-get time frame frame
                   (pool-lookup pool receiver)
                   field)]
        [(list 'set receiver field value)
         (make-set time frame frame
                   (pool-lookup pool receiver)
                   field
                   (pool-lookup pool value))]
        [(list 'inspect receiver)
         (make-inspect time frame frame
                       (pool-lookup pool receiver))])))

  (provide/contract
   [action=? (action? action? . -> . boolean?)]
   [action-source (action? . -> . (optional/c object-handle?))]
   [action-target (action? . -> . (optional/c object-handle?))]
   [initial-stack-frame stack-frame?]
   [spec->action (pool? (optional/c action?) spec/c . -> . action?)])

  )