Skip to content

Commit

Permalink
Use struct representation for partial active patterns
Browse files Browse the repository at this point in the history 
See: https://learn.microsoft.com/en-us/dotnet/fsharp/language-reference/active-patterns#struct-representations-for-partial-active-patterns
  • Loading branch information
@hyazinthh
hyazinthh committed Jul 10, 2024
1 parent eb11753 commit 8926d25
Show file tree
Hide file tree
Showing 18 changed files with 1,270 additions and 1,113 deletions.
210 changes: 117 additions & 93 deletions src/FShade.Preprocessor/Interpreter.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -100,172 +100,196 @@ let getFieldInfo (ctx : AssemblyLoadContext) (m : FieldReference) =

module Patterns =

[<return: Struct>]
let (|Call|_|) (ctx : AssemblyLoadContext) (i : Instruction) =
match i.OpCode.Code with
| Code.Call | Code.Callvirt -> Some (getMethodBase ctx (i.Operand :?> MethodReference) :?> MethodInfo)
| _ -> None
| Code.Call | Code.Callvirt -> ValueSome (getMethodBase ctx (i.Operand :?> MethodReference) :?> MethodInfo)
| _ -> ValueNone

[<return: Struct>]
let (|NewObj|_|) (ctx : AssemblyLoadContext) (i : Instruction) =
match i.OpCode.Code with
| Code.Newobj -> Some (getMethodBase ctx (i.Operand :?> MethodReference) :?> ConstructorInfo)
| _ -> None
| Code.Newobj -> ValueSome (getMethodBase ctx (i.Operand :?> MethodReference) :?> ConstructorInfo)
| _ -> ValueNone

