{-
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