git.iko.soy/Idris-dev
on master help sign in
Factor `addSyntax` out of `syntaxDecl` parser
37eae55Alyssa Carter
src/Idris/AbsSyntaxTree.hs+8−1
compare with master
unifiedsplit
@@ -29,7 +29,7 @@ import qualified Data.Map as M
29import Data.Either
29import Data.Either
30import qualified Data.Set as S
30import qualified Data.Set as S
31import Data.Word (Word)
31import Data.Word (Word)
32−import Data.Maybe (fromMaybe)
32+import Data.Maybe (fromMaybe, mapMaybe)
33import Data.Traversable (Traversable)
33import Data.Traversable (Traversable)
34import Data.Foldable (Foldable)
34import Data.Foldable (Foldable)
35
35
@@ -974,6 +974,11 @@ deriving instance NFData SynContext
974
974
975data Syntax = Rule [SSymbol] PTerm SynContext
975data Syntax = Rule [SSymbol] PTerm SynContext
976 deriving Show
976 deriving Show
977+
978+syntaxNames :: Syntax -> [Name]
979+syntaxNames (Rule syms _ _) = mapMaybe ename syms
980+ where ename (Keyword n) = Just n
981+ ename _ = Nothing
977{-!
982{-!
978deriving instance Binary Syntax
983deriving instance Binary Syntax
979deriving instance NFData Syntax
984deriving instance NFData Syntax
@@ -985,6 +990,8 @@ data SSymbol = Keyword Name
985 | Expr Name
990 | Expr Name
986 | SimpleExpr Name
991 | SimpleExpr Name
987 deriving Show
992 deriving Show
993+
994+
988{-!
995{-!
989deriving instance Binary SSymbol
996deriving instance Binary SSymbol
990deriving instance NFData SSymbol
997deriving instance NFData SSymbol
src/Idris/Parser.hs+21−12
@@ -216,19 +216,28 @@ decl' syn = fixity
216-}
216-}
217syntaxDecl :: SyntaxInfo -> IdrisParser PDecl
217syntaxDecl :: SyntaxInfo -> IdrisParser PDecl
218syntaxDecl syn = do s <- syntaxRule syn
218syntaxDecl syn = do s <- syntaxRule syn
219− i <- get
219+ i <- get
220− let rs = syntax_rules i
220+ put (i `addSyntax` s)
221− let ns = syntax_keywords i
222− let ibc = ibc_write i
223− let ks = map show (names s)
224− put (i { syntax_rules = s : rs,
225− syntax_keywords = ks ++ ns,
226− ibc_write = IBCSyntax s : map IBCKeyword ks ++ ibc })
227 fc <- getFC
221 fc <- getFC
228− return (PSyntax fc s)
222+ return (PSyntax fc s)
229− where names (Rule syms _ _) = mapMaybe ename syms
223+
230− ename (Keyword n) = Just n
224+-- | Extend an 'IState' with a new syntax extension. See also 'addReplSyntax'.
231− ename _ = Nothing
225+addSyntax :: IState -> Syntax -> IState
226+addSyntax i s = i { syntax_rules = s : rs,
227+ syntax_keywords = ks ++ ns,
228+ ibc_write = IBCSyntax s : map IBCKeyword ks ++ ibc }
229+ where rs = syntax_rules i
230+ ns = syntax_keywords i
231+ ibc = ibc_write i
232+ ks = map show (syntaxNames s)
233+
234+-- | Like 'addSyntax', but no effect on the IBC.
235+addReplSyntax :: IState -> Syntax -> IState
236+addReplSyntax i s = i { syntax_rules = s : rs,
237+ syntax_keywords = ks ++ ns }
238+ where rs = syntax_rules i
239+ ns = syntax_keywords i
240+ ks = map show (syntaxNames s)
232
241
233{- | Parses a syntax extension declaration
242{- | Parses a syntax extension declaration
234
243