Compare commits

...

5 Commits

Author SHA1 Message Date
Leonardo de Moura
933055e1d1 test: more tests 2025-05-07 10:04:56 +02:00
Leonardo de Moura
810a4b31b5 fix: unintended inlining for Repr 2025-05-07 09:56:34 +02:00
Leonardo de Moura
1733be8649 fix: namespaces 2025-05-07 07:00:08 +01:00
Leonardo de Moura
f7f745ab83 fix: unintended inlining in FromJson and ToJson instances 2025-05-07 06:52:10 +01:00
Leonardo de Moura
764078bffb test: exponential compilation time
The option instance is being inlined.
2025-05-07 06:52:10 +01:00
8 changed files with 272 additions and 91 deletions

View File

@@ -2158,13 +2158,15 @@ Examples:
/-! ### Repr and ToString -/
protected def Array.repr {α : Type u} [Repr α] (xs : Array α) : Std.Format :=
let _ : Std.ToFormat α := repr
if xs.size == 0 then
"#[]"
else
Std.Format.bracketFill "#[" (Std.Format.joinSep (toList xs) ("," ++ Std.Format.line)) "]"
instance {α : Type u} [Repr α] : Repr (Array α) where
reprPrec xs _ :=
let _ : Std.ToFormat α := repr
if xs.size == 0 then
"#[]"
else
Std.Format.bracketFill "#[" (Std.Format.joinSep (toList xs) ("," ++ Std.Format.line)) "]"
reprPrec xs _ := Array.repr xs
instance [ToString α] : ToString (Array α) where
toString xs := "#" ++ toString xs.toList

View File

@@ -464,8 +464,12 @@ instance : Append (Subarray α) where
let a := x.toArray ++ y.toArray
a.toSubarray 0 a.size
/-- `Subarray` representation. -/
protected def Subarray.repr [Repr α] (s : Subarray α) : Std.Format :=
repr s.toArray ++ ".toSubarray"
instance [Repr α] : Repr (Subarray α) where
reprPrec s _ := repr s.toArray ++ ".toSubarray"
reprPrec s _ := Subarray.repr s
instance [ToString α] : ToString (Subarray α) where
toString s := toString s.toArray

View File

@@ -199,7 +199,13 @@ protected def toHex {n : Nat} (x : BitVec n) : String :=
let t := (List.replicate ((n+3) / 4 - s.length) '0').asString
t ++ s
instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Std.Format) ++ "#" ++ repr n
/-- `BitVec` representation. -/
protected def BitVec.repr (a : BitVec n) : Std.Format :=
"0x" ++ (a.toHex : Std.Format) ++ "#" ++ repr n
instance : Repr (BitVec n) where
reprPrec a _ := BitVec.repr a
instance : ToString (BitVec n) where toString a := toString (repr a)
end repr_toString

View File

@@ -291,8 +291,11 @@ implementation.
instance : Inhabited Float where
default := UInt64.toFloat 0
protected def Float.repr (n : Float) (prec : Nat) : Std.Format :=
if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n
instance : Repr Float where
reprPrec n prec := if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n
reprPrec := Float.repr
instance : ReprAtom Float :=

View File

@@ -292,8 +292,11 @@ implementation.
instance : Inhabited Float32 where
default := UInt64.toFloat32 0
protected def Float32.repr (n : Float32) (prec : Nat) : Std.Format :=
if n < UInt64.toFloat32 0 then Repr.addAppParen (toString n) prec else toString n
instance : Repr Float32 where
reprPrec n prec := if n < UInt64.toFloat32 0 then Repr.addAppParen (toString n) prec else toString n
reprPrec := Float32.repr
instance : ReprAtom Float32 :=

View File

