Skip to content

Commit

Permalink
Fixed rules violations, more than just my own, and tests
Browse files Browse the repository at this point in the history
  • Loading branch information
yung-turabian committed Feb 18, 2025
1 parent fc261ba commit a41ccd2
Show file tree
Hide file tree
Showing 7 changed files with 36 additions and 17 deletions.
12 changes: 6 additions & 6 deletions core/lib.ml
Original file line number Diff line number Diff line change
Expand Up @@ -62,11 +62,11 @@ let string_op impl pure : located_primitive * Types.datatype * pure =

let numeric_op impli implf purei puref : located_primitive * Types.datatype * pure =
(`PFun (fun _ args -> match args with
| [x; y] ->
| [x; y] ->
(match (x,y) with
| (`Int _, `Int _) -> Lwt.return (`Int (impli (Value.unbox_int x) (Value.unbox_int y)))
| (`Float _, `Float _) -> Lwt.return (`Float (implf (Value.unbox_float x) (Value.unbox_float y)))
| _ -> raise (runtime_type_error "type error in numeric operation"))
| _ -> raise (runtime_type_error "type error in numeric operation"))
| _ -> raise (internal_error "arity error in numeric operation"))),
datatype "(a::Numeric, a) -> a",
F2 (fun l r -> match (l, r) with
Expand Down Expand Up @@ -260,13 +260,13 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [

"^^", string_op ( ^ ) PURE;

(* moved abs to make use of ad hoc ability,
ideally there could be a way to bootstrap prelude similar to #786 *)
(* moved abs to make use of ad hoc ability,
ideally there could be a way to bootstrap Prelude similar to #786 *)
"abs",
(p1 (fun n -> match n with
| `Int _ -> Value.box_int ( let x = (Value.unbox_int n) in if x > 0 then x else -x )
| `Float _ -> Value.box_float ( let x = (Value.unbox_float n) in if x > 0.0 then x else -.x )
| _ -> raise (runtime_type_error ("Cannot computer absolute value: " ^ Value.string_of_value n))),
| _ -> raise (runtime_type_error ("Cannot computer absolute value: " ^ Value.string_of_value n))),
datatype "(a::Numeric) -> a",
PURE);

Expand Down Expand Up @@ -763,7 +763,7 @@ let env : (string * (located_primitive * Types.datatype * pure)) list = [
(p1 (fun n -> match n with
| `Int _ -> Value.box_int (- (Value.unbox_int n))
| `Float _ -> Value.box_float (-. (Value.unbox_float n))
| _ -> raise (runtime_type_error ("Cannot negate: " ^ Value.string_of_value n))),
| _ -> raise (runtime_type_error ("Cannot negate: " ^ Value.string_of_value n))),
datatype "(a::Numeric) -> a",
PURE);

Expand Down
2 changes: 1 addition & 1 deletion core/transformSugar.ml
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ let type_binary_op env tycon_env =
| Name "!" -> TyEnv.find "Send" env
| Name "+"
| Name "*"
| Name "/"
| Name "/"
| Name "^" -> datatype "(a::Numeric, a) -> a"
| Name n -> TyEnv.find n env

Expand Down
6 changes: 3 additions & 3 deletions core/typeSugar.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2021,9 +2021,9 @@ let type_binary_op pos ctxt =
Function (Types.make_tuple_type [a; a], eff, Primitive Primitive.Bool),
Usage.empty)
| Name "!" -> add_empty_usages (Utils.instantiate ctxt.var_env "Send")
| Name "+"
| Name "*"
| Name "/"
| Name "+"
| Name "*"
| Name "/"
| Name "^" -> add_empty_usages (datatype "(a::Numeric, a) -> a")
| Name n ->
try
Expand Down
9 changes: 6 additions & 3 deletions lens/lens_format.mli
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,8 @@ val pp_comma : unit fmt_fn

(** Format a list as comma separated values.
Example: {[
Example:
{[
Format.asprintf "%a" (Format.pp_comma_list Format.pp_print_int) [5, 6, 7]
]}
Expand All @@ -26,7 +27,8 @@ val pp_comma_list : 'a fmt_fn -> 'a list fmt_fn

(** Format a list of string as comma separated values.
Example: {[
Example:
{[
Format.asprintf "%a" Format.pp_comma_string_list ["hello", "world"]
]}
Expand All @@ -39,7 +41,8 @@ val pp_newline_list : 'a fmt_fn -> 'a list fmt_fn

(** Pad a string so it has [length] characters.
Example: {[
Example:
{[
Format.asprintf "%a - %s"
(Format.pp_padded ~length:8 Format.pp_print_string) "hello" "world"
]}
Expand Down
2 changes: 1 addition & 1 deletion lens/phrase.mli
Original file line number Diff line number Diff line change
Expand Up @@ -199,7 +199,7 @@ module Grouped_variables : sig
Example:
When called on the set `{ A; A B; C D; }` with the cols `A B`, the
When called on the set `{! A; A B; C D; }` with the cols `A B`, the
result is false because `A B` only occurs in groups without further
variables. If it is called with cols `C`, then it returns true, because
the group `C D` contains the column `D` in addition to the column `C`. *)
Expand Down
16 changes: 16 additions & 0 deletions tests/numeric-operations.tests
Original file line number Diff line number Diff line change
Expand Up @@ -82,3 +82,19 @@ stdout : inf : Float
Float division by zero [2]
(-1.0) / 0.0
stdout : -inf : Float

Large floating-point numbers
1.0e308 + 1.0e308
stdout : inf : Float

Small floating-point numbers
1.0e-308 + 1.0e-308
stdout : 2e-308 : Float

Additive identity
5 + 0
stdout : 5 : Int

Multiplicative identity
5.0 * 1.0
stdout : 5.0 : Float
6 changes: 3 additions & 3 deletions tests/unit/ir/schinks.mli
Original file line number Diff line number Diff line change
Expand Up @@ -75,18 +75,18 @@ val fun_t :
?effects:Types.row t -> Types.typ t list -> Types.typ t -> Types.typ t

(** Syntactic sugar for fun_t.
a .-->{e} b becomes Function(a,e,b).
a .-->{!e} b becomes Function(a,e,b).
This operator is left-associative, use parantheses when nesting! *)
val ( .-->{} ) : Types.typ t list -> Types.row t -> Types.typ t -> Types.typ t

(** Equivalent to {}-> in Links' syntactic sugar for function types
(** Equivalent to \{\}-> in Links' syntactic sugar for function types
Shorthand for closed function types (using tuple for parameters) *)
val fun_ct : Types.typ t list -> Types.typ t -> Types.typ t

(** alias for fun_ct *)
val ( |--> ) : Types.typ t list -> Types.typ t -> Types.typ t

(** Equivalent to {}~> in Links' syntactic sugar for function types *)
(** Equivalent to \{\}~> in Links' syntactic sugar for function types *)
val wild_fun_ct : Types.typ t list -> Types.typ t -> Types.typ t

(** alias for wild_fun_ct *)
Expand Down

0 comments on commit a41ccd2

Please sign in to comment.