diff options
Diffstat (limited to 'source/Syntax')
| -rw-r--r-- | source/Syntax/Abstract.hs | 2 | ||||
| -rw-r--r-- | source/Syntax/Adapt.hs | 4 | ||||
| -rw-r--r-- | source/Syntax/Concrete.hs | 13 | ||||
| -rw-r--r-- | source/Syntax/Internal.hs | 2 | ||||
| -rw-r--r-- | source/Syntax/Token.hs | 17 |
5 files changed, 27 insertions, 11 deletions
diff --git a/source/Syntax/Abstract.hs b/source/Syntax/Abstract.hs index 6372c87..13691e7 100644 --- a/source/Syntax/Abstract.hs +++ b/source/Syntax/Abstract.hs @@ -373,7 +373,7 @@ data Proof - | DefineFunctionMathy VarSymbol VarSymbol VarSymbol VarSymbol VarSymbol (NonEmpty (Expr, Formula)) Proof + | DefineFunctionMathy VarSymbol VarSymbol Expr VarSymbol VarSymbol (NonEmpty (Expr, Formula)) Proof -- ^ Local function definition, but in this case we give the domain and target an the rules for $xs$ in some sub domains. -- deriving (Show, Eq, Ord) diff --git a/source/Syntax/Adapt.hs b/source/Syntax/Adapt.hs index 3cff497..4b43bc6 100644 --- a/source/Syntax/Adapt.hs +++ b/source/Syntax/Adapt.hs @@ -34,8 +34,8 @@ scanChunk ltoks = matchOrErr struct "struct definition" pos Located{startPos = pos, unLocated = (BeginEnv "inductive")} :_ -> matchOrErr inductive "inductive definition" pos - Located{startPos = pos, unLocated = (BeginEnv "signature")} :_ -> - matchOrErr signatureIntro "signature" pos + --Located{startPos = pos, unLocated = (BeginEnv "signature")} :_ -> + -- matchOrErr signatureIntro "signature" pos _ -> [] adaptChunks :: [[Located Token]] -> Lexicon -> Lexicon diff --git a/source/Syntax/Concrete.hs b/source/Syntax/Concrete.hs index 69280c1..fe08fec 100644 --- a/source/Syntax/Concrete.hs +++ b/source/Syntax/Concrete.hs @@ -373,16 +373,16 @@ grammar lexicon@Lexicon{..} = mdo -- 3 & \text{else} -- \end{cases} - functionDefineCase <- rule $ (,) <$> expr <*> (_ampersand *> formula) + functionDefineCase <- rule $ (,) <$> (_ampersand *> (expr <|> exprVar )) <*> (_comma *> formula) defineFunctionMathy <- rule $ DefineFunctionMathy <$> (_define *> beginMath *> varSymbol) -- Define $ f <*> (_colon *> varSymbol) -- : 'var' \to 'var' - <*> (_to *> varSymbol <* endMath <* _suchThat) + <*> (_to *> expr <* endMath <* _suchThat) -- <*> (_suchThat *> align (many1 ((_ampersand *> varSymbol <* _mapsto) <*> exprApp <*> (_ampersand *> formula)))) -- <*> (_suchThat *> align (many1 (varSymbol <* exprApp <* formula))) - <*> varSymbol <*> varSymbol <* symbol "=" - <*> many1 functionDefineCase - <*> proof + <*> (beginMath *> varSymbol) <*> (paren varSymbol <* _eq <* endMath) + <*> cases (many1 functionDefineCase) + <*> proof @@ -644,6 +644,9 @@ group body = token InvisibleBraceL *> body <* token InvisibleBraceR <?> "\"{...} align :: Prod r Text (Located Token) a -> Prod r Text (Located Token) a align body = begin "align*" *> body <* end "align*" +cases :: Prod r Text (Located Token) a -> Prod r Text (Located Token) a +cases body = begin "cases" *> body <* end "cases" + maybeVarToken :: Located Token -> Maybe VarSymbol maybeVarToken ltok = case unLocated ltok of diff --git a/source/Syntax/Internal.hs b/source/Syntax/Internal.hs index 0e3361d..7046161 100644 --- a/source/Syntax/Internal.hs +++ b/source/Syntax/Internal.hs @@ -436,7 +436,7 @@ data Proof | Define VarSymbol Term Proof | DefineFunction VarSymbol VarSymbol Term Term Proof - | DefineFunctionMathy VarSymbol VarSymbol VarSymbol VarSymbol (NonEmpty (Term, Formula)) Proof + | DefineFunctionMathy VarSymbol VarSymbol VarSymbol Term (NonEmpty (Term, Formula)) Proof deriving instance Show Proof deriving instance Eq Proof diff --git a/source/Syntax/Token.hs b/source/Syntax/Token.hs index cb3f4cb..52da86a 100644 --- a/source/Syntax/Token.hs +++ b/source/Syntax/Token.hs @@ -189,6 +189,7 @@ toks = whitespace *> goNormal id <* eof Nothing -> pure (f []) Just t@Located{unLocated = BeginEnv "math"} -> goMath (f . (t:)) Just t@Located{unLocated = BeginEnv "align*"} -> goMath (f . (t:)) + Just t@Located{unLocated = BeginEnv "cases"} -> goMath (f . (t:)) Just t -> goNormal (f . (t:)) goText f = do r <- optional textToken @@ -204,6 +205,7 @@ toks = whitespace *> goNormal id <* eof Nothing -> pure (f []) Just t@Located{unLocated = EndEnv "math"} -> goNormal (f . (t:)) Just t@Located{unLocated = EndEnv "align*"} -> goNormal (f . (t:)) + Just t@Located{unLocated = EndEnv "cases"} -> goNormal (f . (t:)) Just t@Located{unLocated = BeginEnv "text"} -> goText (f . (t:)) Just t@Located{unLocated = BeginEnv "explanation"} -> goText (f . (t:)) Just t -> goMath (f . (t:)) @@ -219,12 +221,12 @@ toks = whitespace *> goNormal id <* eof -- | Parses a single normal mode token. tok :: Lexer (Located Token) tok = - word <|> var <|> symbol <|> mathBegin <|> alignBegin <|> begin <|> end <|> opening <|> closing <|> label <|> ref <|> command + word <|> var <|> symbol <|> mathBegin <|> alignBegin <|> casesBegin <|> begin <|> end <|> opening <|> closing <|> label <|> ref <|> command -- | Parses a single math mode token. mathToken :: Lexer (Located Token) mathToken = - var <|> symbol <|> number <|> begin <|> alignEnd <|> end <|> opening <|> closing <|> beginText <|> beginExplanation <|> mathEnd <|> command + var <|> symbol <|> number <|> begin <|> alignEnd <|> casesEnd <|> end <|> opening <|> closing <|> beginText <|> beginExplanation <|> mathEnd <|> command beginText :: Lexer (Located Token) beginText = lexeme do @@ -277,6 +279,11 @@ alignBegin = guardM isTextMode *> lexeme do setMathMode pure (BeginEnv "align*") +casesBegin :: Lexer (Located Token) +casesBegin = guardM isTextMode *> lexeme do + Char.string "\\begin{cases}" + setMathMode + pure (BeginEnv "cases") -- | Parses a single end math token. mathEnd :: Lexer (Located Token) @@ -291,6 +298,12 @@ alignEnd = guardM isMathMode *> lexeme do setTextMode pure (EndEnv "align*") +casesEnd :: Lexer (Located Token) +casesEnd = guardM isMathMode *> lexeme do + Char.string "\\end{cases}" + setTextMode + pure (EndEnv "cases") + -- | Parses a word. Words are returned casefolded, since we want to ignore their case later on. word :: Lexer (Located Token) |