6a8f0db · 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"

94

95{- | Consumes a multi-line comment

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"

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

699 terminator

700 addAcc n acc

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

702− <|> try (postulate syn)

702+ <|> postulate syn

703+ <|> caf syn

703− <|> try (pattern syn)

704+ <|> pattern syn

704− <|> try (caf syn)

705 <?> "function declaration"

706

707

727fnOpts opts

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

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

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

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

731− fnOpts (CExport c : opts))

731+ fnOpts (CExport c : opts)

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

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

733− fnOpts (AssertTotal : opts))

733+ fnOpts (AssertTotal : opts)

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

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

735− fnOpts (Reflection : opts))

735+ fnOpts (Reflection : opts)

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

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

738 fnOpts (Specialise ns : opts)

775 ;

776-}

777postulate :: SyntaxInfo -> IdrisParser PDecl

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

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

779− pushIndent

779+ pushIndent

780− reserved "postulate"

780+ reserved "postulate"

781+ return doc

781 ist <- get

782 ist <- get

782 let initOpts = if default_total ist

783 let initOpts = if default_total ist

783 then [TotalFn]

784 then [TotalFn]

902 ;

903 ;

903 -}

904 -}

904fixityType :: IdrisParser (Int -> Fixity)

905fixityType :: IdrisParser (Int -> Fixity)

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

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

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

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

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

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

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

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

909 <?> "fixity type"

910 <?> "fixity type"

910

911

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

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

1441 ;

1442 ;

1442-}

1443-}

1443arg :: SyntaxInfo -> IdrisParser PArg

1444arg :: SyntaxInfo -> IdrisParser PArg

1444−arg syn = try (implicitArg syn)

1445+arg syn = implicitArg syn

1445− <|> try (constraintArg syn)

1446+ <|> constraintArg syn

1446 <|> do e <- simpleExpr syn

1447 <|> do e <- simpleExpr syn

1447 return (pexp e)

1448 return (pexp e)

1448 <?> "function argument"

1449 <?> "function argument"

1847 fc <- getFC

1848 fc <- getFC

1848 e <- expr syn;

1849 e <- expr syn;

1849 return (DoBindP fc i e))

1850 return (DoBindP fc i e))

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

1851+ <|> do e <- expr syn

1851− fc <- getFC

1852+ fc <- getFC

1852− return (DoExp fc e))

1853+ return (DoExp fc e)

1853 <?> "do block expression"

1854 <?> "do block expression"

1854

1855

1855{- |Parses an expression in idiom brackets

1856{- |Parses an expression in idiom brackets

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

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

2153

2154

2154{- |Parses a function clause

2155{- |Parses a function clause

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

2156+RHSOrWithBlock ::= RHS WhereOrTerminator

2157+ | 'with' SimpleExpr OpenBlock FnDecl+ CloseBlock

2158+ ;

2159+Clause ::= WExpr+ RHSOrWithBlock

2156 | SimpleExpr '<==' FnName RHS WhereOrTerminator

2160 | SimpleExpr '<==' FnName RHS WhereOrTerminator

2157− | WExpr+ RHS WhereOrTerminator

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

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

2162+ | 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 ;

2163 ;

2163ImplicitOrArgExpr ::= ImplicitArg | ArgExpr;

2164ImplicitOrArgExpr ::= ImplicitArg | ArgExpr;

2164WhereOrTerminator ::= WhereBlock | Terminator;

2165WhereOrTerminator ::= WhereBlock | Terminator;

2165-}

2166-}

2166clause :: SyntaxInfo -> IdrisParser PClause

2167clause :: SyntaxInfo -> IdrisParser PClause

2167clause syn

2168clause 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

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

2190− ty <- simpleExpr syn

2170+ 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

2171+ ist <- get

2213− n <- case lastParse ist of

2172+ n <- case lastParse ist of

2214− Just t -> return t

2173+ Just t -> return t

2215− Nothing -> fail "Invalid clause"

2174+ Nothing -> fail "Invalid clause"

2216− fc <- getFC

2217− r <- rhs syn n

2175+ (do r <- rhs syn n

2218− let ctxt = tt_ctxt ist

2176+ let ctxt = tt_ctxt ist

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

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

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

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

2221− popIndent

2179+ popIndent

2222− return x,

2180+ return x,

2223− do terminator

2181+ do terminator

2224− return ([], [])]

2182+ return ([], [])]

2225− return $ PClauseR fc wargs r wheres)

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

2226−

2184+ 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"

2185+ reserved "with"

2239− wval <- simpleExpr syn

2186+ wval <- simpleExpr syn

2240− openBlock

2187+ openBlock

2241− ds <- some $ fnDecl syn

2188+ ds <- some $ fnDecl syn

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

2189+ let withs = concat ds

2243− closeBlock

2190+ closeBlock

2191+ return $ PWithR fc wargs wval withs)

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

2193+ ty <- simpleExpr syn

2194+ symbol "<=="

2195+ return ty)

2196+ fc <- getFC

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

2198+ r <- rhs syn n

2199+ ist <- get

2200+ let ctxt = tt_ctxt ist

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

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

2203+ popIndent

2204+ return x,

2205+ do terminator

2206+ return ([], [])]

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

2208+ ty

2209+ (PMatchApp fc n)

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

2211+ ist <- get

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

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

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

2215+ pushIndent

2216+ l <- argExpr syn

2217+ op <- operator

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

