Concatenative programming in Haskell's Arrows

On Sunday, I was reading about arrows in Haskell, and I noticed that these diagrams of the primitive arrow functions looked rather like diagrams of data flow in concatenative (stack-based) languages.

This suggested that they might be related, or transformable.

(IRC log of the early discussion)

I have now found that simple concatenative code is quite easily expressed with arrows, but there are apparent limitations depending on the value representation.

• If you use tuples (i.e. (a, (b, ()))), then the standard arrow combinators can be used for some nice definitions (e.g. call and m1_0 in the code below), and you automatically get Haskell's static typing for stack elements, but recursion and general quotation calling is not possible because the entire "stack", even the items not touched by the current "word", needs a specific type. I'd think this could be solved by existential types but I haven't seen a way to do so yet.
• If you use lists (i.e. a : b : []), then general calls and recursion are possible, but the stack is homogeneous, and the type system can't see anything interesting about words' stack usage.

Below are my (rather disorganized) experiments so far. If you see a way to remove the restrictions of the tuple version, please let me know!

{-# OPTIONS -fno-monomorphism-restriction #-}
module Concat where

import Data.Typeable
import Data.Dynamic
import Control.Arrow
import Data.Maybe

-- Stack shuffling combinators
rot = arr (\(a, (b, (c, z))) -> (c, (a, (b, z))))
dup = arr (\(a, z) -> (a, (a, z)))
swap = arr (\(a, (b, z)) -> (b, (a, z)))

-- opN: N-argument pure functions to words
op1 f = arr (\(a, z) -> (f a, z))
op2 f = arr (\(a, (b, z)) -> (f b a, z))

-- Turn a function producing a monadic action into a word
m1_0 f = first (Kleisli f) >>> arr snd

-- Literal push; usually implicit in concatenative languages
push x = arr ((,) x)

-- Call a quotation
call = app
keep = arr (\(q, (v, z)) -> ((q, (v, z)), v)) 
       >>> first app 
       >>> arr (\(z, v) -> (v, z))
dip = arr (\(q, (v, z)) -> ((q, z), v)) 
      >>> first app
      >>> arr (\(z, v) -> (v, z))

-- callM_N: Call a quotation, hiding all but M stack elements and producing N.
-- This was an attempt to work around the recursion/call typing problem.
call1_1 :: (ArrowApply a) => a (a (b, ()) (c, ()), (b, z)) (c, z)
call1_1 = arr (\(q, (v, z)) -> ((q, (v, ())), z)) 
          >>> first app 
          >>> arr(\((v, ()), z) -> (v, z))
call1_0 = arr (\(q, (v, z)) -> ((q, (v, ())), z)) 
          >>> first app
          >>> arr(\((), z) -> z)

-- Conditionals
-- ifte takes quotations on the stack like in Joy and Factor; iftep is 
-- parameterized by the branches and thus more like Forth, and doesn't need
-- ArrowApply.
ifte = arr (\(fq, (tq, (c, z))) -> if c then Left (tq, z) else Right (fq, z))
       >>> (app ||| app)
iftep t f = arr (\(c, z) -> if c then Left z else Right z) >>> (t ||| f)

-- Failed experiment in avoiding explicitly specifying one of the callM_N family.
-- For some reason, it infers an equal-height input and output stack, or
-- something like that.
class Call i o where
  ccall :: (ArrowApply a) => a (a (i ()) (o ()), (i z)) (o z)

-- Examples/test cases.
e2 = push (push 1 >>> m1_0 print) >>> call
e3 = push 1 >>> push 2 >>> push (m1_0 print) >>> dip >>> (m1_0 print)
e4 = push False >>> push (push "T") >>> push (push "F") >>> ifte >>> m1_0 print
e5 = push False >>> iftep (push "T") (push "F") >>> m1_0 print

e6 = push 1 >>> push (m1_0 print) >>> keep >>> m1_0 print

--typetest = push (m1_0 print) >>> dup >>> push "a" >>> swap >>> ccall 
--           >>> push "b" >>> swap >>> ccall

example = push 1 >>> push 2 >>> push 3 >>> rot >>> op2 (/) >>> op2 (*) 
          >>> m1_0 print

hide = second toDyn
reveal = second (fromJust . fromDynamic)

--recursive = hide >>> dup >>> op1 null >>> iftep (returnA) (dup >>> op1 head
--            >>> op1 succ >>> swap >>> op1 tail >>> recursive >>> op2 (:)) 
--            >>> reveal


-- List-based combinators. Currently lacking a solution for putting interesting
-- values on the stack.
lop1 f = arr (\(a:z) -> f a : z)
lop2 f = arr (\(a:b:z) -> f b a : z)
ldup f = arr (\(a:z) -> a:a:z)
lpush x = arr (x:)
lrot = arr (\(a:b:c:z) -> c:a:b:z)
lswap = arr (\(a:b:z) -> b:a:z)
liftep t f = arr (\(c:z) -> if c then Left z else Right z) >>> (t ||| f)

lexample = lpush 1 >>> lpush 2 >>> lpush 3 >>> lrot
           >>> lop2 (/) >>> lop2 (*) >>> (Kleisli print)

--lrecursive = ldup >>> lop1 null >>> liftep (returnA) (ldup >>> lop1 head
--             >>> lop1 succ >>> lswap >>> lop1 tail >>> lrecursive >>> lop2 (:))