Add tuple projection tokens

src/boot/lib/lexer.mll

@@ -203,12 +203,14 @@ rule main = parse
       { mklcid s }
   | uident as s
       { mkucid s }
+  | '.' (unsigned_integer as s)
+      { mkid (fun t -> Parser.TUP_PROJ_LABEL t) s }
   | '\'' ((s_escape | utf8) as c) '\''
       { let s = Ustring.from_utf8 c in
         let esc_s = Ustring.convert_escaped_chars s in
         Parser.CHAR{i=mkinfo_ustring (us"'" ^. s ^. us"'"); v=esc_s}}
   | '#' (("con" | "type" | "var" | "label" | "frozen") as ident) '"'
-       { Buffer.reset string_buf ;  parsestring lexbuf;
+       { Buffer.reset string_buf; parsestring lexbuf;
 	 let s = Ustring.from_utf8 (Buffer.contents string_buf) in
          let id = Ustring.convert_escaped_chars s  in
          let fi = mkinfo_ustring (s ^. us"  #" ^. us(ident)) in
@@ -220,9 +222,9 @@ rule main = parse
             | "frozen" -> Parser.FROZEN_IDENT{i=fi; v=id}
             | _ -> failwith "Cannot happen")
          in
-	 add_colno 3; colcount_fast ident; rval}
+	 add_colno 3; colcount_fast ident; rval }
   | '"'
-      { Buffer.reset string_buf ;  parsestring lexbuf;
+      { Buffer.reset string_buf; parsestring lexbuf;
 	 let s = Ustring.from_utf8 (Buffer.contents string_buf) in
          let esc_s = Ustring.convert_escaped_chars s in
 	 let rval = Parser.STRING{i=mkinfo_ustring (s ^. us"  "); v=esc_s} in

src/boot/lib/parser.mly

@@ -27,6 +27,11 @@
   let set_con_params params = function
     | CDecl (fi, _, name, ty) -> CDecl (fi, params, name, ty)
 
+  let record_proj fi tm label =
+    let id = unique_ident in
+    let pat_named = (PatNamed(fi,NameStr(id,Symb.Helpers.nosym))) in
+    let pat = PatRecord(fi,Record.singleton label pat_named) in
+    TmMatch(fi,tm,pat,TmVar(fi,id,Symb.Helpers.nosym,false,false), TmNever(fi))
 
 %}
 
@@ -41,6 +46,7 @@
 %token <Ustring.ustring Ast.tokendata> LABEL_IDENT
 %token <Ustring.ustring Ast.tokendata> UC_IDENT  /* An identifier that starts with an upper-case letter */
 %token <Ustring.ustring Ast.tokendata> LC_IDENT  /* An identifier that starts with "_" or a lower-case letter */
+%token <Ustring.ustring Ast.tokendata> TUP_PROJ_LABEL
 %token <Ustring.ustring Ast.tokendata> STRING
 %token <Ustring.ustring Ast.tokendata> CHAR
 %token <int Ast.tokendata> UINT
@@ -418,11 +424,10 @@ swcases:
       { TmNever($1.i) }
 
 atom:
-  | atom DOT proj_label
-      { let fi = mkinfo (tm_info $1) (fst $3) in
-        let id = unique_ident in
-        TmMatch(fi,$1,PatRecord(fi,Record.singleton (snd $3) (PatNamed(fi,NameStr(id,Symb.Helpers.nosym)))),
-                                TmVar(fi,id,Symb.Helpers.nosym,false,false), TmNever(fi)) }
+  | atom DOT label_ident
+      { let fi = mkinfo (tm_info $1) $3.i in record_proj fi $1 $3.v }
+  | atom TUP_PROJ_LABEL
+      { let fi = mkinfo (tm_info $1) $2.i in record_proj fi $1 $2.v }
   | LPAREN seq RPAREN
       { if List.length $2 = 1 then List.hd $2
         else tuple2record (mkinfo $1.i $3.i) $2 }
@@ -450,14 +455,6 @@ atom:
           TmRecordUpdate (mkinfo $1.i $5.i, acc, k, v)
         ) $2 $4}
 
-proj_label:
-  | UINT
-    { ($1.i, ustring_of_int $1.v) }
-  | label_ident
-    { ($1.i,$1.v) }
-
-
-
 seq:
   | mexpr
       { [$1] }

stdlib/javascript/pprint.mc

@@ -28,7 +28,7 @@ let joinAsStatements = lam indent. lam seq.
   else join [pprintNewline indent, (strJoin (concat ";" (pprintNewline indent)) seq), ";"]
 
 
