Created
February 16, 2012 20:51
-
-
Save rampion/1847747 to your computer and use it in GitHub Desktop.
Playing with Factor's Row Polymorphism in Haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE TypeOperators #-} | |
-- inspired by "Why concatenative programming matters." | |
-- (http://evincarofautumn.blogspot.com/2012/02/why-concatenative-programming-matters.html) | |
-- | |
-- playing with adapting row polymorphism to Haskell, because, hey, why not? | |
module RowPolymorphism.Primitives ( | |
(:>)(), Stack, | |
lift, quote, (!), | |
dip, dup, over, swap, drop, call | |
) where | |
-- our drop is better | |
import Prelude hiding (drop) | |
-- build a Stack for us to be Row Polymorphic on | |
data s :> a = s :> a | |
deriving (Show, Eq, Ord) | |
infixl 5 :> | |
class Stack a | |
instance Stack () | |
instance Stack s => Stack (s :> a) | |
-- lift lets us change all our haskell functions into | |
-- into more factor-like words that operate on the stack | |
lift :: Stack s => (a -> b) -> (s :> a) -> (s :> b) | |
lift f (s :> a) = s :> f a | |
-- quote lets us push things onto the stack. | |
-- | |
-- `quote dip` is equivalent to factor's `[ dip ]` | |
-- | |
-- Note that `quote 3` is not the equivalent of `[ 3 ]`. | |
-- For that, we need `quote __3__`, where | |
-- __3__ :: (Stack s, Num a) => s -> (s :> a) | |
-- __3__ = quote 3 | |
-- This is due to the different semantic meaning of the literal 3 in | |
-- haskell and factor. | |
quote :: Stack s => a -> s -> (s :> a) | |
quote = flip (:>) | |
-- factor uses whitespace to represent concatenation, whereas | |
-- haskell uses whitespace to represent application, so we'll | |
-- need an operator to combine our factor terms | |
(!) :: (Stack s, Stack s') => (s -> s') -> (s' -> s'') -> (s -> s'') | |
(!) = flip (.) | |
infixl 9 ! | |
-- equivalent to factor's dip from http://docs.factorcode.org/content/word-dip,kernel.html | |
dip :: (Stack s, Stack s') => (s :> x :> (s -> s')) -> (s' :> x) | |
dip (s :> x :> f) = f s :> x | |
-- equivalent to factor's dup from http://docs.factorcode.org/content/word-dup,kernel.html | |
dup :: Stack s => (s :> a) -> (s :> a :> a) | |
dup s@(_ :> a) = s :> a | |
-- equivalent to factor's over from http://docs.factorcode.org/content/word-over,kernel.html | |
over :: Stack s => (s :> a :> b) -> (s :> a :> b :> a) | |
over s@(_ :> a :> _) = s :> a | |
-- equivalent to factor's swap from http://docs.factorcode.org/content/word-swap,kernel.html | |
swap :: Stack s => (s :> b :> a) -> (s :> a :> b) | |
swap (s :> b :> a) = s :> a :> b | |
-- equivalent to factor's drop from http://docs.factorcode.org/content/word-drop,kernel.html | |
drop :: Stack s => (s :> a) -> s | |
drop (s :> _) = s | |
-- equivalent to factor's call from http://docs.factorcode.org/content/word-call,kernel.html | |
call :: Stack s => (s :> (s -> s')) -> s' | |
call ( s :> f ) = f s | |
-- not going to claim this is a minimum basis, but it's a start, right? |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE TypeOperators #-} | |
module RowPolymorphism.Core where | |
-- now that we've got some primitives | |
import RowPolymorphism.Primitives | |
-- let's see whether we can do some factor in haskell! | |
__plus__ :: (Stack s, Num a) => (s :> a :> a) -> (s :> a) | |
-- lift . (+) :: a -> (s :> a) -> (s :> a) | |
-- lift (lift . (+)) :: (s' :> a) -> (s' :> ((s :> a) -> (s:> a)) | |
-- lift (lift . (+)) ! call :: (s :> a :> a) -> (s :> a) | |
__plus__ = lift (lift . (+)) ! call | |
__minus__ :: (Stack s, Num a) => (s :> a :> a) -> (s :> a) | |
__minus__ = lift (lift . flip (-)) ! call | |
__replicate__ :: Stack s => (s :> a :> Int) -> (s :> [a]) | |
-- replicate :: Int -> a -> [a] | |
-- lift . replicate :: Int -> (s :> a) -> (s :> [a]) | |
-- lift (lift . replicate) :: (s' :> Int) -> (s' :> ((s :> a) -> (s:> [a])) | |
-- lift (lift . replicate) ! call :: (s :> a :> Int) -> (s :> [a]) | |
__replicate__ = lift (lift . replicate) ! call | |
-- similar to factor's if, except it forces the two branches to | |
-- leave an identical stack | |
-- (see http://docs.factorcode.org/content/word-if,kernel.html) | |
__if__ :: Stack s => (s :> Bool :> (s -> s') :> (s -> s')) -> s' | |
-- lift (\a -> lift (\a' -> lift (ifThenElse a a'))) ! call ! call | |
-- :: ( s :> Bool :> a :> a ) -> ( s :> a ) | |
__if__ = lift (lift . (lift .) . ifThenElse) ! call ! call ! call | |
where ifThenElse :: a -> a -> Bool -> a | |
ifThenElse a a' b = if b then a else a' | |
-- for a quarternary function f, to lift it, we'd need: | |
-- lift ( lift . ( lift . ) . ( (lift .) . ) . f ) ! call ! call ! call | |
-- which is getting completely out of hand :) | |
-- same as definition from http://docs.factorcode.org/content/word-keep,kernel.html | |
keep :: (Stack s, Stack s') => (s :> x :> (s :> x -> s')) -> (s' :> x) | |
keep = over ! quote call ! dip | |
-- same as definition from http://docs.factorcode.org/content/word-bi,kernel.html | |
bi :: (Stack s, Stack s') => (s :> x :> (s :> x -> s') :> (s' :> x -> s'')) -> s'' | |
bi = quote keep ! dip ! call | |
-- same as definition from http://docs.factorcode.org/content/word-bi__star__,kernel.html | |
bi__star__ :: (Stack s, Stack s') => (s :> x :> y :> (s :> x -> s') :> (s' :> y -> s'')) -> s'' | |
bi__star__ = quote dip ! dip ! call | |
-- same as definition from http://docs.factorcode.org/content/word-2dup,kernel.html | |
__2__dup :: Stack s => (s :> x :> y) -> (s :> x :> y :> x :> y) | |
__2__dup = over ! over | |
-- same as definition from http://docs.factorcode.org/content/word-2dip,kernel.html | |
__2__dip :: (Stack s, Stack s') => (s :> x :> y :> (s -> s')) -> (s' :> x :> y) | |
__2__dip = swap ! quote dip ! dip | |
-- same as definition from http://docs.factorcode.org/content/word-2keep,kernel.html | |
__2__keep :: (Stack s, Stack s') => (s :> x :> y :> (s :> x :> y -> s')) -> (s' :> x :> y) | |
__2__keep = quote __2__dup ! dip ! __2__dip | |
-- same as definition from http://docs.factorcode.org/content/word-2bi,kernel.html | |
__2__bi :: (Stack s, Stack s') => (s :> x :> y :> (s :> x :> y -> s') :> (s' :> x :> y -> s'')) -> s'' | |
__2__bi = quote __2__keep ! dip ! call | |
-- this obviously won't work for everything (what about all that side-effecty | |
-- stuff), but it's still fun. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
1_RowPolymorphism_Core.hs |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
0_RowPolymorphism_Primitives.hs |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment