Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Performance optimisations: Using more value-types and structs #68

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Performance optimisations: Using more value-types and structs #68

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
8de403d
Performance optimizations: Use Structs for faster execution and small…
Thorium Nov 9, 2023
a67eaa6
less function nesting, more valuetypes
Thorium Nov 9, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
193 changes: 118 additions & 75 deletions FSharp.Json/Core.fs
View file
Open in desktop

Large diffs are not rendered by default.

5 changes: 4 additions & 1 deletion FSharp.Json/FSharp.Json.fsproj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,10 @@
<RepositoryUrl>https://github.com/vsapronov/FSharp.Json</RepositoryUrl>
<Version>0.4.1</Version>
</PropertyGroup>

<PropertyGroup Condition="'$(Configuration)'=='Release'">
<Optimize>true</Optimize>
<Tailcalls>true</Tailcalls>
</PropertyGroup>
<ItemGroup>
<Compile Include="TextConversions.fs" />
<Compile Include="JsonValue.fs" />
Expand Down
7 changes: 5 additions & 2 deletions FSharp.Json/InterfaceTypes.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -77,11 +77,12 @@ with


/// Represents one item in [JsonPath]
[<Struct>]
type JsonPathItem =
/// Field in JSON object.
| Field of string
| Field of field: string
/// Item in JSON array.
| ArrayItem of int
| ArrayItem of itm: int