@@ -55,10 +55,12 @@ This instance allows us to use `Empty` as a type parameter without causing insta
instance : Repr Empty where
reprPrec := nofun
protected def Bool.repr : Bool Nat Format
| true, _ => "true"
| false, _ => "false"
instance : Repr Bool where
reprPrec
| true, _ => "true"
| false, _ => "false"
reprPrec := Bool.repr
def Repr.addAppParen (f : Format) (prec : Nat) : Format :=
if prec >= max_prec then
@@ -66,10 +68,12 @@ def Repr.addAppParen (f : Format) (prec : Nat) : Format :=
else
f
protected def Decidable.repr : Decidable p Nat Format
| .isTrue _, prec => Repr.addAppParen "isTrue _" prec
| .isFalse _, prec => Repr.addAppParen "isFalse _" prec
instance : Repr (Decidable p) where
reprPrec
| Decidable.isTrue _, prec => Repr.addAppParen "isTrue _" prec
| Decidable.isFalse _, prec => Repr.addAppParen "isFalse _" prec
reprPrec := Decidable.repr
instance : Repr PUnit.{u+1} where
reprPrec _ _ := "PUnit.unit"
@@ -109,8 +113,11 @@ export ReprTuple (reprTuple)
instance [Repr α] : ReprTuple α where
reprTuple a xs := repr a :: xs
protected def Prod.reprTuple [Repr α] [ReprTuple β] : α × β List Format List Format
| (a, b), xs => reprTuple b (repr a :: xs)
instance [Repr α] [ReprTuple β] : ReprTuple (α × β) where
reprTuple | (a, b), xs => reprTuple b (repr a :: xs)
reprTuple := Prod.reprTuple
protected def Prod.repr [Repr α] [ReprTuple β] : α × β Nat Format
| (a, b), _ => Format.bracket "(" (Format.joinSep (reprTuple b [repr a]).reverse ("," ++ Format.line)) ")"
@@ -118,8 +125,11 @@ protected def Prod.repr [Repr α] [ReprTuple β] : α × β → Nat → Format
instance [Repr α] [ReprTuple β] : Repr (α × β) where
reprPrec := Prod.repr
protected def Sigma.repr {β : α Type v} [Repr α] [(x : α) Repr (β x)] : Sigma β Nat Format
| a, b, _ => Format.bracket "" (repr a ++ ", " ++ repr b) ""
instance {β : α Type v} [Repr α] [(x : α) Repr (β x)] : Repr (Sigma β) where
reprPrec | a, b, _ => Format.bracket "" (repr a ++ ", " ++ repr b) ""
reprPrec := Sigma.repr
instance {p : α Prop} [Repr α] : Repr (Subtype p) where
reprPrec s prec := reprPrec s.val prec

View File

