6a98908 · Idris-dev · git.iko.soy

89 -}

90singleLineComment :: MonadicParsing m => m ()

91singleLineComment = try (string "--" *> satisfy isEol *> pure ())

92− <|> try (string "--" *> satisfy (not . isDocCommentMarker) *> many (satisfy (not . isEol)) *> (satisfy isEol <?> "end of line") *> pure ())

92+ <|> string "--" *> satisfy (not . isDocCommentMarker) *> many (satisfy (not . isEol)) *> (satisfy isEol <?> "end of line") *> pure ()

93− <?> "single-line comment"

93+ <?> ""

94

95{- | Consumes a multi-line comment

96 MultiLineComment_t ::=

107

108multiLineComment :: MonadicParsing m => m ()

109multiLineComment = try (string "{-" *> (string "-}") *> pure ())

110− <|> try (string "{-" *> satisfy (not . isDocCommentMarker) *> inCommentChars)

110+ <|> string "{-" *> satisfy (not . isDocCommentMarker) *> inCommentChars

111− <?> "multi-line comment"

111+ <?> ""

112 where inCommentChars :: MonadicParsing m => m ()

113− inCommentChars = try (string "-}" *> pure ())

113+ inCommentChars = string "-}" *> pure ()

114− <|> try (multiLineComment *> inCommentChars)

114+ <|> try (multiLineComment) *> inCommentChars

115− <|> try (docComment '|' *> inCommentChars)

115+ <|> try (docComment '|') *> inCommentChars

116− <|> try (docComment '^' *> inCommentChars)

116+ <|> try (docComment '^') *> inCommentChars

117− <|> try (skipSome (noneOf startEnd) *> inCommentChars)

117+ <|> skipSome (noneOf startEnd) *> inCommentChars

118 <|> oneOf startEnd *> inCommentChars

119 <?> "end of comment"

120 startEnd :: String

131 where docComment' :: MonadicParsing m => Char -> m String

132 docComment' marker = string "--" *> char marker *> many (satisfy (not . isEol)) <* satisfy isEol

133 <|> string "{-" *> char marker *> (manyTill anyChar (try (string "-}")) <?> "end of comment")

134− <?> "documentation comment"

134+ <?> ""

135

136-- | Consumes whitespace (and comments)

137whiteSpace :: MonadicParsing m => m ()

555 <|> instance_ syn

556 <|> do d <- dsl syn; return [d]

557 <|> directive syn

558− <|> try(provider syn)

558+ <|> provider syn

559 <|> transform syn

560− <|> try(do import_; fail "imports must be at top of file")

560+ <|> do import_; fail "imports must be at top of file"

561 <?> "declaration"

562 declBody' :: IdrisParser [PDecl]

563 declBody' = do d <- decl' syn

575 ;

576-}

577decl' :: SyntaxInfo -> IdrisParser PDecl

578−decl' syn = try fixity

578+decl' syn = fixity

579+ <|> syntaxDecl syn