2219+ return (l, op))

2220+ let n = expandNS syn (UN op)

2221+ r <- argExpr syn

2222+ fc <- getFC

2223+ wargs <- many (wExpr syn)

2224+ (do rs <- rhs syn n

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

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

2227+ popIndent

2228+ return x,

2229+ do terminator

2230+ return ([], [])]

2231+ ist <- get

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

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

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

2244 popIndent

2235 popIndent

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

2246−

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

2248− fc <- getFC

2249 reserved "with"

2236 reserved "with"

2250 wval <- simpleExpr syn

2237 wval <- simpleExpr syn

2251 openBlock

2238 openBlock

2252 ds <- some $ fnDecl syn

2239 ds <- some $ fnDecl syn

2253− let withs = concat ds

2254 closeBlock

2240 closeBlock

2241+ ist <- get

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

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

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

2255− return $ PWithR fc wargs wval withs)

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

2256−

2257− <|> try(do pushIndent

2246+ <|> do pushIndent

2258− l <- argExpr syn

2259− op <- operator

2260− let n = expandNS syn (UN op)

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

2261− r <- argExpr syn

2248+ cargs <- many (constraintArg syn)

2262− fc <- getFC

2249+ fc <- getFC

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

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

2263− wargs <- many (wExpr syn)

2252+ wargs <- many (wExpr syn)

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

2254+ (cargs ++ args)

2264− rs <- rhs syn n

2255+ (do r <- rhs syn n

2256+ ist <- get

2257+ let ctxt = tt_ctxt ist

2265 let wsyn = syn { syn_namespace = [] }

2258 let wsyn = syn { syn_namespace = [] }

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

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

2267 popIndent

2260 popIndent

2269 do terminator

2262 do terminator

2270 return ([], [])]

2263 return ([], [])]

2271 ist <- get

2264 ist <- get

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

2273 put (ist { lastParse = Just n })

2265 put (ist { lastParse = Just n })

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

2266+ 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"

2267+ reserved "with"

2268+ ist <- get

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

2283− wval <- simpleExpr syn

2270+ wval <- simpleExpr syn

2284− openBlock

2271+ openBlock

2285− ds <- some $ fnDecl syn

2272+ 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

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

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

2274+ closeBlock

2275+ popIndent

2291− return $ PWith fc n capp wargs wval withs

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

2292 <?> "function clause"

2277 <?> "function clause"

2293 where

2278 where

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

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

2332 ;

2317 ;

2333-}

2318-}

2334codegen_ :: IdrisParser Codegen

2319codegen_ :: IdrisParser Codegen

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

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

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

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

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

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

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

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

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

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

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

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

2341− <?> "code generation language"

2326+ <?> "code generation language"

2342

2327

2343{- |Parses a compiler directive

2328{- |Parses a compiler directive

2344StringList ::=

2329StringList ::=

2362 ;

2347 ;

2363-}

2348-}

2364directive :: SyntaxInfo -> IdrisParser [PDecl]

2349directive :: SyntaxInfo -> IdrisParser [PDecl]

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

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

2366− return [PDirective (do addLib cgn lib

2351+ return [PDirective (do addLib cgn lib

2367− addIBC (IBCLib cgn lib))])

2352+ addIBC (IBCLib cgn lib))]

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

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

2369− return [PDirective (do dirs <- allImportDirs

2354+ return [PDirective (do dirs <- allImportDirs

2370− o <- liftIO $ findInPath dirs obj

2355+ o <- liftIO $ findInPath dirs obj

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

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

2372− addObjectFile cgn o)])

2357+ addObjectFile cgn o)]

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

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

2374− flag <- stringLiteral

2359+ flag <- stringLiteral

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

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

2376− addFlag cgn flag)])

2361+ addFlag cgn flag)]

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

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

2378− return [PDirective (do addHdr cgn hdr

2363+ return [PDirective (do addHdr cgn hdr

2379− addIBC (IBCHeader cgn hdr))])

2364+ addIBC (IBCHeader cgn hdr))]

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

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

2381− return [PDirective (do setAccessibility n Hidden

2366+ return [PDirective (do setAccessibility n Hidden

2382− addIBC (IBCAccess n Hidden))])

2367+ addIBC (IBCAccess n Hidden))]

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

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

2384− return [PDirective (do setAccessibility n Frozen

2369+ return [PDirective (do setAccessibility n Frozen

2385− addIBC (IBCAccess n Frozen))])

2370+ addIBC (IBCAccess n Frozen))]

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

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

2387− return [PDirective (do i <- get

2372+ return [PDirective (do i <- get

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

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

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

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

2390− i <- get

2375+ i <- get

2391− put (i { default_total = tot } )

2376+ put (i { default_total = tot } )

2392− return [PDirective (do i <- get

2377+ return [PDirective (do i <- get

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

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

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

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

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

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

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

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

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

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

2398− case added of

2383+ case added of

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

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

2400− Right msg ->

2385+ Right msg ->

2401− fail $ msg)])

2386+ fail $ msg)]

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

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

2403− return [PDirective (addLangExt TypeProviders)])

2388+ return [PDirective (addLangExt TypeProviders)]

2404 <?> "directive"

2389 <?> "directive"

2405

2390

2406{- | Parses a totality

2391{- | Parses a totality

2769

2754

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

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

2771 addIBC (IBCAccess n a)

2756 addIBC (IBCAccess n a)

2772−