Dual.hs

module Dual where

import Prelude.Unicode
import Data.List
import Control.Applicative

data Term = Term :$: [Term]
          | Term :→: Term
          | Id String

instance Show Term where
  show (tc :$: ts)                    = show tc ++ " " ++ intercalate " " (show <$> ts)
  show (ta :→: (tb@(_ :→: _) :→: tc)) = show ta ++ " -> (" ++ show tb ++ ") -> " ++ show tc
  show (ta :→: tb)                    = show ta ++ " -> " ++ show tb
  show (Id name)                      = name

infixr :→:, :$:

assoc (ta :→: tb) = ta : assoc tb
assoc x           = [x]

unassoc = foldr1 (:→:)
                  
app f t@(_ :→: _) = f t
app _ t           = t

dual = unassoc ∘ map (app dual) ∘ reverse ∘ assoc

ret  = Id "a" :→: (Id "m" :$: [Id "a"])
bind = (Id "m" :$: [Id "a"]) :→: (Id "a" :→: (Id "m" :$: [Id "b"])) :→: (Id "m" :$: [Id "b"])

coret  = dual ret
cobind = dual bind