579− <|> try (fnDecl' syn)

580+ <|> fnDecl' syn

580− <|> try (data_ syn)

581+ <|> data_ syn

581− <|> try (record syn)

582+ <|> record syn

582− <|> try (syntaxDecl syn)

583 <?> "declaration"

584

585{- | Parses a syntax extension declaration (and adds the rule to parser state)

615-}

616syntaxRule :: SyntaxInfo -> IdrisParser Syntax

617syntaxRule syn

618+ = do sty <- try (do

618− = do pushIndent

619+ pushIndent

619− sty <- option AnySyntax (do reserved "term"; return TermSyntax

620+ sty <- option AnySyntax (do reserved "term"; return TermSyntax

620 <|> do reserved "pattern"; return PatternSyntax)

621 <|> do reserved "pattern"; return PatternSyntax)

621− reserved "syntax"

622+ reserved "syntax"

623+ return sty)

622 syms <- some syntaxSym

624 syms <- some syntaxSym

623 when (all isExpr syms) $ unexpected "missing keywords in syntax rule"

625 when (all isExpr syms) $ unexpected "missing keywords in syntax rule"

624 let ns = mapMaybe getName syms

626 let ns = mapMaybe getName syms

699 terminator

701 terminator

700 addAcc n acc

702 addAcc n acc

701 return (PTy doc syn fc opts' n ty))

703 return (PTy doc syn fc opts' n ty))

702− <|> try (postulate syn)

704+ <|> postulate syn

705+ <|> caf syn

703− <|> try (pattern syn)

706+ <|> pattern syn

704− <|> try (caf syn)

705 <?> "function declaration"

707 <?> "function declaration"

706

708

707

709

727fnOpts opts

729fnOpts opts

728 = do reserved "total"; fnOpts (TotalFn : opts)

730 = do reserved "total"; fnOpts (TotalFn : opts)

729 <|> do reserved "partial"; fnOpts (PartialFn : (opts \\ [TotalFn]))

731 <|> do reserved "partial"; fnOpts (PartialFn : (opts \\ [TotalFn]))

730− <|> try (do lchar '%'; reserved "export"; c <- stringLiteral;

732+ <|> do try (lchar '%' *> reserved "export"); c <- stringLiteral;

731− fnOpts (CExport c : opts))

733+ fnOpts (CExport c : opts)

732− <|> try (do lchar '%'; reserved "assert_total";

734+ <|> do try (lchar '%' *> reserved "assert_total");

733− fnOpts (AssertTotal : opts))

735+ fnOpts (AssertTotal : opts)

734− <|> try (do lchar '%'; reserved "reflection";

736+ <|> do try (lchar '%' *> reserved "reflection");

735− fnOpts (Reflection : opts))

737+ fnOpts (Reflection : opts)

736 <|> do lchar '%'; reserved "specialise";

738 <|> do lchar '%'; reserved "specialise";

737 lchar '['; ns <- sepBy nameTimes (lchar ','); lchar ']'

739 lchar '['; ns <- sepBy nameTimes (lchar ','); lchar ']'

738 fnOpts (Specialise ns : opts)

740 fnOpts (Specialise ns : opts)

775 ;

777 ;

776-}

778-}

777postulate :: SyntaxInfo -> IdrisParser PDecl

779postulate :: SyntaxInfo -> IdrisParser PDecl

778−postulate syn = do doc <- option "" (docComment '|')

780+postulate syn = do doc <- try $ do doc <- option "" (docComment '|')

779− pushIndent

781+ pushIndent

780− reserved "postulate"

782+ reserved "postulate"

783+ return doc

781 ist <- get

784 ist <- get

782 let initOpts = if default_total ist

785 let initOpts = if default_total ist

783 then [TotalFn]

786 then [TotalFn]

902 ;

905 ;

903 -}

906 -}

904fixityType :: IdrisParser (Int -> Fixity)

907fixityType :: IdrisParser (Int -> Fixity)

905−fixityType = try (do reserved "infixl"; return Infixl)

908+fixityType = do reserved "infixl"; return Infixl

906− <|> try (do reserved "infixr"; return Infixr)

909+ <|> do reserved "infixr"; return Infixr

907− <|> try (do reserved "infix"; return InfixN)

910+ <|> do reserved "infix"; return InfixN

908− <|> try (do reserved "prefix"; return PrefixN)

911+ <|> do reserved "prefix"; return PrefixN

909 <?> "fixity type"

912 <?> "fixity type"

910

913

911{- |Parses a methods block (for type classes and instances)

914{- |Parses a methods block (for type classes and instances)

931 ;

934 ;

932-}

935-}

933class_ :: SyntaxInfo -> IdrisParser [PDecl]

936class_ :: SyntaxInfo -> IdrisParser [PDecl]

937+class_ syn = do (doc, acc) <- try (do

934−class_ syn = do doc <- option "" (docComment '|')

938+ doc <- option "" (docComment '|')

935− acc <- optional accessibility

939+ acc <- optional accessibility

940+ return (doc, acc))

936 reserved "class"; fc <- getFC; cons <- constraintList syn; n_in <- name

941 reserved "class"; fc <- getFC; cons <- constraintList syn; n_in <- name

937 let n = expandNS syn n_in

942 let n = expandNS syn n_in

938 cs <- many carg

943 cs <- many carg

1441 ;

1446 ;

1442-}

1447-}

1443arg :: SyntaxInfo -> IdrisParser PArg

1448arg :: SyntaxInfo -> IdrisParser PArg

1444−arg syn = try (implicitArg syn)

1449+arg syn = implicitArg syn

1445− <|> try (constraintArg syn)

1450+ <|> constraintArg syn

1446 <|> do e <- simpleExpr syn

