;; Hidden state threading.

;; The easiest way to thread invisible state through a program is to
;; hide it on the op of the stack, and shield it from words that are
;; not aware of it. This module implements syntax to do this.

;; The basic idea is to have some composite code like
;;
;;   a b c GET d e f PUT h i j
;;
;; and transform it to
;;
;;   (a) dip (b) dip (c) dip GET (d) dip (e) dip (f) dip PUT ...
;;
;; which is actually equivalent to
;;
;;   (a b c) dip GET (d e f) dip PUT (h i j) dip
;;

;; Words that are not in a particular dictionary will be lifted so
;; they never see the state object on the top of the stack, while the
;; words in that dictionary do see it. The lifting is the 'map'
;; operation from the unit-map-join formulation of monads.

;; Note that because we do not have polymorphy and type inference, we
;; can't define 'join' and 'return' without annotating the type,
;; i.e. by providing functions like 'foo:join' and 'foo:return'.

;; So, basicly, this is some ad-hoc monad thingy.. Will probably stay
;; like that until i figure out a reason to make it more formal.




(module state mzscheme
  (require "composite.ss"
           "primitive.ss"
           "ns-state-stx.ss"
           "base.ss"
           "ns.ss")

  (provide (all-defined))

  ;; Namespaces and compilers
  ;; (ns-new  '(state))
  ;; (ns-new  '(store))
  
  (ns-state-stx (state: base:)
                ((state))
                ((base)))
  
  (ns-state-stx (store: base:)
                ((store) (state))
                ((base)))
  

  
  ;; STATE

  (compositions (base) base:

   ;; Independent of the syntactic extensions are the operations
   ;; 'unit' and 'bind'. Refer to any text on monads in Haskell for
   ;; more information.

   (unit-state)           ;; simply the identity function
   (bind-state-state run) ;; S S->S  -- S

  )                
  
  (compositions (state) base:

   ;; This dictionary implements words for single state object
   ;; access. The access itself is fairly trivial. 'state!' is a
   ;; 'join' operation from the unit-map-join formulation of monads.
                
   (state  dup)
   (state! drop)   

   ;; The fun is in the higher order combinators. Observe that in
   ;; state syntax (see rpn-tx.ss) 

   ;; * Quoted programs by default DO NOT use state syntax. 

   ;; * Higher order functions like 'run', 'for-each', 'ifte', 'dip',
   ;;   ... are ignorant of state: they are lifted themselves.

   ;; These two are according to the "no surprises please"
   ;; rule. Suppose quoted programs would be aware of state. Then they
   ;; could never be passed as an argument to a higher order (pure)
   ;; function, unless all these functions are somehow made aware of
   ;; state. This is a non-trivial problem, so i opt for a simple
   ;; explicit solution:

   ;; * Quotation syntax can be overridden if explicitly mentioned,
   ;;   i.e. (state: 123 state!) instead of (123 state!)

   ;; * Higher order functions have an explicit state passing version,
   ;;   which is named as the original, but with the '/s' postfix.

   (run/s            swap run)
   (run/error/s      swap run/error)
   
   (interpret/s      swap interpret)
   (for-each/s       -rot for-each)
   (for/s            -rot for)

   (dip/s            -rot dip swap)
   (ifte/s           -rot4 ifte)

   (with-io-device/s -rot with-io-device)

   )


  ;; STORE - tagged dictionary object
  (compositions (base) base:

   ;; The unit function maps a (name . value) pair to a dictionary
   (unit-store  '() cons)

   ;; Inter-store binding updates the dictionary.
   (bind-store-store   ;; M fn -- M
    ;; ??? not so trivial..
    )
   
   )
  
  (compositions (store) base:

   ;; Extending the state object with operations that interpret the
   ;; state as a dictionary: data can be accesses by tag (i.e. a
   ;; symbol). The dictionary is implemented purely functionally: only
   ;; functional mutation (rebuilding of data structure) is used.
                
   (@      dup (swap dict-find) dip)
   (!      swap3 dict-set)            ;; doesn't define

   ;; These words are for hierarchical access: instead of a single
   ;; tag, a list is used for recursively indexing into a chain of
   ;; dictionaries.
   
   (@@     dup (swap dict-recursive-find) dip)
   (!!     swap3 dict-recursive-mute)
   
   )

  (compositions (store) store:
   ;; stack ops
   ;; FIXME: maybe hierarchical?                
   (push   dup (store: @ cons) dip/s !)
   (pop    dup (store: @ uncons) dip/s !)
   )
 

   
                    
  

  
)