Concatenative programming in Haskell's Arrows

10/18/06 11:03 pm

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 (:))

Tags: haskell, programming

6 comments

darius
10/19/06 04:01 am (UTC)

I don't know about that specific question, but FP has a concatenative flavor (not often remarked on because the syntax looks like "foo o bar" instead of Forth's "bar foo") and an easy translation into point-free Haskell ("foo . bar").
- Thread
- kpreid
  10/19/06 12:24 pm (UTC)
  
  (->) is an arrow, and in that case >>> (arrow composition) is equivalent to flip (.).
  
  What's interesting about doing this with general arrows rather than functions is that side-effects and so on are possible (e.g. e2, e3, and e6 have a print embedded, therefore they're in the Kleisli IO arrow).
- (Anonymous)
  7/28/08 05:50 am (UTC)
  
  FP does have a similar flavor, yes, but it is not concatenative. (Not that you were making that claim of course). The main difference is that FP is an applicative language, whereas languages like Joy are based on composition.
  
  - John Nowak
Embedding Postfix Languages in Haskell
(Anonymous)
11/9/06 11:44 pm (UTC)

See also Techniques for Embedding Postfix Languages in Haskell (http://www.eecs.usma.edu/webs/people/okasaki/pubs.html#hw02) by Chris Okasaki.

-- Chung-chieh Shan (http://www.cs.rutgers.edu/~ccshan/)
- Thread
(Anonymous)
7/28/08 05:52 am (UTC)

Reddit discussion here: http://tinyurl.com/6s7oho
- Thread

Recursion (and infix type constructors)

(Anonymous)

7/28/08 04:34 pm (UTC)

It looks bit nicer if you use infix type constructors for the pairs, because most of the pairing stuff from Arrows is not needed, due to the stack discipline. Also, something shorter than (>>>) looks better; I used (#) below.

Recursion works if you don't use the no-monorphism option, but instead give a type annotation (so I suspect there's a polymorphioc recursion hidden somewhere). And one can get rid of the inefficiencies of passing around all the typeclass dictionaries by specialising early, in this case to (Kleisli IO).

The result looks rather more like Cat (http://en.wikipedia.org/wiki/Cat_(programming_language)) than Joy or Factor. BTW, implementation of Cat as a Haskell DSL is not a new idea (see e.g. this post (http://groups.google.com/group/catlanguage/browse_thread/thread/1cd20cee5a087509)).

- Dirk

Code:

{-# OPTIONS -fglasgow-exts #-}
import Control.Arrow
import System.IO.Unsafe

type Cat a b = Kleisli IO a b

infixr 5 :.
infixr 1 #

data (:.) a b = a :. b

instance (Show a, Show z) => Show (a:.z) where
  show (a:.z) = show a ++ " " ++ show z

( # ) :: Cat a b -> Cat b c -> Cat a c
( # ) = (>>>)

pass :: Cat a a
pass = returnA

dup :: Cat (a:.z) (a:.a:.z)
dup = arr $ \(a:.z) -> (a:.a:.z)

rot :: Cat (a:.b:.c:.z) (c:.a:.b:.z)
rot = arr $ \(a:.b:.c:.z) -> (c:.a:.b:.z)

swap :: Cat (a:.b:.z) (b:.a:.z)
swap = arr $ \(a:.b:.z) -> (b:.a:.z)

pop :: Cat (a:.z) (z)
pop = arr $ \(a:.z) -> (z)

---- opN: N-argument pure functions to words

op0 :: a -> Cat (z) (a:.z)
op0 a = arr $ \(z) -> (a:.z)

op1 :: (a -> b) -> Cat (a:.z) (b:.z)
op1 f = arr $ \(a:.z) -> (f a:.z)

op2 :: (b -> a -> c) -> Cat (a:.b:.z) (c:.z)
op2 f = arr $ \(a:.b:.z) -> (f b a:.z)

push :: a -> Cat (z) (a:.z)
push x = op0 x

-- ioN: N-argument IO monadic functions to words

io0 :: IO a -> Cat (z) (a:.z)
io0 m = Kleisli $ \z -> m >>= \a -> return (a:.z)

io1 :: (a -> IO b) -> Cat (a:.z) (b:.z)
io1 m = Kleisli $ \(a:.z) -> m a >>= \b -> return (b:.z)

io2 :: (a -> b -> IO c) -> Cat (a:.b:.z) (c:.z)
io2 m = Kleisli $ \(a:.b:.z) -> m a b >>= \c -> return (c:.z)

---- if-then-else

ifte :: Cat (a:.a:.Bool:.z) (a:.z)
ifte = arr $ \(e:.t:.b:.z) -> if b then (t:.z) else (e:.z)

---- Application

apply :: Cat (Cat (x) (y) :. x) (y)
apply = arr (\(x:.y) -> (x,y)) >>> app

---- Execution

run :: Show y => Cat x y -> x -> y
run (Kleisli f) x = unsafePerformIO (f x)

---- Example

fib :: Cat (Integer:.z) (Integer:.z)
fib = dup # push 1 # op2 (<=) 
  # push (pass)
  # push (dup # push 1 # op2 (-) # fib # swap # push 2 # op2 (-) # fib # op2 (+))
  # ifte # apply

Example in the toplevel:

*Main> [run fib (x:.()) | x <- [1..10]]
[1 (),1 (),2 (),3 (),5 (),8 (),13 (),21 (),34 (),55 ()]

Thread

Log in

Kevin Reid's blog

View

Links

Concatenative programming in Haskell's Arrows

Embedding Postfix Languages in Haskell

Recursion (and infix type constructors)