1451 <|> do e <- simpleExpr syn

1447 return (pexp e)

1452 return (pexp e)

1448 <?> "function argument"

1453 <?> "function argument"

1847 fc <- getFC

1852 fc <- getFC

1848 e <- expr syn;

1853 e <- expr syn;

1849 return (DoBindP fc i e))

1854 return (DoBindP fc i e))

1850− <|> try (do e <- expr syn

1855+ <|> do e <- expr syn

1851− fc <- getFC

1856+ fc <- getFC

1852− return (DoExp fc e))

1857+ return (DoExp fc e)

1853 <?> "do block expression"

1858 <?> "do block expression"

1854

1859

1855{- |Parses an expression in idiom brackets

1860{- |Parses an expression in idiom brackets

1922 DocComment Accessibility? 'record' FnName TypeSig 'where' OpenBlock Constructor KeepTerminator CloseBlock;

1927 DocComment Accessibility? 'record' FnName TypeSig 'where' OpenBlock Constructor KeepTerminator CloseBlock;

1923-}

1928-}

1924record :: SyntaxInfo -> IdrisParser PDecl

1929record :: SyntaxInfo -> IdrisParser PDecl

1930+record syn = do (doc, acc) <- try (do

1925−record syn = do doc <- option "" (docComment '|')

1931+ doc <- option "" (docComment '|')

1926− acc <- optional accessibility

1932+ acc <- optional accessibility

1927− reserved "record"

1933+ reserved "record"

1934+ return (doc, acc))

1928 fc <- getFC

1935 fc <- getFC

1929 tyn_in <- fnName

1936 tyn_in <- fnName

1930 ty <- typeSig (allowImp syn)

1937 ty <- typeSig (allowImp syn)

2152 addLet nm r = (PLet (UN "value") Placeholder r (PMetavar nm))

2159 addLet nm r = (PLet (UN "value") Placeholder r (PMetavar nm))

2153

2160

2154{- |Parses a function clause

2161{- |Parses a function clause

2155−Clause ::= FnName ConstraintArg* ImplicitOrArgExpr* WExpr* RHS WhereOrTerminator

2162+RHSOrWithBlock ::= RHS WhereOrTerminator

2163+ | 'with' SimpleExpr OpenBlock FnDecl+ CloseBlock

2164+ ;

2165+Clause ::= WExpr+ RHSOrWithBlock

2156 | SimpleExpr '<==' FnName RHS WhereOrTerminator

2166 | SimpleExpr '<==' FnName RHS WhereOrTerminator

2157− | WExpr+ RHS WhereOrTerminator

2167+ | ArgExpr Operator ArgExpr WExpr* RHSOrWithBlock {- Except "=" and "?=" operators to avoid ambiguity -}

2158− | FnName ConstraintArg* ImplicitOrArgExpr* WExpr* 'with' SimpleExpr OpenBlock FnDecl+ CloseBlock

2168+ | FnName ConstraintArg* ImplicitOrArgExpr* WExpr* RHSOrWithBlock

2159− | WExpr+ 'with' SimpleExpr OpenBlock FnDecl+ CloseBlock

2160− | ArgExpr Operator ArgExpr WExpr* RHS WhereOrTerminator

2161− | ArgExpr Operator ArgExpr WExpr* 'with' SimpleExpr OpenBlock FnDecl+ CloseBlock

2162 ;

2169 ;

2163ImplicitOrArgExpr ::= ImplicitArg | ArgExpr;

2170ImplicitOrArgExpr ::= ImplicitArg | ArgExpr;

2164WhereOrTerminator ::= WhereBlock | Terminator;

2171WhereOrTerminator ::= WhereBlock | Terminator;

2165-}

2172-}

2166clause :: SyntaxInfo -> IdrisParser PClause

2173clause :: SyntaxInfo -> IdrisParser PClause

2167clause syn

2174clause syn

2168− = try (do pushIndent

2169− n_in <- fnName; let n = expandNS syn n_in

2170− cargs <- many (constraintArg syn)

2171− fc <- getFC

2172− args <- many (try (implicitArg (syn { inPattern = True } ))

2173− <|> (fmap pexp (argExpr syn)))

2174− wargs <- many (wExpr syn)

2175− r <- rhs syn n

2176− ist <- get

2177− let ctxt = tt_ctxt ist

2178− let wsyn = syn { syn_namespace = [] }

2179− (wheres, nmap) <- choice [do x <- whereBlock n wsyn

2180− popIndent

2181− return x,

2182− do terminator

2183− return ([], [])]

2184− let capp = PApp fc (PRef fc n)

2185− (cargs ++ args)

2186− ist <- get

2187− put (ist { lastParse = Just n })

2188− return $ PClause fc n capp wargs r wheres)

