{-# 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