-let getNameStrDefault =  lam default: String.lam env. lam id: Name.
+let getNameStrDefault =  lam default: String. lam env. lam id: Name.
   if null (nameGetStr id) then (env, default)
   else if stringIsInt (nameGetStr id) then
     match pprintEnvGetStr env id with (env, str) in

stdlib/mexpr/boot-parser.mc

@@ -444,19 +444,19 @@ utest lside ["z1", "z2"] s with rside s in
 utest l_info ["_aas_12"] "  _aas_12 " with r_info 1 2 1 9 in
 
 -- TmLet, TmLam
-let s = "let y = lam x.x in y" in
+let s = "let y = lam x. x in y" in
 utest lsideClosed s with rside s in
-utest l_infoClosed "  \n lam x.x" with r_info 2 1 2 8 in
+utest l_infoClosed "  \n lam x. x" with r_info 2 1 2 9 in
 utest match parseMExprStringKeywords [] s with TmLet r then infoTm r.body else NoInfo ()
-with r_info 1 8 1 15 in
+with r_info 1 8 1 16 in
 utest l_info ["y"] "  let x = 4 in y  " with r_info 1 2 1 14 in
 let s = "(printLn x); 10" in
 utest lside ["printLn", "x"] s with rside s in
 
 -- TmRecLets, TmLam
-let s = "recursive let x = lam x.x in x" in
+let s = "recursive let x = lam x. x in x" in
 utest lsideClosed s with rside s in
-let s = "recursive let x = lam x.x let y = lam x. x in y" in
+let s = "recursive let x = lam x. x let y = lam x. x in y" in
 utest lsideClosed s with rside s in
 let s = "   recursive let x = 5 \n let foo = 7 in x " in
 utest l_infoClosed s with r_info 1 3 2 15 in
@@ -614,7 +614,7 @@ utest match parseMExprStringKeywords ["x"] s with TmMatch r then infoPat r.pat e
 with r_info 1 14 1 26 in
 
 -- TmUtest
-let s = "utest lam x.x with 4 in 0" in
+let s = "utest lam x. x with 4 in 0" in
 utest lsideClosed s with rside s in
 utest l_infoClosed "\n utest 3 with 4 in () " with r_info 2 1 2 18 in
 
@@ -633,8 +633,8 @@ utest lsideClosed s with rside s in
 utest l_infoClosed "   \n  external y! : Int in 1" with r_info 2 2 2 24 in
 
 -- TyUnknown
-let s = "let y:Unknown = lam x.x in y" in
-utest lsideClosed s with rside "let y = lam x.x in y" in
+let s = "let y:Unknown = lam x. x in y" in
+utest lsideClosed s with rside "let y = lam x. x in y" in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 13 in
 let s = "lam x:Int. lam y:Char. x" in
@@ -643,43 +643,43 @@ utest match parseMExprStringKeywords [] " \n lam x:Int. lam y:Char. x" with TmLa
 with r_info 2 7 2 10 in
 
 -- TyInt
-let s = "let y:Int = lam x.x in y" in
+let s = "let y:Int = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 9 in
 
 -- TyFloat
-let s = "let y:Float = lam x.x in y" in
+let s = "let y:Float = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 11 in
 
 -- TyChar
-let s = "let y:Char = lam x.x in y" in
+let s = "let y:Char = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 10 in
 
 -- TyArrow
-let s = "let y:Int->Int = lam x.x in y" in
+let s = "let y:Int->Int = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 14 in
 
 -- Nested TyArrow
-let s = "let y:[Float]->Int = lam x.x in y" in
+let s = "let y:[Float]->Int = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 18 in
 
 -- TySeq
-let s = "let y:[Int] = lam x.x in y" in
+let s = "let y:[Int] = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 11 in
 
 -- Nested TySeq
