diff options
Diffstat (limited to 'src/LambdaCube/Compiler')
-rw-r--r-- | src/LambdaCube/Compiler/CoreToIR.hs | 2 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/DesugaredSource.hs | 5 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Infer.hs | 2 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Lexer.hs | 5 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Parser.hs | 2 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Patterns.hs | 4 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Pretty.hs | 1 |
7 files changed, 10 insertions, 11 deletions
diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs index 7e4a938e..c8c0dcaa 100644 --- a/src/LambdaCube/Compiler/CoreToIR.hs +++ b/src/LambdaCube/Compiler/CoreToIR.hs | |||
@@ -226,7 +226,7 @@ compFrameBuffer = \case | |||
226 | 226 | ||
227 | compSemantics = map compSemantic . compList | 227 | compSemantics = map compSemantic . compList |
228 | 228 | ||
229 | compList (A2 "Cons" a x) = a : compList x | 229 | compList (A2 ":" a x) = a : compList x |
230 | compList (A0 "Nil") = [] | 230 | compList (A0 "Nil") = [] |
231 | compList x = error $ "compList: " ++ ppShow x | 231 | compList x = error $ "compList: " ++ ppShow x |
232 | 232 | ||
diff --git a/src/LambdaCube/Compiler/DesugaredSource.hs b/src/LambdaCube/Compiler/DesugaredSource.hs index c17717f3..5d3a70f3 100644 --- a/src/LambdaCube/Compiler/DesugaredSource.hs +++ b/src/LambdaCube/Compiler/DesugaredSource.hs | |||
@@ -242,6 +242,9 @@ infixl 2 `SAppV`, `SAppH` | |||
242 | pattern SBuiltin s <- SGlobal (SIName _ s) | 242 | pattern SBuiltin s <- SGlobal (SIName _ s) |
243 | where SBuiltin s = SGlobal (SIName (debugSI $ "builtin " ++ s) s) | 243 | where SBuiltin s = SGlobal (SIName (debugSI $ "builtin " ++ s) s) |
244 | 244 | ||
245 | pattern ConsName <- SIName _ ":" | ||
246 | where ConsName = SIName_ mempty (Just $ InfixR 5) ":" | ||
247 | |||
245 | pattern SRHS a = SBuiltin "_rhs" `SAppV` a | 248 | pattern SRHS a = SBuiltin "_rhs" `SAppV` a |
246 | pattern Section e = SBuiltin "^section" `SAppV` e | 249 | pattern Section e = SBuiltin "^section" `SAppV` e |
247 | pattern SType = SBuiltin "'Type" | 250 | pattern SType = SBuiltin "'Type" |
@@ -256,7 +259,7 @@ pattern HNil = SBuiltin "HNil" | |||
256 | 259 | ||
257 | -- builtin list | 260 | -- builtin list |
258 | pattern BList a = SBuiltin "'List" `SAppV` a | 261 | pattern BList a = SBuiltin "'List" `SAppV` a |
259 | pattern BCons a b = SBuiltin "Cons" `SAppV` a `SAppV` b | 262 | pattern BCons a b = SGlobal ConsName `SAppV` a `SAppV` b |
260 | pattern BNil = SBuiltin "Nil" | 263 | pattern BNil = SBuiltin "Nil" |
261 | 264 | ||
262 | getTTuple (HList (getList -> Just xs)) = xs | 265 | getTTuple (HList (getList -> Just xs)) = xs |
diff --git a/src/LambdaCube/Compiler/Infer.hs b/src/LambdaCube/Compiler/Infer.hs index 1b747e69..986a564d 100644 --- a/src/LambdaCube/Compiler/Infer.hs +++ b/src/LambdaCube/Compiler/Infer.hs | |||
@@ -192,7 +192,7 @@ fntable = | |||
192 | , (,) "EQ" FEQ | 192 | , (,) "EQ" FEQ |
193 | , (,) "TT" FTT | 193 | , (,) "TT" FTT |
194 | , (,) "Nil" FNil | 194 | , (,) "Nil" FNil |
195 | , (,) "Cons" FCons | 195 | , (,) ":" FCons |
196 | , (,) "'Split" FSplit | 196 | , (,) "'Split" FSplit |
197 | ] | 197 | ] |
198 | 198 | ||
diff --git a/src/LambdaCube/Compiler/Lexer.hs b/src/LambdaCube/Compiler/Lexer.hs index e10ac817..9f5e1c7d 100644 --- a/src/LambdaCube/Compiler/Lexer.hs +++ b/src/LambdaCube/Compiler/Lexer.hs | |||
@@ -233,10 +233,7 @@ expect msg p i = i >>= \n -> if p n then unexpected (msg ++ " " ++ show n) else | |||
233 | 233 | ||
234 | identifier name = lexemeName $ try $ expect "reserved word" (`Set.member` theReservedNames) name | 234 | identifier name = lexemeName $ try $ expect "reserved word" (`Set.member` theReservedNames) name |
235 | 235 | ||
236 | operator name = lexemeName $ try $ trCons <$> expect "reserved operator" (`Set.member` theReservedOpNames) name | 236 | operator name = lexemeName $ try $ expect "reserved operator" (`Set.member` theReservedOpNames) name |
237 | where | ||
238 | trCons ":" = "Cons" | ||
239 | trCons x = x | ||
240 | 237 | ||
241 | theReservedOpNames = Set.fromList ["::","..","=","\\","|","<-","->","@","~","=>"] | 238 | theReservedOpNames = Set.fromList ["::","..","=","\\","|","<-","->","@","~","=>"] |
242 | 239 | ||
diff --git a/src/LambdaCube/Compiler/Parser.hs b/src/LambdaCube/Compiler/Parser.hs index 70525cba..8f457e49 100644 --- a/src/LambdaCube/Compiler/Parser.hs +++ b/src/LambdaCube/Compiler/Parser.hs | |||
@@ -404,7 +404,7 @@ parseDef = | |||
404 | (af, cs) <- option (True, []) $ | 404 | (af, cs) <- option (True, []) $ |
405 | (,) True . map (second $ (,) Nothing) . concat <$ reserved "where" <*> identation True (typedIds id npsd Nothing) | 405 | (,) True . map (second $ (,) Nothing) . concat <$ reserved "where" <*> identation True (typedIds id npsd Nothing) |
406 | <|> (,) False <$ reservedOp "=" <*> | 406 | <|> (,) False <$ reservedOp "=" <*> |
407 | sepBy1 ((,) <$> addFixity' upperCase | 407 | sepBy1 ((,) <$> (addFixity' upperCase <|> parens (addFixity colonSymbols)) |
408 | <*> (mkConTy True <$> braces telescopeDataFields <|> mkConTy False <$> telescope Nothing) | 408 | <*> (mkConTy True <$> braces telescopeDataFields <|> mkConTy False <$> telescope Nothing) |
409 | ) | 409 | ) |
410 | (reservedOp "|") | 410 | (reservedOp "|") |
diff --git a/src/LambdaCube/Compiler/Patterns.hs b/src/LambdaCube/Compiler/Patterns.hs index a6b96d58..856de00d 100644 --- a/src/LambdaCube/Compiler/Patterns.hs +++ b/src/LambdaCube/Compiler/Patterns.hs | |||
@@ -92,12 +92,12 @@ pBuiltin n = pBuiltin_ (SIName (debugSI $ "Constructor_" ++ n) n) | |||
92 | 92 | ||
93 | cTrue = pBuiltin "True" (Left ((CaseName "'Bool", 0), [("False", 0), ("True", 0)])) [] | 93 | cTrue = pBuiltin "True" (Left ((CaseName "'Bool", 0), [("False", 0), ("True", 0)])) [] |
94 | cZero = pBuiltin "Zero" (Left ((CaseName "'Nat", 0), [("Zero", 0), ("Succ", 1)])) [] | 94 | cZero = pBuiltin "Zero" (Left ((CaseName "'Nat", 0), [("Zero", 0), ("Succ", 1)])) [] |
95 | cNil = pBuiltin "Nil" (Left ((CaseName "'List", 0), [("Nil", 0), ("Cons", 2)])) [] | 95 | cNil = pBuiltin "Nil" (Left ((CaseName "'List", 0), [("Nil", 0), (":", 2)])) [] |
96 | cHNil = pBuiltin "HNil" (Left (("hlistNilCase", -1), [("HNil", 0)])) [] | 96 | cHNil = pBuiltin "HNil" (Left (("hlistNilCase", -1), [("HNil", 0)])) [] |
97 | cList a = pBuiltin "'List" (Right 1) [a] | 97 | cList a = pBuiltin "'List" (Right 1) [a] |
98 | cHList a = pBuiltin "'HList" (Right 1) [a] | 98 | cHList a = pBuiltin "'HList" (Right 1) [a] |
99 | cSucc a = pBuiltin "Succ" (Left ((CaseName "'Nat", 0), [("Zero", 0), ("Succ", 1)])) [a] | 99 | cSucc a = pBuiltin "Succ" (Left ((CaseName "'Nat", 0), [("Zero", 0), ("Succ", 1)])) [a] |
100 | cCons a b = pBuiltin_ (SIName_ mempty (Just $ InfixR 5) "Cons") (Left ((CaseName "'List", 0), [("Nil", 0), ("Cons", 2)])) [a, b] | 100 | cCons a b = pBuiltin_ ConsName (Left ((CaseName "'List", 0), [("Nil", 0), (":", 2)])) [a, b] |
101 | cHCons a b = pBuiltin "HCons" (Left (("hlistConsCase", -1), [("HCons", 2)])) [a, b] | 101 | cHCons a b = pBuiltin "HCons" (Left (("hlistConsCase", -1), [("HCons", 2)])) [a, b] |
102 | 102 | ||
103 | pattern PParens p = ViewPatSimp (SBuiltin "parens") p | 103 | pattern PParens p = ViewPatSimp (SBuiltin "parens") p |
diff --git a/src/LambdaCube/Compiler/Pretty.hs b/src/LambdaCube/Compiler/Pretty.hs index 204a9547..e7047a7e 100644 --- a/src/LambdaCube/Compiler/Pretty.hs +++ b/src/LambdaCube/Compiler/Pretty.hs | |||
@@ -175,7 +175,6 @@ renderDoc | |||
175 | addParA (ComplexAtom s i d a) = ComplexAtom s i (addPar tn (Infix i) d) $ addParA a | 175 | addParA (ComplexAtom s i d a) = ComplexAtom s i (addPar tn (Infix i) d) $ addParA a |
176 | 176 | ||
177 | addBackquotes "'EqCTt" = "~" | 177 | addBackquotes "'EqCTt" = "~" |
178 | addBackquotes "Cons" = ":" | ||
179 | addBackquotes s@(c:_) | isAlpha c || c == '_' || c == '\'' = '`': s ++ "`" | 178 | addBackquotes s@(c:_) | isAlpha c || c == '_' || c == '\'' = '`': s ++ "`" |
180 | addBackquotes s = s | 179 | addBackquotes s = s |
181 | 180 | ||