graph-rewriting-ski-0.4.3: Term.hs

-- | Syntax does not allow spaces, combinator names in capital letters, any other character besides combinators and parentheses is interpreted as a variable name. 

module Term where

import Prelude.Unicode
import Text.ParserCombinators.Parsec as Parsec
import Control.Monad (liftM)

data Expr = A Expr Expr | S | K | I | {- B | C | -} V String deriving (Ord, Eq)

instance Show Expr where
	show = showComp False where
		showComp :: Bool → Expr → String
		showComp isComponent expr = case expr of
			A (A e1 e2) e3 → maybeWrap $ show e1 ⧺ " " ⧺ diverge e2 ⧺ " " ⧺ diverge e3
			A e1 e2 → maybeWrap $ diverge e1 ⧺ " " ⧺ diverge e2
			S → "S"
			K → "K"
			I → "I"
--			B → "B"
--			C → "C"
			V v → v
			where
			maybeWrap str = if isComponent then "(" ⧺ str ⧺ ")" else str
			diverge = showComp True

parse ∷ String → Expr
parse str = either (error ∘ show) id (Parsec.parse parser "(null)" str)

parseFile ∷ FilePath → IO Expr
parseFile = liftM (either (error ∘ show) id) ∘ Parsec.parseFromFile parser

parser ∷ Parser Expr
parser = let expr = parser in liftM (foldl1 A) $ many1 $ choice
	[char 'S' >> return S,
	 char 'K' >> return K,
	 char 'I' >> return I,
--	 char 'B' >> return B,
--	 char 'C' >> return C,
--	 char 'R' >> return B,
--	 char 'L' >> return C,
	 between (char '(') (char ')') expr,
	 liftM (V ∘ return) letter]