[Haskell-cafe] Simple but slow, and complex but fast Forth emulation [Was: Bang, a drum DSL for Haskell]

[oleg at okmij.org]

Emulation of a simple subset of Forth in Haskell seems easy. The trick,
continuation-passing style, has been known for a long time. The trick
underlies `functional unparsing' by Olivier Danvy.
        http://www.brics.dk/RS/98/12/BRICS-RS-98-12.pdf
(published in JFP in 1998). 

Chris Okasaki later extended the technique
        http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.121.1890
        http://dl.acm.org/citation.cfm?id=581699

He also noted huge types and slow compilation times.

But there is another way. It is far more complex, and far fast. It is
used in HSXML, which handles polyvariadic functions with literally
thousands of arguments (some of my web pages are long). The following
complete code illustrates the idea.

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

-- Simple Forth

module SimpleForth where

-- The simple way: Danvy's Functional unparsing
begin k = k ()
n st x k = k ((x::Int),st)
add (n1,(n2,st)) k = k (n1+n2,st)
end (top,st) = top

t1 = begin n 1 n 2 add end

-- Uncomment the following to get a hint why t2 is too slow
-- t1 = begin _h n 1 n 2 add end

-- Uncomment the following only if you are prepared to wait
{-
t2 = begin n 1 n 2 n 3 n 4 n 5 n 6 n 7 n 8 n 9
           add
           add
           add
           add
           add
           add
           add
           add
           end
-}

-- A more complex but faster way

-- Start with a stack 'stack' and then continue
class Forth stack r where
  build :: stack -> r

data End = End

instance (a ~ stack) => Forth stack (End -> a) where
  build stack _ = stack

data Add = Add

-- Start with (Int, (Int, stack)), see Add and continue with (Int,stack)
instance Forth (Int,stack) r => Forth (Int,(Int,stack)) (Add -> r) where
  build (n1,(n2,stack)) _ = build (n1+n2,stack)

data N = N

instance (a ~ Int, Forth (Int,stack) r) => Forth stack (N -> a -> r) where
  build stack _ n = build (n,stack)


-- All of the following typecheck instantaneously, even on my slow
-- laptop

tt1 = build () N 1 N 2 Add End

tt2 = build () N 1 N 2 N 3 N 4 N 5 N 6 N 7 N 8 N 9
      Add
      Add
      Add
      Add
      Add
      Add
      Add
      Add
      End

tt3 = build () N 1
      N 2 Add
      N 3 Add
      N 4 Add
      N 5 Add
      N 6 Add
      N 7 Add
      N 8 Add
      N 9 Add
      End