2189− <|> try (do pushIndent

2175+ = do wargs <- try (do pushIndent; some (wExpr syn))

2190− ty <- simpleExpr syn

2176+ fc <- getFC

2191− symbol "<=="

2192− fc <- getFC

2193− n_in <- fnName; let n = expandNS syn n_in

2194− r <- rhs syn n

2195− ist <- get

2196− let ctxt = tt_ctxt ist

2197− let wsyn = syn { syn_namespace = [] }

2198− (wheres, nmap) <- choice [do x <- whereBlock n wsyn

2199− popIndent

2200− return x,

2201− do terminator

2202− return ([], [])]

2203− let capp = PLet (MN 0 "match")

2204− ty

2205− (PMatchApp fc n)

2206− (PRef fc (MN 0 "match"))

2207− ist <- get

2208− put (ist { lastParse = Just n })

2209− return $ PClause fc n capp [] r wheres)

2210− <|> try (do pushIndent

2211− wargs <- some (wExpr syn)

2212− ist <- get

2177+ ist <- get

2213− n <- case lastParse ist of

2178+ n <- case lastParse ist of

2214− Just t -> return t

2179+ Just t -> return t

2215− Nothing -> fail "Invalid clause"

2180+ Nothing -> fail "Invalid clause"

2216− fc <- getFC

2217− r <- rhs syn n

2181+ (do r <- rhs syn n

2218− let ctxt = tt_ctxt ist

2182+ let ctxt = tt_ctxt ist

2219− let wsyn = syn { syn_namespace = [] }

2183+ let wsyn = syn { syn_namespace = [] }

2220− (wheres, nmap) <- choice [do x <- whereBlock n wsyn

2184+ (wheres, nmap) <- choice [do x <- whereBlock n wsyn

2221− popIndent

2185+ popIndent

2222− return x,

2186+ return x,

2223− do terminator

2187+ do terminator

2224− return ([], [])]

2188+ return ([], [])]

2225− return $ PClauseR fc wargs r wheres)

2189+ return $ PClauseR fc wargs r wheres) <|> (do

2226−

2190+ popIndent

2227− <|> try (do pushIndent

2228− n_in <- fnName; let n = expandNS syn n_in

2229− cargs <- many (constraintArg syn)

2230− fc <- getFC

2231− args <- many (try (implicitArg (syn { inPattern = True } ))

2232− <|> (fmap pexp (argExpr syn)))

2233− wargs <- many (wExpr syn)

2234− let capp = PApp fc (PRef fc n)

2235− (cargs ++ args)

2236− ist <- get

2237− put (ist { lastParse = Just n })

2238− reserved "with"

2191+ reserved "with"

2239− wval <- simpleExpr syn

2192+ wval <- simpleExpr syn

2240− openBlock

2193+ openBlock

2241− ds <- some $ fnDecl syn

2194+ ds <- some $ fnDecl syn

2242− let withs = map (fillLHSD n capp wargs) $ concat ds

2195+ let withs = concat ds

2243− closeBlock

2196+ closeBlock

2197+ return $ PWithR fc wargs wval withs)

2198+ <|> do ty <- try (do pushIndent

2199+ ty <- simpleExpr syn

2200+ symbol "<=="

2201+ return ty)

2202+ fc <- getFC

2203+ n_in <- fnName; let n = expandNS syn n_in

2204+ r <- rhs syn n

2205+ ist <- get

2206+ let ctxt = tt_ctxt ist

2207+ let wsyn = syn { syn_namespace = [] }

2208+ (wheres, nmap) <- choice [do x <- whereBlock n wsyn

2209+ popIndent

2210+ return x,

2211+ do terminator

2212+ return ([], [])]

2213+ let capp = PLet (MN 0 "match")

2214+ ty

2215+ (PMatchApp fc n)

2216+ (PRef fc (MN 0 "match"))

2217+ ist <- get

2218+ put (ist { lastParse = Just n })

2219+ return $ PClause fc n capp [] r wheres

2220+ <|> do (l, op) <- try (do

2221+ pushIndent

2222+ l <- argExpr syn

2223+ op <- operator

2224+ when (op == "=" || op == "?=" ) (fail "infix clause definition with \"=\" and \"?=\" not supported ")

2225+ return (l, op))

2226+ let n = expandNS syn (UN op)

2227+ r <- argExpr syn

2228+ fc <- getFC

2229+ wargs <- many (wExpr syn)

2230+ (do rs <- rhs syn n

2231+ let wsyn = syn { syn_namespace = [] }

2232+ (wheres, nmap) <- choice [do x <- whereBlock n wsyn

2233+ popIndent

2234+ return x,

2235+ do terminator

2236+ return ([], [])]

2237+ ist <- get

2238+ let capp = PApp fc (PRef fc n) [pexp l, pexp r]

2239+ put (ist { lastParse = Just n })

2240+ return $ PClause fc n capp wargs rs wheres) <|> (do

2244 popIndent

2241 popIndent

2245− return $ PWith fc n capp wargs wval withs)

2246−

2247− <|> try (do wargs <- some (wExpr syn)

2248− fc <- getFC

2249 reserved "with"

2242 reserved "with"

2250 wval <- simpleExpr syn

2243 wval <- simpleExpr syn

2251 openBlock

2244 openBlock

2252 ds <- some $ fnDecl syn

2245 ds <- some $ fnDecl syn

2253− let withs = concat ds

2254 closeBlock

2246 closeBlock

2247+ ist <- get

2248+ let capp = PApp fc (PRef fc n) [pexp l, pexp r]

2249+ let withs = map (fillLHSD n capp wargs) $ concat ds

2250+ put (ist { lastParse = Just n })

2255− return $ PWithR fc wargs wval withs)

2251+ return $ PWith fc n capp wargs wval withs)

