Cat in Haskell

391 views
Skip to first unread message

Christopher Diggins

unread,
Sep 16, 2007, 9:37:04 PM9/16/07
to catla...@googlegroups.com
Stefan Monnier has generously shared his implementation of Cat in
Haskell. There are still some issues to be worked out (I may have
inadvertently introduced bugs). The source code follows:

{-
An embedding of the Cat language in Haskell
Copyright 2007, Stefan Monnier
Modified by Christopher Diggins

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.

Compile with Glasgow extensions on. From GHCi this can be done using
":set -fglasgow-exts"

See Also:
* Techniques for Embedding Postfix Languages in Haskell by Chris
Okasaki. Haskell Workshop,
October 2002, pages 105-113.
- http://www.eecs.usma.edu/webs/people/okasaki/hw02.ps
- http://www.eecs.usma.edu/webs/people/okasaki/Hw02code.zip
* Miaou: Cat in Haskell using Monads by Adrien Pierard
- http://pied.mine.nu//index.php?page=Lambda&id=22
* Cat interpreter in Omega using thrists (threaded lists) by Gabor Greif
- http://svn.berlios.de/viewcvs/al4nin/trunk/purgatory/Thrist.omg?rev=351
* Cat evaluator function in Standard ML by Kevin Millikin
- http://lambda-the-ultimate.org/node/2281#comment-33765
-}

-- Push a literal value "x" onto stack "s"
lit' x s = (s, x)

-- Remove top value from stack
pop' (s, x) = s

-- Duplicate top value on stack
dup' (s, x) = ((s, x), x)

-- Add top two values on stack
add' ((s, x), y) = (s, x + y)

-- Apply function on the top of the stack to the rest of the stack
apply'(s, f) = f s

-- Apply function on the stack below the next value
-- Should be equivalent to "swap quote compose apply"
dip' ((s, x), f) = (f s, x)

-- Swap top two elements of the stack
swap' ((s, x), y) = ((s, y), x)

-- Compose top two functions on the stack
compose' ((s, f), g) = (s, g . f)

-- Create a constant generaing function from top value on the stack
quote' :: (t, a) -> (t, forall u . u -> (u, a))
quote' (s, x) = (s, \s -> (s,x))

-- Used to delimit sequences of Cat instructions
start k = k ()
end s = s

-- Technique to allow Cat instructions to be expressed in postfix
postfix0 f s k = k (f s)
postfix1 f s arg k = k (f arg s)
postfix2 f s arg1 arg2 k = k (f arg1 arg2 s)

-- Construct postfix versions of each function
lit = postfix1 lit'
pop = postfix0 pop'
dup = postfix0 dup'
swap = postfix0 swap'
add = postfix0 add'
apply = postfix0 apply'
dip = postfix0 dip'
quote = postfix0 quote'
compose = postfix0 compose'

-- Some tests, expect a stack of "((), 1, 2)" as a result of each test
t0 = start lit 1 lit 2 end
t1 = start lit 0 lit 1 add lit 2 end
t2 = start lit 1 dup lit 1 add end
t3 = start lit 1 lit 2 lit 3 pop end
t4 = start lit 2 lit 1 swap end

-- Failing Tests
t5 = start lit 0 lit 1 lit add apply lit 2 end
t6 = start lit 0 lit 1 lit 2 lit add dip end

-- Won't Compile Tests
-- t7 = start lit 1 quote apply lit 2 end
-- t8 = start lit 1 quote lit 2 quote compose apply end
-- t9 = start lit 1 quote end -- should return [1], but fails

Reply all
Reply to author
Forward
0 new messages