Fix symbol numbering bug (#1574)

anoma · Oct 4, 2022 · f4ca940 · f4ca940
1 parent 57446c6
commit f4ca940
Show file tree

Hide file tree

Showing 5 changed files with 31 additions and 44 deletions.
diff --git a/src/Juvix/Compiler/Core/Data/InfoTable.hs b/src/Juvix/Compiler/Core/Data/InfoTable.hs
@@ -12,7 +12,9 @@ data InfoTable = InfoTable
     _infoIdentifiers :: HashMap Symbol IdentifierInfo,
     _infoInductives :: HashMap Symbol InductiveInfo,
     _infoConstructors :: HashMap Tag ConstructorInfo,
-    _infoAxioms :: HashMap Name AxiomInfo
+    _infoAxioms :: HashMap Name AxiomInfo,
+    _infoNextSymbol :: Word,
+    _infoNextTag :: Word
   }
 
 emptyInfoTable :: InfoTable
@@ -24,7 +26,9 @@ emptyInfoTable =
       _infoIdentifiers = mempty,
       _infoInductives = mempty,
       _infoConstructors = mempty,
-      _infoAxioms = mempty
+      _infoAxioms = mempty,
+      _infoNextSymbol = 0,
+      _infoNextTag = 0
     }
 
 data IdentKind = IdentSym Symbol | IdentTag Tag

diff --git a/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Core/Data/InfoTableBuilder.hs
@@ -26,52 +26,35 @@ checkSymbolDefined sym = do
   tab <- getInfoTable
   return $ HashMap.member sym (tab ^. identContext)
 
-data BuilderState = BuilderState
-  { _stateNextSymbol :: Word,
-    _stateNextUserTag :: Word,
-    _stateInfoTable :: InfoTable
-  }
-
-makeLenses ''BuilderState
-
-initBuilderState :: InfoTable -> BuilderState
-initBuilderState tab =
-  BuilderState
-    { _stateNextSymbol = fromIntegral $ HashMap.size (tab ^. infoIdentifiers),
-      _stateNextUserTag = fromIntegral $ HashMap.size (tab ^. infoConstructors),
-      _stateInfoTable = tab
-    }
-
 runInfoTableBuilder :: InfoTable -> Sem (InfoTableBuilder ': r) a -> Sem r (InfoTable, a)
 runInfoTableBuilder tab =
-  fmap (first (^. stateInfoTable))
-    . runState (initBuilderState tab)
+  runState tab
     . reinterpret interp
   where
-    interp :: InfoTableBuilder m a -> Sem (State BuilderState : r) a
+    interp :: InfoTableBuilder m a -> Sem (State InfoTable : r) a
     interp = \case
       FreshSymbol -> do
-        modify' (over stateNextSymbol (+ 1))
         s <- get
-        return (s ^. stateNextSymbol - 1)
+        modify' (over infoNextSymbol (+ 1))
+        return (s ^. infoNextSymbol)
       FreshTag -> do
-        modify' (over stateNextUserTag (+ 1))
         s <- get
-        return (UserTag (s ^. stateNextUserTag - 1))
+        modify' (over infoNextTag (+ 1))
+        return (UserTag (s ^. infoNextTag))
       RegisterIdent ii -> do
-        modify' (over stateInfoTable (over infoIdentifiers (HashMap.insert (ii ^. identifierSymbol) ii)))
+        modify' (over infoIdentifiers (HashMap.insert (ii ^. identifierSymbol) ii))
         whenJust (ii ^? identifierName . _Just . nameText) $ \name ->
-          modify' (over stateInfoTable (over identMap (HashMap.insert name (IdentSym (ii ^. identifierSymbol)))))
+          modify' (over identMap (HashMap.insert name (IdentSym (ii ^. identifierSymbol))))
       RegisterConstructor ci -> do
-        modify' (over stateInfoTable (over infoConstructors (HashMap.insert (ci ^. constructorTag) ci)))
-        modify' (over stateInfoTable (over identMap (HashMap.insert (ci ^. (constructorName . nameText)) (IdentTag (ci ^. constructorTag)))))
+        modify' (over infoConstructors (HashMap.insert (ci ^. constructorTag) ci))
+        modify' (over identMap (HashMap.insert (ci ^. (constructorName . nameText)) (IdentTag (ci ^. constructorTag))))
       RegisterIdentNode sym node ->
-        modify' (over stateInfoTable (over identContext (HashMap.insert sym node)))
+        modify' (over identContext (HashMap.insert sym node))
       SetIdentArgsInfo sym argsInfo -> do
-        modify' (over stateInfoTable (over infoIdentifiers (HashMap.adjust (set identifierArgsInfo argsInfo) sym)))
-        modify' (over stateInfoTable (over infoIdentifiers (HashMap.adjust (set identifierArgsNum (length argsInfo)) sym)))
+        modify' (set (infoIdentifiers . at sym . _Just . identifierArgsInfo) argsInfo)
+        modify' (set (infoIdentifiers . at sym . _Just . identifierArgsNum) (length argsInfo))
       GetIdent txt -> do
         s <- get
-        return $ HashMap.lookup txt (s ^. (stateInfoTable . identMap))
+        return $ HashMap.lookup txt (s ^. identMap)
       GetInfoTable ->
-        get <&> (^. stateInfoTable)
+        get
diff --git a/tests/Core/positive/lambda-lifting/test1.out b/tests/Core/positive/lambda-lifting/test1.out
@@ -1,3 +1,3 @@
 -- IdentContext
-def 1 := λg λx λy λz g$3 x$2
-def t1 := λg λf f$0 (!1 g$1)
+def t1 := λg λf f$0 (!7 g$1)
+def 7 := λg λx λy λz g$3 x$2
diff --git a/tests/Core/positive/lambda-lifting/test2.out b/tests/Core/positive/lambda-lifting/test2.out
@@ -1,6 +1,6 @@
 -- IdentContext
-def 1 := λx λw w$0 x$1
-def 2 := λy λx λe y$2 e$0 x$1 y$2
-def 3 := λy λx λz z$0 y$2 x$1 (!1 x$1) (!2 x$1 y$2)
-def 4 := λs λx λy s$2 y$0 (!3 x$1 y$0)
-def t2 := λr λs r$1 (!4 s$0)
+def t2 := λr λs r$1 (!10 s$0)
+def 7 := λx λw w$0 x$1
+def 8 := λy λx λe y$2 e$0 x$1 y$2
+def 9 := λy λx λz z$0 y$2 x$1 (!7 x$1) (!8 x$1 y$2)
+def 10 := λs λx λy s$2 y$0 (!9 x$1 y$0)
diff --git a/tests/Core/positive/lambda-lifting/test3.out b/tests/Core/positive/lambda-lifting/test3.out
@@ -1,6 +1,6 @@
 -- IdentContext
-def 3 := λx x$0
-def 4 := λr λx r$1
 def const := λx λy x$1
 def id := λx x$0
-def t3 := λr λs const !3 (id (!4 r$1))
+def t3 := λr λs const !9 (id (!10 r$1))
+def 9 := λx x$0
+def 10 := λr λx r$1