graph-rewriting-cl-0.2.2: Graph.hs

{-# LANGUAGE UnicodeSyntax, FlexibleInstances, MultiParamTypeClasses #-}
module Graph where

import Data.View
import GraphRewriting.Graph
import GraphRewriting.Graph.Write
import qualified Term
import Data.Maybe (listToMaybe)

data Combinator = S | K | I | B | C | S' | B' | C' | W deriving (Show,Read,Eq)

data Vertex
	= Applicator {inp, out1, out2 ∷ Port}
	| Combinator {inp ∷ Port, combinator ∷ Combinator}
	| Duplicator {inp1, inp2, out ∷ Port}
	| Variable   {inp ∷ Port, variable ∷ String}
	| Eraser     {out ∷ Port}
	| Root       {out ∷ Port}

instance View [Port] Vertex where
	inspect node = case node of
		Applicator {inp = i, out1 = o1, out2 = o2} → [i,o1,o2]
		Combinator {inp = i}                       → [i]
		Duplicator {inp1 = i1, inp2 = i2, out = o} → [i1,i2,o]
		Variable   {inp = i}                       → [i]
		Eraser     {out = o}                       → [o]
		Root       {out = o}                       → [o]
	update ports node = case node of
		Applicator {} → node {inp = i, out1 = o1, out2 = o2} where [i,o1,o2] = ports
		Combinator {} → node {inp = i}                       where [i]       = ports
		Duplicator {} → node {inp1 = i1, inp2 = i2, out = o} where [i1,i2,o] = ports
		Variable   {} → node {inp = i}                       where [i]       = ports
		Eraser     {} → node {out = o}                       where [o]       = ports
		Root       {} → node {out = o}                       where [o]       = ports

fromTerm ∷ Term.Expr → Graph Vertex
fromTerm term = flip execGraph emptyGraph $ do
	e ← compile term
	newNode Root {out = e}

compile ∷ Term.Expr → Rewrite Vertex Edge
compile term = do
	e ← newEdge
	case term of
		Term.Application f x → do
			ef ← compile f
			ex ← compile x
			newNode Applicator {inp = e, out1 = ef, out2 = ex}
		Term.Variable v → case maybeRead v of
			Just c  → newNode Combinator {inp = e, combinator = c}
			Nothing → newNode Variable   {inp = e, variable   = v}
	return e

maybeRead :: Read a => String -> Maybe a
maybeRead = fmap fst . listToMaybe . reads