-let s = "let y:[{a:{a_1:Int,a_2:Float},b:{b_1:[Char],b_2:Float}}]= lam x.x in y" in
+let s = "let y:[{a:{a_1:Int,a_2:Float},b:{b_1:[Char],b_2:Float}}]= lam x. x in y" in
 let recTy = tyseq_ (tyrecord_ [
   ("a", tyrecord_ [
     ("a_1", tyint_),
@@ -695,13 +695,13 @@ utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot els
 with r_info 1 6 1 56 in
 
 -- TyTensor
-let s = "let y:Tensor[Int] = lam x.x in y" in
+let s = "let y:Tensor[Int] = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 17 in
 
 -- Nested TyTensor
-let s = "let y:{a:Tensor[Char],b:Float}= lam x.x in y" in
+let s = "let y:{a:Tensor[Char],b:Float}= lam x. x in y" in
 let recTy = tyseq_ (tyrecord_ [
     ("a", tytensor_ tychar_),
     ("b", tyfloat_)
@@ -715,14 +715,14 @@ utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot els
 with r_info 1 6 1 30 in
 
 -- TyRecord
-let s = "let y:{a:Int,b:[Char]} = lam x.x in y" in
+let s = "let y:{a:Int,b:[Char]} = lam x. x in y" in
 let recTy = tyrecord_ [("a", tyint_), ("b", tystr_)] in
 utest parseMExprStringKeywords [] s with typedLet recTy using eqExpr in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 22 in
 
 -- Nested TyRecord
-let s = "let y:{a:{a_1:Int,a_2:Float},b:{b_1:[Char],b_2:Float}} = lam x.x in y" in
+let s = "let y:{a:{a_1:Int,a_2:Float},b:{b_1:[Char],b_2:Float}} = lam x. x in y" in
 let recTy = tyrecord_ [
   ("a", tyrecord_ [
     ("a_1", tyint_),
@@ -735,44 +735,44 @@ utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot els
 with r_info 1 6 1 54 in
 
 -- TyVariant
-let s = "let y:<> = lam x.x in y" in
+let s = "let y:<> = lam x. x in y" in
 -- NOTE(caylak,2021-03-17): Parsing of TyVariant is not supported yet
 --utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 8 in
 
 -- TyVar
-let s = "let y:_asd = lam x.x in y" in
+let s = "let y:_asd = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 10 in
 
 -- TyAll
-let s = "let y:all x.x = lam x.x in y" in
+let s = "let y:all x. x = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
-with r_info 1 6 1 13 in
+with r_info 1 6 1 14 in
 
 -- Nested TyAll
-let s = "let y:all x.(all y.all z.z)->all w.w = lam x.x in y" in
+let s = "let y:all x. (all y. all z. z)->all w. w = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
-with r_info 1 6 1 36 in
+with r_info 1 6 1 40 in
 
 -- TyCon
-let s = "let y:Foo = lam x.x in y" in
+let s = "let y:Foo = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 6 1 9 in
 
 -- TyApp
-let s = "let y:(Int->Int)Int = lam x.x in y" in
+let s = "let y:(Int->Int)Int = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 7 1 19 in
 
 -- Nested TyApp
-let s = "let y:((Int->Int)Int->Int)Int = lam x.x in y" in
+let s = "let y:((Int->Int)Int->Int)Int = lam x. x in y" in
 utest lsideClosed s with rside s in
 utest match parseMExprStringKeywords [] s with TmLet l then infoTy l.tyAnnot else NoInfo ()
 with r_info 1 8 1 29 in

stdlib/mexpr/pprint.mc

@@ -583,14 +583,8 @@ lang RecordProjectionSyntaxSugarPrettyPrint = MExprIdentifierPrettyPrint +
     })
     ->
     match matchIsProj bindings exprName with Some fieldLabel then
-      -- NOTE(oerikss, 2023-05-29): nested tuple projections are parsed as
-      -- floats if we do not group them.
-      if and (isTupleLabel fieldLabel) (isTupleProj expr) then
-        match pprintCode indent env expr with (env, expr) in
-        (env, join ["(", expr, ").", pprintProjString fieldLabel])
-      else
-        match printParen indent env expr with (env, expr) in
-        (env, join [expr, ".", pprintProjString fieldLabel])
+      match printParen indent env expr with (env, expr) in
+      (env, join [expr, ".", pprintProjString fieldLabel])
     else pprintTmMatchIn indent env t
 end
 

test/mexpr/records.mc

@@ -27,6 +27,12 @@ let nested = {a = {b = 1}} in
 let arec = {nested.a with b = addi nested.a.b 1} in
 utest arec.b with 2 in
 
+let nested = (1,(2,3)) in
+utest nested.1.0 with 2 in
+utest nested .1 .0 with 2 in
+utest nested.#label"1".#label"0" with 2 in
+utest nested .#label"1" .#label"0" with 2 in
+
 -- test order of evaluation for record expressions by observing side effects
 let v = ref 0 in
 let r5 = {x = 10, y = 11, z = 12, a = 13} in
@@ -39,4 +45,9 @@ let r5mod = {r5 with
 
 utest r5mod with {x = 12, y = 14, z = 13, a = 17} in
 
+-- NOTE(oerikss, 2024-01-10): Checks so that the parser does not confuse .x with
+-- a record projection. However, lam x.1 will not parse as .1 is tokenized as a
+-- tuple projection label.
+utest (lam x.x) 1 with 1 in
+
 ()