Skip to content
Browse files

Got more complete patterns parsing.

  • Loading branch information...
1 parent 5be5c9f commit bc7ab55154aa5c8a3ba3cb83687c0e4fa80fbc4f @tomahawkins committed
Showing with 50 additions and 18 deletions.
  1. +24 −1 Tutorial.atom
  2. +1 −1 atom.vim
  3. +8 −4 src/AST.hs
  4. +2 −1 src/Parser/Lex.x
  5. +14 −11 src/Parser/Parse.y
  6. +1 −0 src/Parser/Tokens.hs
View
25 Tutorial.atom
@@ -3,7 +3,7 @@
-- Comments look like this.
{- And like this. -}
-{- These comments can be {- nested -} . -}
+{- Comments can be {- nested -} . -}
-- Named values have a type and value in one line:
someBoolean :: Bool = true;
@@ -26,3 +26,26 @@ infixl 6 +
-- Lambda expressions. Note the '=' instead of '->':
add :: Int -> Int -> Int = \ a b = a + b;
+-- Recursive let (where) bindings.
+something :: Int -> Bool | arg = c
+ where
+ a :: Bool = false;
+ b :: Bool = true;
+ c :: Bool = a && b;
+ ;
+
+-- Datatype definitions:
+datatype Something param1 param2 = constructor1 | constructor2 param1 | constructor3 param2 Bool;
+
+-- Case (pattern matching) expressions:
+match :: Something -> SomethingElse | a = case a of
+ contructor1 = ();
+ constructor2 a = ();
+ c@(constructor3 a b)
+ | guard1 = ()
+ | guard2 = ()
+ | otherwise = ();
+ _ = ();
+ ;
+
+
View
2 atom.vim
@@ -60,7 +60,7 @@ syn match hsImport "\<import\>.*"he=s+6 contains=hsImportMod,hsLineComment,hsBl
syn match hsImportMod contained "\<\(as\|qualified\|hiding\)\>"
syn match hsExport "\<export\>"
syn match hsInfix "\<\(infix\|infixl\|infixr\)\>"
-syn match hsStructure "\<\(class\|data\|deriving\|instance\|default\|where\)\>"
+syn match hsStructure "\<\(class\|datatype\|deriving\|instance\|default\|where\)\>"
syn match hsTypedef "\<\(type\|newtype\)\>"
syn match hsStatement "\<\(do\|case\|of\|let\|in\)\>"
syn match hsConditional "\<\(if\|then\|else\)\>"
View
12 src/AST.hs
@@ -59,14 +59,18 @@ instance Locate Expr where
Case a _ _ -> a
data Pattern
- = Wildcard L
- | Constructor L Name
+ = Wildcard L
+ | PatternVar L Name
+ | PatternApply L Pattern Pattern
+ | As L Name Pattern
deriving Show
instance Locate Pattern where
locate a = case a of
- Wildcard a -> a
- Constructor a _ -> a
+ Wildcard a -> a
+ PatternVar a _ -> a
+ PatternApply a _ _ -> a
+ As a _ _ -> a
data Guard
= Unguarded L Expr
View
3 src/Parser/Lex.x
@@ -36,10 +36,11 @@ tokens :-
"=" { tok Equal }
"::" { tok ColonColon }
";" { tok Semi }
- "`" { tok Tic }
+ --"`" { tok Tic }
"|" { tok Pipe }
"\" { tok Backslash }
"_" { tok Underscore }
+ "@" { tok At }
@idUpper { tok IdUpper }
@idLower { tok IdLower }
View
25 src/Parser/Parse.y
@@ -37,10 +37,11 @@ idUpper { Token IdUpper _ _ }
"::" { Token ColonColon _ _ }
"=" { Token Equal _ _ }
";" { Token Semi _ _ }
-"`" { Token Tic _ _ }
+--"`" { Token Tic _ _ }
"|" { Token Pipe _ _ }
"\\" { Token Backslash _ _ }
"_" { Token Underscore _ _ }
+"@" { Token At _ _ }
"infixl9" { Token InfixL9 _ _ } "infixr9" { Token InfixR9 _ _ } "infix9" { Token Infix9 _ _ }
"infixl8" { Token InfixL8 _ _ } "infixr8" { Token InfixR8 _ _ } "infix8" { Token Infix8 _ _ }
@@ -70,7 +71,7 @@ Value :: { Value }
| ValueId "::" Expression "|" IdLowers_ "=" Expression ";" { Value (fst $1) (snd $1) (Just $3) $5 $7 }
Values :: { [Value] }
-: { [] }
+: { [] }
| Values Value { $1 ++ [$2] }
ValueId :: { (Location, Name) }
@@ -86,7 +87,7 @@ IdLowers :: { [Name] }
Constructors :: { [(Location, Name, [Expr])] }
: IdLower Expressions { [(fst $1, snd $1, $2)] }
-| Constructors "|" IdUpper Expressions { $1 ++ [(fst $3, snd $3, $4)] }
+| Constructors "|" IdLower Expressions { $1 ++ [(fst $3, snd $3, $4)] }
IdLower :: { (Location, Name) }
: idLower { tokenLocStr $1 }
@@ -105,7 +106,7 @@ Operator :: { (Location, Name) }
| "infix7" { tokenLocStr $1 } | "infixl7" { tokenLocStr $1 } | "infixr7" { tokenLocStr $1 }
| "infix8" { tokenLocStr $1 } | "infixl8" { tokenLocStr $1 } | "infixr8" { tokenLocStr $1 }
| "infix9" { tokenLocStr $1 } | "infixl9" { tokenLocStr $1 } | "infixr9" { tokenLocStr $1 }
-| "`" IdLower "`" { $2 }
+--| "`" IdLower "`" { $2 }
Cases :: { [(Pattern, Guard)] }
: Case { [$1] }
@@ -123,15 +124,17 @@ Pattern :: { Pattern }
: Pattern0 { $1 }
Pattern0 :: { Pattern }
-: Pattern1 { $1 }
+: Pattern0 Pattern1 { PatternApply (locate $1) $1 $2 }
+| Pattern1 { $1 }
Pattern1 :: { Pattern }
-: "_" { Wildcard $ locate $1 }
-| IdLower { Constructor (fst $1) (snd $1) }
+: IdLower "@" Pattern1 { As (locate $2) (snd $1) $3 }
+| Pattern2 { $1 }
-Patterns :: { [Pattern] }
-: { [] }
-| Patterns Pattern { $1 ++ [$2] }
+Pattern2 :: { Pattern }
+: "_" { Wildcard $ locate $1 }
+| IdLower { PatternVar (fst $1) (snd $1) }
+| "(" Pattern ")" { $2 }
DoItem :: { () }
: "let" Value { () }
@@ -155,7 +158,7 @@ Expr0 :: { Expr }
| "case" Expr0 "of" Cases { Case (locate $1) $2 $4 }
| Expr1 "::" Expr0 { ApplyContract (locate $2) $1 $3 }
| "do" DoItems { undefined }
-| Expr0a { $1 }
+| Expr1 { $1 }
Expr1 :: { Expr }
: Expr1 "where" Values { Where (locate $1) $1 $3 }
View
1 src/Parser/Tokens.hs
@@ -33,6 +33,7 @@ data TokenName
| Pipe
| Backslash
| Underscore
+ | At
| Unit
| KW_case

0 comments on commit bc7ab55

Please sign in to comment.
Something went wrong with that request. Please try again.