[scoper] add error for unused operator syntax definitions

src/MiniJuvix/Syntax/Concrete/Scoped/Error.hs

@@ -28,6 +28,7 @@ data ScopeError
   | ErrMultipleExport MultipleExportConflict
   | ErrAmbiguousSym [SymbolEntry]
   | ErrAmbiguousModuleSym [SymbolEntry]
+  | ErrUnusedOperatorDef UnusedOperatorDef
   -- | Eventually this needs to go away
   | ErrGeneric Text
   deriving stock (Show)
@@ -49,6 +50,7 @@ ppScopeError s = case s of
   ErrMultipleExport e -> ppError e
   ErrAmbiguousSym {} -> undefined
   ErrAmbiguousModuleSym {} -> undefined
+  ErrUnusedOperatorDef e -> ppError e
 
 docStream :: ScopeError -> SimpleDocStream Eann
 docStream = layoutPretty defaultLayoutOptions . ppScopeError

src/MiniJuvix/Syntax/Concrete/Scoped/Error/Pretty/Base.hs

@@ -119,3 +119,8 @@ instance PrettyError ModuleNotInScope where
 
 instance PrettyError MegaParsecError where
   ppError MegaParsecError {..} = pretty _megaParsecError
+
+instance PrettyError UnusedOperatorDef where
+  ppError UnusedOperatorDef {..} =
+    "Unused operator syntax definition:" <> line
+    <> ppCode _unusedOperatorDef

src/MiniJuvix/Syntax/Concrete/Scoped/Error/Types.hs

@@ -74,3 +74,8 @@ newtype MegaParsecError = MegaParsecError {
   _megaParsecError :: Text
   }
  deriving stock (Show)
+
+newtype UnusedOperatorDef = UnusedOperatorDef {
+  _unusedOperatorDef :: OperatorSyntaxDef
+  }
+ deriving stock (Show)

src/MiniJuvix/Syntax/Concrete/Scoped/Scoper.hs

@@ -527,9 +527,16 @@ checkLocalModule Module {..} = do
     inheritEntry :: SymbolEntry -> SymbolEntry
     inheritEntry = over S.nameWhyInScope S.BecauseInherited
 
--- | TODO checks if there is an infix declaration without a binding.
-checkOrphanFixities :: Members '[Error ScopeError, State Scope] r => Sem r ()
-checkOrphanFixities = return ()
+checkOrphanFixities :: forall r .Members '[Error ScopeError, State Scope] r => Sem r ()
+checkOrphanFixities = do
+  path <- gets _scopePath
+  declared <- gets _scopeFixities
+  used <- gets (HashMap.keys . fmap (filter (== path) . HashMap.keys . _symbolInfo) . _scopeSymbols)
+  let unused = toList $ foldr HashMap.delete declared used
+  case unused of
+    [] -> return ()
+    (x : _) -> throw (ErrUnusedOperatorDef (UnusedOperatorDef x))
+
 
 symbolInfoSingle :: SymbolEntry -> SymbolInfo
 symbolInfoSingle p = SymbolInfo $ HashMap.singleton (S._nameDefinedIn p) p

test/Scope/Negative.hs

@@ -103,4 +103,12 @@ tests = [
       case er of
         ErrModuleNotInScope {} -> Nothing
         _ -> wrongError
+
+  ,  NegTest "Unused operator syntax definition"
+    "."
+   "UnusedOperatorDef.mjuvix" $ \er ->
+      case er of
+        ErrUnusedOperatorDef {} -> Nothing
+        _ -> wrongError
+
   ]

tests/negative/UnusedOperatorDef.mjuvix

@@ -0,0 +1,3 @@
+module UnusedOperatorDef;
+  infixl 12 + ;
+end ;