New fixity/iterator syntax (#2332)

- Closes #2330
- Closes #2329 

This pr implements the syntax changes described in #2330. It drops
support for the old yaml-based syntax.
Some valid examples:
```
syntax iterator for {init := 1; range := 1};

syntax fixity cons := binary {assoc := right};
syntax fixity cmp := binary;
syntax fixity cmp := binary {}; -- debatable whether we want to accept empty {} or not. I think we should
```
# Future work
This pr creates an asymmetry between iterators and operators
definitions. Iterators definition do not require a constructor. We could
add it to make it homogeneous, but it looks a bit redundant:
```
syntax iterator for := mkIterator {init := 1; range := 1};
```

We could consider merging iterator and fixity declarations with this
alternative syntax.
```
syntax XXX for := iterator {init := 1; range := 1};

syntax XXX cons := binary {assoc := right};
```
where `XXX` is a common keyword. Suggestion by @lukaszcz XXX = declare

---------

Co-authored-by: Łukasz Czajka <62751+lukaszcz@users.noreply.github.com>
Co-authored-by: Lukasz Czajka <lukasz@heliax.dev>

src/Juvix/Compiler/Backend/C/Extra/Serialization.hs

@@ -2,7 +2,7 @@ module Juvix.Compiler.Backend.C.Extra.Serialization where
 
 import Codec.Binary.UTF8.String qualified as UTF8
 import Juvix.Compiler.Backend.C.Language
-import Juvix.Prelude hiding (Binary, Unary)
+import Juvix.Prelude
 import Language.C qualified as C
 import Language.C.Data.Ident qualified as C
 import Language.C.Pretty qualified as P

src/Juvix/Compiler/Backend/C/Translation/FromReg.hs

@@ -73,10 +73,10 @@ fromReg lims tab =
 
         getAssoc :: OperatorArity -> Text
         getAssoc = \case
-          Fixity.Unary _ -> "assoc_none"
-          Fixity.Binary AssocNone -> "assoc_none"
-          Fixity.Binary AssocLeft -> "assoc_left"
-          Fixity.Binary AssocRight -> "assoc_right"
+          Fixity.OpUnary _ -> "assoc_none"
+          Fixity.OpBinary AssocNone -> "assoc_none"
+          Fixity.OpBinary AssocLeft -> "assoc_left"
+          Fixity.OpBinary AssocRight -> "assoc_right"
 
     functionInfo :: CCode
     functionInfo =

src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs

@@ -7,7 +7,6 @@ where
 
 import Data.ByteString.Builder qualified as Builder
 import Data.HashMap.Strict qualified as HashMap
-import Data.Text qualified as Text
 import Data.Time.Clock
 import Data.Versions (prettySemVer)
 import Juvix.Compiler.Backend.Html.Data
@@ -23,7 +22,6 @@ import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.ArityChecking.D
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking qualified as InternalTyped
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context
 import Juvix.Compiler.Pipeline.EntryPoint
-import Juvix.Data.FixityInfo as FixityInfo
 import Juvix.Extra.Assets
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
@@ -441,9 +439,10 @@ goStatement = \case
 
 goFixity :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => FixitySyntaxDef 'Scoped -> Sem r Html
 goFixity def = do
-  sig' <- ppHelper (ppFixityDefHeader def)
+  sig' <- ppHelper (ppFixityDefHeaderNew def)
   header' <- defHeader (def ^. fixitySymbol) sig' (def ^. fixityDoc)
-  let tbl' = table . tbody $ ari <> prec
+  prec' <- mkPrec
+  let tbl' = table . tbody $ ari <> prec'
   return $
     header'
       <> ( Html.div
@@ -452,27 +451,31 @@ goFixity def = do
                <> tbl'
          )
   where
-    info :: FixityInfo
-    info = def ^. fixityInfo . withLocParam . withSourceValue
+    info :: ParsedFixityInfo 'Scoped
+    info = def ^. fixityInfo
 
     row :: Html -> Html
     row x = tr $ td ! Attr.class_ "src" $ x
 
-    prec :: Html
-    prec = case info ^. fixityPrecSame of
-      Just txt -> row $ toHtml ("Same precedence as " <> txt)
+    mkPrec :: Sem r Html
+    mkPrec = case info ^. fixityPrecSame of
+      Just txt -> do
+        s <- ppCodeHtml defaultOptions txt
+        return (row $ toHtml ("Same precedence as " <> s))
       Nothing ->
         goPrec "Higher" (info ^. fixityPrecAbove)
           <> goPrec "Lower" (info ^. fixityPrecBelow)
         where
-          goPrec :: Html -> [Text] -> Html
-          goPrec above ls = case nonEmpty ls of
+          goPrec :: Html -> Maybe [S.Symbol] -> Sem r Html
+          goPrec above ls = case ls >>= nonEmpty of
             Nothing -> mempty
-            Just l -> row $ above <> " precedence than: " <> toHtml (Text.intercalate ", " (toList l))
+            Just l -> do
+              l' <- foldr (\x acc -> x <> ", " <> acc) mempty <$> mapM (ppCodeHtml defaultOptions) l
+              return (row $ above <> " precedence than: " <> l')
 
     ari :: Html
     ari =
-      let arit = toHtml @String $ show (info ^. FixityInfo.fixityArity)
+      let arit = toHtml @String $ show (info ^. fixityParsedArity)
           assoc = toHtml @String $ case fromMaybe AssocNone (info ^. fixityAssoc) of
             AssocNone -> ""
             AssocRight -> ", right-associative"

src/Juvix/Compiler/Concrete/Data/ScopedName.hs

@@ -10,7 +10,7 @@ import Juvix.Compiler.Concrete.Data.IsConcrete
 import Juvix.Compiler.Concrete.Data.Name qualified as C
 import Juvix.Compiler.Concrete.Data.VisibilityAnn
 import Juvix.Data.Fixity qualified as C
-import Juvix.Data.IteratorAttribs (IteratorAttribs)
+import Juvix.Data.IteratorInfo
 import Juvix.Data.NameId
 import Juvix.Data.NameKind
 import Juvix.Prelude
@@ -71,7 +71,7 @@ data Name' n = Name'
     _nameKind :: NameKind,
     _nameDefinedIn :: AbsModulePath,
     _nameFixity :: Maybe C.Fixity,
-    _nameIterator :: Maybe IteratorAttribs,
+    _nameIterator :: Maybe IteratorInfo,
     _nameWhyInScope :: WhyInScope,
     _nameVisibilityAnn :: VisibilityAnn,
     -- | The textual representation of the name at the binding site

src/Juvix/Compiler/Concrete/Keywords.hs

@@ -21,11 +21,15 @@ import Juvix.Data.Keyword.All
     delimSemicolon,
     -- keywords
 
+    kwAbove,
     kwAlias,
     kwAs,
     kwAssign,
+    kwAssoc,
     kwAt,
     kwAxiom,
+    kwBelow,
+    kwBinary,
     kwBracketL,
     kwBracketR,
     kwBuiltin,
@@ -39,34 +43,41 @@ import Juvix.Data.Keyword.All
     kwImport,
     kwIn,
     kwInductive,
+    kwInit,
     kwInstance,
     kwIterator,
     kwLambda,
+    kwLeft,
     kwLet,
     kwMapsTo,
     kwModule,
+    kwNone,
     kwOf,
     kwOpen,
     kwOperator,
     kwPipe,
     kwPositive,
     kwPublic,
+    kwRange,
+    kwRight,
     kwRightArrow,
+    kwSame,
     kwSyntax,
     kwTerminating,
     kwTrait,
     kwType,
+    kwUnary,
     kwUsing,
     kwWhere,
     kwWildcard,
   )
 import Juvix.Prelude
 
 allKeywordStrings :: HashSet Text
-allKeywordStrings = keywordsStrings allKeywords
+allKeywordStrings = keywordsStrings reservedKeywords
 
-allKeywords :: [Keyword]
-allKeywords =
+reservedKeywords :: [Keyword]
+reservedKeywords =
   [ delimSemicolon,
     kwAssign,
     kwAt,
@@ -93,15 +104,3 @@ allKeywords =
     kwWhere,
     kwWildcard
   ]
-
--- | Keywords that do not need to be reserved. Currently only for documentation
--- purposes
-nonKeywords :: [Keyword]
-nonKeywords =
-  [ kwAs,
-    kwEq,
-    kwFixity,
-    kwOperator,
-    kwAlias,
-    kwIterator
-  ]

src/Juvix/Compiler/Concrete/Language.hs

@@ -2,6 +2,8 @@
 
 module Juvix.Compiler.Concrete.Language
   ( module Juvix.Compiler.Concrete.Language,
+    module Juvix.Data.FixityInfo,
+    module Juvix.Data.IteratorInfo,
     module Juvix.Compiler.Concrete.Data.Name,
     module Juvix.Compiler.Concrete.Data.Stage,
     module Juvix.Compiler.Concrete.Data.NameRef,
@@ -31,8 +33,8 @@ import Juvix.Compiler.Concrete.Data.VisibilityAnn
 import Juvix.Data
 import Juvix.Data.Ape.Base as Ape
 import Juvix.Data.Fixity
-import Juvix.Data.FixityInfo (FixityInfo)
-import Juvix.Data.IteratorAttribs
+import Juvix.Data.FixityInfo (Arity (..), FixityInfo)
+import Juvix.Data.IteratorInfo
 import Juvix.Data.Keyword
 import Juvix.Data.NameKind
 import Juvix.Parser.Lexer (isDelimiterStr)
@@ -142,10 +144,6 @@ type family ModuleEndType t = res | res -> t where
 -- choices on the user.
 type ParsedPragmas = WithLoc (WithSource Pragmas)
 
-type ParsedIteratorAttribs = WithLoc (WithSource IteratorAttribs)
-
-type ParsedFixityInfo = WithLoc (WithSource FixityInfo)
-
 data Argument (s :: Stage)
   = ArgumentSymbol (SymbolType s)
   | ArgumentWildcard Wildcard
@@ -269,6 +267,13 @@ deriving stock instance (Ord (AliasDef 'Parsed))
 
 deriving stock instance (Ord (AliasDef 'Scoped))
 
+data ParsedIteratorInfo = ParsedIteratorInfo
+  { _parsedIteratorInfoInitNum :: Maybe (WithLoc Int),
+    _parsedIteratorInfoRangeNum :: Maybe (WithLoc Int),
+    _parsedIteratorInfoBraces :: Irrelevant (KeywordRef, KeywordRef)
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
 data SyntaxDef (s :: Stage)
   = SyntaxFixity (FixitySyntaxDef s)
   | SyntaxOperator OperatorSyntaxDef
@@ -287,11 +292,49 @@ deriving stock instance (Ord (SyntaxDef 'Parsed))
 
 deriving stock instance (Ord (SyntaxDef 'Scoped))
 
+data ParsedFixityFields (s :: Stage) = ParsedFixityFields
+  { _fixityFieldsAssoc :: Maybe BinaryAssoc,
+    _fixityFieldsPrecSame :: Maybe (SymbolType s),
+    _fixityFieldsPrecBelow :: Maybe [SymbolType s],
+    _fixityFieldsPrecAbove :: Maybe [SymbolType s],
+    _fixityFieldsBraces :: Irrelevant (KeywordRef, KeywordRef)
+  }
+
+deriving stock instance (Show (ParsedFixityFields 'Parsed))
+
+deriving stock instance (Show (ParsedFixityFields 'Scoped))
+
+deriving stock instance (Eq (ParsedFixityFields 'Parsed))
+
+deriving stock instance (Eq (ParsedFixityFields 'Scoped))
+
+deriving stock instance (Ord (ParsedFixityFields 'Parsed))
+
+deriving stock instance (Ord (ParsedFixityFields 'Scoped))
+
+data ParsedFixityInfo (s :: Stage) = ParsedFixityInfo
+  { _fixityParsedArity :: WithLoc Arity,
+    _fixityFields :: Maybe (ParsedFixityFields s)
+  }
+
+deriving stock instance (Show (ParsedFixityInfo 'Parsed))
+
+deriving stock instance (Show (ParsedFixityInfo 'Scoped))
+
+deriving stock instance (Eq (ParsedFixityInfo 'Parsed))
+
+deriving stock instance (Eq (ParsedFixityInfo 'Scoped))
+
+deriving stock instance (Ord (ParsedFixityInfo 'Parsed))
+
+deriving stock instance (Ord (ParsedFixityInfo 'Scoped))
+
 data FixitySyntaxDef (s :: Stage) = FixitySyntaxDef
   { _fixitySymbol :: SymbolType s,
     _fixityDoc :: Maybe (Judoc s),
-    _fixityInfo :: ParsedFixityInfo,
+    _fixityInfo :: ParsedFixityInfo s,
     _fixityKw :: KeywordRef,
+    _fixityAssignKw :: KeywordRef,
     _fixitySyntaxKw :: KeywordRef
   }
 
@@ -314,9 +357,6 @@ data FixityDef = FixityDef
   }
   deriving stock (Show, Eq, Ord)
 
-instance HasLoc (FixitySyntaxDef s) where
-  getLoc FixitySyntaxDef {..} = getLoc _fixitySyntaxKw <> getLoc _fixityInfo
-
 data OperatorSyntaxDef = OperatorSyntaxDef
   { _opSymbol :: Symbol,
     _opFixity :: Symbol,
@@ -330,7 +370,7 @@ instance HasLoc OperatorSyntaxDef where
 
 data IteratorSyntaxDef = IteratorSyntaxDef
   { _iterSymbol :: Symbol,
-    _iterAttribs :: Maybe ParsedIteratorAttribs,
+    _iterInfo :: Maybe ParsedIteratorInfo,
     _iterSyntaxKw :: KeywordRef,
     _iterIteratorKw :: KeywordRef
   }
@@ -1705,7 +1745,6 @@ makeLenses ''Application
 makeLenses ''Let
 makeLenses ''FunctionParameters
 makeLenses ''Import
-makeLenses ''FixitySyntaxDef
 makeLenses ''OperatorSyntaxDef
 makeLenses ''IteratorSyntaxDef
 makeLenses ''ConstructorDef
@@ -1737,10 +1776,39 @@ makeLenses ''ArgumentBlock
 makeLenses ''NamedArgument
 makeLenses ''NamedApplication
 makeLenses ''AliasDef
+makeLenses ''FixitySyntaxDef
+makeLenses ''ParsedFixityInfo
+makeLenses ''ParsedFixityFields
+
+fixityFieldHelper :: SimpleGetter (ParsedFixityFields s) (Maybe a) -> SimpleGetter (ParsedFixityInfo s) (Maybe a)
+fixityFieldHelper l = to (^? fixityFields . _Just . l . _Just)
+
+fixityAssoc :: SimpleGetter (ParsedFixityInfo s) (Maybe (BinaryAssoc))
+fixityAssoc = fixityFieldHelper fixityFieldsAssoc
+
+fixityPrecSame :: SimpleGetter (ParsedFixityInfo s) (Maybe (SymbolType s))
+fixityPrecSame = fixityFieldHelper fixityFieldsPrecSame
+
+fixityPrecAbove :: SimpleGetter (ParsedFixityInfo s) (Maybe [SymbolType s])
+fixityPrecAbove = fixityFieldHelper fixityFieldsPrecAbove
+
+fixityPrecBelow :: SimpleGetter (ParsedFixityInfo s) (Maybe [SymbolType s])
+fixityPrecBelow = fixityFieldHelper fixityFieldsPrecBelow
 
 instance (SingI s) => HasLoc (AliasDef s) where
   getLoc AliasDef {..} = getLoc _aliasDefSyntaxKw <> getLocIdentifierType _aliasDefAsName
 
+instance HasLoc (ParsedFixityFields s) where
+  getLoc d = getLoc l <> getLoc r
+    where
+      (l, r) = d ^. fixityFieldsBraces . unIrrelevant
+
+instance HasLoc (ParsedFixityInfo s) where
+  getLoc def = getLoc (def ^. fixityParsedArity) <>? (getLoc <$> def ^. fixityFields)
+
+instance HasLoc (FixitySyntaxDef s) where
+  getLoc def = getLoc (def ^. fixitySyntaxKw) <> getLoc (def ^. fixityInfo)
+
 instance (SingI s) => HasLoc (SyntaxDef s) where
   getLoc = \case
     SyntaxFixity t -> getLoc t
@@ -2427,6 +2495,13 @@ scopedIdenName f n = case n ^. scopedIdenAlias of
     a' <- f a
     pure (set scopedIdenAlias (Just a') n)
 
+fromParsedIteratorInfo :: ParsedIteratorInfo -> IteratorInfo
+fromParsedIteratorInfo ParsedIteratorInfo {..} =
+  IteratorInfo
+    { _iteratorInfoInitNum = (^. withLocParam) <$> _parsedIteratorInfoInitNum,
+      _iteratorInfoRangeNum = (^. withLocParam) <$> _parsedIteratorInfoRangeNum
+    }
+
 instance HasFixity PostfixApplication where
   getFixity (PostfixApplication _ op) = fromMaybe impossible (op ^. scopedIdenName . S.nameFixity)