/// Represents path in JSON structure
type JsonPath = {
Expand Down Expand Up @@ -119,13 +120,15 @@ type JsonDeserializationError(path: JsonPath, message: string) =
member e.Path = path

/// Modes of serialization of option None value
[<Struct>]
type SerializeNone =
/// Serialize None value as null in JSON.
| Null
/// Omit members with None values in JSON.
| Omit

/// Modes of deserialization of option types
[<Struct>]
type DeserializeOption =
/// Allow members with None value to be omitted in JSON.
| AllowOmit
Expand Down
10 changes: 5 additions & 5 deletions FSharp.Json/JsonValue.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -212,16 +212,16 @@ type private JsonParser(jsonText:string, cultureInfo, tolerateErrors) =
elif d >= 'A' && d <= 'F' then int32 d - int32 'A' + 10
else failwith "hexdigit"
let unicodeChar (s:string) =
if s.Length <> 4 then failwith "unicodeChar";
if s.Length <> 4 then failwithf "unicodeChar (%s)" s;
char (hexdigit s.[0] * 4096 + hexdigit s.[1] * 256 + hexdigit s.[2] * 16 + hexdigit s.[3])
let ch = unicodeChar (s.Substring(i+2, 4))
buf.Append(ch) |> ignore
i <- i + 4 // the \ and u will also be skipped past further below
| 'U' ->
ensure(i+9 < s.Length)
let unicodeChar (s:string) =
if s.Length <> 8 then failwith "unicodeChar";
if s.[0..1] <> "00" then failwith "unicodeChar";
if s.Length <> 8 then failwithf "unicodeChar (%s)" s;
if s.[0..1] <> "00" then failwithf "unicodeChar (%s)" s;
UnicodeHelper.getUnicodeSurrogatePair <| System.UInt32.Parse(s, NumberStyles.HexNumber)
let lead, trail = unicodeChar (s.Substring(i+2, 8))
buf.Append(lead) |> ignore
Expand All @@ -245,10 +245,10 @@ type private JsonParser(jsonText:string, cultureInfo, tolerateErrors) =
let len = i - start
let sub = s.Substring(start,len)
match TextConversions.AsDecimal cultureInfo sub with
| Some x -> JsonValue.Number x
| ValueSome x -> JsonValue.Number x
| _ ->
match TextConversions.AsFloat [| |] (*useNoneForMissingValues*)false cultureInfo sub with
| Some x -> JsonValue.Float x
| ValueSome x -> JsonValue.Float x
| _ -> throw()

and parsePair() =
Expand Down
165 changes: 89 additions & 76 deletions FSharp.Json/JsonValueHelpers.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,124 +8,137 @@ module internal JsonValueHelpers =
let raiseWrongType path typeName jvalue =
raise(JsonDeserializationError(path, sprintf "Expected type %s is incompatible with jvalue: %A" typeName jvalue))

let getInt16 (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetInt16|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> int16 value
| JsonValue.Float value -> int16 value
| _ -> raiseWrongType path "int16" jvalue
| JsonValue.Number value -> ValueSome (int16 value)
| JsonValue.Float value -> ValueSome (int16 value)
| _ -> ValueNone

let getUInt16 (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetUInt16|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> uint16 value
| JsonValue.Float value -> uint16 value
| _ -> raiseWrongType path "uint16" jvalue
| JsonValue.Number value -> ValueSome (uint16 value)
| JsonValue.Float value -> ValueSome (uint16 value)
| _ -> ValueNone

let getInt (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetInt|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> int value
| JsonValue.Float value -> int value
| _ -> raiseWrongType path "int" jvalue
| JsonValue.Number value -> ValueSome (int value)
| JsonValue.Float value -> ValueSome (int value)
| _ -> ValueNone

let getUInt32 (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetUInt32|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> uint32 value
| JsonValue.Float value -> uint32 value
| _ -> raiseWrongType path "uint32" jvalue
| JsonValue.Number value -> ValueSome (uint32 value)
| JsonValue.Float value -> ValueSome (uint32 value)
| _ -> ValueNone

let getInt64 (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetInt64|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> int64 value
| JsonValue.Float value -> int64 value
| _ -> raiseWrongType path "int64" jvalue
| JsonValue.Number value -> ValueSome (int64 value)
| JsonValue.Float value -> ValueSome (int64 value)
| _ -> ValueNone

let getUInt64 (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetUInt64|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> uint64 value
| JsonValue.Float value -> uint64 value
| _ -> raiseWrongType path "uint64" jvalue
| JsonValue.Number value -> ValueSome (uint64 value)
| JsonValue.Float value -> ValueSome (uint64 value)
| _ -> ValueNone

let getBigint (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetBigint|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> bigint value
| JsonValue.Float value -> bigint value
| _ -> raiseWrongType path "bigint" jvalue
| JsonValue.Number value -> ValueSome (bigint value)
| JsonValue.Float value -> ValueSome (bigint value)
| _ -> ValueNone

let getSingle (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetSingle|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Float value -> single value
| JsonValue.Number value -> single value
| _ -> raiseWrongType path "single" jvalue
| JsonValue.Float value -> ValueSome (single value)
| JsonValue.Number value -> ValueSome (single value)
| _ -> ValueNone

let getFloat (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetFloat|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Float value -> value
| JsonValue.Number value -> float value
| _ -> raiseWrongType path "float" jvalue
| JsonValue.Float value -> ValueSome value
| JsonValue.Number value -> ValueSome (float value)
| _ -> ValueNone

let getDecimal (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetDecimal|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> value
| JsonValue.Float value -> decimal value
| _ -> raiseWrongType path "decimal" jvalue
| JsonValue.Number value -> ValueSome value
| JsonValue.Float value -> ValueSome (decimal value)
| _ -> ValueNone

let getByte (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetByte|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> byte value
| JsonValue.Float value -> byte value
| _ -> raiseWrongType path "byte" jvalue
| JsonValue.Number value -> ValueSome (byte value)
| JsonValue.Float value -> ValueSome (byte value)
| _ -> ValueNone

let getSByte (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetSByte|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Number value -> sbyte value
| JsonValue.Float value -> sbyte value
| _ -> raiseWrongType path "sbyte" jvalue
| JsonValue.Number value -> ValueSome (sbyte value)
| JsonValue.Float value -> ValueSome (sbyte value)
| _ -> ValueNone

let getBool (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetBool|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Boolean value -> value
| _ -> raiseWrongType path "bool" jvalue
| JsonValue.Boolean value -> ValueSome value
| _ -> ValueNone

let getString (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetString|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.String value -> value
| _ -> raiseWrongType path "string" jvalue
| JsonValue.String value -> ValueSome value
| _ -> ValueNone

let getChar (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetChar|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.String value ->
match value.Length with
| 1 -> value.Chars(0)
| _ -> raise(JsonDeserializationError(path, sprintf "Expected string with single character, got jvalue: %s" value))
| _ -> raiseWrongType path "char" jvalue
| 1 -> ValueSome (value.Chars 0)
| _ -> ValueNone
| _ -> ValueNone

let getDateTime cultureInfo (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetDateTime|_|) cultureInfo (jvalue: JsonValue) =
match jvalue with
| JsonValue.String value ->
let jvalue = TextConversions.AsDateTime cultureInfo value
match jvalue with
| Some jvalue -> jvalue
| None -> raiseWrongType path "DateTime" jvalue
| _ -> raiseWrongType path "DateTime" jvalue
jvalue
| _ -> ValueNone

let getDateTimeOffset cultureInfo (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetDateTimeOffset|_|) cultureInfo (jvalue: JsonValue) =
match jvalue with
| JsonValue.String value ->
let jvalue = AsDateTimeOffset cultureInfo value
match jvalue with
| Some jvalue -> jvalue
| None -> raiseWrongType path "DateTimeOffset" jvalue
| _ -> raiseWrongType path "DateTimeOffset" jvalue
jvalue
| _ -> ValueNone

let getGuid (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetGuid|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.String value ->
let jvalue = TextConversions.AsGuid value
match jvalue with
| Some jvalue -> jvalue
| None -> raiseWrongType path "Guid" jvalue
| _ -> raiseWrongType path "Guid" jvalue
jvalue
| _ -> ValueNone

let getArray (path: JsonPath) (jvalue: JsonValue) =
[<return: Struct>]
let (|GetArray|_|) (jvalue: JsonValue) =
match jvalue with
| JsonValue.Array arr -> arr
| _ -> raiseWrongType path "array" jvalue
| JsonValue.Array arr -> ValueSome arr
| _ -> ValueNone
6 changes: 3 additions & 3 deletions FSharp.Json/Reflection.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -77,11 +77,11 @@ module internal Reflection =
let getMapValueType: Type -> Type = getMapValueType_ |> cacheResult
let getMapKvpTupleType: Type -> Type = getMapKvpTupleType_ |> cacheResult

let unwrapOption (t: Type) (value: obj): obj option =
let unwrapOption (t: Type) (value: obj): obj voption =
let _, fields = FSharpValue.GetUnionFields(value, t)
match fields.Length with
| 1 -> Some fields.[0]
| _ -> None
| 1 -> ValueSome fields.[0]
| _ -> ValueNone

let optionNone (t: Type): obj =
let casesInfos = getUnionCases t
Expand Down
20 changes: 11 additions & 9 deletions FSharp.Json/TextConversions.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,14 +14,16 @@ open System.Text.RegularExpressions
module private Helpers =

/// Convert the result of TryParse to option type
let asOption = function true, v -> Some v | _ -> None
let asOption = function true, v -> ValueSome v | _ -> ValueNone

[<return: Struct>]
let (|StringEqualsIgnoreCase|_|) (s1:string) s2 =
if s1.Equals(s2, StringComparison.OrdinalIgnoreCase)
then Some () else None
then ValueSome () else ValueNone

[<return: Struct>]
let (|OneOfIgnoreCase|_|) set str =
if Array.exists (fun s -> StringComparer.OrdinalIgnoreCase.Compare(s, str) = 0) set then Some() else None
if Array.exists (fun s -> StringComparer.OrdinalIgnoreCase.Compare(s, str) = 0) set then ValueSome() else ValueNone

let regexOptions =
#if FX_NO_REGEX_COMPILATION
Expand Down Expand Up @@ -73,10 +75,10 @@ type internal TextConversions private() =
/// if useNoneForMissingValues is true, NAs are returned as None, otherwise Some Double.NaN is used
static member AsFloat missingValues useNoneForMissingValues cultureInfo (text:string) =
match text.Trim() with
| OneOfIgnoreCase missingValues -> if useNoneForMissingValues then None else Some Double.NaN
| OneOfIgnoreCase missingValues -> if useNoneForMissingValues then ValueNone else ValueSome Double.NaN
| _ -> Double.TryParse(text, NumberStyles.Any, cultureInfo)
|> asOption
|> Option.bind (fun f -> if useNoneForMissingValues && Double.IsNaN f then None else Some f)
|> ValueOption.bind (fun f -> if useNoneForMissingValues && Double.IsNaN f then ValueNone else ValueSome f)

static member AsBoolean (text:string) =
match text.Trim() with
Expand All @@ -94,17 +96,17 @@ type internal TextConversions private() =
matchesMS.Groups.[1].Value
|> Double.Parse
|> DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc).AddMilliseconds
|> Some
|> ValueSome
else
// Parse ISO 8601 format, fixing time zone if needed
let dateTimeStyles = DateTimeStyles.AllowWhiteSpaces ||| DateTimeStyles.RoundtripKind
match DateTime.TryParse(text, cultureInfo, dateTimeStyles) with
| true, d ->
if d.Kind = DateTimeKind.Unspecified then
new DateTime(d.Ticks, DateTimeKind.Local) |> Some
new DateTime(d.Ticks, DateTimeKind.Local) |> ValueSome
else
Some d
| _ -> None
ValueSome d
| _ -> ValueNone

static member AsGuid (text:string) =
Guid.TryParse(text.Trim()) |> asOption
Expand Down
4 changes: 2 additions & 2 deletions FSharp.Json/Utils.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,5 +8,5 @@ module internal Conversions =
// Parse ISO 8601 format, fixing time zone if needed
let dateTimeStyles = DateTimeStyles.AllowWhiteSpaces ||| DateTimeStyles.RoundtripKind ||| DateTimeStyles.AssumeUniversal
match DateTimeOffset.TryParse(text, cultureInfo, dateTimeStyles) with
| true, d -> Some d
| _ -> None
| true, d -> ValueSome d
| _ -> ValueNone