Add fixity none and make aliases inherit fixity (#2391)

* Closes #2310 
* Makes aliases inherit fixity
* Adds `none` fixity definition to the standard library

juvix-stdlib

@@ -1 +1 @@
-Subproject commit 2680b19844616821d4ce77a40e9f02fb2e6c1995
+Subproject commit 23f6b1991e8f31e1360a7e23a21c6a9732a292b1

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

@@ -77,6 +77,7 @@ fromReg lims tab =
           Fixity.OpBinary AssocNone -> "assoc_none"
           Fixity.OpBinary AssocLeft -> "assoc_left"
           Fixity.OpBinary AssocRight -> "assoc_right"
+          Fixity.OpNone -> "assoc_none"
 
     functionInfo :: CCode
     functionInfo =

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

@@ -117,7 +117,9 @@ instance HasNameKind AName where
   getNameKind = (^. anameKind)
 
 hasFixity :: Name' s -> Bool
-hasFixity n = isJust (n ^. nameFixity)
+hasFixity n = case n ^. nameFixity of
+  Just Fixity {..} -> _fixityArity /= OpNone
+  Nothing -> False
 
 isConstructor :: Name' s -> Bool
 isConstructor n = case n ^. nameKind of

src/Juvix/Compiler/Concrete/Print/Base.hs

@@ -663,6 +663,7 @@ instance PrettyPrint Arity where
   ppCode = \case
     Unary -> noLoc Str.unary
     Binary -> noLoc Str.binary
+    None -> noLoc Str.none
 
 instance PrettyPrint BinaryAssoc where
   ppCode a = noLoc $ case a of

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs

@@ -556,9 +556,12 @@ entryToScopedIden name e = do
           }
     PreSymbolAlias {} -> do
       e' <- normalizePreSymbolEntry e
