Fix #685.

diku-dk · Dec 23, 2018 · b47154b · b47154b
1 parent ad638ec
commit b47154b
Show file tree

Hide file tree

Showing 5 changed files with 23 additions and 11 deletions.
diff --git a/src/Futhark/Test/Values.hs b/src/Futhark/Test/Values.hs
@@ -358,15 +358,15 @@ readFloat f t = do
 readFloat32 :: ReadValue Float
 readFloat32 = readFloat lexFloat32
   where lexFloat32 [F32LIT x] = Just x
-        lexFloat32 [ID "f32", DOT, ID "inf"] = Just $ 1/0
-        lexFloat32 [ID "f32", DOT, ID "nan"] = Just $ 0/0
+        lexFloat32 [ID "f32", PROJ_FIELD "inf"] = Just $ 1/0
+        lexFloat32 [ID "f32", PROJ_FIELD "nan"] = Just $ 0/0
         lexFloat32 _ = Nothing
 
 readFloat64 :: ReadValue Double
 readFloat64 = readFloat lexFloat64
   where lexFloat64 [F64LIT x] = Just x
-        lexFloat64 [ID "f64", DOT, ID "inf"] = Just $ 1/0
-        lexFloat64 [ID "f64", DOT, ID "nan"] = Just $ 0/0
+        lexFloat64 [ID "f64", PROJ_FIELD "inf"] = Just $ 1/0
+        lexFloat64 [ID "f64", PROJ_FIELD "nan"] = Just $ 0/0
         lexFloat64 _          = Nothing
 
 readBool :: ReadValue Bool

diff --git a/src/Language/Futhark/Parser/Lexer.x b/src/Language/Futhark/Parser/Lexer.x
@@ -77,7 +77,6 @@ tokens :-
   "_"                      { tokenC UNDERSCORE }
   "->"                     { tokenC RIGHT_ARROW }
   ":"                      { tokenC COLON }
-  "."                      { tokenC DOT }
   "\"                      { tokenC BACKSLASH }
   "'"                      { tokenC APOSTROPHE }
   "'^"                     { tokenC APOSTROPHE_THEN_HAT }
@@ -118,6 +117,9 @@ tokens :-
 
   @binop                   { tokenM $ return . symbol [] . nameFromText }
   @qualbinop               { tokenM $ \s -> do (qs,k) <- mkQualId s; return (symbol qs k) }
+
+  "." (@identifier|[0-9]+) { tokenM $ return . PROJ_FIELD . nameFromText . T.drop 1 }
+  "." "["                  { tokenC PROJ_INDEX }
 {
 
 keyword :: T.Text -> Token
@@ -298,6 +300,8 @@ data Token = ID Name
            | QUALUNOP [Name] Name
            | SYMBOL BinOp [Name] Name
            | CONSTRUCTOR Name
+           | PROJ_FIELD Name
+           | PROJ_INDEX
 
            | INTLIT Integer
            | STRINGLIT String
@@ -319,7 +323,6 @@ data Token = ID Name
            | APOSTROPHE
            | APOSTROPHE_THEN_HAT
            | BACKTICK
-           | DOT
            | TWO_DOTS
            | TWO_DOTS_LT
            | TWO_DOTS_GT

diff --git a/src/Language/Futhark/Parser/Parser.y b/src/Language/Futhark/Parser/Parser.y
@@ -71,6 +71,9 @@ import Language.Futhark.Parser.Lexer
 
       constructor     { L _ (CONSTRUCTOR _) }
 
+      '.field'        { L _ (PROJ_FIELD _) }
+      '.['            { L _ PROJ_INDEX }
+
       intlit          { L _ (INTLIT _) }
       i8lit           { L _ (I8LIT _) }
       i16lit          { L _ (I16LIT _) }
@@ -138,7 +141,6 @@ import Language.Futhark.Parser.Lexer
       entry           { L $$ ENTRY }
       '->'            { L $$ RIGHT_ARROW }
       ':'             { L $$ COLON }
-      '.'             { L $$ DOT }
       for             { L $$ FOR }
       do              { L $$ DO }
       with            { L $$ WITH }
@@ -634,8 +636,8 @@ Atom : PrimLit        { Literal (fst $1) (snd $1) }
      | '(' FieldAccess FieldAccesses ')'
        { ProjectSection (map fst ($2:$3)) NoInfo (srcspan $1 $>) }
 
-     | '(' '.' '[' DimIndices ']' ')'
-       { IndexSection $4 NoInfo (srcspan $1 $>) }
+     | '(' '.[' DimIndices ']' ')'
+       { IndexSection $3 NoInfo (srcspan $1 $>) }
 
 
 PrimLit :: { (PrimValue, SrcLoc) }
@@ -668,7 +670,7 @@ Exps1_ :: { ([UncheckedExp], UncheckedExp) }
         | Exp            { ([], $1) }
 
 FieldAccess :: { (Name, SrcLoc) }
-             : '.' FieldId { (fst $2, srcspan $1 (snd $>)) }
+             : '.field' { let L loc (PROJ_FIELD f) = $1 in (f, loc) }
 
 FieldAccesses :: { [(Name, SrcLoc)] }
                : FieldAccess FieldAccesses { $1 : $2 }

diff --git a/tests/proj3.fut b/tests/proj3.fut
@@ -1,4 +1,4 @@
--- Can we map a deeper tuple projection?
+-- Can we map a deeper record projection?
 -- ==
 -- input { [1,2] [3,4] }
 -- output { [1,2] }

diff --git a/tests/proj4.fut b/tests/proj4.fut
@@ -0,0 +1,7 @@
+-- Can we map a deeper tuple projection?
+-- ==
+-- input { [1,2] [3,4] }
+-- output { [1,2] }
+
+let main (xs: []i32) (ys: []i32): []i32 =
+  map (.1.1) (map2 (\x y -> ((x,x), y)) xs ys)