initGrLang :: GrLangState -> Lua ()
initGrLang globalState = do
  setNative "GrLang"
    [ ("getNodeTypes", haskellFn0 globalState $ do
          types <- get nodeTypes
          return . map Text.unpack $ Map.keys types
      )
    , ("getEdgeTypes", haskellFn0 globalState $ do
          types <- Map.keys <$> get edgeTypes
          forM types $ \(name, srcId, tgtId) -> do
            tgraph <- get typeGraph
            let Just srcType = TypeGraph.lookupNode srcId tgraph
                Just tgtType = TypeGraph.lookupNode tgtId tgraph
            return . Text.unpack $ formatEdgeType name (nodeName srcType) (nodeName tgtType)
      )
    , ("addNodeType", haskellFn1 globalState $ \name ->
          GrLang.addNodeType (A Nothing name)
      )
    , ("addEdgeType", haskellFn3 globalState $ \name srcName tgtName ->
          GrLang.addEdgeType (A Nothing name) (A Nothing srcName) (A Nothing tgtName)
      )
    , ("resetTypes", haskellFn0 globalState $ do
          areEmpty <- memSpacesAreEmpty
          unless areEmpty . GrLang.throwError Nothing $
            "Cannot reset types, some GrLang values still refer to the type graph."
          put typeGraph TypeGraph.empty
          put nodeTypes Map.empty
          put edgeTypes Map.empty
      )
    , ("toString", haskellFn1 globalState $ \idx ->
          show . pretty <$> lookupGrLangValue idx
      )
    , ("equals", haskellFn2 globalState $ \idxA idxB -> do
          valA <- lookupGrLangValue idxA
          valB <- lookupGrLangValue idxB
          return (valA == valB)
      )
    , ("deallocate", haskellFn1 globalState $ \idx ->
          freeGrLang idx
      )
    , ("toDot", haskellFn2 globalState $ \idx name -> do
          VGraph graph <- lookupGrLangValue idx
          return . show $ Dot.typedGraph grLangNamingContext (pretty $ Text.decodeUtf8 name) graph
      )
    , ("compileFile", haskellFn1 globalState $ \path ->
          GrLang.compileFile path
      )
    , ("readGGX", haskellFn1 globalState $ \fileName -> do
          (grammar, _, _) <- liftIO $ GGX.readGrammar fileName False morphConf
          let makeValidIdentifier = Text.pack . GrLang.makeIdentifier . takeWhile (/='%')
          names <- liftIO $ Map.fromList . map (id *** makeValidIdentifier) <$> GGX.readNames fileName

          -- Construct a type graph with proper names and update the current type graph
          let tgraph = useGgxNamesOnTypeGraph (fmap correctTypeName names) $ TGraph.typeGraph (start grammar)
                where correctTypeName = Text.takeWhile (/='%')
          put typeGraph tgraph
          put nodeTypes $ Map.fromList [(nodeName n, nodeId n) | n <- TypeGraph.nodes tgraph ]
          put edgeTypes $ Map.fromList [((edgeName e, sourceId e, targetId e), edgeId e) | e <- TypeGraph.edges tgraph ]

          -- Return a table of productions indexed by name
          prods <- forM (productions grammar) $ \(name, prod) -> do
            idx <- allocateGrLang . addNamesFromTypes . useGgxNames names . updateTypeGraph tgraph $ VRule prod
            return (name, idx)
          return (Map.fromList prods)
      )
    ]

  setNative "HsListIterator"
    [ ("deallocate", haskellFn1 globalState $ \idx ->
          withMemSpace iterLists $ freeMemSpace idx
      )
    , ("hasNextItem", haskellFn1 globalState $ \idx ->
          not . null <$> withMemSpace iterLists (lookupMemSpace idx)
      )
    , ("getNextItem", haskellFn1 globalState $ \listIdx -> do
          list <- withMemSpace iterLists $ lookupMemSpace listIdx
          case list of
            [] -> return (0 :: Lua.NumResults)
            (vals : rest) -> do
              withMemSpace iterLists $ putMemSpace listIdx rest
              returnVals vals
      )
    ]

  setNative "Graph"
    [ ("parse", haskellFn1 globalState $ \string -> do
          graph <- GrLang.compileGraph =<< GrLang.parseGraph "<repl>" (string :: String)
          allocateGrLang (VGraph graph)
      )
    , ("identity", haskellFn1 globalState $ \idx -> do
          VGraph graph <- lookupGrLangValue idx
          allocateGrLang (VMorph $ identity graph)
      )
    , ("isInitial", haskellFn1 globalState $ \idx -> do
          VGraph graph <- lookupGrLangValue idx
          return (isInitial (Proxy @GrMorphism) graph)
      )
    , ("calculateCoproduct", haskellFn2 globalState $ \idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          let (jG, jH) = calculateCoproduct g h
          returnVals [VGraph (codomain jG), VMorph jG, VMorph jH]
      )
    , ("calculateProduct", haskellFn2 globalState $ \idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          let (pG, pH) = calculateProduct g h
          returnVals [VGraph (domain pG), VMorph pG, VMorph pH]
      )
    , ("findMorphisms", haskellFn3 globalState $ \kindStr idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          cls <- morphClassFromString kindStr
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VMorph f]) $ findMorphisms cls g h
      )
    , ("findAllSubobjectsOf", haskellFn1 globalState $ \idx -> do
          VGraph g <- lookupGrLangValue idx
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VGraph (domain f), VMorph f]) $
              findAllSubobjectsOf g
      )
    , ("findAllQuotientsOf", haskellFn1 globalState $ \idx -> do
          VGraph g <- lookupGrLangValue idx
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VGraph (codomain f), VMorph f]) $
              findAllQuotientsOf g
      )
    , ("findJointSurjections", haskellFn4 globalState $ \idG kindStrG idH kindStrH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          clsG <- morphClassFromString kindStrG
          clsH <- morphClassFromString kindStrH
          withMemSpace iterLists .
            allocateMemSpace . map (\(jg, jh) -> [VGraph (codomain jg), VMorph jg, VMorph jh]) $
              findJointSurjections (clsG, g) (clsH, h)
      )
    ]

  setNative "Morphism"
    [ ("parse", haskellFn3 globalState $ \domIdx codIdx string -> do
          VGraph dom <- lookupGrLangValue domIdx
          VGraph cod <- lookupGrLangValue codIdx
          morphism <- GrLang.compileMorphism Nothing dom cod =<< GrLang.parseMorphism "<repl>" (string :: String)
          allocateGrLang (VMorph morphism)
      )
    , ("compose", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          allocateGrLang (VMorph $ f <&> g)
      )
    , ("isMonic", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isMonic f)
      )
    , ("isEpic", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isEpic f)
      )
    , ("isIsomorphism", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isIsomorphism f)
      )
    , ("calculatePullback", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (f', g') = calculatePullback f g
          returnVals [VGraph (domain f'), VMorph f', VMorph g']
      )
    , ("calculatePushout", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (f', g') = calculatePushout f g
          returnVals [VGraph (codomain f'), VMorph f', VMorph g']
      )
    , ("calculateEqualizer", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let e = calculateEqualizer f g
          returnVals [VGraph (domain e), VMorph e]
      )
    , ("calculateCoequalizer", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let e = calculateCoequalizer f g
          returnVals [VGraph (codomain e), VMorph e]
      )
    , ("hasPushoutComplementAlongM", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          return (hasPushoutComplementAlongM f g)
      )
    , ("calculatePushoutComplementAlongM", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (g', f') = calculatePushoutComplementAlongM f g
          returnVals [VGraph (codomain g'), VMorph g', VMorph f']
      )
    , ("calculateInitialPushout", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          let (b, f', c) = calculateMInitialPushout f
          returnVals [VGraph (domain b), VGraph (domain c), VMorph b, VMorph f', VMorph c]
      )
    , ("subobjectIntersection", haskellFn2 globalState $ \idA idB -> do
          VMorph a <- lookupGrLangValue idA
          VMorph b <- lookupGrLangValue idB
          let c = subobjectIntersection a b
          returnVals [VGraph (domain c), VMorph c]
      )
    , ("subobjectUnion", haskellFn2 globalState $ \idA idB -> do
          VMorph a <- lookupGrLangValue idA
          VMorph b <- lookupGrLangValue idB
          let c = subobjectUnion a b
          returnVals [VGraph (domain c), VMorph c]
      )
    , ("findJointSurjectionSquares", haskellFn4 globalState $ \kindStrF idF kindStrG idG -> do
        VMorph f <- lookupGrLangValue idF
        VMorph g <- lookupGrLangValue idG
        clsF <- morphClassFromString kindStrF
        clsG <- morphClassFromString kindStrG
        withMemSpace iterLists .
          allocateMemSpace . map (\(f', g') -> [VGraph (codomain f'), VMorph f', VMorph g']) $
            findJointSurjectionSquares (clsF, f) (clsG, g)
      )
    ]

  setNative "Cospan"
    [ ("findCospanCommuters", haskellFn3 globalState $ \kindStr idF idG -> do
        VMorph f <- lookupGrLangValue idF
        VMorph g <- lookupGrLangValue idG
        cls <- morphClassFromString kindStr
        withMemSpace iterLists .
          allocateMemSpace . map (\h -> [VMorph h]) $ findCospanCommuters cls f g
      )
    ]

  setNative "Rule"
    [ ("parse", haskellFn1 globalState $ \string -> do
          rule <- GrLang.compileRule =<< GrLang.parseRule "<repl>" (string :: String)
          allocateGrLang (VRule rule)
      )
    , ("getLeftObject", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ leftObject rule)
      )
    , ("getRightObject", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ rightObject rule)
      )
    , ("getInterface", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ interfaceObject rule)
      )
    , ("getLeftMorphism", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VMorph $ leftMorphism rule)
      )
    , ("getRightMorphism", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VMorph $ rightMorphism rule)
      )
    ]
  where
    setNative className entries = do
      Lua.getglobal className
      tableIdx <- Lua.gettop
      createTable entries
      Lua.setfield tableIdx "native"
      Lua.pop 1
initGrLang :: GrLangState -> Lua ()
initGrLang globalState = do
  setNative "GrLang"
    [ ("getNodeTypes", haskellFn0 globalState $ do
          types <- get nodeTypes
          return . map Text.unpack $ Map.keys types
      )
    , ("getEdgeTypes", haskellFn0 globalState $ do
          types <- Map.keys <$> get edgeTypes
          forM types $ \(name, srcId, tgtId) -> do
            tgraph <- get typeGraph
            let Just srcType = TypeGraph.lookupNode srcId tgraph
                Just tgtType = TypeGraph.lookupNode tgtId tgraph
            return . Text.unpack $ formatEdgeType name (nodeName srcType) (nodeName tgtType)
      )
    , ("addNodeType", haskellFn1 globalState $ \name ->
          GrLang.addNodeType (A Nothing name)
      )
    , ("addEdgeType", haskellFn3 globalState $ \name srcName tgtName ->
          GrLang.addEdgeType (A Nothing name) (A Nothing srcName) (A Nothing tgtName)
      )
    , ("resetTypes", haskellFn0 globalState $ do
          areEmpty <- memSpacesAreEmpty
          unless areEmpty . GrLang.throwError Nothing $
            "Cannot reset types, some GrLang values still refer to the type graph."
          put typeGraph TypeGraph.empty
          put nodeTypes Map.empty
          put edgeTypes Map.empty
      )
    , ("toString", haskellFn1 globalState $ \idx ->
          show . pretty <$> lookupGrLangValue idx
      )
    , ("equals", haskellFn2 globalState $ \idxA idxB -> do
          valA <- lookupGrLangValue idxA
          valB <- lookupGrLangValue idxB
          return (valA == valB)
      )
    , ("deallocate", haskellFn1 globalState $ \idx ->
          freeGrLang idx
      )
    , ("toDot", haskellFn2 globalState $ \idx name -> do
          VGraph graph <- lookupGrLangValue idx
          return . show $ Dot.typedGraph grLangNamingContext (pretty $ Text.decodeUtf8 name) graph
      )
    , ("compileFile", haskellFn1 globalState $ \path ->
          GrLang.compileFile path
      )
    , ("readGGX", haskellFn1 globalState $ \fileName -> do
          (grammar, _, _) <- liftIO $ GGX.readGrammar fileName False morphConf
          let makeValidIdentifier = Text.pack . GrLang.makeIdentifier . takeWhile (/='%')
          names <- liftIO $ Map.fromList . map (id *** makeValidIdentifier) <$> GGX.readNames fileName

          -- Construct a type graph with proper names and update the current type graph
          let tgraph = useGgxNamesOnTypeGraph (fmap correctTypeName names) $ TGraph.typeGraph (start grammar)
                where correctTypeName = Text.takeWhile (/='%')
          put typeGraph tgraph
          put nodeTypes $ Map.fromList [(nodeName n, nodeId n) | n <- TypeGraph.nodes tgraph ]
          put edgeTypes $ Map.fromList [((edgeName e, sourceId e, targetId e), edgeId e) | e <- TypeGraph.edges tgraph ]

          -- Return a table of productions indexed by name
          prods <- forM (productions grammar) $ \(name, prod) -> do
            idx <- allocateGrLang . addNamesFromTypes . useGgxNames names . updateTypeGraph tgraph $ VRule prod
            return (name, idx)
          return (Map.fromList prods)
      )
    ]

  setNative "HsListIterator"
    [ ("deallocate", haskellFn1 globalState $ \idx ->
          withMemSpace iterLists $ freeMemSpace idx
      )
    , ("hasNextItem", haskellFn1 globalState $ \idx ->
          not . null <$> withMemSpace iterLists (lookupMemSpace idx)
      )
    , ("getNextItem", haskellFn1 globalState $ \listIdx -> do
          list <- withMemSpace iterLists $ lookupMemSpace listIdx
          case list of
            [] -> return (0 :: Lua.NumResults)
            (vals : rest) -> do
              withMemSpace iterLists $ putMemSpace listIdx rest
              returnVals vals
      )
    ]

  setNative "Graph"
    [ ("parse", haskellFn1 globalState $ \string -> do
          graph <- GrLang.compileGraph =<< GrLang.parseGraph "<repl>" (string :: String)
          allocateGrLang (VGraph graph)
      )
    , ("identity", haskellFn1 globalState $ \idx -> do
          VGraph graph <- lookupGrLangValue idx
          allocateGrLang (VMorph $ identity graph)
      )
    , ("isInitial", haskellFn1 globalState $ \idx -> do
          VGraph graph <- lookupGrLangValue idx
          return (isInitial (Proxy @GrMorphism) graph)
      )
    , ("calculateCoproduct", haskellFn2 globalState $ \idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          let (jG, jH) = calculateCoproduct g h
          returnVals [VGraph (codomain jG), VMorph jG, VMorph jH]
      )
    , ("calculateProduct", haskellFn2 globalState $ \idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          let (pG, pH) = calculateProduct g h
          returnVals [VGraph (domain pG), VMorph pG, VMorph pH]
      )
    , ("findMorphisms", haskellFn3 globalState $ \kindStr idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          cls <- morphClassFromString kindStr
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VMorph f]) $ findMorphisms cls g h
      )
    , ("findAllSubobjectsOf", haskellFn1 globalState $ \idx -> do
          VGraph g <- lookupGrLangValue idx
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VGraph (domain f), VMorph f]) $
              findAllSubobjectsOf g
      )
    , ("findAllQuotientsOf", haskellFn1 globalState $ \idx -> do
          VGraph g <- lookupGrLangValue idx
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VGraph (codomain f), VMorph f]) $
              findAllQuotientsOf g
      )
    , ("findJointSurjections", haskellFn4 globalState $ \idG kindStrG idH kindStrH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          clsG <- morphClassFromString kindStrG
          clsH <- morphClassFromString kindStrH
          withMemSpace iterLists .
            allocateMemSpace . map (\(jg, jh) -> [VGraph (codomain jg), VMorph jg, VMorph jh]) $
              findJointSurjections (clsG, g) (clsH, h)
      )
    ]

  setNative "Morphism"
    [ ("parse", haskellFn3 globalState $ \domIdx codIdx string -> do
          VGraph dom <- lookupGrLangValue domIdx
          VGraph cod <- lookupGrLangValue codIdx
          morphism <- GrLang.compileMorphism Nothing dom cod =<< GrLang.parseMorphism "<repl>" (string :: String)
          allocateGrLang (VMorph morphism)
      )
    , ("compose", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          allocateGrLang (VMorph $ f <&> g)
      )
    , ("isMonic", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isMonic f)
      )
    , ("isEpic", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isEpic f)
      )
    , ("isIsomorphism", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isIsomorphism f)
      )
    , ("calculatePullback", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (f', g') = calculatePullback f g
          returnVals [VGraph (domain f'), VMorph f', VMorph g']
      )
    , ("calculatePushout", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (f', g') = calculatePushout f g
          returnVals [VGraph (codomain f'), VMorph f', VMorph g']
      )
    , ("calculateEqualizer", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let e = calculateEqualizer f g
          returnVals [VGraph (domain e), VMorph e]
      )
    , ("calculateCoequalizer", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let e = calculateCoequalizer f g
          returnVals [VGraph (codomain e), VMorph e]
      )
    , ("hasPushoutComplementAlongM", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          return (hasPushoutComplementAlongM f g)
      )
    , ("calculatePushoutComplementAlongM", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (g', f') = calculatePushoutComplementAlongM f g
          returnVals [VGraph (codomain g'), VMorph g', VMorph f']
      )
    , ("calculateInitialPushout", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          let (b, f', c) = calculateMInitialPushout f
          returnVals [VGraph (domain b), VGraph (domain c), VMorph b, VMorph f', VMorph c]
      )
    , ("subobjectIntersection", haskellFn2 globalState $ \idA idB -> do
          VMorph a <- lookupGrLangValue idA
          VMorph b <- lookupGrLangValue idB
          let c = subobjectIntersection a b
          returnVals [VGraph (domain c), VMorph c]
      )
    , ("subobjectUnion", haskellFn2 globalState $ \idA idB -> do
          VMorph a <- lookupGrLangValue idA
          VMorph b <- lookupGrLangValue idB
          let c = subobjectUnion a b
          returnVals [VGraph (domain c), VMorph c]
      )
    , ("findJointSurjectionSquares", haskellFn4 globalState $ \kindStrF idF kindStrG idG -> do
        VMorph f <- lookupGrLangValue idF
        VMorph g <- lookupGrLangValue idG
        clsF <- morphClassFromString kindStrF
        clsG <- morphClassFromString kindStrG
        withMemSpace iterLists .
          allocateMemSpace . map (\(f', g') -> [VGraph (codomain f'), VMorph f', VMorph g']) $
            findJointSurjectionSquares (clsF, f) (clsG, g)
      )
    ]

  setNative "Cospan"
    [ ("findCospanCommuters", haskellFn3 globalState $ \kindStr idF idG -> do
        VMorph f <- lookupGrLangValue idF
        VMorph g <- lookupGrLangValue idG
        cls <- morphClassFromString kindStr
        withMemSpace iterLists .
          allocateMemSpace . map (\h -> [VMorph h]) $ findCospanCommuters cls f g
      )
    ]

  setNative "Rule"
    [ ("parse", haskellFn1 globalState $ \string -> do
          rule <- GrLang.compileRule =<< GrLang.parseRule "<repl>" (string :: String)
          allocateGrLang (VRule rule)
      )
    , ("getLeftObject", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ leftObject rule)
      )
    , ("getRightObject", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ rightObject rule)
      )
    , ("getInterface", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ interfaceObject rule)
      )
    , ("getLeftMorphism", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VMorph $ leftMorphism rule)
      )
    , ("getRightMorphism", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VMorph $ rightMorphism rule)
      )
    ]
  where
    setNative className entries = do
      Lua.getglobal className
      tableIdx <- Lua.gettop
      createTable entries
      Lua.setfield tableIdx "native"
      Lua.pop 1
initGrLang globalState = do
  setNative "GrLang"
    [ ("getNodeTypes", haskellFn0 globalState $ do
          types <- get nodeTypes
          return . map Text.unpack $ Map.keys types
      )
    , ("getEdgeTypes", haskellFn0 globalState $ do
          types <- Map.keys <$> get edgeTypes
          forM types $ \(name, srcId, tgtId) -> do
            tgraph <- get typeGraph
            let Just srcType = TypeGraph.lookupNode srcId tgraph
                Just tgtType = TypeGraph.lookupNode tgtId tgraph
            return . Text.unpack $ formatEdgeType name (nodeName srcType) (nodeName tgtType)
      )
    , ("addNodeType", haskellFn1 globalState $ \name ->
          GrLang.addNodeType (A Nothing name)
      )
    , ("addEdgeType", haskellFn3 globalState $ \name srcName tgtName ->
          GrLang.addEdgeType (A Nothing name) (A Nothing srcName) (A Nothing tgtName)
      )
    , ("resetTypes", haskellFn0 globalState $ do
          areEmpty <- memSpacesAreEmpty
          unless areEmpty . GrLang.throwError Nothing $
            "Cannot reset types, some GrLang values still refer to the type graph."
          put typeGraph TypeGraph.empty
          put nodeTypes Map.empty
          put edgeTypes Map.empty
      )
    , ("toString", haskellFn1 globalState $ \idx ->
          show . pretty <$> lookupGrLangValue idx
      )
    , ("equals", haskellFn2 globalState $ \idxA idxB -> do
          valA <- lookupGrLangValue idxA
          valB <- lookupGrLangValue idxB
          return (valA == valB)
      )
    , ("deallocate", haskellFn1 globalState $ \idx ->
          freeGrLang idx
      )
    , ("toDot", haskellFn2 globalState $ \idx name -> do
          VGraph graph <- lookupGrLangValue idx
          return . show $ Dot.typedGraph grLangNamingContext (pretty $ Text.decodeUtf8 name) graph
      )
    , ("compileFile", haskellFn1 globalState $ \path ->
          GrLang.compileFile path
      )
    , ("readGGX", haskellFn1 globalState $ \fileName -> do
          (grammar, _, _) <- liftIO $ GGX.readGrammar fileName False morphConf
          let makeValidIdentifier = Text.pack . GrLang.makeIdentifier . takeWhile (/='%')
          names <- liftIO $ Map.fromList . map (id *** makeValidIdentifier) <$> GGX.readNames fileName

          -- Construct a type graph with proper names and update the current type graph
          let tgraph = useGgxNamesOnTypeGraph (fmap correctTypeName names) $ TGraph.typeGraph (start grammar)
                where correctTypeName = Text.takeWhile (/='%')
          put typeGraph tgraph
          put nodeTypes $ Map.fromList [(nodeName n, nodeId n) | n <- TypeGraph.nodes tgraph ]
          put edgeTypes $ Map.fromList [((edgeName e, sourceId e, targetId e), edgeId e) | e <- TypeGraph.edges tgraph ]

          -- Return a table of productions indexed by name
          prods <- forM (productions grammar) $ \(name, prod) -> do
            idx <- allocateGrLang . addNamesFromTypes . useGgxNames names . updateTypeGraph tgraph $ VRule prod
            return (name, idx)
          return (Map.fromList prods)
      )
    ]

  setNative "HsListIterator"
    [ ("deallocate", haskellFn1 globalState $ \idx ->
          withMemSpace iterLists $ freeMemSpace idx
      )
    , ("hasNextItem", haskellFn1 globalState $ \idx ->
          not . null <$> withMemSpace iterLists (lookupMemSpace idx)
      )
    , ("getNextItem", haskellFn1 globalState $ \listIdx -> do
          list <- withMemSpace iterLists $ lookupMemSpace listIdx
          case list of
            [] -> return (0 :: Lua.NumResults)
            (vals : rest) -> do
              withMemSpace iterLists $ putMemSpace listIdx rest
              returnVals vals
      )
    ]

  setNative "Graph"
    [ ("parse", haskellFn1 globalState $ \string -> do
          graph <- GrLang.compileGraph =<< GrLang.parseGraph "<repl>" (string :: String)
          allocateGrLang (VGraph graph)
      )
    , ("identity", haskellFn1 globalState $ \idx -> do
          VGraph graph <- lookupGrLangValue idx
          allocateGrLang (VMorph $ identity graph)
      )
    , ("isInitial", haskellFn1 globalState $ \idx -> do
          VGraph graph <- lookupGrLangValue idx
          return (isInitial (Proxy @GrMorphism) graph)
      )
    , ("calculateCoproduct", haskellFn2 globalState $ \idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          let (jG, jH) = calculateCoproduct g h
          returnVals [VGraph (codomain jG), VMorph jG, VMorph jH]
      )
    , ("calculateProduct", haskellFn2 globalState $ \idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          let (pG, pH) = calculateProduct g h
          returnVals [VGraph (domain pG), VMorph pG, VMorph pH]
      )
    , ("findMorphisms", haskellFn3 globalState $ \kindStr idG idH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          cls <- morphClassFromString kindStr
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VMorph f]) $ findMorphisms cls g h
      )
    , ("findAllSubobjectsOf", haskellFn1 globalState $ \idx -> do
          VGraph g <- lookupGrLangValue idx
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VGraph (domain f), VMorph f]) $
              findAllSubobjectsOf g
      )
    , ("findAllQuotientsOf", haskellFn1 globalState $ \idx -> do
          VGraph g <- lookupGrLangValue idx
          withMemSpace iterLists .
            allocateMemSpace . map (\f -> [VGraph (codomain f), VMorph f]) $
              findAllQuotientsOf g
      )
    , ("findJointSurjections", haskellFn4 globalState $ \idG kindStrG idH kindStrH -> do
          VGraph g <- lookupGrLangValue idG
          VGraph h <- lookupGrLangValue idH
          clsG <- morphClassFromString kindStrG
          clsH <- morphClassFromString kindStrH
          withMemSpace iterLists .
            allocateMemSpace . map (\(jg, jh) -> [VGraph (codomain jg), VMorph jg, VMorph jh]) $
              findJointSurjections (clsG, g) (clsH, h)
      )
    ]

  setNative "Morphism"
    [ ("parse", haskellFn3 globalState $ \domIdx codIdx string -> do
          VGraph dom <- lookupGrLangValue domIdx
          VGraph cod <- lookupGrLangValue codIdx
          morphism <- GrLang.compileMorphism Nothing dom cod =<< GrLang.parseMorphism "<repl>" (string :: String)
          allocateGrLang (VMorph morphism)
      )
    , ("compose", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          allocateGrLang (VMorph $ f <&> g)
      )
    , ("isMonic", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isMonic f)
      )
    , ("isEpic", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isEpic f)
      )
    , ("isIsomorphism", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          return (isIsomorphism f)
      )
    , ("calculatePullback", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (f', g') = calculatePullback f g
          returnVals [VGraph (domain f'), VMorph f', VMorph g']
      )
    , ("calculatePushout", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (f', g') = calculatePushout f g
          returnVals [VGraph (codomain f'), VMorph f', VMorph g']
      )
    , ("calculateEqualizer", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let e = calculateEqualizer f g
          returnVals [VGraph (domain e), VMorph e]
      )
    , ("calculateCoequalizer", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let e = calculateCoequalizer f g
          returnVals [VGraph (codomain e), VMorph e]
      )
    , ("hasPushoutComplementAlongM", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          return (hasPushoutComplementAlongM f g)
      )
    , ("calculatePushoutComplementAlongM", haskellFn2 globalState $ \idF idG -> do
          VMorph f <- lookupGrLangValue idF
          VMorph g <- lookupGrLangValue idG
          let (g', f') = calculatePushoutComplementAlongM f g
          returnVals [VGraph (codomain g'), VMorph g', VMorph f']
      )
    , ("calculateInitialPushout", haskellFn1 globalState $ \idx -> do
          VMorph f <- lookupGrLangValue idx
          let (b, f', c) = calculateMInitialPushout f
          returnVals [VGraph (domain b), VGraph (domain c), VMorph b, VMorph f', VMorph c]
      )
    , ("subobjectIntersection", haskellFn2 globalState $ \idA idB -> do
          VMorph a <- lookupGrLangValue idA
          VMorph b <- lookupGrLangValue idB
          let c = subobjectIntersection a b
          returnVals [VGraph (domain c), VMorph c]
      )
    , ("subobjectUnion", haskellFn2 globalState $ \idA idB -> do
          VMorph a <- lookupGrLangValue idA
          VMorph b <- lookupGrLangValue idB
          let c = subobjectUnion a b
          returnVals [VGraph (domain c), VMorph c]
      )
    , ("findJointSurjectionSquares", haskellFn4 globalState $ \kindStrF idF kindStrG idG -> do
        VMorph f <- lookupGrLangValue idF
        VMorph g <- lookupGrLangValue idG
        clsF <- morphClassFromString kindStrF
        clsG <- morphClassFromString kindStrG
        withMemSpace iterLists .
          allocateMemSpace . map (\(f', g') -> [VGraph (codomain f'), VMorph f', VMorph g']) $
            findJointSurjectionSquares (clsF, f) (clsG, g)
      )
    ]

  setNative "Cospan"
    [ ("findCospanCommuters", haskellFn3 globalState $ \kindStr idF idG -> do
        VMorph f <- lookupGrLangValue idF
        VMorph g <- lookupGrLangValue idG
        cls <- morphClassFromString kindStr
        withMemSpace iterLists .
          allocateMemSpace . map (\h -> [VMorph h]) $ findCospanCommuters cls f g
      )
    ]

  setNative "Rule"
    [ ("parse", haskellFn1 globalState $ \string -> do
          rule <- GrLang.compileRule =<< GrLang.parseRule "<repl>" (string :: String)
          allocateGrLang (VRule rule)
      )
    , ("getLeftObject", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ leftObject rule)
      )
    , ("getRightObject", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ rightObject rule)
      )
    , ("getInterface", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VGraph $ interfaceObject rule)
      )
    , ("getLeftMorphism", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VMorph $ leftMorphism rule)
      )
    , ("getRightMorphism", haskellFn1 globalState $ \idRule -> do
          VRule rule <- lookupGrLangValue idRule
          allocateGrLang (VMorph $ rightMorphism rule)
      )
    ]
  where
    setNative className entries = do
      Lua.getglobal className
      tableIdx <- Lua.gettop
      createTable entries
      Lua.setfield tableIdx "native"
      Lua.pop 1