2256−

2257− <|> try(do pushIndent

2252+ <|> do pushIndent

2258− l <- argExpr syn

2259− op <- operator

2260− let n = expandNS syn (UN op)

2253+ n_in <- fnName; let n = expandNS syn n_in

2261− r <- argExpr syn

2254+ cargs <- many (constraintArg syn)

2262− fc <- getFC

2255+ fc <- getFC

2256+ args <- many (try (implicitArg (syn { inPattern = True } ))

2257+ <|> (fmap pexp (argExpr syn)))

2263− wargs <- many (wExpr syn)

2258+ wargs <- many (wExpr syn)

2259+ let capp = PApp fc (PRef fc n)

2260+ (cargs ++ args)

2264− rs <- rhs syn n

2261+ (do r <- rhs syn n

2262+ ist <- get

2263+ let ctxt = tt_ctxt ist

2265 let wsyn = syn { syn_namespace = [] }

2264 let wsyn = syn { syn_namespace = [] }

2266 (wheres, nmap) <- choice [do x <- whereBlock n wsyn

2265 (wheres, nmap) <- choice [do x <- whereBlock n wsyn

2267 popIndent

2266 popIndent

2269 do terminator

2268 do terminator

2270 return ([], [])]

2269 return ([], [])]

2271 ist <- get

2270 ist <- get

2272− let capp = PApp fc (PRef fc n) [pexp l, pexp r]

2273 put (ist { lastParse = Just n })

2271 put (ist { lastParse = Just n })

2274− return $ PClause fc n capp wargs rs wheres)

2272+ return $ PClause fc n capp wargs r wheres) <|> (do

2275−

2276− <|> do l <- argExpr syn

2277− op <- operator

2278− let n = expandNS syn (UN op)

2279− r <- argExpr syn

2280− fc <- getFC

2281− wargs <- many (wExpr syn)

2282− reserved "with"

2273+ reserved "with"

2274+ ist <- get

2275+ put (ist { lastParse = Just n })

2283− wval <- simpleExpr syn

2276+ wval <- simpleExpr syn

2284− openBlock

2277+ openBlock

2285− ds <- some $ fnDecl syn

2278+ ds <- some $ fnDecl syn

2286− closeBlock

2287− ist <- get

2288− let capp = PApp fc (PRef fc n) [pexp l, pexp r]

2289− let withs = map (fillLHSD n capp wargs) $ concat ds

2279+ let withs = map (fillLHSD n capp wargs) $ concat ds

2290− put (ist { lastParse = Just n })

2280+ closeBlock

2281+ popIndent

2291− return $ PWith fc n capp wargs wval withs

2282+ return $ PWith fc n capp wargs wval withs)

