public

Playing with Factor's Row Polymorphism in Haskell

  • Download Gist
0_RowPolymorphism_Primitives.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
{-# 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?
1_RowPolymorphism_Core.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
{-# 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.
Core.hs
Haskell
1
1_RowPolymorphism_Core.hs
Primitives.hs
Haskell
1
0_RowPolymorphism_Primitives.hs

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.