From 39ef87d3ce39152febc130aa95e25dc0722c3525 Mon Sep 17 00:00:00 2001 From: adelon <22380201+adelon@users.noreply.github.com> Date: Tue, 12 Aug 2025 00:37:28 +0200 Subject: Allow relation symbols with parameters Parameters must follow the relation symbol and be surrounded by braces, like so: `\rel{x}{y}{z}`. This attempt is still brittle/broken in a few ways: - It makes using braces in creative ways in mixfix notation ambiguous. - It does not verify that the parameters are used in a consistent manner for each symbol. It essentially allows users to define `a\MyRel b` and `a\MyRel{x} b` (and ones with even more parameters). - It allows parameters for all relation symbols, even for those where it makes no sense in ordinary TeX markup, e.g. `a <{x} b`. --- source/Syntax/Abstract.hs | 8 ++++---- source/Syntax/Adapt.hs | 15 ++++++++++----- source/Syntax/Concrete.hs | 8 ++++---- source/Syntax/Lexicon.hs | 2 +- 4 files changed, 19 insertions(+), 14 deletions(-) (limited to 'source/Syntax') diff --git a/source/Syntax/Abstract.hs b/source/Syntax/Abstract.hs index 23da652..31a1029 100644 --- a/source/Syntax/Abstract.hs +++ b/source/Syntax/Abstract.hs @@ -92,8 +92,8 @@ makeTuple = foldr1 ExprPair data Chain - = ChainBase (NonEmpty Expr) Sign Relation (NonEmpty Expr) - | ChainCons (NonEmpty Expr) Sign Relation Chain + = ChainBase (NonEmpty Expr) Sign Relation [Expr] (NonEmpty Expr) -- left arguments, possibly empty list of parameters, right arguments + | ChainCons (NonEmpty Expr) Sign Relation [Expr] Chain deriving (Show, Eq, Ord) data Relation @@ -319,7 +319,7 @@ data DefnHead | DefnVerb (Maybe (NounPhrase Maybe)) VarSymbol (VerbOf VarSymbol) | DefnNoun VarSymbol (NounOf VarSymbol) | DefnSymbolicPredicate PrefixPredicate (NonEmpty VarSymbol) - | DefnRel VarSymbol RelationSymbol VarSymbol + | DefnRel VarSymbol RelationSymbol [VarSymbol] VarSymbol -- ^ E.g.: /@$x \subseteq y$ iff [...@/ deriving (Show, Eq, Ord) @@ -411,7 +411,7 @@ data Abbreviation = AbbreviationAdj VarSymbol (AdjOf VarSymbol) Stmt | AbbreviationVerb VarSymbol (VerbOf VarSymbol) Stmt | AbbreviationNoun VarSymbol (NounOf VarSymbol) Stmt - | AbbreviationRel VarSymbol RelationSymbol VarSymbol Stmt + | AbbreviationRel VarSymbol RelationSymbol [VarSymbol] VarSymbol Stmt | AbbreviationFun (FunOf VarSymbol) Term | AbbreviationEq SymbolPattern Expr deriving (Show, Eq, Ord) diff --git a/source/Syntax/Adapt.hs b/source/Syntax/Adapt.hs index b338d47..1b5a237 100644 --- a/source/Syntax/Adapt.hs +++ b/source/Syntax/Adapt.hs @@ -124,7 +124,7 @@ head = ScanNoun <$> noun <|> ScanAdj <$> adj <|> ScanVerb <$> verb <|> ScanFun <$> fun - <|> ScanRelationSymbol <$> relationSymbol + <|> ScanRelationSymbol . fst <$> relationSymbol <|> ScanFunctionSymbol <$> functionSymbol <|> ScanPrefixPredicate <$> prefixPredicate @@ -184,14 +184,19 @@ verb = toLexicalPhrase <$> (var *> pat <* iff) fun :: RE Token LexicalPhrase fun = toLexicalPhrase <$> (the *> pat <* (is <|> comma)) -relationSymbol :: RE Token RelationSymbol -relationSymbol = math relator' <* iff +relationSymbol :: RE Token (RelationSymbol, Int) +relationSymbol = definiendum <* iff where - relator' = do + definiendum = math do varSymbol rel <- symbol + k <- params varSymbol - pure rel + pure (rel, k) + params :: RE Token Int + params = do + vars <- many (sym InvisibleBraceL *> var <* sym InvisibleBraceR) + pure (length vars) functionSymbol :: RE Token FunctionSymbol functionSymbol = do diff --git a/source/Syntax/Concrete.hs b/source/Syntax/Concrete.hs index 383f348..3c6700b 100644 --- a/source/Syntax/Concrete.hs +++ b/source/Syntax/Concrete.hs @@ -84,8 +84,8 @@ grammar lexicon@Lexicon{..} = mdo relationSign <- rule $ pure Positive <|> (Negative <$ command "not") relationExpr <- rule $ RelationExpr <$> (command "mathrel" *> group expr) relation <- rule $ (RelationSymbol <$> relator) <|> relationExpr - chainBase <- rule $ ChainBase <$> exprs <*> relationSign <*> relation <*> exprs - chainCons <- rule $ ChainCons <$> exprs <*> relationSign <*> relation <*> chain + chainBase <- rule $ ChainBase <$> exprs <*> relationSign <*> relation <*> many (brace expr) <*> exprs + chainCons <- rule $ ChainCons <$> exprs <*> relationSign <*> relation <*> many (brace expr) <*> chain chain <- rule $ chainCons <|> chainBase formulaPredicate <- rule $ asum $ prefixPredicateOf FormulaPredicate expr <$> HM.keys lexiconPrefixPredicates @@ -250,7 +250,7 @@ grammar lexicon@Lexicon{..} = mdo defnAdj <- rule $ DefnAdj <$> optional (_an *> nounPhrase) <*> var <* _is <*> adjVar defnVerb <- rule $ DefnVerb <$> optional (_an *> nounPhrase) <*> var <*> verbVar defnNoun <- rule $ DefnNoun <$> var <* _is <* _an <*> nounVar - defnRel <- rule $ DefnRel <$> (beginMath *> varSymbol) <*> relator <*> varSymbol <* endMath + defnRel <- rule $ DefnRel <$> (beginMath *> varSymbol) <*> relator <*> many (group varSymbol) <*> varSymbol <* endMath defnSymbolicPredicate <- rule $ math $ asum $ prefixPredicateOf DefnSymbolicPredicate varSymbol <$> HM.keys lexiconPrefixPredicates defnHead <- rule $ optional _write *> asum [defnAdj, defnVerb, defnNoun, defnRel, defnSymbolicPredicate] @@ -269,7 +269,7 @@ grammar lexicon@Lexicon{..} = mdo abbreviationVerb <- rule $ AbbreviationVerb <$> var <*> verbVar <* (_iff <|> _if) <*> stmt <* _dot abbreviationAdj <- rule $ AbbreviationAdj <$> var <* _is <*> adjVar <* (_iff <|> _if) <*> stmt <* _dot abbreviationNoun <- rule $ AbbreviationNoun <$> var <* _is <* _an <*> nounVar <* (_iff <|> _if) <*> stmt <* _dot - abbreviationRel <- rule $ AbbreviationRel <$> (beginMath *> varSymbol) <*> relator <*> varSymbol <* endMath <* (_iff <|> _if) <*> stmt <* _dot + abbreviationRel <- rule $ AbbreviationRel <$> (beginMath *> varSymbol) <*> relator <*> many (brace varSymbol) <*> varSymbol <* endMath <* (_iff <|> _if) <*> stmt <* _dot abbreviationFun <- rule $ AbbreviationFun <$> (_the *> funVar) <* (_is <|> _denotes) <*> term <* _dot abbreviationEq <- rule $ uncurry AbbreviationEq <$> symbolicPatternEqTerm abbreviation <- rule $ (abbreviationVerb <|> abbreviationAdj <|> abbreviationNoun <|> abbreviationRel <|> abbreviationFun <|> abbreviationEq) diff --git a/source/Syntax/Lexicon.hs b/source/Syntax/Lexicon.hs index 4fe8730..7f79294 100644 --- a/source/Syntax/Lexicon.hs +++ b/source/Syntax/Lexicon.hs @@ -112,7 +112,7 @@ prefixOps = , ([Just (Command "pow"), Just InvisibleBraceL, Nothing, Just InvisibleBraceR], (NonAssoc, "pow")) , ([Just (Command "neg"), Just InvisibleBraceL, Nothing, Just InvisibleBraceR], (NonAssoc, "neg")) , ([Just (Command "inv"), Just InvisibleBraceL, Nothing, Just InvisibleBraceR], (NonAssoc, "inv")) - , ([Just (Command "abs"), Just InvisibleBraceL, Nothing, Just InvisibleBraceR], (NonAssoc, "abs")) + , ([Just (Command "abs"), Just InvisibleBraceL, Nothing, Just InvisibleBraceR], (NonAssoc, "abs")) , (ConsSymbol, (NonAssoc, "cons")) , (PairSymbol, (NonAssoc, "pair")) -- NOTE Is now defined and hence no longer necessary , (ApplySymbol, (NonAssoc, "apply")) -- cgit v1.2.3