@@ -47,69 +47,96 @@ instance : ToJson String := ⟨fun s => s⟩
instance : FromJson System.FilePath := fun j => System.FilePath.mk <$> Json.getStr? j
instance : ToJson System.FilePath := fun p => p.toString
instance [FromJson α] : FromJson (Array α) where
fromJson?
| Json.arr a => a.mapM fromJson?
| j => throw s!"expected JSON array, got '{j}'"
protected def _root_.Array.fromJson? [FromJson α] : Json Except String (Array α)
| Json.arr a => a.mapM fromJson?
| j => throw s!"expected JSON array, got '{j}'"
instance [ToJson α] : ToJson (Array α) :=
fun a => Json.arr (a.map toJson)
instance [FromJson α] : FromJson (Array α) where
fromJson? := Array.fromJson?
protected def _root_.Array.toJson [ToJson α] (a : Array α) : Json :=
Json.arr (a.map toJson)
instance [ToJson α] : ToJson (Array α) where
toJson := Array.toJson
protected def _root_.List.fromJson? [FromJson α] (j : Json) : Except String (List α) :=
(fromJson? j (α := Array α)).map Array.toList
instance [FromJson α] : FromJson (List α) where
fromJson? j := (fromJson? j (α := Array α)).map Array.toList
fromJson? := List.fromJson?
protected def _root_.List.toJson [ToJson α] (a : List α) : Json :=
toJson a.toArray
instance [ToJson α] : ToJson (List α) where
toJson xs := toJson xs.toArray
toJson := List.toJson
protected def _root_.Option.fromJson? [FromJson α] : Json Except String (Option α)
| Json.null => Except.ok none
| j => some <$> fromJson? j
instance [FromJson α] : FromJson (Option α) where
fromJson?
| Json.null => Except.ok none
| j => some <$> fromJson? j
fromJson? := Option.fromJson?
instance [ToJson α] : ToJson (Option α) :=
fun
| none => Json.null
| some a => toJson a
protected def _root_.Option.toJson [ToJson α] : Option α Json
| none => Json.null
| some a => toJson a
instance [ToJson α] : ToJson (Option α) where
toJson := Option.toJson
protected def _root_.Prod.fromJson? {α : Type u} {β : Type v} [FromJson α] [FromJson β] : Json Except String (α × β)
| Json.arr #[ja, jb] => do
let a : ULift.{v} α := (fromJson? ja).map ULift.up
let b : ULift.{u} β := (fromJson? jb).map ULift.up
return (a, b)
| j => throw s!"expected pair, got '{j}'"
instance {α : Type u} {β : Type v} [FromJson α] [FromJson β] : FromJson (α × β) where
fromJson?
| Json.arr #[ja, jb] => do
let a : ULift.{v} α := (fromJson? ja).map ULift.up
let b : ULift.{u} β := (fromJson? jb).map ULift.up
return (a, b)
| j => throw s!"expected pair, got '{j}'"
fromJson? := Prod.fromJson?
protected def _root_.Prod.toJson [ToJson α] [ToJson β] : α × β Json
| (a, b) => Json.arr #[toJson a, toJson b]
instance [ToJson α] [ToJson β] : ToJson (α × β) where
toJson := fun (a, b) => Json.arr #[toJson a, toJson b]
toJson := Prod.toJson
protected def Name.fromJson? (j : Json) : Except String Name := do
let s j.getStr?
if s == "[anonymous]" then
return Name.anonymous
else
let n := s.toName
if n.isAnonymous then throw s!"expected a `Name`, got '{j}'"
return n
instance : FromJson Name where
fromJson? j := do
let s j.getStr?
if s == "[anonymous]" then
return Name.anonymous
else
let n := s.toName
if n.isAnonymous then throw s!"expected a `Name`, got '{j}'"
return n
fromJson? := Name.fromJson?
instance : ToJson Name where
toJson n := toString n
instance [FromJson α] : FromJson (NameMap α) where
fromJson?
| .obj obj => obj.foldM (init := {}) fun m k v => do
if k == "[anonymous]" then
return m.insert .anonymous ( fromJson? v)
protected def NameMap.fromJson? [FromJson α] : Json Except String (NameMap α)
| .obj obj => obj.foldM (init := {}) fun m k v => do
if k == "[anonymous]" then
return m.insert .anonymous ( fromJson? v)
else
let n := k.toName
if n.isAnonymous then
throw s!"expected a `Name`, got '{k}'"
else
let n := k.toName
if n.isAnonymous then
throw s!"expected a `Name`, got '{k}'"
else
return m.insert n ( fromJson? v)
| j => throw s!"expected a `NameMap`, got '{j}'"
return m.insert n ( fromJson? v)
| j => throw s!"expected a `NameMap`, got '{j}'"
instance [FromJson α] : FromJson (NameMap α) where
fromJson? := NameMap.fromJson?
protected def NameMap.toJson [ToJson α] (m : NameMap α) : Json :=
Json.obj <| m.fold (fun n k v => n.insert compare k.toString (toJson v)) .leaf
instance [ToJson α] : ToJson (NameMap α) where
toJson m := Json.obj <| m.fold (fun n k v => n.insert compare k.toString (toJson v)) .leaf
toJson := NameMap.toJson
/-- Note that `USize`s and `UInt64`s are stored as strings because JavaScript
cannot represent 64-bit numbers. -/
@@ -122,58 +149,77 @@ def bignumFromJson? (j : Json) : Except String Nat := do
def bignumToJson (n : Nat) : Json :=
toString n
protected def _root_.USize.fromJson? (j : Json) : Except String USize := do
let n bignumFromJson? j
if n USize.size then
throw "value '{j}' is too large for `USize`"
return USize.ofNat n
instance : FromJson USize where
fromJson? j := do
let n bignumFromJson? j
if n USize.size then
throw "value '{j}' is too large for `USize`"
return USize.ofNat n
fromJson? := USize.fromJson?
instance : ToJson USize where
toJson v := bignumToJson (USize.toNat v)
protected def _root_.UInt64.fromJson? (j : Json) : Except String UInt64 := do
let n bignumFromJson? j
if n UInt64.size then
throw "value '{j}' is too large for `UInt64`"
return UInt64.ofNat n
instance : FromJson UInt64 where
fromJson? j := do
let n bignumFromJson? j
if n UInt64.size then
throw "value '{j}' is too large for `UInt64`"
return UInt64.ofNat n
fromJson? := UInt64.fromJson?
instance : ToJson UInt64 where
toJson v := bignumToJson (UInt64.toNat v)
protected def _root_.Float.toJson (x : Float) : Json :=
match JsonNumber.fromFloat? x with
| Sum.inl e => Json.str e
| Sum.inr n => Json.num n
instance : ToJson Float where
toJson x :=
match JsonNumber.fromFloat? x with
| Sum.inl e => Json.str e
| Sum.inr n => Json.num n
toJson := Float.toJson
protected def _root_.Float.fromJson? : Json Except String Float
| (Json.str "Infinity") => Except.ok (1.0 / 0.0)
| (Json.str "-Infinity") => Except.ok (-1.0 / 0.0)
| (Json.str "NaN") => Except.ok (0.0 / 0.0)
| (Json.num jn) => Except.ok jn.toFloat
| _ => Except.error "Expected a number or a string 'Infinity', '-Infinity', 'NaN'."
instance : FromJson Float where
fromJson? := fun
| (Json.str "Infinity") => Except.ok (1.0 / 0.0)
| (Json.str "-Infinity") => Except.ok (-1.0 / 0.0)
| (Json.str "NaN") => Except.ok (0.0 / 0.0)
| (Json.num jn) => Except.ok jn.toFloat
| _ => Except.error "Expected a number or a string 'Infinity', '-Infinity', 'NaN'."
fromJson? := Float.fromJson?
protected def RBMap.toJson [ToJson α] (m : RBMap String α cmp) : Json :=
Json.obj <| RBNode.map (fun _ => toJson) <| m.val
instance [ToJson α] : ToJson (RBMap String α cmp) where
toJson m := Json.obj <| RBNode.map (fun _ => toJson) <| m.val
toJson := RBMap.toJson
protected def RBMap.fromJson? [FromJson α] (j : Json) : Except String (RBMap String α cmp) := do
let o j.getObj?
o.foldM (fun x k v => x.insert k <$> fromJson? v)
instance {cmp} [FromJson α] : FromJson (RBMap String α cmp) where
fromJson? j := do
let o j.getObj?
o.foldM (fun x k v => x.insert k <$> fromJson? v)
fromJson? := RBMap.fromJson?
namespace Json
instance : FromJson Structured := fun
| arr a => return Structured.arr a
| obj o => return Structured.obj o
| j => throw s!"expected structured object, got '{j}'"
protected def Structured.fromJson? : Json Except String Structured
| .arr a => return Structured.arr a
| .obj o => return Structured.obj o
| j => throw s!"expected structured object, got '{j}'"
instance : ToJson Structured := fun
| Structured.arr a => arr a
| Structured.obj o => obj o
instance : FromJson Structured where
fromJson? := Structured.fromJson?
protected def Structured.toJson : Structured Json
| .arr a => .arr a
| .obj o => .obj o
instance : ToJson Structured where
toJson := Structured.toJson
def toStructured? [ToJson α] (v : α) : Except String Structured :=
fromJson? (toJson v)

