Uminus improvements.

.gitignore

@@ -14,3 +14,4 @@ package-lock.json
 src/tooling/prettier-plugin-liquidsoap/dist/liquidsoap.js
 src/tooling/prettier-plugin-liquidsoap/dist/web.mjs
 src/tooling/prettier-plugin-liquidsoap/dist/node.js
+*.conflicts

src/lang/parser.mly

@@ -98,6 +98,8 @@ open Parser_helper
 %nonassoc no_app
 %nonassoc LPAR
 
+%nonassoc UMINUS
+
 %start program
 %type <Term.t> program
 
@@ -200,23 +202,15 @@ simple_fun_body:
   | explicit_binding s       { mk_let ~pos:$loc($1) $1 (mk ~pos:$loc unit) }
   | explicit_binding s exprs { mk_let ~pos:$loc($1) $1 $3 }
 
-parenthesis_expr:
-  | LPAR expr RPAR           { mk ~pos:$loc (`Parenthesis $2) }
-
 (* General expressions. *)
 expr:
   | INCLUDE                          { mk ~pos:$loc (`Include $1) }
   | if_def                           { mk ~pos:$loc (`If_def $1) }
   | if_encoder                       { mk ~pos:$loc (`If_encoder $1) }
   | if_version                       { mk ~pos:$loc (`If_version $1) }
   | LPAR expr COLON ty RPAR          { mk ~pos:$loc (`Cast ($2, $4)) }
-  | UMINUS FLOAT                     {
-      let (ipart, fpart) = $2 in
-      mk ~pos:$loc (`Float (false, ipart, fpart))
-  }
-  | UMINUS INT                       { mk ~pos:$loc (`Int ("-" ^ $2)) }
-  | UMINUS parenthesis_expr          { mk ~pos:$loc (`Negative $2) }
-  | parenthesis_expr                 { $1 }
+  | UMINUS expr                      { mk ~pos:$loc (`Negative $2) }
+  | LPAR expr RPAR                   { mk ~pos:$loc (`Parenthesis $2) }
   | INT                              { mk ~pos:$loc (`Int $1) }
   | NOT expr                         { mk ~pos:$loc (`Not $2) }
   | BOOL                             { mk ~pos:$loc (`Ground (Bool $1)) }

src/lang/preprocessor.ml

@@ -133,8 +133,11 @@ let uminus tokenizer =
   let no_uminus = 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 ->
           no_uminus := true;
           t
       | Parser.MINUS, pos when not !no_uminus ->

src/lang/typechecking.ml

@@ -224,7 +224,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
               | _ ->

tests/core/more_types.ml

@@ -61,3 +61,30 @@ let () =
           | [{ Type.meth = "foo"; optional = true; _ }] -> ()
           | _ -> assert false)
     | _ -> assert false
+
+exception Failed
+
+let () =
+  (* term = (1 : int.{opt?: string}).foo *)
+  let typ = Type.meth ~optional:true "opt" ([], Lang.string_t) Lang.int_t in
+  let term =
+    {
+      Term.t = typ;
+      term = `Ground (Term.Ground.Int 1);
+      methods = Term.Methods.empty;
+    }
+  in
+  let invoke =
+    {
+      Term.t = Lang.univ_t ();
+      term =
+        `Invoke { Term.invoked = term; invoke_default = None; meth = "opt" };
+      methods = Term.Methods.empty;
+    }
+  in
+  try
+    Typechecking.check ~throw:(fun exn -> raise exn) invoke;
+    raise Failed
+  with
+    | Failed -> raise Failed
+    | _ -> ()

tests/language/math.liq

@@ -6,6 +6,10 @@ def test_db_lin() =
   test.almost_equals(dB_of_lin(lin_of_dB(x)), x)
   test.almost_equals(lin_of_dB(dB_of_lin(x)), x)
 
+  y = -x
+  test.equals(y, -5.)
+  test.equals(y == -5., true)
+
   test.pass()
 end
 

tests/language/record.liq

@@ -271,6 +271,11 @@ def f() =
 
   let json.parse.foo = 456
 
+  x = 1
+  y = x.{foo=123}
+  -3
+  test.equals("#{y}", "#{-2}")
+
   test.pass()
 end