From 0134e614c1747d2d9aff56f260249d809b541287 Mon Sep 17 00:00:00 2001 From: Péter Diviánszky Date: Tue, 2 Feb 2016 06:19:58 +0100 Subject: try to speed up parseTerm --- lc/Internals.lc | 2 + src/LambdaCube/Compiler/Lexer.hs | 12 +- src/LambdaCube/Compiler/Parser.hs | 29 ++- testdata/Builtins.out | 92 ++++++++ testdata/Internals.out | 254 +++++++++++---------- testdata/Prelude.out | 2 + .../basic-values/def05.reject.out | 2 +- .../basic-values/def06.reject.out | 2 +- .../basic-values/redefine03.reject.out | 2 +- .../language-features/guard/guard10.reject.out | 2 +- testdata/listcompr01.reject.out | 2 +- 11 files changed, 248 insertions(+), 153 deletions(-) diff --git a/lc/Internals.lc b/lc/Internals.lc index df5814e6..0ea96032 100644 --- a/lc/Internals.lc +++ b/lc/Internals.lc @@ -41,6 +41,8 @@ type family T2 a b -- equality constraints type family EqCT (t :: Type) (a :: t) (b :: t) +type EqCTt = EqCT Type + --type instance EqCT t (a, b) (JoinTupleType a' b') = T2 (EqCT Type a a') (EqCT Type b b') -- builtin conjuction of constraint witnesses diff --git a/src/LambdaCube/Compiler/Lexer.hs b/src/LambdaCube/Compiler/Lexer.hs index 9bf3dc8c..171dd5cf 100644 --- a/src/LambdaCube/Compiler/Lexer.hs +++ b/src/LambdaCube/Compiler/Lexer.hs @@ -42,12 +42,10 @@ import LambdaCube.Compiler.Pretty hiding (Doc, braces, parens) -- see http://blog.ezyang.com/2014/05/parsec-try-a-or-b-considered-harmful/comment-page-1/#comment-6602 try_ s m = Pa.try m s --- n, m >= 1, n < m -manyNM n m p = do - xs <- many1 p - let lxs = length xs - unless (n <= lxs && lxs <= m) . fail $ unwords ["manyNM", show n, show m, "found", show lxs, "occurences."] - return xs +manyNM a b _ | b < a || b < 0 || a < 0 = mzero +manyNM 0 0 _ = pure [] +manyNM 0 n p = option [] $ (:) <$> p <*> manyNM 0 (n-1) p +manyNM k n p = (:) <$> p <*> manyNM (k-1) (n-1) p -------------------------------------------------------------------------------- parser type @@ -262,7 +260,7 @@ calcPrec -> e -> [(f, e)] -> e -calcPrec app getFixity e = compileOps [((Infix, -1), undefined, e)] +calcPrec app getFixity e = compileOps [((Infix, -1000), error "calcPrec", e)] where compileOps [(_, _, e)] [] = e compileOps acc [] = compileOps (shrink acc) [] diff --git a/src/LambdaCube/Compiler/Parser.hs b/src/LambdaCube/Compiler/Parser.hs index 74f7d3d0..2becb86c 100644 --- a/src/LambdaCube/Compiler/Parser.hs +++ b/src/LambdaCube/Compiler/Parser.hs @@ -351,7 +351,8 @@ parseETerm = expNS . parseTerm parseTerm :: Prec -> P SExp parseTerm prec = withRange setSI $ case prec of PrecLam -> - mkIf <$ reserved "if" <*> parseTerm PrecLam <* reserved "then" <*> parseTerm PrecLam <* reserved "else" <*> parseTerm PrecLam + do level PrecAnn $ \t -> mkPi <$> (Visible <$ reservedOp "->" <|> Hidden <$ reservedOp "=>") <*> pure t <*> parseTTerm PrecLam + <|> mkIf <$ reserved "if" <*> parseTerm PrecLam <* reserved "then" <*> parseTerm PrecLam <* reserved "else" <*> parseTerm PrecLam <|> do reserved "forall" (fe, ts) <- telescope (Just $ Wildcard SType) f <- SPi . const Hidden <$ reservedOp "." <|> SPi . const Visible <$ reservedOp "->" @@ -363,21 +364,17 @@ parseTerm prec = withRange setSI $ case prec of t' <- dbf' fe <$> parseTerm PrecLam ge <- dsInfo return $ foldr (uncurry (patLam_ id ge)) t' ts - <|> compileCase <$> dsInfo - <* reserved "case" <*> parseETerm PrecLam - <* reserved "of" <*> do - localIndentation Ge $ localAbsoluteIndentation $ some $ do - (fe, p) <- longPattern - (,) p <$> parseRHS (dbf' fe) "->" - <|> compileGuardTree id id <$> dsInfo <*> (Alts <$> parseSomeGuards (const True)) - <|> do level PrecEq $ \t -> mkPi <$> (Visible <$ reservedOp "->" <|> Hidden <$ reservedOp "=>") <*> pure t <*> parseTTerm PrecLam - PrecEq -> level PrecAnn $ \t -> SAppV (SBuiltin "'EqCT" `SAppV` SType `SAppV` t) <$ reservedOp "~" <*> parseTTerm PrecAnn + <|> compileCase <$ reserved "case" <*> dsInfo <*> parseETerm PrecLam <* reserved "of" <*> do + localIndentation Ge $ localAbsoluteIndentation $ some $ do + (fe, p) <- longPattern + (,) p <$> parseRHS (dbf' fe) "->" +-- <|> compileGuardTree id id <$> dsInfo <*> (Alts <$> parseSomeGuards (const True)) PrecAnn -> level PrecOp $ \t -> SAnn t <$> parseType Nothing - PrecOp -> join $ calculatePrecs <$> namespace <*> dsInfo <*> (notExp <|> notOp False) where + PrecOp -> (notOp False <|> notExp) >>= \xs -> join $ calculatePrecs <$> namespace <*> dsInfo <*> pure xs where notExp = (++) <$> ope <*> notOp True notOp x = (++) <$> try "expression" ((++) <$> ex PrecApp <*> option [] ope) <*> notOp True <|> if x then option [] (try "lambda" $ ex PrecLam) else mzero - ope = pure . Left <$> parseSIName operatorT + ope = pure . Left <$> parseSIName (operatorT <|> "'EqCTt" <$ reservedOp "~") ex pr = pure . Right <$> parseTerm pr PrecApp -> apps' <$> try "record" (sVar upperCase <* reservedOp "{") <*> (commaSep $ lowerCase *> reservedOp "=" *> ((,) Visible <$> parseTerm PrecLam)) <* reservedOp "}" @@ -805,7 +802,7 @@ parseDef = cs <- option [] $ reserved "where" *> localIndentation Ge (localAbsoluteIndentation $ many $ typedIds Nothing) return $ pure $ Class x (map snd ts) (concatMap (\(vs, t) -> (,) <$> vs <*> pure (dbf' nps t)) cs) <|> do indentation (reserved "instance") $ typeNS $ do - constraints <- option [] $ try "constraint" $ getTTuple' <$> parseTerm PrecEq <* reservedOp "=>" + constraints <- option [] $ try "constraint" $ getTTuple' <$> parseTerm PrecOp <* reservedOp "=>" x <- parseSIName upperCase (nps, args) <- telescopePat checkPattern nps @@ -885,9 +882,9 @@ parseSomeGuards f = do (e', f) <- do (e', PCon (_, p) vs) <- try "pattern" $ longPattern <* reservedOp "<-" checkPattern e' - x <- parseETerm PrecEq + x <- parseETerm PrecOp return (e', \gs' gs -> GuardNode x p vs (Alts gs'): gs) - <|> do x <- parseETerm PrecEq + <|> do x <- parseETerm PrecOp return (mempty, \gs' gs -> [GuardNode x "True" [] $ Alts gs', GuardNode x "False" [] $ Alts gs]) f <$> ((map (dbfGT e') <$> parseSomeGuards (> pos)) <|> (:[]) . GuardLeaf <$ reservedOp "->" <*> (dbf' e' <$> parseETerm PrecLam)) <*> option [] (parseSomeGuards (== pos)) @@ -973,7 +970,7 @@ dbFunAlt v (FunAlt n ts gue) = FunAlt n (map (second $ mapP (dbf' v)) ts) $ fmap mkDesugarInfo :: [Stmt] -> DesugarInfo mkDesugarInfo ss = - ( Map.fromList [(s, f) | PrecDef (_, s) f <- ss] + ( Map.fromList $ ("'EqCTt", (Infix, -1)): [(s, f) | PrecDef (_, s) f <- ss] , Map.fromList $ [(cn, Left ((t, pars ty), (snd *** pars) <$> cs)) | Data (_, t) ps ty _ cs <- ss, ((_, cn), ct) <- cs] ++ [(t, Right $ pars $ addParamsS ps ty) | Data (_, t) ps ty _ cs <- ss] diff --git a/testdata/Builtins.out b/testdata/Builtins.out index 5c4ff581..6f407c39 100644 --- a/testdata/Builtins.out +++ b/testdata/Builtins.out @@ -1019,15 +1019,19 @@ testdata/Builtins.lc 329:3-329:10 FragmentOperation (Color V6) | {a} -> {b:Nat} testdata/Builtins.lc 329:3-330:102 Type testdata/Builtins.lc 329:26-330:102 Type testdata/Builtins.lc 329:27-329:31 V7 +testdata/Builtins.lc 329:27-329:33 Type->Type testdata/Builtins.lc 329:27-329:50 Type +testdata/Builtins.lc 329:32-329:33 Type -> Type->Type testdata/Builtins.lc 329:34-329:43 Nat -> Type->Type testdata/Builtins.lc 329:34-329:45 Type->Type testdata/Builtins.lc 329:34-329:50 Type testdata/Builtins.lc 329:44-329:45 V5 testdata/Builtins.lc 329:46-329:50 Type testdata/Builtins.lc 329:52-329:57 V4 +testdata/Builtins.lc 329:52-329:59 Type->Type testdata/Builtins.lc 329:52-329:73 Type testdata/Builtins.lc 329:52-330:102 Type +testdata/Builtins.lc 329:58-329:59 Type -> Type->Type testdata/Builtins.lc 329:60-329:69 Nat -> Type->Type testdata/Builtins.lc 329:60-329:71 Type->Type testdata/Builtins.lc 329:60-329:73 Type @@ -1219,8 +1223,10 @@ testdata/Builtins.lc 361:42-361:56 Type->Type testdata/Builtins.lc 361:42-361:58 Type testdata/Builtins.lc 361:57-361:58 V3 testdata/Builtins.lc 361:60-361:61 Type +testdata/Builtins.lc 361:60-361:63 Type->Type testdata/Builtins.lc 361:60-361:74 Type testdata/Builtins.lc 361:60-361:104 Type +testdata/Builtins.lc 361:62-361:63 Type -> Type->Type testdata/Builtins.lc 361:64-361:71 Type->Type testdata/Builtins.lc 361:64-361:74 Type testdata/Builtins.lc 361:72-361:74 V2 @@ -1367,13 +1373,17 @@ testdata/Builtins.lc 389:47-389:48 V5 testdata/Builtins.lc 391:1-391:11 {a} -> {b} -> {c} -> {d:PrimitiveType} -> {e : a ~ InterpolatedType b} -> {f : c ~ JoinTupleType (VecS Float 4) a} -> c->Float -> b -> RasterContext d -> Primitive d c -> Stream (Fragment 1 a) testdata/Builtins.lc 391:20-395:55 Type testdata/Builtins.lc 391:21-391:22 V7 +testdata/Builtins.lc 391:21-391:24 Type->Type testdata/Builtins.lc 391:21-391:43 Type +testdata/Builtins.lc 391:23-391:24 Type -> Type->Type testdata/Builtins.lc 391:25-391:41 Type->Type testdata/Builtins.lc 391:25-391:43 Type testdata/Builtins.lc 391:42-391:43 V5 testdata/Builtins.lc 391:45-391:46 V4 +testdata/Builtins.lc 391:45-391:48 Type->Type testdata/Builtins.lc 391:45-391:78 Type testdata/Builtins.lc 391:45-395:55 Type +testdata/Builtins.lc 391:47-391:48 Type -> Type->Type testdata/Builtins.lc 391:49-391:62 Type -> Type->Type testdata/Builtins.lc 391:49-391:76 Type->Type testdata/Builtins.lc 391:49-391:78 Type @@ -1468,8 +1478,10 @@ testdata/Builtins.lc 409:48-409:51 Type->Type testdata/Builtins.lc 409:48-409:53 Type testdata/Builtins.lc 409:52-409:53 V3 testdata/Builtins.lc 409:55-409:60 V2 +testdata/Builtins.lc 409:55-409:62 Type->Type testdata/Builtins.lc 409:55-409:76 Type testdata/Builtins.lc 409:55-410:57 Type +testdata/Builtins.lc 409:61-409:62 Type -> Type->Type testdata/Builtins.lc 409:63-409:72 Nat -> Type->Type testdata/Builtins.lc 409:63-409:74 Type->Type testdata/Builtins.lc 409:63-409:76 Type @@ -1644,10 +1656,12 @@ testdata/Builtins.lc 438:56-438:57 V2 testdata/Builtins.lc 438:59-438:73 Nat -> Type->Type testdata/Builtins.lc 438:59-438:75 Type->Type testdata/Builtins.lc 438:59-438:77 Type +testdata/Builtins.lc 438:59-438:79 Type->Type testdata/Builtins.lc 438:59-438:95 Type testdata/Builtins.lc 438:59-438:120 Type testdata/Builtins.lc 438:74-438:75 Nat testdata/Builtins.lc 438:76-438:77 Type +testdata/Builtins.lc 438:78-438:79 Type -> Type->Type testdata/Builtins.lc 438:80-438:93 Type->Type testdata/Builtins.lc 438:80-438:95 Type testdata/Builtins.lc 438:94-438:95 Type @@ -1740,7 +1754,9 @@ testdata/Builtins.lc 456:11-456:19 {a} -> {b} -> {c : a ~ MatVecScalarElem b} - testdata/Builtins.lc 456:21-456:29 {a} -> {b} -> {c : a ~ MatVecScalarElem b} -> {d : Num a} -> b -> a->b testdata/Builtins.lc 456:34-456:80 Type testdata/Builtins.lc 456:35-456:36 V3 +testdata/Builtins.lc 456:35-456:38 Type->Type testdata/Builtins.lc 456:35-456:57 Type +testdata/Builtins.lc 456:37-456:38 Type -> Type->Type testdata/Builtins.lc 456:39-456:55 Type->Type testdata/Builtins.lc 456:39-456:57 Type testdata/Builtins.lc 456:56-456:57 V1 @@ -1760,8 +1776,10 @@ testdata/Builtins.lc 457:35-457:38 Type->Type testdata/Builtins.lc 457:35-457:40 Type testdata/Builtins.lc 457:39-457:40 V5 testdata/Builtins.lc 457:42-457:43 V4 +testdata/Builtins.lc 457:42-457:45 Type->Type testdata/Builtins.lc 457:42-457:59 Type testdata/Builtins.lc 457:42-457:75 Type +testdata/Builtins.lc 457:44-457:45 Type -> Type->Type testdata/Builtins.lc 457:46-457:55 Nat -> Type->Type testdata/Builtins.lc 457:46-457:57 Type->Type testdata/Builtins.lc 457:46-457:59 Type @@ -1779,8 +1797,10 @@ testdata/Builtins.lc 458:35-458:38 Type->Type testdata/Builtins.lc 458:35-458:40 Type testdata/Builtins.lc 458:39-458:40 V5 testdata/Builtins.lc 458:42-458:43 V4 +testdata/Builtins.lc 458:42-458:45 Type->Type testdata/Builtins.lc 458:42-458:59 Type testdata/Builtins.lc 458:42-458:75 Type +testdata/Builtins.lc 458:44-458:45 Type -> Type->Type testdata/Builtins.lc 458:46-458:55 Nat -> Type->Type testdata/Builtins.lc 458:46-458:57 Type->Type testdata/Builtins.lc 458:46-458:59 Type @@ -1809,8 +1829,10 @@ testdata/Builtins.lc 461:35-461:43 Type->Type testdata/Builtins.lc 461:35-461:45 Type testdata/Builtins.lc 461:44-461:45 V5 testdata/Builtins.lc 461:47-461:48 V4 +testdata/Builtins.lc 461:47-461:50 Type->Type testdata/Builtins.lc 461:47-461:64 Type testdata/Builtins.lc 461:47-461:80 Type +testdata/Builtins.lc 461:49-461:50 Type -> Type->Type testdata/Builtins.lc 461:51-461:60 Nat -> Type->Type testdata/Builtins.lc 461:51-461:62 Type->Type testdata/Builtins.lc 461:51-461:64 Type @@ -1829,8 +1851,10 @@ testdata/Builtins.lc 462:35-462:43 Type->Type testdata/Builtins.lc 462:35-462:45 Type testdata/Builtins.lc 462:44-462:45 V5 testdata/Builtins.lc 462:47-462:48 V4 +testdata/Builtins.lc 462:47-462:50 Type->Type testdata/Builtins.lc 462:47-462:64 Type testdata/Builtins.lc 462:47-462:80 Type +testdata/Builtins.lc 462:49-462:50 Type -> Type->Type testdata/Builtins.lc 462:51-462:60 Nat -> Type->Type testdata/Builtins.lc 462:51-462:62 Type->Type testdata/Builtins.lc 462:51-462:64 Type @@ -1847,8 +1871,10 @@ testdata/Builtins.lc 463:35-463:43 Type->Type testdata/Builtins.lc 463:35-463:45 Type testdata/Builtins.lc 463:44-463:45 V5 testdata/Builtins.lc 463:47-463:48 V4 +testdata/Builtins.lc 463:47-463:50 Type->Type testdata/Builtins.lc 463:47-463:64 Type testdata/Builtins.lc 463:47-463:75 Type +testdata/Builtins.lc 463:49-463:50 Type -> Type->Type testdata/Builtins.lc 463:51-463:60 Nat -> Type->Type testdata/Builtins.lc 463:51-463:62 Type->Type testdata/Builtins.lc 463:51-463:64 Type @@ -1864,16 +1890,20 @@ testdata/Builtins.lc 464:35-464:43 Type->Type testdata/Builtins.lc 464:35-464:45 Type testdata/Builtins.lc 464:44-464:45 V7 testdata/Builtins.lc 464:47-464:48 V6 +testdata/Builtins.lc 464:47-464:50 Type->Type testdata/Builtins.lc 464:47-464:64 Type testdata/Builtins.lc 464:47-464:102 Type +testdata/Builtins.lc 464:49-464:50 Type -> Type->Type testdata/Builtins.lc 464:51-464:60 Nat -> Type->Type testdata/Builtins.lc 464:51-464:62 Type->Type testdata/Builtins.lc 464:51-464:64 Type testdata/Builtins.lc 464:61-464:62 V4 testdata/Builtins.lc 464:63-464:64 Type testdata/Builtins.lc 464:66-464:67 V3 +testdata/Builtins.lc 464:66-464:69 Type->Type testdata/Builtins.lc 464:66-464:86 Type testdata/Builtins.lc 464:66-464:102 Type +testdata/Builtins.lc 464:68-464:69 Type -> Type->Type testdata/Builtins.lc 464:70-464:79 Nat -> Type->Type testdata/Builtins.lc 464:70-464:81 Type->Type testdata/Builtins.lc 464:70-464:86 Type @@ -1891,8 +1921,10 @@ testdata/Builtins.lc 465:35-465:43 Type->Type testdata/Builtins.lc 465:35-465:45 Type testdata/Builtins.lc 465:44-465:45 V5 testdata/Builtins.lc 465:47-465:48 V4 +testdata/Builtins.lc 465:47-465:50 Type->Type testdata/Builtins.lc 465:47-465:64 Type testdata/Builtins.lc 465:47-465:83 Type +testdata/Builtins.lc 465:49-465:50 Type -> Type->Type testdata/Builtins.lc 465:51-465:60 Nat -> Type->Type testdata/Builtins.lc 465:51-465:62 Type->Type testdata/Builtins.lc 465:51-465:64 Type @@ -1914,6 +1946,8 @@ testdata/Builtins.lc 468:1-468:8 {a} -> {b:Nat} -> {c : a ~ VecScalar b Bool} - testdata/Builtins.lc 468:34-468:56 Type testdata/Builtins.lc 468:34-468:66 Type testdata/Builtins.lc 468:35-468:36 V3 +testdata/Builtins.lc 468:35-468:38 Type->Type +testdata/Builtins.lc 468:37-468:38 Type -> Type->Type testdata/Builtins.lc 468:39-468:48 Nat -> Type->Type testdata/Builtins.lc 468:39-468:50 Type->Type testdata/Builtins.lc 468:39-468:55 Type @@ -1954,6 +1988,8 @@ testdata/Builtins.lc 472:195-472:206 {a} -> {b:Nat} -> {c : a ~ VecScalar b Flo testdata/Builtins.lc 473:34-473:57 Type testdata/Builtins.lc 473:34-473:67 Type testdata/Builtins.lc 473:35-473:36 V3 +testdata/Builtins.lc 473:35-473:38 Type->Type +testdata/Builtins.lc 473:37-473:38 Type -> Type->Type testdata/Builtins.lc 473:39-473:48 Nat -> Type->Type testdata/Builtins.lc 473:39-473:50 Type->Type testdata/Builtins.lc 473:39-473:56 Type @@ -1967,6 +2003,8 @@ testdata/Builtins.lc 474:10-474:19 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float testdata/Builtins.lc 474:34-474:57 Type testdata/Builtins.lc 474:34-474:72 Type testdata/Builtins.lc 474:35-474:36 V3 +testdata/Builtins.lc 474:35-474:38 Type->Type +testdata/Builtins.lc 474:37-474:38 Type -> Type->Type testdata/Builtins.lc 474:39-474:48 Nat -> Type->Type testdata/Builtins.lc 474:39-474:50 Type->Type testdata/Builtins.lc 474:39-474:56 Type @@ -1986,6 +2024,8 @@ testdata/Builtins.lc 476:59-476:68 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float testdata/Builtins.lc 477:34-477:57 Type testdata/Builtins.lc 477:34-477:67 Type testdata/Builtins.lc 477:35-477:36 V3 +testdata/Builtins.lc 477:35-477:38 Type->Type +testdata/Builtins.lc 477:37-477:38 Type -> Type->Type testdata/Builtins.lc 477:39-477:48 Nat -> Type->Type testdata/Builtins.lc 477:39-477:50 Type->Type testdata/Builtins.lc 477:39-477:56 Type @@ -2001,8 +2041,10 @@ testdata/Builtins.lc 478:35-478:38 Type->Type testdata/Builtins.lc 478:35-478:40 Type testdata/Builtins.lc 478:39-478:40 V5 testdata/Builtins.lc 478:42-478:43 V4 +testdata/Builtins.lc 478:42-478:45 Type->Type testdata/Builtins.lc 478:42-478:59 Type testdata/Builtins.lc 478:42-478:75 Type +testdata/Builtins.lc 478:44-478:45 Type -> Type->Type testdata/Builtins.lc 478:46-478:55 Nat -> Type->Type testdata/Builtins.lc 478:46-478:57 Type->Type testdata/Builtins.lc 478:46-478:59 Type @@ -2020,8 +2062,10 @@ testdata/Builtins.lc 479:35-479:38 Type->Type testdata/Builtins.lc 479:35-479:40 Type testdata/Builtins.lc 479:39-479:40 V5 testdata/Builtins.lc 479:42-479:43 V4 +testdata/Builtins.lc 479:42-479:45 Type->Type testdata/Builtins.lc 479:42-479:59 Type testdata/Builtins.lc 479:42-479:75 Type +testdata/Builtins.lc 479:44-479:45 Type -> Type->Type testdata/Builtins.lc 479:46-479:55 Nat -> Type->Type testdata/Builtins.lc 479:46-479:57 Type->Type testdata/Builtins.lc 479:46-479:59 Type @@ -2036,15 +2080,19 @@ testdata/Builtins.lc 480:1-480:10 {a} -> {b:Nat} -> {c} -> {d : a ~ VecScalar b testdata/Builtins.lc 480:12-480:21 {a} -> {b:Nat} -> {c} -> {d : a ~ VecScalar b Float} -> {e : c ~ VecScalar b Bool} -> a->c testdata/Builtins.lc 480:34-480:89 Type testdata/Builtins.lc 480:35-480:36 V5 +testdata/Builtins.lc 480:35-480:38 Type->Type testdata/Builtins.lc 480:35-480:56 Type +testdata/Builtins.lc 480:37-480:38 Type -> Type->Type testdata/Builtins.lc 480:39-480:48 Nat -> Type->Type testdata/Builtins.lc 480:39-480:50 Type->Type testdata/Builtins.lc 480:39-480:56 Type testdata/Builtins.lc 480:49-480:50 V3 testdata/Builtins.lc 480:51-480:56 Type testdata/Builtins.lc 480:58-480:59 V2 +testdata/Builtins.lc 480:58-480:61 Type->Type testdata/Builtins.lc 480:58-480:78 Type testdata/Builtins.lc 480:58-480:89 Type +testdata/Builtins.lc 480:60-480:61 Type -> Type->Type testdata/Builtins.lc 480:62-480:71 Nat -> Type->Type testdata/Builtins.lc 480:62-480:73 Type->Type testdata/Builtins.lc 480:62-480:78 Type @@ -2060,8 +2108,10 @@ testdata/Builtins.lc 481:35-481:41 Type->Type testdata/Builtins.lc 481:35-481:43 Type testdata/Builtins.lc 481:42-481:43 V5 testdata/Builtins.lc 481:45-481:46 V4 +testdata/Builtins.lc 481:45-481:48 Type->Type testdata/Builtins.lc 481:45-481:62 Type testdata/Builtins.lc 481:45-481:73 Type +testdata/Builtins.lc 481:47-481:48 Type -> Type->Type testdata/Builtins.lc 481:49-481:58 Nat -> Type->Type testdata/Builtins.lc 481:49-481:60 Type->Type testdata/Builtins.lc 481:49-481:62 Type @@ -2074,6 +2124,8 @@ testdata/Builtins.lc 482:1-482:9 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float} testdata/Builtins.lc 482:34-482:57 Type testdata/Builtins.lc 482:34-482:72 Type testdata/Builtins.lc 482:35-482:36 V3 +testdata/Builtins.lc 482:35-482:38 Type->Type +testdata/Builtins.lc 482:37-482:38 Type -> Type->Type testdata/Builtins.lc 482:39-482:48 Nat -> Type->Type testdata/Builtins.lc 482:39-482:50 Type->Type testdata/Builtins.lc 482:39-482:56 Type @@ -2090,8 +2142,10 @@ testdata/Builtins.lc 483:35-483:38 Type->Type testdata/Builtins.lc 483:35-483:40 Type testdata/Builtins.lc 483:39-483:40 V5 testdata/Builtins.lc 483:42-483:43 V4 +testdata/Builtins.lc 483:42-483:45 Type->Type testdata/Builtins.lc 483:42-483:59 Type testdata/Builtins.lc 483:42-483:80 Type +testdata/Builtins.lc 483:44-483:45 Type -> Type->Type testdata/Builtins.lc 483:46-483:55 Nat -> Type->Type testdata/Builtins.lc 483:46-483:57 Type->Type testdata/Builtins.lc 483:46-483:59 Type @@ -2110,8 +2164,10 @@ testdata/Builtins.lc 484:35-484:38 Type->Type testdata/Builtins.lc 484:35-484:40 Type testdata/Builtins.lc 484:39-484:40 V5 testdata/Builtins.lc 484:42-484:43 V4 +testdata/Builtins.lc 484:42-484:45 Type->Type testdata/Builtins.lc 484:42-484:59 Type testdata/Builtins.lc 484:42-484:80 Type +testdata/Builtins.lc 484:44-484:45 Type -> Type->Type testdata/Builtins.lc 484:46-484:55 Nat -> Type->Type testdata/Builtins.lc 484:46-484:57 Type->Type testdata/Builtins.lc 484:46-484:59 Type @@ -2128,6 +2184,8 @@ testdata/Builtins.lc 485:1-485:8 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float} testdata/Builtins.lc 485:34-485:57 Type testdata/Builtins.lc 485:34-485:77 Type testdata/Builtins.lc 485:35-485:36 V3 +testdata/Builtins.lc 485:35-485:38 Type->Type +testdata/Builtins.lc 485:37-485:38 Type -> Type->Type testdata/Builtins.lc 485:39-485:48 Nat -> Type->Type testdata/Builtins.lc 485:39-485:50 Type->Type testdata/Builtins.lc 485:39-485:56 Type @@ -2144,6 +2202,8 @@ testdata/Builtins.lc 486:1-486:9 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float} testdata/Builtins.lc 486:34-486:57 Type testdata/Builtins.lc 486:34-486:81 Type testdata/Builtins.lc 486:35-486:36 V3 +testdata/Builtins.lc 486:35-486:38 Type->Type +testdata/Builtins.lc 486:37-486:38 Type -> Type->Type testdata/Builtins.lc 486:39-486:48 Nat -> Type->Type testdata/Builtins.lc 486:39-486:50 Type->Type testdata/Builtins.lc 486:39-486:56 Type @@ -2159,15 +2219,19 @@ testdata/Builtins.lc 486:80-486:81 Type testdata/Builtins.lc 487:1-487:9 {a} -> {b:Nat} -> {c} -> {d : a ~ VecScalar b Float} -> {e : c ~ VecScalar b Bool} -> a -> a -> c->a testdata/Builtins.lc 487:34-487:99 Type testdata/Builtins.lc 487:35-487:36 V5 +testdata/Builtins.lc 487:35-487:38 Type->Type testdata/Builtins.lc 487:35-487:56 Type +testdata/Builtins.lc 487:37-487:38 Type -> Type->Type testdata/Builtins.lc 487:39-487:48 Nat -> Type->Type testdata/Builtins.lc 487:39-487:50 Type->Type testdata/Builtins.lc 487:39-487:56 Type testdata/Builtins.lc 487:49-487:50 V3 testdata/Builtins.lc 487:51-487:56 Type testdata/Builtins.lc 487:58-487:59 V2 +testdata/Builtins.lc 487:58-487:61 Type->Type testdata/Builtins.lc 487:58-487:78 Type testdata/Builtins.lc 487:58-487:99 Type +testdata/Builtins.lc 487:60-487:61 Type -> Type->Type testdata/Builtins.lc 487:62-487:71 Nat -> Type->Type testdata/Builtins.lc 487:62-487:73 Type->Type testdata/Builtins.lc 487:62-487:78 Type @@ -2184,6 +2248,8 @@ testdata/Builtins.lc 488:1-488:9 {a} -> {b:Nat} -> {c : a ~ VecS Float b} -> a testdata/Builtins.lc 488:34-488:53 Type testdata/Builtins.lc 488:34-488:68 Type testdata/Builtins.lc 488:35-488:36 V3 +testdata/Builtins.lc 488:35-488:38 Type->Type +testdata/Builtins.lc 488:37-488:38 Type -> Type->Type testdata/Builtins.lc 488:39-488:44 Nat -> Type->Type testdata/Builtins.lc 488:39-488:46 Type->Type testdata/Builtins.lc 488:39-488:52 Type @@ -2198,6 +2264,8 @@ testdata/Builtins.lc 489:1-489:10 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float} testdata/Builtins.lc 489:34-489:57 Type testdata/Builtins.lc 489:34-489:76 Type testdata/Builtins.lc 489:35-489:36 V3 +testdata/Builtins.lc 489:35-489:38 Type->Type +testdata/Builtins.lc 489:37-489:38 Type -> Type->Type testdata/Builtins.lc 489:39-489:48 Nat -> Type->Type testdata/Builtins.lc 489:39-489:50 Type->Type testdata/Builtins.lc 489:39-489:56 Type @@ -2212,6 +2280,8 @@ testdata/Builtins.lc 490:1-490:15 {a} -> {b:Nat} -> {c : a ~ VecS Float b} -> a testdata/Builtins.lc 490:34-490:53 Type testdata/Builtins.lc 490:34-490:73 Type testdata/Builtins.lc 490:35-490:36 V3 +testdata/Builtins.lc 490:35-490:38 Type->Type +testdata/Builtins.lc 490:37-490:38 Type -> Type->Type testdata/Builtins.lc 490:39-490:44 Nat -> Type->Type testdata/Builtins.lc 490:39-490:46 Type->Type testdata/Builtins.lc 490:39-490:52 Type @@ -2228,6 +2298,8 @@ testdata/Builtins.lc 491:1-491:16 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float} testdata/Builtins.lc 491:34-491:57 Type testdata/Builtins.lc 491:34-491:85 Type testdata/Builtins.lc 491:35-491:36 V3 +testdata/Builtins.lc 491:35-491:38 Type->Type +testdata/Builtins.lc 491:37-491:38 Type -> Type->Type testdata/Builtins.lc 491:39-491:48 Nat -> Type->Type testdata/Builtins.lc 491:39-491:50 Type->Type testdata/Builtins.lc 491:39-491:56 Type @@ -2292,6 +2364,8 @@ testdata/Builtins.lc 499:1-499:11 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float} testdata/Builtins.lc 499:34-499:57 Type testdata/Builtins.lc 499:34-499:71 Type testdata/Builtins.lc 499:35-499:36 V3 +testdata/Builtins.lc 499:35-499:38 Type->Type +testdata/Builtins.lc 499:37-499:38 Type -> Type->Type testdata/Builtins.lc 499:39-499:48 Nat -> Type->Type testdata/Builtins.lc 499:39-499:50 Type->Type testdata/Builtins.lc 499:39-499:56 Type @@ -2305,6 +2379,8 @@ testdata/Builtins.lc 500:15-500:22 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float testdata/Builtins.lc 500:34-500:57 Type testdata/Builtins.lc 500:34-500:76 Type testdata/Builtins.lc 500:35-500:36 V3 +testdata/Builtins.lc 500:35-500:38 Type->Type +testdata/Builtins.lc 500:37-500:38 Type -> Type->Type testdata/Builtins.lc 500:39-500:48 Nat -> Type->Type testdata/Builtins.lc 500:39-500:50 Type->Type testdata/Builtins.lc 500:39-500:56 Type @@ -2319,6 +2395,8 @@ testdata/Builtins.lc 501:1-501:10 {a} -> {b : a ~ VecS Float 3} -> a -> a->a testdata/Builtins.lc 501:34-501:57 Type testdata/Builtins.lc 501:34-501:72 Type testdata/Builtins.lc 501:35-501:36 V1 +testdata/Builtins.lc 501:35-501:38 Type->Type +testdata/Builtins.lc 501:37-501:38 Type -> Type->Type testdata/Builtins.lc 501:39-501:48 Nat -> Type->Type testdata/Builtins.lc 501:39-501:50 Type->Type testdata/Builtins.lc 501:39-501:56 Type @@ -2333,6 +2411,8 @@ testdata/Builtins.lc 502:1-502:14 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float} testdata/Builtins.lc 502:34-502:57 Type testdata/Builtins.lc 502:34-502:67 Type testdata/Builtins.lc 502:35-502:36 V3 +testdata/Builtins.lc 502:35-502:38 Type->Type +testdata/Builtins.lc 502:37-502:38 Type -> Type->Type testdata/Builtins.lc 502:39-502:48 Nat -> Type->Type testdata/Builtins.lc 502:39-502:50 Type->Type testdata/Builtins.lc 502:39-502:56 Type @@ -2346,6 +2426,8 @@ testdata/Builtins.lc 503:18-503:29 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float testdata/Builtins.lc 503:34-503:57 Type testdata/Builtins.lc 503:34-503:77 Type testdata/Builtins.lc 503:35-503:36 V3 +testdata/Builtins.lc 503:35-503:38 Type->Type +testdata/Builtins.lc 503:37-503:38 Type -> Type->Type testdata/Builtins.lc 503:39-503:48 Nat -> Type->Type testdata/Builtins.lc 503:39-503:50 Type->Type testdata/Builtins.lc 503:39-503:56 Type @@ -2362,6 +2444,8 @@ testdata/Builtins.lc 504:1-504:12 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float} testdata/Builtins.lc 504:34-504:57 Type testdata/Builtins.lc 504:34-504:72 Type testdata/Builtins.lc 504:35-504:36 V3 +testdata/Builtins.lc 504:35-504:38 Type->Type +testdata/Builtins.lc 504:37-504:38 Type -> Type->Type testdata/Builtins.lc 504:39-504:48 Nat -> Type->Type testdata/Builtins.lc 504:39-504:50 Type->Type testdata/Builtins.lc 504:39-504:56 Type @@ -2509,16 +2593,20 @@ testdata/Builtins.lc 515:35-515:38 Type->Type testdata/Builtins.lc 515:35-515:40 Type testdata/Builtins.lc 515:39-515:40 V7 testdata/Builtins.lc 515:42-515:43 V6 +testdata/Builtins.lc 515:42-515:45 Type->Type testdata/Builtins.lc 515:42-515:59 Type testdata/Builtins.lc 515:42-515:97 Type +testdata/Builtins.lc 515:44-515:45 Type -> Type->Type testdata/Builtins.lc 515:46-515:55 Nat -> Type->Type testdata/Builtins.lc 515:46-515:57 Type->Type testdata/Builtins.lc 515:46-515:59 Type testdata/Builtins.lc 515:56-515:57 V4 testdata/Builtins.lc 515:58-515:59 Type testdata/Builtins.lc 515:61-515:62 V3 +testdata/Builtins.lc 515:61-515:64 Type->Type testdata/Builtins.lc 515:61-515:81 Type testdata/Builtins.lc 515:61-515:97 Type +testdata/Builtins.lc 515:63-515:64 Type -> Type->Type testdata/Builtins.lc 515:65-515:74 Nat -> Type->Type testdata/Builtins.lc 515:65-515:76 Type->Type testdata/Builtins.lc 515:65-515:81 Type @@ -2534,6 +2622,8 @@ testdata/Builtins.lc 516:12-516:24 {a} -> {b} -> {c : a ~ MatVecScalarElem b} - testdata/Builtins.lc 516:34-516:58 Type testdata/Builtins.lc 516:34-516:76 Type testdata/Builtins.lc 516:35-516:36 V3 +testdata/Builtins.lc 516:35-516:38 Type->Type +testdata/Builtins.lc 516:37-516:38 Type -> Type->Type testdata/Builtins.lc 516:39-516:55 Type->Type testdata/Builtins.lc 516:39-516:57 Type testdata/Builtins.lc 516:56-516:57 V1 @@ -2548,6 +2638,8 @@ testdata/Builtins.lc 518:21-518:31 {a} -> {b:Nat} -> {c : a ~ VecScalar b Float testdata/Builtins.lc 519:34-519:57 Type testdata/Builtins.lc 519:34-519:67 Type testdata/Builtins.lc 519:35-519:36 V3 +testdata/Builtins.lc 519:35-519:38 Type->Type +testdata/Builtins.lc 519:37-519:38 Type -> Type->Type testdata/Builtins.lc 519:39-519:48 Nat -> Type->Type testdata/Builtins.lc 519:39-519:50 Type->Type testdata/Builtins.lc 519:39-519:56 Type diff --git a/testdata/Internals.out b/testdata/Internals.out index f55a02c2..a3430051 100644 --- a/testdata/Internals.out +++ b/testdata/Internals.out @@ -103,143 +103,147 @@ testdata/Internals.lc 42:24-42:28 Type testdata/Internals.lc 42:36-42:37 Type testdata/Internals.lc 42:36-42:46 Type testdata/Internals.lc 42:45-42:46 Type -testdata/Internals.lc 47:1-47:4 Unit -> Unit->Unit -testdata/Internals.lc 47:8-47:12 Type -testdata/Internals.lc 47:16-47:20 Type -testdata/Internals.lc 47:16-47:28 Type -testdata/Internals.lc 47:24-47:28 Type -testdata/Internals.lc 50:6-50:9 Type -testdata/Internals.lc 51:6-51:10 Type -testdata/Internals.lc 52:6-52:11 Type +testdata/Internals.lc 44:6-44:11 Type -> Type->Type +testdata/Internals.lc 44:14-44:18 a:Type -> a -> a->Type +testdata/Internals.lc 44:14-44:23 Type -> Type->Type +testdata/Internals.lc 44:19-44:23 Type +testdata/Internals.lc 49:1-49:4 Unit -> Unit->Unit +testdata/Internals.lc 49:8-49:12 Type +testdata/Internals.lc 49:16-49:20 Type +testdata/Internals.lc 49:16-49:28 Type +testdata/Internals.lc 49:24-49:28 Type +testdata/Internals.lc 52:6-52:9 Type testdata/Internals.lc 53:6-53:10 Type +testdata/Internals.lc 54:6-54:11 Type testdata/Internals.lc 55:6-55:10 Type -testdata/Internals.lc 55:6-55:25 Type -testdata/Internals.lc 55:13-55:18 Bool -testdata/Internals.lc 55:21-55:25 Bool -testdata/Internals.lc 57:6-57:14 Type -testdata/Internals.lc 57:6-57:29 Type -testdata/Internals.lc 57:17-57:19 Ordering -testdata/Internals.lc 57:22-57:24 Ordering -testdata/Internals.lc 57:27-57:29 Ordering -testdata/Internals.lc 60:1-60:14 Int->Word -testdata/Internals.lc 60:24-60:27 Type -testdata/Internals.lc 60:33-60:37 Type -testdata/Internals.lc 61:1-61:15 Int->Float -testdata/Internals.lc 61:24-61:27 Type -testdata/Internals.lc 61:33-61:38 Type -testdata/Internals.lc 62:1-62:15 Int -> Int->Ordering +testdata/Internals.lc 57:6-57:10 Type +testdata/Internals.lc 57:6-57:25 Type +testdata/Internals.lc 57:13-57:18 Bool +testdata/Internals.lc 57:21-57:25 Bool +testdata/Internals.lc 59:6-59:14 Type +testdata/Internals.lc 59:6-59:29 Type +testdata/Internals.lc 59:17-59:19 Ordering +testdata/Internals.lc 59:22-59:24 Ordering +testdata/Internals.lc 59:27-59:29 Ordering +testdata/Internals.lc 62:1-62:14 Int->Word testdata/Internals.lc 62:24-62:27 Type -testdata/Internals.lc 62:33-62:36 Type -testdata/Internals.lc 62:33-62:50 Type -testdata/Internals.lc 62:42-62:50 Type -testdata/Internals.lc 63:1-63:16 Word -> Word->Ordering -testdata/Internals.lc 63:24-63:28 Type -testdata/Internals.lc 63:33-63:37 Type -testdata/Internals.lc 63:33-63:50 Type -testdata/Internals.lc 63:42-63:50 Type -testdata/Internals.lc 64:1-64:17 Float -> Float->Ordering -testdata/Internals.lc 64:24-64:29 Type -testdata/Internals.lc 64:33-64:38 Type +testdata/Internals.lc 62:33-62:37 Type +testdata/Internals.lc 63:1-63:15 Int->Float +testdata/Internals.lc 63:24-63:27 Type +testdata/Internals.lc 63:33-63:38 Type +testdata/Internals.lc 64:1-64:15 Int -> Int->Ordering +testdata/Internals.lc 64:24-64:27 Type +testdata/Internals.lc 64:33-64:36 Type testdata/Internals.lc 64:33-64:50 Type testdata/Internals.lc 64:42-64:50 Type -testdata/Internals.lc 65:1-65:16 Char -> Char->Ordering +testdata/Internals.lc 65:1-65:16 Word -> Word->Ordering testdata/Internals.lc 65:24-65:28 Type testdata/Internals.lc 65:33-65:37 Type testdata/Internals.lc 65:33-65:50 Type testdata/Internals.lc 65:42-65:50 Type -testdata/Internals.lc 66:1-66:18 String -> String->Ordering -testdata/Internals.lc 66:24-66:30 Type -testdata/Internals.lc 66:34-66:40 Type -testdata/Internals.lc 66:34-66:52 Type -testdata/Internals.lc 66:44-66:52 Type -testdata/Internals.lc 67:1-67:14 Int->Int -testdata/Internals.lc 67:24-67:27 Type -testdata/Internals.lc 67:33-67:36 Type -testdata/Internals.lc 68:1-68:15 Word->Word -testdata/Internals.lc 68:24-68:28 Type -testdata/Internals.lc 68:33-68:37 Type -testdata/Internals.lc 69:1-69:16 Float->Float -testdata/Internals.lc 69:24-69:29 Type -testdata/Internals.lc 69:33-69:38 Type -testdata/Internals.lc 70:1-70:11 Int -> Int->Int -testdata/Internals.lc 70:24-70:27 Type -testdata/Internals.lc 70:33-70:36 Type -testdata/Internals.lc 70:33-70:45 Type -testdata/Internals.lc 70:42-70:45 Type -testdata/Internals.lc 71:1-71:11 Int -> Int->Int -testdata/Internals.lc 71:24-71:27 Type -testdata/Internals.lc 71:33-71:36 Type -testdata/Internals.lc 71:33-71:45 Type -testdata/Internals.lc 71:42-71:45 Type +testdata/Internals.lc 66:1-66:17 Float -> Float->Ordering +testdata/Internals.lc 66:24-66:29 Type +testdata/Internals.lc 66:33-66:38 Type +testdata/Internals.lc 66:33-66:50 Type +testdata/Internals.lc 66:42-66:50 Type +testdata/Internals.lc 67:1-67:16 Char -> Char->Ordering +testdata/Internals.lc 67:24-67:28 Type +testdata/Internals.lc 67:33-67:37 Type +testdata/Internals.lc 67:33-67:50 Type +testdata/Internals.lc 67:42-67:50 Type +testdata/Internals.lc 68:1-68:18 String -> String->Ordering +testdata/Internals.lc 68:24-68:30 Type +testdata/Internals.lc 68:34-68:40 Type +testdata/Internals.lc 68:34-68:52 Type +testdata/Internals.lc 68:44-68:52 Type +testdata/Internals.lc 69:1-69:14 Int->Int +testdata/Internals.lc 69:24-69:27 Type +testdata/Internals.lc 69:33-69:36 Type +testdata/Internals.lc 70:1-70:15 Word->Word +testdata/Internals.lc 70:24-70:28 Type +testdata/Internals.lc 70:33-70:37 Type +testdata/Internals.lc 71:1-71:16 Float->Float +testdata/Internals.lc 71:24-71:29 Type +testdata/Internals.lc 71:33-71:38 Type testdata/Internals.lc 72:1-72:11 Int -> Int->Int testdata/Internals.lc 72:24-72:27 Type testdata/Internals.lc 72:33-72:36 Type testdata/Internals.lc 72:33-72:45 Type testdata/Internals.lc 72:42-72:45 Type -testdata/Internals.lc 73:1-73:14 Float->Float -testdata/Internals.lc 73:24-73:29 Type -testdata/Internals.lc 73:33-73:38 Type -testdata/Internals.lc 74:1-74:10 Float->Int -testdata/Internals.lc 74:24-74:29 Type +testdata/Internals.lc 73:1-73:11 Int -> Int->Int +testdata/Internals.lc 73:24-73:27 Type +testdata/Internals.lc 73:33-73:36 Type +testdata/Internals.lc 73:33-73:45 Type +testdata/Internals.lc 73:42-73:45 Type +testdata/Internals.lc 74:1-74:11 Int -> Int->Int +testdata/Internals.lc 74:24-74:27 Type testdata/Internals.lc 74:33-74:36 Type -testdata/Internals.lc 77:19-77:23 Type -testdata/Internals.lc 77:19-77:38 Type -testdata/Internals.lc 77:27-77:28 V2 -testdata/Internals.lc 77:27-77:38 Type -testdata/Internals.lc 77:32-77:33 Type -testdata/Internals.lc 77:32-77:38 Type -testdata/Internals.lc 77:37-77:38 Type -testdata/Internals.lc 78:1-78:15 {a} -> Bool -> a -> a->a -testdata/Internals.lc 78:16-78:20 Bool -testdata/Internals.lc 78:16-79:29 Bool -> V1 -> V2->V3 | V1 -> V2->V3 | V2->V3 | V3 -testdata/Internals.lc 78:28-78:29 V3 -testdata/Internals.lc 78:28-79:29 Bool->V4 -testdata/Internals.lc 79:28-79:29 V4 -testdata/Internals.lc 82:7-82:10 Type->Type -testdata/Internals.lc 82:7-83:22 Type -testdata/Internals.lc 82:7-84:32 Type -testdata/Internals.lc 82:7-85:19 Type -testdata/Internals.lc 83:3-83:10 {a} -> {b : Num a} -> Int->a -testdata/Internals.lc 83:14-83:17 Type -testdata/Internals.lc 83:14-83:22 Type -testdata/Internals.lc 83:21-83:22 Type -testdata/Internals.lc 84:3-84:10 {a} -> {b : Num a} -> a -> a->Ordering -testdata/Internals.lc 84:14-84:15 Type -testdata/Internals.lc 84:14-84:32 Type -testdata/Internals.lc 84:19-84:20 Type -testdata/Internals.lc 84:19-84:32 Type -testdata/Internals.lc 84:24-84:32 Type -testdata/Internals.lc 85:3-85:9 {a} -> {b : Num a} -> a->a -testdata/Internals.lc 85:13-85:14 Type -testdata/Internals.lc 85:13-85:19 Type -testdata/Internals.lc 85:18-85:19 Type -testdata/Internals.lc 87:14-87:17 Type -testdata/Internals.lc 87:14-88:20 ({a : Num V0} -> Int->V2) -> {d : Num V1} -> Int->V3 -testdata/Internals.lc 87:14-89:27 ({a : Num V0} -> V1 -> V2->Ordering) -> {e : Num V1} -> V2 -> V3->Ordering -testdata/Internals.lc 87:14-90:26 ({a : Num V0} -> V1->V2) -> {d : Num V1} -> V2->V3 -testdata/Internals.lc 87:14-95:19 Type | Type->Type -testdata/Internals.lc 87:14-96:27 {a : Num V0} -> Int->V2 | {a} -> {b : Num a} -> Int->a -testdata/Internals.lc 87:14-97:29 {a : Num V0} -> V1 -> V2->Ordering | {a} -> {b : Num a} -> a -> a->Ordering -testdata/Internals.lc 87:14-98:28 {a : Num V0} -> V1->V2 | {a} -> {b : Num a} -> a->a -testdata/Internals.lc 88:13-88:20 Int->Int -testdata/Internals.lc 88:19-88:20 Int -testdata/Internals.lc 89:13-89:27 Int -> Int->Ordering -testdata/Internals.lc 90:13-90:26 Int->Int -testdata/Internals.lc 91:14-91:18 Type -testdata/Internals.lc 91:14-92:26 ({a : Num V0} -> Int->V2) -> {d : Num V1} -> Int->V3 -testdata/Internals.lc 91:14-93:28 ({a : Num V0} -> V1 -> V2->Ordering) -> {e : Num V1} -> V2 -> V3->Ordering -testdata/Internals.lc 91:14-94:27 ({a : Num V0} -> V1->V2) -> {d : Num V1} -> V2->V3 -testdata/Internals.lc 91:14-95:19 Type -testdata/Internals.lc 91:14-96:27 {a : Num V0} -> Int->V2 -testdata/Internals.lc 91:14-97:29 {a : Num V0} -> V1 -> V2->Ordering -testdata/Internals.lc 91:14-98:28 {a : Num V0} -> V1->V2 -testdata/Internals.lc 92:13-92:26 Int->Word -testdata/Internals.lc 93:13-93:28 Word -> Word->Ordering -testdata/Internals.lc 94:13-94:27 Word->Word -testdata/Internals.lc 95:14-95:19 Type -testdata/Internals.lc 95:14-96:27 ({a : Num V0} -> Int->V2) -> {d : Num V1} -> Int->V3 -testdata/Internals.lc 95:14-97:29 ({a : Num V0} -> V1 -> V2->Ordering) -> {e : Num V1} -> V2 -> V3->Ordering -testdata/Internals.lc 95:14-98:28 ({a : Num V0} -> V1->V2) -> {d : Num V1} -> V2->V3 -testdata/Internals.lc 96:13-96:27 Int->Float -testdata/Internals.lc 97:13-97:29 Float -> Float->Ordering -testdata/Internals.lc 98:13-98:28 Float->Float +testdata/Internals.lc 74:33-74:45 Type +testdata/Internals.lc 74:42-74:45 Type +testdata/Internals.lc 75:1-75:14 Float->Float +testdata/Internals.lc 75:24-75:29 Type +testdata/Internals.lc 75:33-75:38 Type +testdata/Internals.lc 76:1-76:10 Float->Int +testdata/Internals.lc 76:24-76:29 Type +testdata/Internals.lc 76:33-76:36 Type +testdata/Internals.lc 79:19-79:23 Type +testdata/Internals.lc 79:19-79:38 Type +testdata/Internals.lc 79:27-79:28 V2 +testdata/Internals.lc 79:27-79:38 Type +testdata/Internals.lc 79:32-79:33 Type +testdata/Internals.lc 79:32-79:38 Type +testdata/Internals.lc 79:37-79:38 Type +testdata/Internals.lc 80:1-80:15 {a} -> Bool -> a -> a->a +testdata/Internals.lc 80:16-80:20 Bool +testdata/Internals.lc 80:16-81:29 Bool -> V1 -> V2->V3 | V1 -> V2->V3 | V2->V3 | V3 +testdata/Internals.lc 80:28-80:29 V3 +testdata/Internals.lc 80:28-81:29 Bool->V4 +testdata/Internals.lc 81:28-81:29 V4 +testdata/Internals.lc 84:7-84:10 Type->Type +testdata/Internals.lc 84:7-85:22 Type +testdata/Internals.lc 84:7-86:32 Type +testdata/Internals.lc 84:7-87:19 Type +testdata/Internals.lc 85:3-85:10 {a} -> {b : Num a} -> Int->a +testdata/Internals.lc 85:14-85:17 Type +testdata/Internals.lc 85:14-85:22 Type +testdata/Internals.lc 85:21-85:22 Type +testdata/Internals.lc 86:3-86:10 {a} -> {b : Num a} -> a -> a->Ordering +testdata/Internals.lc 86:14-86:15 Type +testdata/Internals.lc 86:14-86:32 Type +testdata/Internals.lc 86:19-86:20 Type +testdata/Internals.lc 86:19-86:32 Type +testdata/Internals.lc 86:24-86:32 Type +testdata/Internals.lc 87:3-87:9 {a} -> {b : Num a} -> a->a +testdata/Internals.lc 87:13-87:14 Type +testdata/Internals.lc 87:13-87:19 Type +testdata/Internals.lc 87:18-87:19 Type +testdata/Internals.lc 89:14-89:17 Type +testdata/Internals.lc 89:14-90:20 ({a : Num V0} -> Int->V2) -> {d : Num V1} -> Int->V3 +testdata/Internals.lc 89:14-91:27 ({a : Num V0} -> V1 -> V2->Ordering) -> {e : Num V1} -> V2 -> V3->Ordering +testdata/Internals.lc 89:14-92:26 ({a : Num V0} -> V1->V2) -> {d : Num V1} -> V2->V3 +testdata/Internals.lc 89:14-97:19 Type | Type->Type +testdata/Internals.lc 89:14-98:27 {a : Num V0} -> Int->V2 | {a} -> {b : Num a} -> Int->a +testdata/Internals.lc 89:14-99:29 {a : Num V0} -> V1 -> V2->Ordering | {a} -> {b : Num a} -> a -> a->Ordering +testdata/Internals.lc 89:14-100:28 {a : Num V0} -> V1->V2 | {a} -> {b : Num a} -> a->a +testdata/Internals.lc 90:13-90:20 Int->Int +testdata/Internals.lc 90:19-90:20 Int +testdata/Internals.lc 91:13-91:27 Int -> Int->Ordering +testdata/Internals.lc 92:13-92:26 Int->Int +testdata/Internals.lc 93:14-93:18 Type +testdata/Internals.lc 93:14-94:26 ({a : Num V0} -> Int->V2) -> {d : Num V1} -> Int->V3 +testdata/Internals.lc 93:14-95:28 ({a : Num V0} -> V1 -> V2->Ordering) -> {e : Num V1} -> V2 -> V3->Ordering +testdata/Internals.lc 93:14-96:27 ({a : Num V0} -> V1->V2) -> {d : Num V1} -> V2->V3 +testdata/Internals.lc 93:14-97:19 Type +testdata/Internals.lc 93:14-98:27 {a : Num V0} -> Int->V2 +testdata/Internals.lc 93:14-99:29 {a : Num V0} -> V1 -> V2->Ordering +testdata/Internals.lc 93:14-100:28 {a : Num V0} -> V1->V2 +testdata/Internals.lc 94:13-94:26 Int->Word +testdata/Internals.lc 95:13-95:28 Word -> Word->Ordering +testdata/Internals.lc 96:13-96:27 Word->Word +testdata/Internals.lc 97:14-97:19 Type +testdata/Internals.lc 97:14-98:27 ({a : Num V0} -> Int->V2) -> {d : Num V1} -> Int->V3 +testdata/Internals.lc 97:14-99:29 ({a : Num V0} -> V1 -> V2->Ordering) -> {e : Num V1} -> V2 -> V3->Ordering +testdata/Internals.lc 97:14-100:28 ({a : Num V0} -> V1->V2) -> {d : Num V1} -> V2->V3 +testdata/Internals.lc 98:13-98:27 Int->Float +testdata/Internals.lc 99:13-99:29 Float -> Float->Ordering +testdata/Internals.lc 100:13-100:28 Float->Float diff --git a/testdata/Prelude.out b/testdata/Prelude.out index 1ce1896f..4d590c76 100644 --- a/testdata/Prelude.out +++ b/testdata/Prelude.out @@ -400,7 +400,9 @@ testdata/Prelude.lc 165:32-165:52 Type->Type testdata/Prelude.lc 165:34-165:37 {a} -> {b : Eq a} -> a -> a->Bool testdata/Prelude.lc 165:38-165:40 V6 testdata/Prelude.lc 165:46-165:47 V12 +testdata/Prelude.lc 165:46-165:49 Type->Type testdata/Prelude.lc 165:46-165:52 Type +testdata/Prelude.lc 165:48-165:49 Type -> Type->Type testdata/Prelude.lc 165:50-165:52 V4 testdata/Prelude.lc 165:58-165:64 V12 testdata/Prelude.lc 165:65-165:66 V13 diff --git a/testdata/language-features/basic-values/def05.reject.out b/testdata/language-features/basic-values/def05.reject.out index f24dbe10..d260d164 100644 --- a/testdata/language-features/basic-values/def05.reject.out +++ b/testdata/language-features/basic-values/def05.reject.out @@ -1,4 +1,4 @@ "testdata/language-features/basic-values/def05.reject.lc" (line 4, column 1): unexpected end of input -expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, expression, lambda, "::", "~", "->", "=>", "where", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs or pattern +expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, "~", expression, lambda, "::", "->", "=>", "where", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs or pattern different number of arguments of fun at testdata/language-features/basic-values/def05.reject.lc 1:1-1:4 \ No newline at end of file diff --git a/testdata/language-features/basic-values/def06.reject.out b/testdata/language-features/basic-values/def06.reject.out index 32761406..f80e12f8 100644 --- a/testdata/language-features/basic-values/def06.reject.out +++ b/testdata/language-features/basic-values/def06.reject.out @@ -1,4 +1,4 @@ "testdata/language-features/basic-values/def06.reject.lc" (line 5, column 1): unexpected end of input -expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, expression, lambda, "::", "~", "->", "=>", "where", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs or pattern +expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, "~", expression, lambda, "::", "->", "=>", "where", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs or pattern different number of arguments of fun2 at testdata/language-features/basic-values/def06.reject.lc 1:1-1:5 \ No newline at end of file diff --git a/testdata/language-features/basic-values/redefine03.reject.out b/testdata/language-features/basic-values/redefine03.reject.out index aa37ecee..f8e236ab 100644 --- a/testdata/language-features/basic-values/redefine03.reject.out +++ b/testdata/language-features/basic-values/redefine03.reject.out @@ -1,4 +1,4 @@ "testdata/language-features/basic-values/redefine03.reject.lc" (line 4, column 1): unexpected end of input -expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, expression, lambda, "::", "~", "->", "=>", "where", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs or pattern +expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, "~", expression, lambda, "::", "->", "=>", "where", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs or pattern redefined x at testdata/language-features/basic-values/redefine03.reject.lc 2:9-2:10 \ No newline at end of file diff --git a/testdata/language-features/guard/guard10.reject.out b/testdata/language-features/guard/guard10.reject.out index d998f2d5..16c0debe 100644 --- a/testdata/language-features/guard/guard10.reject.out +++ b/testdata/language-features/guard/guard10.reject.out @@ -1,3 +1,3 @@ "testdata/language-features/guard/guard10.reject.lc" (line 2, column 1): unexpected '|' -expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, expression, lambda, "::", "~", "->", "=>", "|", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs, pattern or end of input \ No newline at end of file +expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, "~", expression, lambda, "::", "->", "=>", "|", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs, pattern or end of input \ No newline at end of file diff --git a/testdata/listcompr01.reject.out b/testdata/listcompr01.reject.out index b43b8f71..1d3a6936 100644 --- a/testdata/listcompr01.reject.out +++ b/testdata/listcompr01.reject.out @@ -1,3 +1,3 @@ "testdata/listcompr01.reject.lc" (line 6, column 42): unexpected ',' -expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, expression, lambda, "::", "~", "->", "=>", "where", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs, pattern or end of input \ No newline at end of file +expecting projection, swizzling, "@", char literal, literal string, float literal, "#", natural, "_", "'", identifier, uppercase ident, "[", "(", "{", "let", symbols, op symbols, backquoted ident, "~", expression, lambda, "::", "->", "=>", "where", "data", "class", "instance", type family, type instance, "type", typed ident, "infix", "infixl", "infixr", operator definition, lhs, pattern or end of input \ No newline at end of file -- cgit v1.2.3