2292 <?> "function clause"

2283 <?> "function clause"

2293 where

2284 where

2294 fillLHS :: Name -> PTerm -> [PTerm] -> PClause -> PClause

2285 fillLHS :: Name -> PTerm -> [PTerm] -> PClause -> PClause

2332 ;

2323 ;

2333-}

2324-}

2334codegen_ :: IdrisParser Codegen

2325codegen_ :: IdrisParser Codegen

2335−codegen_ = try (do reserved "C"; return ViaC)

2326+codegen_ = do reserved "C"; return ViaC

2336− <|> try (do reserved "Java"; return ViaJava)

2327+ <|> do reserved "Java"; return ViaJava

2337− <|> try (do reserved "JavaScript"; return ViaJavaScript)

2328+ <|> do reserved "JavaScript"; return ViaJavaScript

2338− <|> try (do reserved "Node"; return ViaNode)

2329+ <|> do reserved "Node"; return ViaNode

2339− <|> try (do reserved "LLVM"; return ViaLLVM)

2330+ <|> do reserved "LLVM"; return ViaLLVM

2340− <|> try (do reserved "Bytecode"; return Bytecode)

2331+ <|> do reserved "Bytecode"; return Bytecode

2341− <?> "code generation language"

2332+ <?> "code generation language"

2342

2333

2343{- |Parses a compiler directive

2334{- |Parses a compiler directive

2344StringList ::=

2335StringList ::=

2362 ;

2353 ;

2363-}

2354-}

2364directive :: SyntaxInfo -> IdrisParser [PDecl]

2355directive :: SyntaxInfo -> IdrisParser [PDecl]

2365−directive syn = try (do lchar '%'; reserved "lib"; cgn <- codegen_; lib <- stringLiteral;

2356+directive syn = do try (lchar '%' *> reserved "lib"); cgn <- codegen_; lib <- stringLiteral;

2366− return [PDirective (do addLib cgn lib

2357+ return [PDirective (do addLib cgn lib

2367− addIBC (IBCLib cgn lib))])

2358+ addIBC (IBCLib cgn lib))]

2368− <|> try (do lchar '%'; reserved "link"; cgn <- codegen_; obj <- stringLiteral;

2359+ <|> do try (lchar '%' *> reserved "link"); cgn <- codegen_; obj <- stringLiteral;

2369− return [PDirective (do dirs <- allImportDirs

2360+ return [PDirective (do dirs <- allImportDirs

2370− o <- liftIO $ findInPath dirs obj

2361+ o <- liftIO $ findInPath dirs obj

2371− addIBC (IBCObj cgn obj) -- just name, search on loading ibc

2362+ addIBC (IBCObj cgn obj) -- just name, search on loading ibc

2372− addObjectFile cgn o)])

2363+ addObjectFile cgn o)]

2373− <|> try (do lchar '%'; reserved "flag"; cgn <- codegen_;

2364+ <|> do try (lchar '%' *> reserved "flag"); cgn <- codegen_;

2374− flag <- stringLiteral

2365+ flag <- stringLiteral

2375− return [PDirective (do addIBC (IBCCGFlag cgn flag)

2366+ return [PDirective (do addIBC (IBCCGFlag cgn flag)

2376− addFlag cgn flag)])

2367+ addFlag cgn flag)]

2377− <|> try (do lchar '%'; reserved "include"; cgn <- codegen_; hdr <- stringLiteral;

2368+ <|> do try (lchar '%' *> reserved "include"); cgn <- codegen_; hdr <- stringLiteral;

2378− return [PDirective (do addHdr cgn hdr

2369+ return [PDirective (do addHdr cgn hdr

2379− addIBC (IBCHeader cgn hdr))])

2370+ addIBC (IBCHeader cgn hdr))]

2380− <|> try (do lchar '%'; reserved "hide"; n <- iName []

2371+ <|> do try (lchar '%' *> reserved "hide"); n <- iName []

2381− return [PDirective (do setAccessibility n Hidden

2372+ return [PDirective (do setAccessibility n Hidden

2382− addIBC (IBCAccess n Hidden))])

2373+ addIBC (IBCAccess n Hidden))]