+      let scopedName' =
+            over S.nameFixity (maybe (e' ^. symbolEntry . S.nameFixity) Just) $
+              set S.nameKind (getNameKind e') scopedName
       return
         ScopedIden
-          { _scopedIdenAlias = Just (set S.nameKind (getNameKind e') scopedName),
+          { _scopedIdenAlias = Just scopedName',
             _scopedIdenFinal = helper (e' ^. symbolEntry)
           }
   registerScopedIden si
@@ -706,6 +709,7 @@ resolveFixitySyntaxDef fdef@FixitySyntaxDef {..} = topBindings $ do
                   Just FI.AssocLeft -> OpBinary AssocLeft
                   Just FI.AssocRight -> OpBinary AssocRight
                   Just FI.AssocNone -> OpBinary AssocNone
+                FI.None -> OpNone
           }
   registerFixity
     @$> FixityDef
@@ -2433,14 +2437,14 @@ makeExpressionTable (ExpressionAtoms atoms _) = [recordUpdate] : [appOpExplicit]
       where
         mkOperator :: ScopedIden -> Maybe (Precedence, P.Operator Parse Expression)
         mkOperator iden
-          | Just Fixity {..} <- _nameFixity = Just $
+          | Just Fixity {..} <- _nameFixity =
               case _fixityArity of
-                OpUnary u -> (_fixityPrecedence, P.Postfix (unaryApp <$> parseSymbolId _nameId))
+                OpUnary u -> Just (_fixityPrecedence, P.Postfix (unaryApp <$> parseSymbolId _nameId))
                   where
                     unaryApp :: ScopedIden -> Expression -> Expression
                     unaryApp funName arg = case u of
                       AssocPostfix -> ExpressionPostfixApplication (PostfixApplication arg funName)
-                OpBinary b -> (_fixityPrecedence, infixLRN (binaryApp <$> parseSymbolId _nameId))
+                OpBinary b -> Just (_fixityPrecedence, infixLRN (binaryApp <$> parseSymbolId _nameId))
                   where
                     binaryApp :: ScopedIden -> Expression -> Expression -> Expression
                     binaryApp _infixAppOperator _infixAppLeft _infixAppRight =
@@ -2450,6 +2454,7 @@ makeExpressionTable (ExpressionAtoms atoms _) = [recordUpdate] : [appOpExplicit]
                       AssocLeft -> P.InfixL
                       AssocRight -> P.InfixR
                       AssocNone -> P.InfixN
+                OpNone -> Nothing
           | otherwise = Nothing
           where
             S.Name' {..} = iden ^. scopedIdenName
@@ -2725,13 +2730,13 @@ makePatternTable (PatternAtoms latoms _) = [appOp] : operators
         unqualifiedSymbolOp constr = run . runFail $ do
           Fixity {..} <- failMaybe (constr ^. scopedIdenName . S.nameFixity)
           let _nameId = constr ^. scopedIdenName . S.nameId
-          return $ case _fixityArity of
-            OpUnary u -> (_fixityPrecedence, P.Postfix (unaryApp <$> parseSymbolId _nameId))
+          case _fixityArity of
+            OpUnary u -> return (_fixityPrecedence, P.Postfix (unaryApp <$> parseSymbolId _nameId))
               where
                 unaryApp :: ScopedIden -> PatternArg -> PatternArg
                 unaryApp constrName = case u of
                   AssocPostfix -> explicitP . PatternPostfixApplication . (`PatternPostfixApp` constrName)
-            OpBinary b -> (_fixityPrecedence, infixLRN (binaryInfixApp <$> parseSymbolId _nameId))
+            OpBinary b -> return (_fixityPrecedence, infixLRN (binaryInfixApp <$> parseSymbolId _nameId))
               where
                 binaryInfixApp :: ScopedIden -> PatternArg -> PatternArg -> PatternArg
                 binaryInfixApp name argLeft = explicitP . PatternInfixApplication . PatternInfixApp argLeft name
@@ -2740,6 +2745,7 @@ makePatternTable (PatternAtoms latoms _) = [appOp] : operators
                   AssocLeft -> P.InfixL
                   AssocRight -> P.InfixR
                   AssocNone -> P.InfixN
+            OpNone -> fail
         parseSymbolId :: S.NameId -> ParsePat ScopedIden
         parseSymbolId uid = P.token getConstructorRefWithId mempty
           where

src/Juvix/Compiler/Concrete/Translation/FromSource.hs

@@ -568,6 +568,8 @@ parsedFixityInfo = do
         $> Unary
         <|> kw kwBinary
           $> Binary
+        <|> kw kwNone
+          $> None
 
 fixitySyntaxDef :: forall r. (Members '[InfoTableBuilder, PragmasStash, JudocStash, NameIdGen] r) => KeywordRef -> ParsecS r (FixitySyntaxDef 'Parsed)
 fixitySyntaxDef _fixitySyntaxKw = P.label "<fixity declaration>" $ do

src/Juvix/Data/Fixity.hs

@@ -24,6 +24,7 @@ data BinaryAssoc
 data OperatorArity
   = OpUnary UnaryAssoc
   | OpBinary BinaryAssoc
+  | OpNone
   deriving stock (Show, Eq, Ord, Data)
 
 data Fixity = Fixity
@@ -65,6 +66,7 @@ isBinary :: Fixity -> Bool
 isBinary f = case f ^. fixityArity of
   OpBinary {} -> True
   OpUnary {} -> False
+  OpNone -> False
 
 isUnary :: Fixity -> Bool
 isUnary = not . isBinary

src/Juvix/Data/FixityInfo.hs

@@ -11,6 +11,7 @@ import Juvix.Prelude.Base
 data Arity
   = Unary
   | Binary
+  | None
   deriving stock (Show, Eq, Ord, Generic)
 
 -- TODO consider using sum type for Same | Below && Above

tests/positive/Alias.juvix

@@ -37,10 +37,15 @@ syntax operator || logical;
   | zero b := b
   | one _ := one;
 
+syntax operator or none;
 syntax alias or := ||;
 
+syntax alias ||| := ||;
+
 or3 (a b c : Binary) : Binary := or (or a b) c;
 
+or3' (a b c : Binary) : Binary := (a ||| b) ||| c;
+
 type Pair :=
   | mkPair Binary Binary;