[<return: Struct>]
let (|Ldc|_|) (ctx : AssemblyLoadContext) (i : Instruction) =
if i.OpCode = OpCodes.Ldc_I4 then Some (System.Convert.ToInt32 i.Operand :> obj)
elif i.OpCode = OpCodes.Ldc_I4_S then Some (System.Convert.ToInt32 i.Operand :> obj)
elif i.OpCode = OpCodes.Ldc_I4_0 then Some (0 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_1 then Some (1 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_2 then Some (2 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_3 then Some (3 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_4 then Some (4 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_5 then Some (5 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_6 then Some (6 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_7 then Some (7 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_8 then Some (8 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_M1 then Some (-1 :> obj)
elif i.OpCode = OpCodes.Ldc_I8 then Some (System.Convert.ToInt64 i.Operand)
elif i.OpCode = OpCodes.Ldc_R4 then Some (System.Convert.ToSingle i.Operand)
elif i.OpCode = OpCodes.Ldc_R8 then Some (System.Convert.ToDouble i.Operand)
elif i.OpCode = OpCodes.Ldstr then Some (System.Convert.ToString i.Operand)
if i.OpCode = OpCodes.Ldc_I4 then ValueSome (System.Convert.ToInt32 i.Operand :> obj)
elif i.OpCode = OpCodes.Ldc_I4_S then ValueSome (System.Convert.ToInt32 i.Operand :> obj)
elif i.OpCode = OpCodes.Ldc_I4_0 then ValueSome (0 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_1 then ValueSome (1 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_2 then ValueSome (2 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_3 then ValueSome (3 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_4 then ValueSome (4 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_5 then ValueSome (5 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_6 then ValueSome (6 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_7 then ValueSome (7 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_8 then ValueSome (8 :> obj)
elif i.OpCode = OpCodes.Ldc_I4_M1 then ValueSome (-1 :> obj)
elif i.OpCode = OpCodes.Ldc_I8 then ValueSome (System.Convert.ToInt64 i.Operand)
elif i.OpCode = OpCodes.Ldc_R4 then ValueSome (System.Convert.ToSingle i.Operand)
elif i.OpCode = OpCodes.Ldc_R8 then ValueSome (System.Convert.ToDouble i.Operand)
elif i.OpCode = OpCodes.Ldstr then ValueSome (System.Convert.ToString i.Operand)
elif i.OpCode = OpCodes.Ldtoken then
let value =
match i.Operand with
| :? MethodReference as m -> getMethodBase ctx m :> obj
| :? FieldReference as m -> getFieldInfo ctx m :> obj
| :? TypeReference as m -> getType ctx m :> obj
| _ -> null
Some ValueNone
ValueSome ValueNone
else
None

ValueNone

[<return: Struct>]
let (|Pop|_|) (i : Instruction) =
if i.OpCode = OpCodes.Pop then Some ()
else None

if i.OpCode = OpCodes.Pop then ValueSome ()
else ValueNone

[<return: Struct>]
let (|Nop|_|) (i : Instruction) =
if i.OpCode = OpCodes.Nop then Some ()
else None

if i.OpCode = OpCodes.Nop then ValueSome ()
else ValueNone

[<return: Struct>]
let (|Ceq|_|) (i : Instruction) =
if i.OpCode = OpCodes.Ceq then Some ()
else None
if i.OpCode = OpCodes.Ceq then ValueSome ()
else ValueNone

[<return: Struct>]
let (|Clt|_|) (i : Instruction) =
if i.OpCode = OpCodes.Clt then Some ()
else None
if i.OpCode = OpCodes.Clt then ValueSome ()
else ValueNone

[<return: Struct>]
let (|Cgt|_|) (i : Instruction) =
if i.OpCode = OpCodes.Cgt then Some ()
else None
if i.OpCode = OpCodes.Cgt then ValueSome ()
else ValueNone

[<return: Struct>]
let (|CltUn|_|) (i : Instruction) =
if i.OpCode = OpCodes.Clt_Un then Some ()
else None
if i.OpCode = OpCodes.Clt_Un then ValueSome ()
else ValueNone

[<return: Struct>]
let (|CgtUn|_|) (i : Instruction) =
if i.OpCode = OpCodes.Cgt_Un then Some ()
else None
if i.OpCode = OpCodes.Cgt_Un then ValueSome ()
else ValueNone

[<return: Struct>]
let (|Ldnull|_|) (i : Instruction) =
if i.OpCode = OpCodes.Ldnull then Some ()
else None
if i.OpCode = OpCodes.Ldnull then ValueSome ()
else ValueNone

[<return: Struct>]
let (|Ldfld|_|) (ctx : AssemblyLoadContext) (i : Instruction) =
if i.OpCode = OpCodes.Ldsfld || i.OpCode = OpCodes.Ldfld then Some (getFieldInfo ctx (i.Operand :?> FieldReference))
else None
if i.OpCode = OpCodes.Ldsfld || i.OpCode = OpCodes.Ldfld then ValueSome (getFieldInfo ctx (i.Operand :?> FieldReference))
else ValueNone

[<return: Struct>]
let (|Stfld|_|) (ctx : AssemblyLoadContext) (i : Instruction) =
if i.OpCode = OpCodes.Stsfld || i.OpCode = OpCodes.Stfld then Some (getFieldInfo ctx (i.Operand :?> FieldReference))
else None
if i.OpCode = OpCodes.Stsfld || i.OpCode = OpCodes.Stfld then ValueSome (getFieldInfo ctx (i.Operand :?> FieldReference))
else ValueNone

[<return: Struct>]
let (|Ldloc|_|) (i : Instruction) =
if i.OpCode = OpCodes.Ldloc then
match i.Operand with
| :? VariableReference as v -> Some v.Index
| _ -> Some (System.Convert.ToInt32 i.Operand)
| :? VariableReference as v -> ValueSome v.Index
| _ -> ValueSome (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Ldloc_S then
match i.Operand with
| :? VariableReference as v -> Some v.Index
| _ -> Some (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Ldloc_0 then Some 0
elif i.OpCode = OpCodes.Ldloc_1 then Some 1
elif i.OpCode = OpCodes.Ldloc_2 then Some 2
elif i.OpCode = OpCodes.Ldloc_3 then Some 3
else None

| :? VariableReference as v -> ValueSome v.Index
| _ -> ValueSome (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Ldloc_0 then ValueSome 0
elif i.OpCode = OpCodes.Ldloc_1 then ValueSome 1
elif i.OpCode = OpCodes.Ldloc_2 then ValueSome 2
elif i.OpCode = OpCodes.Ldloc_3 then ValueSome 3
else ValueNone

[<return: Struct>]
let (|Stloc|_|) (i : Instruction) =
if i.OpCode = OpCodes.Stloc then
match i.Operand with
| :? VariableReference as v -> Some v.Index
| _ -> Some (System.Convert.ToInt32 i.Operand)
| :? VariableReference as v -> ValueSome v.Index
| _ -> ValueSome (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Stloc_S then
match i.Operand with
| :? VariableReference as v -> Some v.Index
| _ -> Some (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Stloc_0 then Some 0
elif i.OpCode = OpCodes.Stloc_1 then Some 1
elif i.OpCode = OpCodes.Stloc_2 then Some 2
elif i.OpCode = OpCodes.Stloc_3 then Some 3
else None

| :? VariableReference as v -> ValueSome v.Index
| _ -> ValueSome (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Stloc_0 then ValueSome 0
elif i.OpCode = OpCodes.Stloc_1 then ValueSome 1
elif i.OpCode = OpCodes.Stloc_2 then ValueSome 2
elif i.OpCode = OpCodes.Stloc_3 then ValueSome 3
else ValueNone

[<return: Struct>]
let (|Conv|_|) (i : Instruction) =
if i.OpCode = OpCodes.Conv_I || i.OpCode = OpCodes.Conv_Ovf_I then
let conv =
if sizeof<nativeint> = 8 then fun (o : obj) -> System.Convert.ToInt64(o) |> nativeint :> obj
else fun (o : obj) -> System.Convert.ToInt32(o) |> nativeint :> obj
Some conv
ValueSome conv
elif i.OpCode = OpCodes.Conv_U ||i.OpCode = OpCodes.Conv_Ovf_U then
let conv =
if sizeof<nativeint> = 8 then fun (o : obj) -> System.Convert.ToInt64(o) |> unativeint :> obj
else fun (o : obj) -> System.Convert.ToInt32(o) |> unativeint :> obj
Some conv
ValueSome conv

elif i.OpCode = OpCodes.Conv_I1 || i.OpCode = OpCodes.Conv_Ovf_I1 then
Some (fun (o : obj) -> System.Convert.ToSByte o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToSByte o :> obj)
elif i.OpCode = OpCodes.Conv_I2 || i.OpCode = OpCodes.Conv_Ovf_I2 then
Some (fun (o : obj) -> System.Convert.ToInt16 o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToInt16 o :> obj)
elif i.OpCode = OpCodes.Conv_I4 || i.OpCode = OpCodes.Conv_Ovf_I4 then
Some (fun (o : obj) -> System.Convert.ToInt32 o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToInt32 o :> obj)
elif i.OpCode = OpCodes.Conv_I8 || i.OpCode = OpCodes.Conv_Ovf_I8 then
Some (fun (o : obj) -> System.Convert.ToInt64 o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToInt64 o :> obj)

elif i.OpCode = OpCodes.Conv_U1 || i.OpCode = OpCodes.Conv_Ovf_U1 then
Some (fun (o : obj) -> System.Convert.ToByte o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToByte o :> obj)
elif i.OpCode = OpCodes.Conv_U2 || i.OpCode = OpCodes.Conv_Ovf_U2 then
Some (fun (o : obj) -> System.Convert.ToUInt16 o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToUInt16 o :> obj)
elif i.OpCode = OpCodes.Conv_U4 || i.OpCode = OpCodes.Conv_Ovf_U4 then
Some (fun (o : obj) -> System.Convert.ToUInt32 o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToUInt32 o :> obj)
elif i.OpCode = OpCodes.Conv_U8 || i.OpCode = OpCodes.Conv_Ovf_U8 then
Some (fun (o : obj) -> System.Convert.ToUInt64 o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToUInt64 o :> obj)


elif i.OpCode = OpCodes.Conv_R4 then
Some (fun (o : obj) -> System.Convert.ToSingle o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToSingle o :> obj)
elif i.OpCode = OpCodes.Conv_R8 then
Some (fun (o : obj) -> System.Convert.ToDouble o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToDouble o :> obj)

elif i.OpCode = OpCodes.Conv_Ovf_I then
Some (fun (o : obj) -> System.Convert.ToSingle o :> obj)
ValueSome (fun (o : obj) -> System.Convert.ToSingle o :> obj)
else
None
ValueNone

[<return: Struct>]
let (|Tail|_|) (i : Instruction) =
if i.OpCode = OpCodes.Tail then Some ()
else None
if i.OpCode = OpCodes.Tail then ValueSome ()
else ValueNone

[<return: Struct>]
let (|Volatile|_|) (i : Instruction) =
if i.OpCode = OpCodes.Volatile then Some ()
else None
if i.OpCode = OpCodes.Volatile then ValueSome ()
else ValueNone

[<return: Struct>]
let (|Ldarg|_|) (i : Instruction) =
if i.OpCode = OpCodes.Ldarg then Some (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Ldarg_S then Some (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Ldarg_0 then Some 0
elif i.OpCode = OpCodes.Ldarg_1 then Some 1
elif i.OpCode = OpCodes.Ldarg_2 then Some 2
elif i.OpCode = OpCodes.Ldarg_3 then Some 3
elif i.OpCode = OpCodes.Ldarga_S then Some (System.Convert.ToInt32 i.Operand)
else None
if i.OpCode = OpCodes.Ldarg then ValueSome (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Ldarg_S then ValueSome (System.Convert.ToInt32 i.Operand)
elif i.OpCode = OpCodes.Ldarg_0 then ValueSome 0
elif i.OpCode = OpCodes.Ldarg_1 then ValueSome 1
elif i.OpCode = OpCodes.Ldarg_2 then ValueSome 2
elif i.OpCode = OpCodes.Ldarg_3 then ValueSome 3
elif i.OpCode = OpCodes.Ldarga_S then ValueSome (System.Convert.ToInt32 i.Operand)
else ValueNone

[<return: Struct>]
let (|Add|_|) (i : Instruction) =
if i.OpCode = OpCodes.Add then Some ()
else None
if i.OpCode = OpCodes.Add then ValueSome ()
else ValueNone

type State(ctx : AssemblyLoadContext) =
let cache = System.Collections.Generic.Dictionary<int * int, option<obj>>()
Expand Down
8 changes: 4 additions & 4 deletions src/Libs/FShade.Core/Core.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -330,12 +330,12 @@ module SplicingExtensions =
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Quotations.ExprShape


[<return: Struct>]
let rec (|ExprValue|_|) (e : Expr) =
match e with
| Coerce(ExprValue v, _) -> Some v
| Value((:? Expr as v),_) -> Some v
| _ -> None
| Coerce(ExprValue v, _) -> ValueSome v
| Value((:? Expr as v),_) -> ValueSome v
| _ -> ValueNone

let rec private removeValueNames (e : Expr) =
match e with
Expand Down
13 changes: 8 additions & 5 deletions src/Libs/FShade.Core/Frontend.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -170,19 +170,22 @@ module Primitives =
let private emitVertexMeth = getMethodInfo <@ emitVertex() @>
let private restartStripMeth = getMethodInfo <@ restartStrip() @>
let private endPrimitiveMeth = getMethodInfo <@ endPrimitive() @>

[<return: Struct>]
let (|EmitVertex|_|) (e : Microsoft.FSharp.Quotations.Expr) =
match e with
| Microsoft.FSharp.Quotations.Patterns.Call(None, mi, []) when mi = emitVertexMeth ->
Some ()
ValueSome ()
| _ ->
None

ValueNone

[<return: Struct>]
let (|RestartStrip|_|) (e : Microsoft.FSharp.Quotations.Expr) =
match e with
| Microsoft.FSharp.Quotations.Patterns.Call(None, mi, []) when mi = restartStripMeth || mi = endPrimitiveMeth ->
Some ()
ValueSome ()
| _ ->
None
ValueNone



Expand Down
Loading

0 comments on commit 8926d25

Please sign in to comment.