View File

@@ -0,0 +1,107 @@
import Lean.Data.Json
open Lean
structure Foo where
a1 : Option Nat
a2 : Option Nat
a3 : Option Nat
a4 : Option Nat
a5 : Option Nat
a6 : Option Nat
a7 : Option Nat
a8 : Option Nat
a9 : Option Nat
a10 : Option Nat
a11 : Option Nat
a12 : Option Nat
a13 : Option Nat
a14 : Option Nat
a15 : Option Nat
a16 : Option Nat
a17 : Option Nat
a18 : Option Nat
a19 : Option Nat
a20 : Option Nat
a21 : Option Nat
a22 : Option Nat
a23 : Option Nat
a24 : Option Nat
a25 : Option Nat
a26 : Option Nat
a27 : Option Nat
a28 : Option Nat
a29 : Option Nat
a30 : Option Nat
a31 : Option Nat
a32 : Option Nat
a33 : Option Nat
a34 : Option Nat
a35 : Option Nat
a36 : Option Nat
a37 : Option Nat
a38 : Option Nat
a39 : Option Nat
deriving ToJson, FromJson, Repr, BEq
structure Boo where
a1 : String × Option Nat
a2 : String × Option Nat
a3 : String × Option Nat
a4 : String × Option Nat
a5 : String × Option Nat
a6 : String × Option Nat
a7 : String × Option Nat
a8 : String × Option Nat
a9 : String × Option Nat
a10 : Array Nat
a11 : Array Nat
a12 : Array Nat
a13 : Array Nat
a14 : Array Nat
a15 : Array Nat
a16 : Array Nat
a17 : Array Nat
a18 : Array Nat
a19 : Array Nat
a20 : Array Nat
a21 : Array Nat
a22 : Array Nat
a23 : Array Nat
a24 : Array Nat
a25 : Array Nat
a26 : Array Nat
a27 : Array Nat
a28 : Array Nat
a29 : List Nat
a30 : List Nat
a31 : List Nat
a32 : List Nat
a33 : List Nat
a34 : List Nat
a35 : List Nat
a36 : List Nat
a37 : List Nat
a38 : List Nat
a39 : List Nat
aa10 : Float × USize × UInt64
aa11 : Float × USize × UInt64
aa12 : Float × USize × UInt64
aa13 : Float × USize × UInt64
aa14 : Float × USize × UInt64
aa15 : Float × USize × UInt64
aa16 : Float × USize × UInt64
aa17 : Float × USize × UInt64
aa18 : Float × USize × UInt64
aa19 : Float × USize × UInt64
aa20 : Float × USize × UInt64
aa21 : Float × USize × UInt64
aa22 : Float × USize × UInt64
aa23 : Float × USize × UInt64
aa24 : Float × USize × UInt64
aa25 : Float × USize × UInt64
aa26 : Float × USize × UInt64
aa27 : Float × USize × UInt64
aa28 : Float × USize × UInt64
aa29 : Float × USize × UInt64
aa30 : Float × USize × UInt64
deriving ToJson, FromJson, Repr, BEq