diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-04-25 11:16:09 +0200 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-04-25 11:16:09 +0200 |
commit | 9d53a4f86a37043d07cd7b288914eaecf4104e25 (patch) | |
tree | a4be1ae0263ac8b527c18d36d5b3419432e74203 | |
parent | b3e157965b055d879c8f5e9a1a73a803d2ea2734 (diff) |
cleanup
-rw-r--r-- | lc/Prelude.lc | 4 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Parser.hs | 6 | ||||
-rw-r--r-- | testdata/Prelude.out | 12 |
3 files changed, 13 insertions, 9 deletions
diff --git a/lc/Prelude.lc b/lc/Prelude.lc index 11cfc4ab..aa065096 100644 --- a/lc/Prelude.lc +++ b/lc/Prelude.lc | |||
@@ -129,8 +129,8 @@ data RecordC (xs :: [RecItem]) | |||
129 | isKeyC _ _ [] = 'Empty "" | 129 | isKeyC _ _ [] = 'Empty "" |
130 | isKeyC s t (RecItem s' t': ss) = if s == s' then t ~ t' else isKeyC s t ss | 130 | isKeyC s t (RecItem s' t': ss) = if s == s' then t ~ t' else isKeyC s t ss |
131 | 131 | ||
132 | fstTup (HCons a _) = a | 132 | fstTup = hlistConsCase _ (\a _ -> a) |
133 | sndTup (HCons _ a) = a | 133 | sndTup = hlistConsCase _ (\_ a -> a) |
134 | 134 | ||
135 | -- todo: don't use unsafeCoerce | 135 | -- todo: don't use unsafeCoerce |
136 | project :: forall a (xs :: [RecItem]) . forall (s :: String) -> isKeyC s a xs => RecordC xs -> a | 136 | project :: forall a (xs :: [RecItem]) . forall (s :: String) -> isKeyC s a xs => RecordC xs -> a |
diff --git a/src/LambdaCube/Compiler/Parser.hs b/src/LambdaCube/Compiler/Parser.hs index 90e576d6..9b50ff0d 100644 --- a/src/LambdaCube/Compiler/Parser.hs +++ b/src/LambdaCube/Compiler/Parser.hs | |||
@@ -1159,7 +1159,7 @@ mkDesugarInfo :: [Stmt] -> DesugarInfo | |||
1159 | mkDesugarInfo ss = | 1159 | mkDesugarInfo ss = |
1160 | ( Map.fromList $ ("'EqCTt", (Infix, -1)): [(s, f) | PrecDef (_, s) f <- ss] | 1160 | ( Map.fromList $ ("'EqCTt", (Infix, -1)): [(s, f) | PrecDef (_, s) f <- ss] |
1161 | , Map.fromList $ | 1161 | , Map.fromList $ |
1162 | [hackHList (cn, Left ((caseName t, pars ty), (snd *** pars) <$> cs)) | Data (_, t) ps ty _ cs <- ss, ((_, cn), ct) <- cs] | 1162 | [(cn, Left ((caseName t, pars ty), (snd *** pars) <$> cs)) | Data (_, t) ps ty _ cs <- ss, ((_, cn), ct) <- cs] |
1163 | ++ [(t, Right $ pars $ UncurryS ps ty) | Data (_, t) ps ty _ _ <- ss] | 1163 | ++ [(t, Right $ pars $ UncurryS ps ty) | Data (_, t) ps ty _ _ <- ss] |
1164 | -- ++ [(t, Right $ length xs) | Let (_, t) _ (Just ty) xs _ <- ss] | 1164 | -- ++ [(t, Right $ length xs) | Let (_, t) _ (Just ty) xs _ <- ss] |
1165 | ++ [("'Type", Right 0)] | 1165 | ++ [("'Type", Right 0)] |
@@ -1167,10 +1167,6 @@ mkDesugarInfo ss = | |||
1167 | where | 1167 | where |
1168 | pars (UncurryS l _) = length $ filter ((== Visible) . fst) l -- todo | 1168 | pars (UncurryS l _) = length $ filter ((== Visible) . fst) l -- todo |
1169 | 1169 | ||
1170 | hackHList ("HCons", _) = ("HCons", Left (("hlistConsCase", -1), [("HCons", 2)])) | ||
1171 | hackHList ("HNil", _) = ("HNil", Left (("hlistNilCase", -1), [("HNil", 0)])) | ||
1172 | hackHList x = x | ||
1173 | |||
1174 | -------------------------------------------------------------------------------- module exports | 1170 | -------------------------------------------------------------------------------- module exports |
1175 | 1171 | ||
1176 | data Export = ExportModule SIName | ExportId SIName | 1172 | data Export = ExportModule SIName | ExportId SIName |
diff --git a/testdata/Prelude.out b/testdata/Prelude.out index f1faf875..0e7d4e05 100644 --- a/testdata/Prelude.out +++ b/testdata/Prelude.out | |||
@@ -479,9 +479,17 @@ testdata/Prelude.lc 130:69-130:70 String | |||
479 | testdata/Prelude.lc 130:71-130:72 Type | 479 | testdata/Prelude.lc 130:71-130:72 Type |
480 | testdata/Prelude.lc 130:73-130:75 List V8 | 480 | testdata/Prelude.lc 130:73-130:75 List V8 |
481 | testdata/Prelude.lc 132:1-132:7 {a} -> {b : List Type} -> HList ('Cons a b) -> a | 481 | testdata/Prelude.lc 132:1-132:7 {a} -> {b : List Type} -> HList ('Cons a b) -> a |
482 | testdata/Prelude.lc 132:22-132:23 HList V2 -> V2 | V2 -> HList V2 -> V2 | V4 | 482 | testdata/Prelude.lc 132:10-132:23 {a} -> {b : List Type} -> c:Type -> (a -> HList b -> c) -> HList ('Cons a b) -> c |
483 | testdata/Prelude.lc 132:10-132:25 (V2 -> HList V2 -> V2) -> HList ('Cons V3 V2) -> V2 | ||
484 | testdata/Prelude.lc 132:10-132:37 HList ('Cons V1 V0) -> V2 | ||
485 | testdata/Prelude.lc 132:27-132:36 V2 -> HList V2 -> V2 | ||
486 | testdata/Prelude.lc 132:35-132:36 HList V2 -> V2 | V4 | ||
483 | testdata/Prelude.lc 133:1-133:7 {a} -> {b : List Type} -> HList ('Cons a b) -> HList b | 487 | testdata/Prelude.lc 133:1-133:7 {a} -> {b : List Type} -> HList ('Cons a b) -> HList b |
484 | testdata/Prelude.lc 133:22-133:23 HList V2 -> V2 | HList V3 | V2 -> HList V2 -> V2 | 488 | testdata/Prelude.lc 133:10-133:23 {a} -> {b : List Type} -> c:Type -> (a -> HList b -> c) -> HList ('Cons a b) -> c |
489 | testdata/Prelude.lc 133:10-133:25 (V2 -> HList V2 -> V2) -> HList ('Cons V3 V2) -> V2 | ||
490 | testdata/Prelude.lc 133:10-133:37 HList ('Cons V1 V0) -> HList V1 | ||
491 | testdata/Prelude.lc 133:27-133:36 V2 -> HList V2 -> V2 | ||
492 | testdata/Prelude.lc 133:35-133:36 HList V2 -> V2 | HList V3 | ||
485 | testdata/Prelude.lc 136:12-138:181 V0->V1 | {a} -> {b : List RecItem} -> c:String -> {d : 'isKeyC c a b} -> RecordC b -> a | 493 | testdata/Prelude.lc 136:12-138:181 V0->V1 | {a} -> {b : List RecItem} -> c:String -> {d : 'isKeyC c a b} -> RecordC b -> a |
486 | testdata/Prelude.lc 136:28-136:37 Type | 494 | testdata/Prelude.lc 136:28-136:37 Type |
487 | testdata/Prelude.lc 136:28-136:97 Type | 495 | testdata/Prelude.lc 136:28-136:97 Type |