2383− <|> try (do lchar '%'; reserved "freeze"; n <- iName []

2374+ <|> do try (lchar '%' *> reserved "freeze"); n <- iName []

2384− return [PDirective (do setAccessibility n Frozen

2375+ return [PDirective (do setAccessibility n Frozen

2385− addIBC (IBCAccess n Frozen))])

2376+ addIBC (IBCAccess n Frozen))]

2386− <|> try (do lchar '%'; reserved "access"; acc <- accessibility

2377+ <|> do try (lchar '%' *> reserved "access"); acc <- accessibility

2387− return [PDirective (do i <- get

2378+ return [PDirective (do i <- get

2388− put(i { default_access = acc }))])

2379+ put(i { default_access = acc }))]

2389− <|> try (do lchar '%'; reserved "default"; tot <- totality

2380+ <|> do try (lchar '%' *> reserved "default"); tot <- totality

2390− i <- get

2381+ i <- get

2391− put (i { default_total = tot } )

2382+ put (i { default_total = tot } )

2392− return [PDirective (do i <- get

2383+ return [PDirective (do i <- get

2393− put(i { default_total = tot }))])

2384+ put(i { default_total = tot }))]

2394− <|> try (do lchar '%'; reserved "logging"; i <- natural;

2385+ <|> do try (lchar '%' *> reserved "logging"); i <- natural;

2395− return [PDirective (setLogLevel (fromInteger i))])

2386+ return [PDirective (setLogLevel (fromInteger i))]

2396− <|> try (do lchar '%'; reserved "dynamic"; libs <- sepBy1 stringLiteral (lchar ',');

2387+ <|> do try (lchar '%' *> reserved "dynamic"); libs <- sepBy1 stringLiteral (lchar ',');

2397− return [PDirective (do added <- addDyLib libs

2388+ return [PDirective (do added <- addDyLib libs

2398− case added of

2389+ case added of

2399− Left lib -> addIBC (IBCDyLib (lib_name lib))

2390+ Left lib -> addIBC (IBCDyLib (lib_name lib))

2400− Right msg ->

2391+ Right msg ->

2401− fail $ msg)])

2392+ fail $ msg)]

2402− <|> try (do lchar '%'; reserved "language"; ext <- reserved "TypeProviders";

2393+ <|> do try (lchar '%' *> reserved "language"); ext <- reserved "TypeProviders";

2403− return [PDirective (addLangExt TypeProviders)])

2394+ return [PDirective (addLangExt TypeProviders)]

2404 <?> "directive"

2395 <?> "directive"

2405

2396

2406{- | Parses a totality

2397{- | Parses a totality

2415Provider ::= '%' 'provide' '(' FnName TypeSig ')' 'with' Expr;

2406Provider ::= '%' 'provide' '(' FnName TypeSig ')' 'with' Expr;

2416 -}

2407 -}

2417provider :: SyntaxInfo -> IdrisParser [PDecl]

2408provider :: SyntaxInfo -> IdrisParser [PDecl]

2418−provider syn = do lchar '%'; reserved "provide";

2409+provider syn = do try (lchar '%' *> reserved "provide");

2419 lchar '('; n <- fnName; t <- typeSig syn; lchar ')'

2410 lchar '('; n <- fnName; t <- typeSig syn; lchar ')'

2420 fc <- getFC

2411 fc <- getFC

2421 reserved "with"

2412 reserved "with"

2427Transform ::= '%' 'transform' Expr '==>' Expr

2418Transform ::= '%' 'transform' Expr '==>' Expr

2428-}

2419-}

2429transform :: SyntaxInfo -> IdrisParser [PDecl]

2420transform :: SyntaxInfo -> IdrisParser [PDecl]

2430−transform syn = do lchar '%'; reserved "transform";

2421+transform syn = do try (lchar '%' *> reserved "transform")

2431 -- leave it unchecked, until we work out what this should

2422 -- leave it unchecked, until we work out what this should

2432 -- actually mean...

2423 -- actually mean...

2433-- safety <- option True (do reserved "unsafe"

2424-- safety <- option True (do reserved "unsafe"

2769

2760

2770 doHide (n, a) = do setAccessibility n a

2761 doHide (n, a) = do setAccessibility n a

2771 addIBC (IBCAccess n a)

2762 addIBC (IBCAccess n a)

2772−