Rewrite Translate.hs to use SimplifySyntax (#4)

* Create branch for in-progress SimplifySyntax work.

* Translate more simple syntax. Improve flat lambda icon. Remove function binds from simple syntax.

* Translate SeApp.

* Fix simplifyExp.

* Translate SpApp and SeCase.

* Translate SeGuard.

* Translate @ patterns and pattern wild cards.

* Transtlate list and tuple patterns.

* Translate tuple and list expressions.

* Translate left sections.

* Translate Do notation.

* Cleanup Translate.hs.

* Translate type signatures.

* More cleanup of Translate.hs.

* Translate negate function application and enum syntax.

* Rename functions in Translate.hs.

app/Icons.hs

@@ -661,7 +661,7 @@ flatLambda paramNames (TransformParams name _ reflect angle)
   portIcons
     = zipWith (makeLabelledPort name reflect angle) paramNames argPortsConst
   middle = alignL (hsep 0.5 lambdaParts)
-  topAndBottomLineWidth = width middle - circleRadius
+  topAndBottomLineWidth = width middle - (circleRadius + defaultLineWidth)
   topAndBottomLine
     = alignL
       $ lwG defaultLineWidth

app/SimplifySyntax.hs

@@ -1,14 +1,30 @@
 module SimplifySyntax (
-  stringToSimpDecl
+  SimpExp(..)
+  , SelectorAndVal(..)
+  , SimpAlt(..)
+  , SimpDecl(..)
+  , SimpPat(..)
+  , stringToSimpDecl
   , qOpToExp
   , qNameToString
   , nameToString
   , customParseDecl
+  , hsDeclToSimpDecl
   ) where
 
+import Data.List(foldl')
+import Data.Maybe(catMaybes, isJust)
+
 import qualified Language.Haskell.Exts as Exts
 
-import TranslateCore(nTupleString)
+import TranslateCore(nTupleSectionString, nTupleString, nListString)
+
+-- TODO use a data constructor for the special case instead of using string
+-- matching for tempvars.
+-- There is a special case in Icons.hs/makeLabelledPort to exclude " tempvar"
+tempVarPrefix :: String
+tempVarPrefix = " tempvar"
+
 -- A simplified Haskell syntax tree
 
 -- rhs is now SimpExp
@@ -40,8 +56,8 @@ data SimpAlt l = SimpAlt {
 
 data SimpDecl l =
   -- These don't have decl lists, since only lets have decl lists
-  SdFunBind l (Exts.Name l) [SimpPat l] (SimpExp l)
+  SdPatBind l (SimpPat l) (SimpExp l)
-  | SdPatBind l (SimpPat l) (SimpExp l)
+  | SdTypeSig l [Exts.Name l] (Exts.Type l)
   deriving (Show, Eq)
 
 data SimpPat l =
@@ -49,12 +65,22 @@ data SimpPat l =
   | SpLit l (Exts.Sign l) (Exts.Literal l)
   | SpApp l (Exts.QName l) [SimpPat l]
   | SpAsPat l (Exts.Name l) (SimpPat l)
+  | SpWildCard l
   deriving (Show, Eq)
 
 -- Helper functions
 
+strToQName :: l -> String -> Exts.QName l
+strToQName l = Exts.UnQual l . Exts.Ident l
+
 makeVarExp :: l -> String -> Exts.Exp l
-makeVarExp l  = Exts.Var l . Exts.UnQual l . Exts.Ident l
+makeVarExp l = Exts.Var l . strToQName l
+
+makePatVar :: l -> String -> Exts.Pat l
+makePatVar l = Exts.PVar l . Exts.Ident l
+
+makeQVarOp :: l -> String -> Exts.QOp l
+makeQVarOp l = Exts.QVarOp l . Exts.UnQual l . Exts.Ident l
 
 qOpToExp :: Exts.QOp l -> Exts.Exp l
 qOpToExp (Exts.QVarOp l n) = Exts.Var l n
@@ -80,28 +106,23 @@ qNameToString q = error $ "Unsupported syntax in qNameToSrting: " <> show q
 
 --
 
-infixAppToSeApp :: Show a =>
-  a -> Exts.Exp a -> Exts.QOp a -> Exts.Exp a -> SimpExp a
-infixAppToSeApp l e1 op e2 = case op of
-  Exts.QVarOp _ (Exts.UnQual _ (Exts.Symbol _ sym)) -> case sym of
-    "$" -> hsExpToSimpExp (Exts.App l e1 e2)
-    -- TODO
-    -- "." -> grNamePortToGrRef
-    --        <$> evalFunctionComposition c (e1 : compositionToList e2)
-    _ -> defaultCase
-  _ -> defaultCase
-  where
-    defaultCase = hsExpToSimpExp $ Exts.App l (Exts.App l (qOpToExp op) e1) e2
-
 hsPatToSimpPat :: Show a => Exts.Pat a -> SimpPat a
 hsPatToSimpPat p = case p of
   Exts.PVar l n -> SpVar l n
   Exts.PLit l sign lit -> SpLit l sign lit
   Exts.PInfixApp l p1 qName p2 -> hsPatToSimpPat (Exts.PApp l qName [p1, p2])
   Exts.PApp l name patts -> SpApp l name (fmap hsPatToSimpPat patts)
+  Exts.PTuple l _ patts -> SpApp
+                           l
+                           ((strToQName l . nTupleString . length) patts)
+                           (fmap hsPatToSimpPat patts)
   Exts.PParen _ pat -> hsPatToSimpPat pat
   Exts.PAsPat l name pat -> SpAsPat l name (hsPatToSimpPat pat)
-  -- TODO PTuple, PList, PWildCard
+  Exts.PWildCard l -> SpWildCard l
+  Exts.PList l patts -> SpApp
+                        l
+                        ((strToQName l . nListString . length) patts)
+                        (fmap hsPatToSimpPat patts)
   _ -> error $  "Unsupported syntax in hsPatToSimpPat: " <> show p
 
 whereToLet :: Show a => a -> Exts.Rhs a -> Maybe (Exts.Binds a) -> SimpExp a
@@ -112,21 +133,24 @@ whereToLet l rhs maybeBinds = val
       Nothing -> rhsExp
       Just binds -> SeLet l (hsBindsToDecls binds) rhsExp
 
-matchToFunBind :: Show a => Exts.Match a -> SimpDecl a
+matchToSimpDecl :: Show a => Exts.Match a -> SimpDecl a
-matchToFunBind (Exts.Match l name patterns rhs maybeWhereBinds)
+matchToSimpDecl (Exts.Match l name patterns rhs maybeWhereBinds)
-  = SdFunBind
+  = SdPatBind
     l
-    name
+    (SpVar l name)
-    (fmap hsPatToSimpPat patterns)
+    (SeLambda l
-    (whereToLet l rhs maybeWhereBinds)
+     (fmap hsPatToSimpPat patterns)
-matchToFunBind m = error $ "Unsupported syntax in matchToFunBind: " <> show m
+     (whereToLet l rhs maybeWhereBinds))
+matchToSimpDecl m = error $ "Unsupported syntax in matchToSimpDecl: " <> show m
 
 -- Only used by matchesToCase
 matchToAlt :: Show l => Exts.Match l -> Exts.Alt l
-matchToAlt (Exts.Match l _ mtaPats rhs binds) = Exts.Alt l altPattern rhs binds where
+matchToAlt (Exts.Match l _ mtaPats rhs binds)
-  altPattern = case mtaPats of
+  = Exts.Alt l altPattern rhs binds
-    [onePat] -> onePat
+  where
-    _ -> Exts.PTuple l Exts.Boxed mtaPats
+    altPattern = case mtaPats of
+      [onePat] -> onePat
+      _ -> Exts.PTuple l Exts.Boxed mtaPats
 matchToAlt match = error $ "Unsupported syntax in matchToAlt: " <> show match
 
 -- TODO Refactor matchesToCase
@@ -135,10 +159,8 @@ matchesToCase match [] = match
 matchesToCase firstMatch@(Exts.Match srcLoc funName pats _ _) restOfMatches = match
   where
     -- There is a special case in Icons.hs/makeLabelledPort to exclude " tempvar"
-    -- TODO use a data constructor for the special case instead of using string
+    tempStrings = fmap (\x -> tempVarPrefix ++ show x) [0..(length pats - 1)]
-    -- matching for tempvars.
+    tempPats = fmap (makePatVar srcLoc) tempStrings
-    tempStrings = fmap (\x -> " tempvar" ++ show x) [0..(length pats - 1)]
-    tempPats = fmap (Exts.PVar srcLoc . Exts.Ident srcLoc) tempStrings
     tempVars = fmap (makeVarExp srcLoc) tempStrings
     tuple = Exts.Tuple srcLoc Exts.Boxed tempVars
     caseExp = case tempVars of
@@ -154,10 +176,11 @@ matchesToCase firstMatch _
 matchesToFunBind :: Show a => a -> [Exts.Match a] -> SimpDecl a
 matchesToFunBind l matches = case matches of
   [] -> error $ "Empty matches in matchesToFunBind. Label is :" <> show l
-  (m : ms) -> matchToFunBind (matchesToCase m ms)
+  (m : ms) -> matchToSimpDecl (matchesToCase m ms)
 
 hsDeclToSimpDecl :: Show a => Exts.Decl a -> SimpDecl a
 hsDeclToSimpDecl decl = case decl of
+  Exts.TypeSig l names typeForNames -> SdTypeSig l names typeForNames
   Exts.FunBind l matches -> matchesToFunBind l matches
   Exts.PatBind l pat rhs maybeBinds -> SdPatBind l (hsPatToSimpPat pat) expr
     where
@@ -198,13 +221,65 @@ ifToGuard l e1 e2 e3
   where
     otherwiseExp = SeName l "otherwise"
 
+simplifyExp :: SimpExp l -> SimpExp l
+simplifyExp e = case e of
+  -- Reduce applications of function compositions (e.g. (f . g) x -> f (g x))
+  SeApp l2 (SeApp l1 (SeApp _ (SeName _ ".") f1) f2) arg
+    -> SeApp l1 f1 $ simplifyExp (SeApp l2 f2 arg)
+  SeApp l (SeApp _ (SeName _ "$") exp1) exp2
+    -> SeApp l exp1 exp2
+  SeApp l1 (SeName l2 "<$>") arg
+    -> SeApp l1 (SeName l2 "fmap") arg
+  x -> x
+
+deListifyApp :: Show l => l -> Exts.Exp l -> [Exts.Exp l] -> Exts.Exp l
+deListifyApp l = foldl' (Exts.App l)
+
+rewriteTupleSection :: Show l => l -> [Maybe (Exts.Exp l)] -> Exts.Exp l
+rewriteTupleSection l mExprs = deListifyApp
+                               l
+                               (makeVarExp l $ nTupleSectionString expIsJustList)
+                               exprs
+  where
+    exprs = catMaybes mExprs
+    expIsJustList = fmap isJust mExprs
+
+-- Rewrite a right section as a lambda.
+-- TODO Simplify this type of lambda to use unused ports.
+rewriteRightSection :: Show l => l -> Exts.QOp l -> Exts.Exp l -> Exts.Exp l
+rewriteRightSection l op expr = Exts.Lambda l [tempPat] appExpr
+  where
+    tempStr = tempVarPrefix <> "0"
+    tempPat = makePatVar l tempStr
+    tempVar = makeVarExp l tempStr
+    appExpr = Exts.App l (Exts.App l (qOpToExp op) tempVar) expr
+
+-- TODO refactor desugarDo
+desugarDo :: Show l => [Exts.Stmt l] -> Exts.Exp l
+desugarDo [Exts.Qualifier _ e] = e
+desugarDo (Exts.Qualifier l e : stmts)
+  = Exts.InfixApp l e thenOp (desugarDo stmts)
+  where
+    thenOp = makeQVarOp l ">>"
+desugarDo (Exts.Generator l pat e : stmts) =
+  Exts.InfixApp l e (makeQVarOp l ">>=") (Exts.Lambda l [pat] (desugarDo stmts))
+desugarDo (Exts.LetStmt l binds : stmts) = Exts.Let l binds (desugarDo stmts)
+desugarDo stmts = error $ "Unsupported syntax in degugarDo: " <> show stmts
+
+desugarEnums :: Show l => l -> String -> [Exts.Exp l] -> SimpExp l
+desugarEnums l funcName exprs = hsExpToSimpExp $ deListifyApp l
+                                (makeVarExp l funcName)
+                                exprs
+
 hsExpToSimpExp :: Show a => Exts.Exp a -> SimpExp a
-hsExpToSimpExp x = case x of
+hsExpToSimpExp x = simplifyExp $ case x of
   Exts.Var l n -> SeName l (qNameToString n)
   Exts.Con l n -> SeName l (qNameToString n)
   Exts.Lit l n -> SeLit l n
-  Exts.InfixApp l e1 op e2 -> infixAppToSeApp l e1 op e2
+  Exts.InfixApp l e1 op e2 ->
+    hsExpToSimpExp $ Exts.App l (Exts.App l (qOpToExp op) e1) e2
   Exts.App l f arg -> SeApp l (hsExpToSimpExp f) (hsExpToSimpExp arg)
+  Exts.NegApp l e -> hsExpToSimpExp $ Exts.App l (makeVarExp l "negate") e
   Exts.Lambda l patterns e
     -> SeLambda l (fmap hsPatToSimpPat patterns) (hsExpToSimpExp e)
   Exts.Let l bs e -> SeLet l (hsBindsToDecls bs) (hsExpToSimpExp e)
@@ -212,6 +287,22 @@ hsExpToSimpExp x = case x of
     -> ifToGuard l (hsExpToSimpExp e1) (hsExpToSimpExp e2) (hsExpToSimpExp e3)
   Exts.Case l e alts -> SeCase l (hsExpToSimpExp e) (fmap hsAltToSimpAlt alts)
   Exts.Paren _ e -> hsExpToSimpExp e
+  Exts.List l exprs -> hsExpToSimpExp $ deListifyApp
+                       l
+                       (makeVarExp l $ nListString $ length exprs)
+                       exprs
+  Exts.Tuple l _ exprs -> hsExpToSimpExp $ deListifyApp
+                       l
+                       (makeVarExp l $ nTupleString $ length exprs)
+                       exprs
+  Exts.TupleSection l _ mExprs -> hsExpToSimpExp $ rewriteTupleSection l mExprs
+  Exts.LeftSection l expr op -> hsExpToSimpExp $ Exts.App l (qOpToExp op) expr
+  Exts.RightSection l op expr -> hsExpToSimpExp $ rewriteRightSection l op expr
+  Exts.Do _ stmts -> hsExpToSimpExp $ desugarDo stmts
+  Exts.EnumFrom l e -> desugarEnums l "enumFrom" [e]
+  Exts.EnumFromTo l e1 e2 -> desugarEnums l "enumFromTo" [e1, e2]
+  Exts.EnumFromThen l e1 e2 -> desugarEnums l "enumFromThen" [e1, e2]
+  Exts.EnumFromThenTo l e1 e2 e3 -> desugarEnums l "enumFromThenTo" [e1, e2, e3]
   _ -> error $ "Unsupported syntax in hsExpToSimpExp: " ++ show x
 
 -- Parsing

app/Translate.hs

@@ -5,7 +5,6 @@ module Translate(
   translateModuleToCollapsedGraphs,
   qOpToExp,
   qNameToString,
-  matchesToCase,
   customParseDecl
 ) where
 
@@ -16,28 +15,25 @@ import Control.Monad.State(State, evalState)
 import Data.Either(partitionEithers)
 import qualified Data.Graph.Inductive.PatriciaTree as FGR
 import Data.List(unzip5, partition, intercalate)
-import Data.Maybe(catMaybes, isJust, fromMaybe)
+import Data.Maybe(catMaybes, fromMaybe)
 
 import qualified Language.Haskell.Exts as Exts
 
-import Language.Haskell.Exts(
-  Decl(..), Name(..), Pat(..), Rhs(..),
-  Exp(..), QName(..), Match(..), QOp(..), GuardedRhs(..),
-  Stmt(..), Binds(..), Alt(..), Module(..), prettyPrint)
-
 import GraphAlgorithms(collapseNodes)
 import Icons(inputPort, resultPort, argumentPorts, caseRhsPorts,
              casePatternPorts)
-import SimplifySyntax(qOpToExp, qNameToString, nameToString, customParseDecl)
+import SimplifySyntax(SimpAlt(..), stringToSimpDecl, SimpExp(..), SimpPat(..)
-import TranslateCore(
+                     , qOpToExp
-  Reference, SyntaxGraph(..), EvalContext, GraphAndRef(..), SgSink(..),
+                     , qNameToString, nameToString, customParseDecl
-  syntaxGraphFromNodes, syntaxGraphFromNodesEdges, getUniqueName,
+                     , SimpDecl(..), hsDeclToSimpDecl, SelectorAndVal(..))
-  edgesForRefPortList, makeApplyGraph, makeGuardGraph, combineExpressions,
+import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef(..)
-  namesInPattern, lookupReference, deleteBindings, makeEdges,
+                    , SgSink(..), syntaxGraphFromNodes
-  makeBox, nTupleString, nTupleSectionString, nListString,
+                    , syntaxGraphFromNodesEdges, getUniqueName
-  syntaxGraphToFglGraph, getUniqueString, bindsToSyntaxGraph,
+                    , edgesForRefPortList, makeApplyGraph, makeGuardGraph
-  SgBind(..), graphAndRefToGraph,
+                    , combineExpressions, namesInPattern, lookupReference
-  initialIdState)
+                    , deleteBindings, makeEdges, makeBox, syntaxGraphToFglGraph
+                    , getUniqueString, bindsToSyntaxGraph, SgBind(..)
+                    , graphAndRefToGraph, initialIdState)
 import Types(Labeled(..), NameAndPort(..), IDState,
   Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, SgNamedNode(..),
   LikeApplyFlavor(..))
@@ -52,12 +48,6 @@ import Util(makeSimpleEdge, nameAndPort, justName)
 
 -- BEGIN Helper Functions --
 
-makeVarExp :: l -> String -> Exp l
-makeVarExp l  = Var l . UnQual l . Ident l
-
-makeQVarOp :: l -> String -> QOp l
-makeQVarOp l = QVarOp l . UnQual l . Ident l
-
 -- | Make a syntax graph that has the bindings for a list of "as pattern" (@)
 -- names.
 makeAsBindGraph :: Reference -> [Maybe String] -> SyntaxGraph
@@ -71,19 +61,20 @@ makeAsBindGraph ref asNames
 grNamePortToGrRef :: (SyntaxGraph, NameAndPort) -> GraphAndRef
 grNamePortToGrRef (graph, np) = GraphAndRef graph (Right np)
 
+-- TODO Find a better name for bindOrAltHelper
 bindOrAltHelper :: Show l =>
   EvalContext
-  -> Pat l
+  -> SimpPat l
-  -> Rhs l
+  -> SimpExp l
-  -> Maybe (Binds l)
   -> State IDState ((GraphAndRef, Maybe String), GraphAndRef)
-bindOrAltHelper c pat rhs maybeWhereBinds = do
+bindOrAltHelper c pat e = do
   patGraphAndRef <- evalPattern pat
   let
     rhsContext = namesInPattern patGraphAndRef <> c
-  rhsGraphAndRef <- rhsWithBinds maybeWhereBinds rhs rhsContext
+  rhsGraphAndRef <- evalExp rhsContext e
   pure (patGraphAndRef, rhsGraphAndRef)
 
+
 patternName :: (GraphAndRef, Maybe String) -> String
 patternName (GraphAndRef _ ref, mStr) = fromMaybe
   (case ref of
@@ -193,8 +184,8 @@ makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
 
 
 evalPApp :: Show l =>
-  QName l
+  Exts.QName l
-  -> [Pat l]
+  -> [SimpPat l]
   -> State IDState (SyntaxGraph, NameAndPort)
 evalPApp name patterns = case patterns of
   [] -> makeBox constructorName
@@ -204,6 +195,7 @@ evalPApp name patterns = case patterns of
     pure $ makeNestedPatternGraph patName constructorName evaledPatterns
   where
     constructorName = qNameToString name
+
 -- END evalPApp
 
 -- BEGIN evalPLit
@@ -229,7 +221,7 @@ evalPLit sign l = case sign of
 -- END evalPLit
 
 evalPAsPat :: Show l =>
-  Name l -> Pat l -> State IDState (GraphAndRef, Maybe String)
+  Exts.Name l -> SimpPat l -> State IDState (GraphAndRef, Maybe String)
 evalPAsPat n p = do
   (GraphAndRef evaledPatGraph evaledPatRef, mInnerName) <- evalPattern p
   let
@@ -243,26 +235,14 @@ makePatternResult :: Functor f =>
 makePatternResult
   = fmap (\(graph, namePort) -> (GraphAndRef graph (Right namePort), Nothing))
 
-evalPattern :: Show l => Pat l -> State IDState (GraphAndRef, Maybe String)
+evalPattern :: Show l => SimpPat l -> State IDState (GraphAndRef, Maybe String)
 evalPattern p = case p of
-  PVar _ n -> pure (GraphAndRef mempty (Left $ nameToString n), Nothing)
+  SpVar _ n -> pure (GraphAndRef mempty (Left $ nameToString n), Nothing)
-  PLit _ s l -> makePatternResult $ evalPLit s l
+  SpLit _ sign lit -> makePatternResult $ evalPLit sign lit
-  PInfixApp l p1 qName p2 -> evalPattern (PApp l qName [p1, p2])
+  SpApp _ name patterns -> makePatternResult $ evalPApp name patterns
-  PApp _ name patterns -> makePatternResult $ evalPApp name patterns
+  SpAsPat _ name pat -> evalPAsPat name pat
-  -- TODO special tuple handling.
+  SpWildCard _ -> makePatternResult $ makeBox "_"
-  PTuple l _ patterns ->
+  -- _ -> error ("evalPattern todo: " <> show p)
-    makePatternResult $ evalPApp
-                (Exts.UnQual l . Ident l . nTupleString . length $ patterns)
-                patterns
-  PList l patterns ->
-    makePatternResult $ evalPApp
-                (Exts.UnQual l . Ident l . nListString . length $ patterns)
-                patterns
-  PParen _ pat -> evalPattern pat
-  PAsPat _ n subPat -> evalPAsPat n subPat
-  PWildCard _ -> makePatternResult $ makeBox "_"
-  _ -> error $ "evalPattern: No pattern in case for " ++ show p
-  -- TODO: Other cases
 
 -- END evalPattern
 
@@ -275,43 +255,14 @@ strToGraphRef c str = fmap mapper (makeBox str) where
     then GraphAndRef mempty (Left str)
     else grNamePortToGrRef gr
 
-evalQName :: Show l => QName l -> EvalContext -> State IDState GraphAndRef
-evalQName qName c = case qName of
-  UnQual _ _ -> graphRef
-  Qual _ _ _ -> graphRef
-  _ -> grNamePortToGrRef <$> makeBox qNameString
-  where
-    qNameString = qNameToString qName
-    graphRef = strToGraphRef c qNameString
-
 -- END evalQName
 
--- TODO Delete these commented out functions.
--- evalQOp :: QOp l -> EvalContext -> State IDState GraphAndRef
--- evalQOp (QVarOp n) = evalQName n
--- evalQOp (QConOp n) = evalQName n
-
--- qOpToString :: QOp l -> String
--- qOpToString (QVarOp n) = qNameToString n
--- qOpToString (QConOp n) = qNameToString n
-
---findReferencedIcon :: Reference -> [(NodeName, Icon)] -> Maybe (Name, Icon)
--- findReferencedIcon :: Either t NameAndPort -> [(NodeName, t1)] -> Maybe (NodeName, t1)
--- findReferencedIcon (Left str) _ = Nothing
--- findReferencedIcon (Right (NameAndPort name _)) nameIconMap = (\x -> (name, x)) <$> lookup name nameIconMap
-
-
 -- BEGIN apply and compose helper functions
 
-removeParen :: Exp l -> Exp l
-removeParen e = case e of
-  Paren _ x -> removeParen x
-  _ -> e
-
 evalFunExpAndArgs :: Show l =>
   EvalContext
   -> LikeApplyFlavor
-  -> (Exp l, [Exp l])
+  -> (SimpExp l, [SimpExp l])
   -> State IDState (SyntaxGraph, NameAndPort)
 evalFunExpAndArgs c flavor (funExp, argExps) = do
   funVal <- evalExp c funExp
@@ -322,10 +273,8 @@ evalFunExpAndArgs c flavor (funExp, argExps) = do
 
 -- END apply and compose helper functions
 
--- BEGIN evalInfixApp
-
 evalFunctionComposition :: Show l =>
-  EvalContext -> [Exp l] -> State IDState (SyntaxGraph, NameAndPort)
+  EvalContext -> [SimpExp l] -> State IDState (SyntaxGraph, NameAndPort)
 evalFunctionComposition c functions = do
   let reversedFunctios = reverse functions
   evaluatedFunctions <- mapM (evalExp c) reversedFunctios
@@ -340,47 +289,18 @@ evalFunctionComposition c functions = do
     evaluatedFunctions
 
 -- | Turn (a . b . c) into [a, b, c]
-compositionToList :: Exp l -> [Exp l]
+compositionToList :: SimpExp l -> [SimpExp l]
-compositionToList e = case removeParen e of
+compositionToList e = case e of
-  (InfixApp _ exp1  (QVarOp _ (UnQual _ (Symbol _ "."))) exp2)
+  (SeApp _ (SeApp _ (SeName  _ ".") f1) f2)
-    -> exp1 : compositionToList exp2
+    -> f1 : compositionToList f2
   x -> [x]
 
--- | In the general case, infix is converted to prefix.
--- Special cases:
--- a $ b is converted to (a b)
--- (a . b . c) uses the compose apply icon with no argument
-evalInfixApp :: Show l =>
-  l -> EvalContext -> Exp l -> QOp l -> Exp l -> State IDState GraphAndRef
-evalInfixApp l c e1 op e2 = case op of
-  QVarOp _ (UnQual _ (Symbol _ sym)) -> case sym of
-    "$" -> evalExp c (App l e1 e2)
-    "." -> grNamePortToGrRef
-           <$> evalFunctionComposition c (e1 : compositionToList e2)
-    _ -> defaultCase
-  _ -> defaultCase
-  where
-    defaultCase = evalExp c $ App l (App l (qOpToExp op) e1) e2
-
--- END evalInfixApp
-
 -- BEGIN evaluateAppExpression
 
-simplifyExp :: Exp l -> Exp l
-simplifyExp e = case removeParen e of
-  InfixApp l exp1  (QVarOp _ (UnQual _ (Symbol _ "$"))) exp2 -> App l exp1 exp2
-  -- Don't convert compose to apply
-  InfixApp _ _ (QVarOp _ (UnQual _ (Symbol _ "."))) _ -> e
-  App l (Var _ (UnQual _ (Symbol _ "<$>"))) arg
-    -> App l (makeVarExp l "fmap") arg
-  InfixApp l exp1 op exp2 -> App l (App l (qOpToExp op) exp1) exp2
-  LeftSection l exp1 op -> App l (qOpToExp op) exp1
-  x -> x
-
 -- | Given two expressions f and x, where f is applied to x,
 -- return the nesting depth if (f x) is rendered with
 -- the (normal apply icon, compose apply icon)
-applyComposeScoreHelper :: Exp l -> Exp l -> (Int, Int)
+applyComposeScoreHelper :: SimpExp l -> SimpExp l -> (Int, Int)
 applyComposeScoreHelper exp1 exp2 = (appScore, compScore) where
   (e1App, e1Comp) = applyComposeScore exp1
   (e2App, e2Comp) = applyComposeScore exp2
@@ -395,96 +315,77 @@ applyComposeScoreHelper exp1 exp2 = (appScore, compScore) where
 
   compScore = max leftComp rightComp
 
+
 -- TODO Consider putting this logic in a separate "simplifyExpression" function.
 -- | Returns the amount of nesting if the App is converted to
 -- (applyNode, composeNode)
-applyComposeScore :: Exp l -> (Int, Int)
+applyComposeScore :: SimpExp l -> (Int, Int)
-applyComposeScore e = case simplifyExp e of
+applyComposeScore e = case e of
-  App _ exp1 exp2 -> applyComposeScoreHelper exp1 exp2
+  SeApp _ exp1 exp2 -> applyComposeScoreHelper exp1 exp2
   _ -> (0, 0)
 
 -- Todo add test for this function
 -- | Given an App expression, return
 -- (function, list of arguments)
-appExpToFuncArgs :: Exp l -> (Exp l, [Exp l])
+appExpToFuncArgs :: SimpExp l -> (SimpExp l, [SimpExp l])
-appExpToFuncArgs e = case simplifyExp e of
+appExpToFuncArgs e = case e of
-  App _ exp1 exp2 -> (funExp, args <> [exp2])
+  SeApp _ exp1 exp2 -> (funExp, args <> [exp2])
     where
       (funExp, args) = appExpToFuncArgs exp1
   x -> (x, [])
 
 -- | Given and App expression, return
 -- (argument, list composed functions)
-appExpToArgFuncs :: Exp l -> (Exp l, [Exp l])
+appExpToArgFuncs :: SimpExp l -> (SimpExp l, [SimpExp l])
-appExpToArgFuncs e = case simplifyExp e of
+appExpToArgFuncs e = case e of
-  App _ exp1 exp2 -> (argExp, funcs <> [exp1])
+  SeApp _ exp1 exp2 -> (argExp, funcs <> [exp1])
     where
       (argExp, funcs) = appExpToArgFuncs exp2
   simpleExp -> (simpleExp, [])
 
-removeCompose :: l -> Exp l -> Exp l -> Exp l
-removeCompose l f x = case removeParen f of
-  (InfixApp _ f1  (QVarOp _ (UnQual _ (Symbol _ "."))) f2)
-    -> App l f1 $ removeCompose l f2 x
-  _ -> App l f x
 
 -- TODO Refactor this and all sub-expressions
 evalApp :: Show l =>
-  l -> EvalContext -> Exp l -> Exp l -> State IDState (SyntaxGraph, NameAndPort)
+  EvalContext -> SimpExp l
-evalApp l c f e = if appScore <= compScore
+  -> State IDState (SyntaxGraph, NameAndPort)
-  then evalFunExpAndArgs c ApplyNodeFlavor (appExpToFuncArgs noComposeExp)
+evalApp c expr = case expr of
-  else evalFunExpAndArgs c ComposeNodeFlavor (appExpToArgFuncs noComposeExp)
+  -- TODO This pattern for "." appears at least twice in this file. Refactor?
-  where
+  (SeApp _ (SeApp _ (SeName  _ ".") _) _)
-    noComposeExp = removeCompose l f e
+    -> evalFunctionComposition c (compositionToList expr)
-    (appScore, compScore) = applyComposeScore noComposeExp
+  _ -> if appScore <= compScore
+    then evalFunExpAndArgs c ApplyNodeFlavor (appExpToFuncArgs expr)
+    else evalFunExpAndArgs c ComposeNodeFlavor (appExpToArgFuncs expr)
+    where
+      (appScore, compScore) = applyComposeScore expr
 
 -- END evaluateAppExpression
 
-evalIf :: Show l =>
-  EvalContext
-  -> Exp l
-  -> Exp l
-  -> Exp l
-  -> State IDState (SyntaxGraph, NameAndPort)
-evalIf c boolExp trueExp falseExp = makeGuardGraph 2
-  <$>
-  getUniqueName
-  <*>
-  -- Use (pure <$>) to put the evaluated expression in a single item list
-  (pure <$> evalExp c boolExp)
-  <*>
-  mapM (evalExp c) [trueExp, falseExp]
-
 -- BEGIN evalGeneralLet
 
-getBoundVarName :: Show l => Decl l -> [String]
+getBoundVarName :: Show l => SimpDecl l -> [String]
--- TODO Should evalState be used here?
+getBoundVarName d = case d of
-getBoundVarName (PatBind _ pat _ _)
+  SdPatBind _ pat _ -> namesInPattern
-  = namesInPattern $ evalState (evalPattern pat) initialIdState
+                     -- TODO Should evalState be used here?
-getBoundVarName (FunBind _ (Match _ name _ _ _:_)) = [nameToString name]
+                     $ evalState (evalPattern pat) initialIdState
--- TODO: Other cases
+  SdTypeSig _ _ _ -> []
-getBoundVarName (TypeSig _ _ _) = []
-getBoundVarName decl
-  = error $ "getBoundVarName: No pattern in case for " ++ show decl
 
-evalBinds :: Show l =>
+evalDecls :: Show l =>
-  EvalContext -> Binds l -> State IDState (SyntaxGraph, EvalContext)
+  EvalContext -> [SimpDecl l] -> State IDState (SyntaxGraph, EvalContext)
-evalBinds c (BDecls _ decls) =
+evalDecls c decls =
   let
     boundNames = concatMap getBoundVarName decls
     augmentedContext = boundNames <> c
   in
     (,augmentedContext) . mconcat <$> mapM (evalDecl augmentedContext) decls
-evalBinds _ binds = error $ "Unsupported syntax in evalBinds: " <> show binds
 
-evalGeneralLet :: Show l =>
+evalLet :: Show l =>
-  (EvalContext -> State IDState GraphAndRef)
+  EvalContext
-  -> EvalContext
+  -> [SimpDecl l]
-  -> Binds l
+  -> SimpExp l
   -> State IDState GraphAndRef
-evalGeneralLet expOrRhsEvaler c bs = do
+evalLet c decls expr = do
-  (bindGraph, bindContext) <- evalBinds c bs
+  (bindGraph, bindContext) <- evalDecls c decls
-  expVal <- expOrRhsEvaler bindContext
+  expVal <- evalExp bindContext expr
   let
     GraphAndRef expGraph expResult = expVal
     newGraph = deleteBindings . makeEdges $ expGraph <> bindGraph
@@ -493,30 +394,17 @@ evalGeneralLet expOrRhsEvaler c bs = do
 
 -- END evalGeneralLet
 
-evalLet :: Show l => EvalContext -> Binds l -> Exp l-> State IDState GraphAndRef
+evalSelectorAndVal :: Show l =>
-evalLet context binds e = evalGeneralLet (`evalExp` e) context binds
+  EvalContext -> SelectorAndVal l -> State IDState (GraphAndRef, GraphAndRef)
+evalSelectorAndVal c SelectorAndVal{svSelector=sel, svVal=val}
+  = (,) <$> evalExp c sel <*> evalExp c val
 
--- BEGIN rhsWithBinds
+evalGuard :: Show l =>
-
+  EvalContext -> [SelectorAndVal l] -> State IDState (SyntaxGraph, NameAndPort)
-evalStmt :: Show l => EvalContext -> Stmt l -> State IDState GraphAndRef
+evalGuard c selectorsAndVals = let
-evalStmt c (Qualifier _ e) = evalExp c e
+  evaledRhss = unzip <$> mapM (evalSelectorAndVal c) selectorsAndVals
-evalStmt _ q = error $ "Unsupported syntax in evalStmt: " <> show q
-
-evalStmts :: Show l => EvalContext -> [Stmt l] -> State IDState GraphAndRef
-evalStmts c [stmt] = evalStmt c stmt
-evalStmts _ stmts = error $ "Unsupported syntax in evalStmts: " <> show stmts
-
-evalGuardedRhs :: Show l =>
-  EvalContext -> GuardedRhs l -> State IDState (GraphAndRef, GraphAndRef)
-evalGuardedRhs c (GuardedRhs _ stmts e)
-  = (,) <$> evalStmts c stmts <*> evalExp c e
-
-evalGuardedRhss :: Show l =>
-  EvalContext -> [GuardedRhs l] -> State IDState (SyntaxGraph, NameAndPort)
-evalGuardedRhss c rhss = let
-  evaledRhss = unzip <$> mapM (evalGuardedRhs c) rhss
   in
-  makeGuardGraph (length rhss)
+  makeGuardGraph (length selectorsAndVals)
   <$>
   getUniqueName
   <*>
@@ -524,33 +412,18 @@ evalGuardedRhss c rhss = let
   <*>
   fmap snd evaledRhss
 
--- | First argument is the right hand side.
--- The second arugement is a list of strings that are bound in the environment.
-evalRhs :: Show l => EvalContext -> Rhs l -> State IDState GraphAndRef
-evalRhs c (UnGuardedRhs _ e) = evalExp c e
-evalRhs c (GuardedRhss _ rhss) = grNamePortToGrRef <$> evalGuardedRhss c rhss
-
-rhsWithBinds :: Show l =>
-  Maybe (Binds l) -> Rhs l -> EvalContext -> State IDState GraphAndRef
-rhsWithBinds maybeWhereBinds rhs rhsContext = case maybeWhereBinds of
-  Nothing -> evalRhs rhsContext rhs
-  Just b -> evalGeneralLet (`evalRhs` rhs) rhsContext b
-
--- END rhsWithBinds
-
 -- BEGIN evalCase
 
 -- TODO patRhsAreConnected is sometimes incorrectly true if the pat is just a
 -- name
-evalPatAndRhs :: Show l =>
+-- returns (combined graph, pattern reference, rhs reference)
+evalAlt :: Show l =>
   EvalContext
-  -> Pat l
+  -> SimpAlt l
-  -> Rhs l
-  -> Maybe (Binds l)
   -> State IDState (Bool, SyntaxGraph, Reference, Reference, Maybe String)
-evalPatAndRhs c pat rhs maybeWhereBinds = do
+evalAlt c (SimpAlt pat rhs) = do
   ((GraphAndRef patGraph patRef, mPatAsName), GraphAndRef rhsGraph rhsRef) <-
-    bindOrAltHelper c pat rhs maybeWhereBinds
+    bindOrAltHelper c pat rhs
   let
     grWithEdges = makeEdges (rhsGraph <> patGraph)
     lookedUpRhsRef = lookupReference (sgBinds grWithEdges) rhsRef
@@ -567,13 +440,6 @@ evalPatAndRhs c pat rhs maybeWhereBinds = do
        , lookedUpRhsRef
        , mPatAsName)
 
--- returns (combined graph, pattern reference, rhs reference)
-evalAlt :: Show l =>
-  EvalContext
-  -> Exts.Alt l
-  -> State IDState (Bool, SyntaxGraph, Reference, Reference, Maybe String)
-evalAlt c (Exts.Alt _ pat rhs maybeBinds) = evalPatAndRhs c pat rhs maybeBinds
-
 evalCaseHelper ::
   Int
   -> NodeName
@@ -624,7 +490,8 @@ evalCaseHelper numAlts caseIconName resultIconNames
 
 
 evalCase :: Show l =>
-  EvalContext -> Exp l -> [Alt l] -> State IDState (SyntaxGraph, NameAndPort)
+  EvalContext -> SimpExp l -> [SimpAlt l]
+  -> State IDState (SyntaxGraph, NameAndPort)
 evalCase c e alts =
   let
     numAlts = length alts
@@ -641,104 +508,27 @@ evalCase c e alts =
 
 -- END evalCase
 
-evalTuple :: Show l =>
-  EvalContext -> [Exp l] -> State IDState (SyntaxGraph, NameAndPort)
-evalTuple c exps =
-  let
-    numExps = length exps
-  in
-    makeApplyGraph numExps ApplyNodeFlavor False
-    <$>
-    getUniqueName
-    <*>
-    (grNamePortToGrRef <$> makeBox (nTupleString numExps))
-    <*>
-    mapM (evalExp c) exps
-
-evalTupleSection :: Show l =>
-  EvalContext -> [Maybe (Exp l)] -> State IDState (SyntaxGraph, NameAndPort)
-evalTupleSection c mExps =
-  let
-    exps = catMaybes mExps
-    expIsJustList = fmap isJust mExps
-  in
-    makeApplyGraph (length exps) ApplyNodeFlavor False
-    <$>
-    getUniqueName
-    <*>
-    (grNamePortToGrRef <$> makeBox (nTupleSectionString expIsJustList))
-    <*>
-    mapM (evalExp c) exps
-
-evalListExp :: Show l =>
-  l -> EvalContext -> [Exp l] -> State IDState (SyntaxGraph, NameAndPort)
-evalListExp _ _ [] = makeBox "[]"
-evalListExp l c exps = evalFunExpAndArgs
-                       c
-                       ApplyNodeFlavor
-                       (makeVarExp l . nListString . length $ exps, exps)
-
-evalLeftSection :: Show l =>
-  l -> EvalContext -> Exp l -> QOp l -> State IDState GraphAndRef
-evalLeftSection l c e op = evalExp c $ App l (qOpToExp op) e
-
-evalRightSection :: Show l =>
-  EvalContext -> QOp l -> Exp l -> State IDState (SyntaxGraph, NameAndPort)
-evalRightSection c op e =
-  makeApplyGraph 2 ApplyNodeFlavor False
-  <$>
-  getUniqueName
-  <*>
-  evalExp c (qOpToExp op)
-  <*>
-  ((\x y -> [x, y]) <$>
-    -- TODO: A better option would be for makeApplyGraph to take the list of
-    -- expressions as Maybes.
-    fmap (GraphAndRef mempty . Left) (getUniqueString "unusedArgument")
-    <*>
-    evalExp c e
-  )
-
--- evalEnums is only used by evalExp
-evalEnums :: Show l =>
-  l -> EvalContext -> String -> [Exp l] -> State IDState GraphAndRef
-evalEnums l c s exps
-  = grNamePortToGrRef
-    <$> evalFunExpAndArgs c ApplyNodeFlavor (makeVarExp l s, exps)
-
-desugarDo :: Show l => [Stmt l] -> Exp l
-desugarDo [Qualifier _ e] = e
-desugarDo (Qualifier l e : stmts) = InfixApp l e thenOp (desugarDo stmts)
-  where thenOp = makeQVarOp l ">>"
-desugarDo (Generator l pat e : stmts) =
-  InfixApp l e (makeQVarOp l ">>=") (Lambda l [pat] (desugarDo stmts))
-desugarDo (LetStmt l binds : stmts) = Let l binds (desugarDo stmts)
-desugarDo stmts = error $ "Unsupported syntax in degugarDo: " <> show stmts
-
--- TODO: Finish evalRecConstr
-evalRecConstr :: Show l =>
-  EvalContext -> QName l -> [Exts.FieldUpdate l] -> State IDState GraphAndRef
-evalRecConstr c qName _ = evalQName qName c
-
 -- BEGIN generalEvalLambda
 
 -- TODO Returning a SyntaxGraph is probably not very efficient
 asBindGraphZipper :: Maybe String -> NameAndPort -> SyntaxGraph
 asBindGraphZipper asName nameNPort = makeAsBindGraph (Right nameNPort) [asName]
 
-generalEvalLambda :: Show l
+-- TODO Refactor evalLambda
-  => EvalContext
+evalLambda :: Show l
-  -> [Pat l]
+  => l
-  -> (EvalContext -> State IDState GraphAndRef)
+  -> EvalContext
+  -> [SimpPat l]
+  -> SimpExp l
   -> State IDState (SyntaxGraph, NameAndPort)
-generalEvalLambda context patterns rhsEvalFun = do
+evalLambda _ context patterns expr = do
   lambdaName <- getUniqueName
   patternValsWithAsNames <- mapM evalPattern patterns
   let
     patternVals = fmap fst patternValsWithAsNames
     patternStrings = concatMap namesInPattern patternValsWithAsNames
     rhsContext = patternStrings <> context
-  GraphAndRef rhsRawGraph rhsRef <- rhsEvalFun rhsContext
+  GraphAndRef rhsRawGraph rhsRef <- evalExp rhsContext expr
   let
     paramNames = fmap patternName patternValsWithAsNames
     enclosedNodeNames = snnName <$> sgNodes combinedGraph
@@ -777,99 +567,23 @@ generalEvalLambda context patterns rhsEvalFun = do
 
 -- END generalEvalLambda
 
-evalLambda :: Show l =>
+evalExp :: Show l => EvalContext -> SimpExp l -> State IDState GraphAndRef
-  EvalContext -> [Pat l] -> Exp l -> State IDState (SyntaxGraph, NameAndPort)
-evalLambda c patterns e = generalEvalLambda c patterns (`evalExp` e)
-
-evalExp :: Show l => EvalContext  -> Exp l -> State IDState GraphAndRef
 evalExp c x = case x of
-  Var _ n -> evalQName n c
+  SeName _ s -> strToGraphRef c s
-  Con _ n -> evalQName n c
+  SeLit _ lit -> grNamePortToGrRef <$> evalLit lit
-  Lit _ l -> grNamePortToGrRef <$> evalLit l
+  SeApp _ _ _ -> grNamePortToGrRef <$> evalApp c x
-  InfixApp l e1 op e2 -> evalInfixApp l c e1 op e2
+  SeLambda l patterns e -> grNamePortToGrRef <$> evalLambda l c patterns e
-  App l f arg -> grNamePortToGrRef <$> evalApp l c f arg
+  SeLet _ decls expr -> evalLet c decls expr
-  NegApp l e -> evalExp c (App l (makeVarExp l "negate") e)
+  SeCase _ expr alts -> grNamePortToGrRef <$> evalCase c expr alts
-  Lambda _ patterns e -> grNamePortToGrRef <$> evalLambda c patterns e
+  SeGuard _ selectorsAndVals -> grNamePortToGrRef <$> evalGuard c selectorsAndVals
-  Let _ bs e -> evalLet c bs e
-  If _ e1 e2 e3 -> grNamePortToGrRef <$> evalIf c e1 e2 e3
-  Case _ e alts -> grNamePortToGrRef <$> evalCase c e alts
-  Do _ stmts -> evalExp c (desugarDo stmts)
-  -- TODO special tuple symbol
-  Tuple _ _ exps -> grNamePortToGrRef <$> evalTuple c exps
-  TupleSection _ _ mExps -> grNamePortToGrRef <$> evalTupleSection c mExps
-  List l exps -> grNamePortToGrRef <$> evalListExp l c exps
-  Paren _ e -> evalExp c e
-  LeftSection l e op -> evalLeftSection l c e op
-  RightSection _ op e -> grNamePortToGrRef <$> evalRightSection c op e
-  RecConstr _ n updates -> evalRecConstr c n updates
-  -- TODO: Do RecUpdate correcly
-  RecUpdate _ e _ -> evalExp c e
-  EnumFrom l e -> evalEnums l c "enumFrom" [e]
-  EnumFromTo l e1 e2 -> evalEnums l c "enumFromTo" [e1, e2]
-  EnumFromThen l e1 e2 -> evalEnums l c "enumFromThen" [e1, e2]
-  EnumFromThenTo l e1 e2 e3 -> evalEnums l c "enumFromThenTo" [e1, e2, e3]
-  -- TODO: Add the type signiture to ExpTypeSig.
-  ExpTypeSig _ e _ -> evalExp c e
-  -- TODO: Add other cases
-  _ -> error $ "evalExp: No pattern in case for " ++ show x
 
 -- BEGIN evalDecl
 
--- BEGIN evalMatches
+evalPatBind :: Show l =>
-
+  l -> EvalContext -> SimpPat l -> SimpExp l -> State IDState SyntaxGraph
--- Only used by matchesToCase
+evalPatBind _ c pat e = do
-matchToAlt :: Show l => Match l -> Alt l
-matchToAlt (Match l _ mtaPats rhs binds) = Alt l altPattern rhs binds where
-  altPattern = case mtaPats of
-    [onePat] -> onePat
-    _ -> PTuple l Exts.Boxed mtaPats
-matchToAlt match = error $ "Unsupported syntax in matchToAlt: " <> show match
-
-matchesToCase :: Show l => Match l -> [Match l] -> Match l
-matchesToCase match [] = match
-matchesToCase firstMatch@(Match srcLoc funName pats _ _) restOfMatches = match
-  where
-    -- There is a special case in Icons.hs/makeLabelledPort to exclude " tempvar"
-    -- TODO use a data constructor for the special case instead of using string
-    -- matching for tempvars.
-    tempStrings = fmap (\x -> " tempvar" ++ show x) [0..(length pats - 1)]
-    tempPats = fmap (PVar srcLoc . Ident srcLoc) tempStrings
-    tempVars = fmap (makeVarExp srcLoc) tempStrings
-    tuple = Tuple srcLoc Exts.Boxed tempVars
-    caseExp = case tempVars of
-      [oneTempVar] -> Case srcLoc oneTempVar alts
-      _ -> Case srcLoc tuple alts
-    rhs = UnGuardedRhs srcLoc caseExp
-    match = Match srcLoc funName tempPats rhs Nothing
-    allMatches = firstMatch:restOfMatches
-    alts = fmap matchToAlt allMatches
-matchesToCase firstMatch _
-  = error $ "Unsupported syntax in matchesToCase: " <> show firstMatch
-
-evalMatch :: Show l => EvalContext -> Match l -> State IDState SyntaxGraph
-evalMatch c (Match _ name patterns rhs maybeWhereBinds) = do
-  let
-    matchFunNameString = nameToString name
-    newContext = matchFunNameString : c
-  (lambdaGraph, lambdaPort) <-
-    generalEvalLambda newContext patterns (rhsWithBinds maybeWhereBinds rhs)
-  let
-    newBinding
-      = bindsToSyntaxGraph [SgBind matchFunNameString (Right lambdaPort)]
-  pure $ makeEdges (newBinding <> lambdaGraph)
-evalMatch _ match = error $ "Unsupported syntax in evalMatch: " <> show match
-
-evalMatches :: Show l => EvalContext -> [Match l] -> State IDState SyntaxGraph
-evalMatches _ [] = pure mempty
-evalMatches c (firstMatch:restOfMatches)
-  = evalMatch c $ matchesToCase firstMatch restOfMatches
-
--- END evalMatches
-
-evalPatBind :: Show l => EvalContext -> Decl l -> State IDState SyntaxGraph
-evalPatBind c (PatBind _ pat rhs maybeWhereBinds) = do
   ((GraphAndRef patGraph patRef, mPatAsName), GraphAndRef rhsGraph rhsRef) <-
-    bindOrAltHelper c pat rhs maybeWhereBinds
+    bindOrAltHelper c pat e
   let
     (newEdges, newSinks, bindings) = case patRef of
       (Left s) -> (mempty, mempty, [SgBind s rhsRef])
@@ -879,12 +593,13 @@ evalPatBind c (PatBind _ pat rhs maybeWhereBinds) = do
     asBindGraph = makeAsBindGraph rhsRef [mPatAsName]
     gr = asBindGraph <> SyntaxGraph mempty newEdges newSinks bindings mempty
   pure . makeEdges $ (gr <> rhsGraph <> patGraph)
-evalPatBind _ decl = error $ "Unsupported syntax in evalPatBind: " <> show decl
 
 -- Pretty printing the entire type sig results in extra whitespace in the middle
 -- TODO May want to trim whitespace from (prettyPrint typeForNames)
-evalTypeSig :: Show l => Decl l -> State IDState (SyntaxGraph, NameAndPort)
+evalTypeSig :: Show l =>
-evalTypeSig (TypeSig _ names typeForNames) = makeBox
+  [Exts.Name l] -> Exts.Type l
+  -> State IDState (SyntaxGraph, NameAndPort)
+evalTypeSig names typeForNames = makeBox
   (intercalate "," (fmap prettyPrintWithoutNewlines names)
    ++ " :: "
    ++ prettyPrintWithoutNewlines typeForNames)
@@ -892,17 +607,12 @@ evalTypeSig (TypeSig _ names typeForNames) = makeBox
     -- TODO Make custom version of prettyPrint for type signitures.
     -- Use (unwords . words) to convert consecutive whitspace characters to one
     -- space.
-    prettyPrintWithoutNewlines = unwords . words . prettyPrint
+    prettyPrintWithoutNewlines = unwords . words . Exts.prettyPrint
-evalTypeSig decl
-  = error $ "Unsupported syntax in evalTypeSig: " <> show decl
 
-evalDecl :: Show l => EvalContext -> Decl l -> State IDState SyntaxGraph
+evalDecl :: Show l => EvalContext -> SimpDecl l -> State IDState SyntaxGraph
 evalDecl c d = case d of
-    PatBind _ _ _ _ -> evalPatBind c d
+  SdPatBind l pat e -> evalPatBind l c pat e
-    FunBind _ matches -> evalMatches c matches
+  SdTypeSig _ names typeForNames -> fst <$> evalTypeSig names typeForNames
-    TypeSig _ _ _ -> fst <$> evalTypeSig d
-    --TODO: Add other cases here
-    _ -> pure mempty
 
 -- END evalDecl
 
@@ -923,32 +633,32 @@ showTopLevelBinds gr = do
   newGraph <- mconcat <$> mapM addBind binds
   pure $ newGraph <> gr
 
-translateDeclToSyntaxGraph :: Show l => Decl l -> SyntaxGraph
+translateDeclToSyntaxGraph :: Show l => SimpDecl l -> SyntaxGraph
 translateDeclToSyntaxGraph d = graph where
   evaluatedDecl = evalDecl mempty d >>= showTopLevelBinds
   graph = evalState evaluatedDecl initialIdState
 
 -- | Convert a single function declaration into a SyntaxGraph
 translateStringToSyntaxGraph :: String -> SyntaxGraph
-translateStringToSyntaxGraph = translateDeclToSyntaxGraph . customParseDecl
+translateStringToSyntaxGraph = translateDeclToSyntaxGraph . stringToSimpDecl
 
 syntaxGraphToCollapsedGraph :: SyntaxGraph -> IngSyntaxGraph FGR.Gr
 syntaxGraphToCollapsedGraph = collapseNodes . syntaxGraphToFglGraph
 
-translateDeclToCollapsedGraph :: Show l => Decl l -> IngSyntaxGraph FGR.Gr
+translateDeclToCollapsedGraph :: Show l => Exts.Decl l -> IngSyntaxGraph FGR.Gr
 translateDeclToCollapsedGraph
-  = syntaxGraphToCollapsedGraph . translateDeclToSyntaxGraph
+  = syntaxGraphToCollapsedGraph . translateDeclToSyntaxGraph . hsDeclToSimpDecl
 
 -- Profiling: At one point, this was about 1.5% of total time.
 translateStringToCollapsedGraphAndDecl ::
-  String -> (IngSyntaxGraph FGR.Gr, Decl Exts.SrcSpanInfo)
+  String -> (IngSyntaxGraph FGR.Gr, Exts.Decl Exts.SrcSpanInfo)
 translateStringToCollapsedGraphAndDecl s = (drawing, decl) where
   decl = customParseDecl s -- :: ParseResult Module
   drawing = translateDeclToCollapsedGraph decl
 
 translateModuleToCollapsedGraphs :: Show l =>
-  Module l -> [IngSyntaxGraph FGR.Gr]
+  Exts.Module l -> [IngSyntaxGraph FGR.Gr]
-translateModuleToCollapsedGraphs (Module _ _ _ _ decls)
+translateModuleToCollapsedGraphs (Exts.Module _ _ _ _ decls)
   = fmap translateDeclToCollapsedGraph decls
 translateModuleToCollapsedGraphs moduleSyntax
   = error $ "Unsupported syntax in translateModuleToCollapsedGraphs: "