Backport #3498 (#3501)

savonet · Nov 2, 2023 · f60d3f9 · f60d3f9
1 parent 3dc336b
commit f60d3f9
Show file tree

Hide file tree

Showing 9 changed files with 38 additions and 12 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -19,6 +19,8 @@ Fixed:
 
 - Allow `channel_layout` argument in ffmpeg encoder to set the
   number of channels.
+- Improved support for unitary minus, fix runtime call of optional
+  methods (#3498)
 - Fixed reloading loop in playlists with invalid files (#3479)
 - Fixed main HLS playlist codecs when using `mpegts` (#3483)
 - Fixed pop/clicks in crossfade and source with caching (#3318)

diff --git a/src/lang/lexer.ml b/src/lang/lexer.ml
@@ -259,6 +259,7 @@ let rec token lexbuf =
     | ';' -> SEQ
     | ";;" -> SEQSEQ
     | "~" -> TILD
+    | "?." -> QUESTION_DOT
     | "?" -> QUESTION
     | "-" -> MINUS
     | "while" -> WHILE

diff --git a/src/lang/parser.mly b/src/lang/parser.mly
@@ -44,6 +44,7 @@ open Parser_helper
 %token <Parser_helper.lexer_let_decoration> LET
 %token <Parser_helper.lexer_let_decoration> LETLBRA
 %token BEGIN END GETS TILD QUESTION
+%token QUESTION_DOT
 (* name, arguments, methods *)
 %token <Doc.Value.t option*Parser_helper.let_decoration> DEF
 %token REPLACES
@@ -84,6 +85,7 @@ open Parser_helper
 %nonassoc QUESTION     (* x ? y : z *)
 %left BINB             (* ((x+(y*z))==3) or ((not a)==b) *)
 %left BIN1
+%left QUESTION_DOT
 %nonassoc NOT
 %left BIN2 MINUS
 %left BIN3 TIMES
@@ -96,6 +98,8 @@ open Parser_helper
 %nonassoc no_app
 %nonassoc LPAR
 
+%nonassoc UMINUS
+
 %start program
 %type <Term.t> program
 
@@ -204,9 +208,7 @@ simple_fun_body:
 (* General expressions. *)
 expr:
   | LPAR expr COLON ty RPAR          { mk ~pos:$loc (Cast ($2, $4)) }
-  | UMINUS FLOAT                     { mk ~pos:$loc (Ground (Float (-. $2))) }
-  | UMINUS INT                       { mk ~pos:$loc (Ground (Int (- $2))) }
-  | UMINUS LPAR expr RPAR            { mk ~pos:$loc (App (mk ~pos:$loc($1) (Var "~-"), ["", $3])) }
+  | UMINUS expr                      { mk ~pos:$loc (App (mk ~pos:$loc($1) (Var "~-"), ["", $2])) }
   | LPAR expr RPAR                   { $2 }
   | INT                              { mk ~pos:$loc (Ground (Int $1)) }
   | NOT expr                         { mk ~pos:$loc (App (mk ~pos:$loc($1) (Var "not"), ["", $2])) }
@@ -226,7 +228,7 @@ expr:
                                      { $2 ~pos:$loc $5 }
   | LCUR record RCUR                 { $2 ~pos:$loc (mk ~pos:$loc (Tuple [])) }
   | LCUR RCUR                        { mk ~pos:$loc (Tuple []) }
-  | expr QUESTION DOT invoke         { mk_invoke ~pos:$loc ~default:(mk ~pos:$loc Null) $1 $4 }
+  | expr QUESTION_DOT invoke         { mk_invoke ~pos:$loc ~default:(mk ~pos:$loc Null) $1 $3 }
   | expr DOT invoke                  { mk_invoke ~pos:$loc $1 $3 }
   | VARLPAR app_list RPAR            { mk ~pos:$loc (App (mk ~pos:$loc($1) (Var $1), $2)) }
   | expr COLONCOLON expr             { mk ~pos:$loc (App (mk ~pos:$loc($2) (Var "_::_"), ["", $1; "", $3])) }

diff --git a/src/lang/preprocessor.ml b/src/lang/preprocessor.ml
@@ -516,8 +516,11 @@ let uminus tokenizer =
   let was_number = ref false in
   let token () =
     match tokenizer () with
-      | (Parser.INT _, _ | Parser.FLOAT _, _ | Parser.VAR _, _ | Parser.RPAR, _)
-        as t ->
+      | ( Parser.INT _, _
+        | Parser.FLOAT _, _
+        | Parser.VAR _, _
+        | Parser.RPAR, _
+        | Parser.RCUR, _ ) as t ->
           was_number := true;
           t
       | Parser.MINUS, pos when not !was_number ->

diff --git a/src/lang/typechecking.ml b/src/lang/typechecking.ml
@@ -216,7 +216,8 @@ let rec check ?(print_toplevel = false) ~throw ~level ~(env : Typing.env) e =
           check ~level ~env a;
           let rec aux t =
             match (Type.deref t).Type.descr with
-              | Type.(Meth ({ meth = l'; scheme = s }, _)) when l = l' ->
+              | Type.(Meth ({ meth = l'; scheme = s; optional = false }, _))
+                when l = l' ->
                   (fst s, Typing.instantiate ~level s)
               | Type.(Meth (_, c)) -> aux c
               | _ ->

diff --git a/tests/language/math.liq b/tests/language/math.liq
@@ -14,6 +14,18 @@ def f() =
   if abs(dB_of_lin(lin_of_dB(x))-x) >= epsilon then success := false end
   if abs(lin_of_dB(dB_of_lin(x))-x) >= epsilon then success := false end
 
+  y = -x
+  test.equals(y, -5.)
+  test.equals(y == -5., true)
+
+  y = 1 + -2
+  test.equals(y, -1)
+
+  def f() =
+    1 + -2
+  end
+  test.equals(f(), -1)
+
   if !success then test.pass() else test.fail() end
 end
 

diff --git a/tests/language/record.liq b/tests/language/record.liq
@@ -229,6 +229,11 @@ def f() =
   end
   g({blo="bla"})
 
+  x = 1
+  y = x.{foo=123} - 3
+  test.equals("#{y}", "#{-2}")
+
+
   test.pass()
 end
 

diff --git a/tests/regression/ffmpeg-copy-encode.liq b/tests/regression/ffmpeg-copy-encode.liq
@@ -9,7 +9,7 @@ def f() =
       streams: [{channels?: int}]
     }) = j
 
-    if s1.channels != 2 or s2.channels != 1 then
+    if s1?.channels != 2 or s2?.channels != 1 then
       test.fail()
     end
 

diff --git a/tests/regression/ffmpeg-naming-convention.liq b/tests/regression/ffmpeg-naming-convention.liq
@@ -25,10 +25,10 @@ def f() =
       streams: [{codec_type: string, channels?: int}]
     }) = j
 
-    test.equals(s1.channels, 2)
-    test.equals(s2.channels, 1)
-    test.equals(s3.channels, 2)
-    test.equals(s4.channels, 1)
+    test.equals(s1?.channels, 2)
+    test.equals(s2?.channels, 1)
+    test.equals(s3?.channels, 2)
+    test.equals(s4?.channels, 1)
     test.equals(s5.codec_type, "video")
     test.equals(s6.codec_type, "video")