handle compiler exception

G-Research · Oct 6, 2023 · 02c1290 · 02c1290
1 parent 2d12ad6
commit 02c1290
Show file tree

Hide file tree

Showing 2 changed files with 93 additions and 83 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,5 +1,10 @@
 # Changelog
 
+## [0.1.1] - 2023-10-06
+
+### Fixed
+* Handle internal compiler exception regarding an unsupported kind of pattern match
+
 ## [0.1.0] - 2023-10-06
 
 ### Added

diff --git a/src/FSharp.Analyzers/TASTCollecting.fs b/src/FSharp.Analyzers/TASTCollecting.fs
@@ -9,91 +9,96 @@ module TASTCollecting =
     type Handler = | CallHandler of (range -> FSharpMemberOrFunctionOrValue -> FSharpExpr list -> unit)
 
     let rec visitExpr (handler : Handler) (e : FSharpExpr) =
-        match e with
-        | AddressOf lvalueExpr -> visitExpr handler lvalueExpr
-        | AddressSet (lvalueExpr, rvalueExpr) ->
-            visitExpr handler lvalueExpr
-            visitExpr handler rvalueExpr
-        | Application (funcExpr, _typeArgs, argExprs) ->
-            visitExpr handler funcExpr
-            visitExprs handler argExprs
-        | Call (objExprOpt, memberOrFunc, _typeArgs1, _typeArgs2, argExprs) ->
-            match handler with
-            | CallHandler f -> f e.Range memberOrFunc argExprs
+        try
 
-            visitObjArg handler objExprOpt
-            visitExprs handler argExprs
-        | Coerce (_targetType, inpExpr) -> visitExpr handler inpExpr
-        | FastIntegerForLoop (startExpr, limitExpr, consumeExpr, _isUp, _debugPointAtFor, _debugPointAtInOrTo) ->
-            visitExpr handler startExpr
-            visitExpr handler limitExpr
-            visitExpr handler consumeExpr
-        | ILAsm (_asmCode, _typeArgs, argExprs) -> visitExprs handler argExprs
-        | ILFieldGet (objExprOpt, _fieldType, _fieldName) -> visitObjArg handler objExprOpt
-        | ILFieldSet (objExprOpt, _fieldType, _fieldName, _valueExpr) -> visitObjArg handler objExprOpt
-        | IfThenElse (guardExpr, thenExpr, elseExpr) ->
-            visitExpr handler guardExpr
-            visitExpr handler thenExpr
-            visitExpr handler elseExpr
-        | Lambda (_lambdaVar, bodyExpr) -> visitExpr handler bodyExpr
-        | Let ((_bindingVar, bindingExpr, _debugPointAtBinding), bodyExpr) ->
-            visitExpr handler bindingExpr
-            visitExpr handler bodyExpr
-        | LetRec (recursiveBindings, bodyExpr) ->
-            let recursiveBindings' =
-                recursiveBindings |> List.map (fun (mfv, expr, _dp) -> (mfv, expr))
+            match e with
+            | AddressOf lvalueExpr -> visitExpr handler lvalueExpr
+            | AddressSet (lvalueExpr, rvalueExpr) ->
+                visitExpr handler lvalueExpr
+                visitExpr handler rvalueExpr
+            | Application (funcExpr, _typeArgs, argExprs) ->
+                visitExpr handler funcExpr
+                visitExprs handler argExprs
+            | Call (objExprOpt, memberOrFunc, _typeArgs1, _typeArgs2, argExprs) ->
+                match handler with
+                | CallHandler f -> f e.Range memberOrFunc argExprs
 
-            List.iter (snd >> visitExpr handler) recursiveBindings'
-            visitExpr handler bodyExpr
-        | NewArray (_arrayType, argExprs) -> visitExprs handler argExprs
-        | NewDelegate (_delegateType, delegateBodyExpr) -> visitExpr handler delegateBodyExpr
-        | NewObject (_objType, _typeArgs, argExprs) -> visitExprs handler argExprs
-        | NewRecord (_recordType, argExprs) -> visitExprs handler argExprs
-        | NewTuple (_tupleType, argExprs) -> visitExprs handler argExprs
-        | NewUnionCase (_unionType, _unionCase, argExprs) -> visitExprs handler argExprs
-        | Quote quotedExpr -> visitExpr handler quotedExpr
-        | FSharpFieldGet (objExprOpt, _recordOrClassType, _fieldInfo) -> visitObjArg handler objExprOpt
-        | FSharpFieldSet (objExprOpt, _recordOrClassType, _fieldInfo, argExpr) ->
-            visitObjArg handler objExprOpt
-            visitExpr handler argExpr
-        | Sequential (firstExpr, secondExpr) ->
-            visitExpr handler firstExpr
-            visitExpr handler secondExpr
-        | TryFinally (bodyExpr, finalizeExpr, _debugPointAtTry, _debugPointAtFinally) ->
-            visitExpr handler bodyExpr
-            visitExpr handler finalizeExpr
-        | TryWith (bodyExpr, _, _, _catchVar, catchExpr, _debugPointAtTry, _debugPointAtWith) ->
-            visitExpr handler bodyExpr
-            visitExpr handler catchExpr
-        | TupleGet (_tupleType, _tupleElemIndex, tupleExpr) -> visitExpr handler tupleExpr
-        | DecisionTree (decisionExpr, decisionTargets) ->
-            visitExpr handler decisionExpr
-            List.iter (snd >> visitExpr handler) decisionTargets
-        | DecisionTreeSuccess (_decisionTargetIdx, decisionTargetExprs) -> visitExprs handler decisionTargetExprs
-        | TypeLambda (_genericParam, bodyExpr) -> visitExpr handler bodyExpr
-        | TypeTest (_ty, inpExpr) -> visitExpr handler inpExpr
-        | UnionCaseSet (unionExpr, _unionType, _unionCase, _unionCaseField, valueExpr) ->
-            visitExpr handler unionExpr
-            visitExpr handler valueExpr
-        | UnionCaseGet (unionExpr, _unionType, _unionCase, _unionCaseField) -> visitExpr handler unionExpr
-        | UnionCaseTest (unionExpr, _unionType, _unionCase) -> visitExpr handler unionExpr
-        | UnionCaseTag (unionExpr, _unionType) -> visitExpr handler unionExpr
-        | ObjectExpr (_objType, baseCallExpr, overrides, interfaceImplementations) ->
-            visitExpr handler baseCallExpr
-            List.iter (visitObjMember handler) overrides
-            List.iter (snd >> List.iter (visitObjMember handler)) interfaceImplementations
-        | TraitCall (_sourceTypes, _traitName, _typeArgs, _typeInstantiation, _argTypes, argExprs) ->
-            visitExprs handler argExprs
-        | ValueSet (_valToSet, valueExpr) -> visitExpr handler valueExpr
-        | WhileLoop (guardExpr, bodyExpr, _debugPointAtWhile) ->
-            visitExpr handler guardExpr
-            visitExpr handler bodyExpr
-        | BaseValue _baseType -> ()
-        | DefaultValue _defaultType -> ()
-        | ThisValue _thisType -> ()
-        | Const (_constValueObj, _constType) -> ()
-        | Value _valueToGet -> ()
-        | _ -> ()
+                visitObjArg handler objExprOpt
+                visitExprs handler argExprs
+            | Coerce (_targetType, inpExpr) -> visitExpr handler inpExpr
+            | FastIntegerForLoop (startExpr, limitExpr, consumeExpr, _isUp, _debugPointAtFor, _debugPointAtInOrTo) ->
+                visitExpr handler startExpr
+                visitExpr handler limitExpr
+                visitExpr handler consumeExpr
+            | ILAsm (_asmCode, _typeArgs, argExprs) -> visitExprs handler argExprs
+            | ILFieldGet (objExprOpt, _fieldType, _fieldName) -> visitObjArg handler objExprOpt
+            | ILFieldSet (objExprOpt, _fieldType, _fieldName, _valueExpr) -> visitObjArg handler objExprOpt
+            | IfThenElse (guardExpr, thenExpr, elseExpr) ->
+                visitExpr handler guardExpr
+                visitExpr handler thenExpr
+                visitExpr handler elseExpr
+            | Lambda (_lambdaVar, bodyExpr) -> visitExpr handler bodyExpr
+            | Let ((_bindingVar, bindingExpr, _debugPointAtBinding), bodyExpr) ->
+                visitExpr handler bindingExpr
+                visitExpr handler bodyExpr
+            | LetRec (recursiveBindings, bodyExpr) ->
+                let recursiveBindings' =
+                    recursiveBindings |> List.map (fun (mfv, expr, _dp) -> (mfv, expr))
+
+                List.iter (snd >> visitExpr handler) recursiveBindings'
+                visitExpr handler bodyExpr
+            | NewArray (_arrayType, argExprs) -> visitExprs handler argExprs
+            | NewDelegate (_delegateType, delegateBodyExpr) -> visitExpr handler delegateBodyExpr
+            | NewObject (_objType, _typeArgs, argExprs) -> visitExprs handler argExprs
+            | NewRecord (_recordType, argExprs) -> visitExprs handler argExprs
+            | NewTuple (_tupleType, argExprs) -> visitExprs handler argExprs
+            | NewUnionCase (_unionType, _unionCase, argExprs) -> visitExprs handler argExprs
+            | Quote quotedExpr -> visitExpr handler quotedExpr
+            | FSharpFieldGet (objExprOpt, _recordOrClassType, _fieldInfo) -> visitObjArg handler objExprOpt
+            | FSharpFieldSet (objExprOpt, _recordOrClassType, _fieldInfo, argExpr) ->
+                visitObjArg handler objExprOpt
+                visitExpr handler argExpr
+            | Sequential (firstExpr, secondExpr) ->
+                visitExpr handler firstExpr
+                visitExpr handler secondExpr
+            | TryFinally (bodyExpr, finalizeExpr, _debugPointAtTry, _debugPointAtFinally) ->
+                visitExpr handler bodyExpr
+                visitExpr handler finalizeExpr
+            | TryWith (bodyExpr, _, _, _catchVar, catchExpr, _debugPointAtTry, _debugPointAtWith) ->
+                visitExpr handler bodyExpr
+                visitExpr handler catchExpr
+            | TupleGet (_tupleType, _tupleElemIndex, tupleExpr) -> visitExpr handler tupleExpr
+            | DecisionTree (decisionExpr, decisionTargets) ->
+                visitExpr handler decisionExpr
+                List.iter (snd >> visitExpr handler) decisionTargets
+            | DecisionTreeSuccess (_decisionTargetIdx, decisionTargetExprs) -> visitExprs handler decisionTargetExprs
+            | TypeLambda (_genericParam, bodyExpr) -> visitExpr handler bodyExpr
+            | TypeTest (_ty, inpExpr) -> visitExpr handler inpExpr
+            | UnionCaseSet (unionExpr, _unionType, _unionCase, _unionCaseField, valueExpr) ->
+                visitExpr handler unionExpr
+                visitExpr handler valueExpr
+            | UnionCaseGet (unionExpr, _unionType, _unionCase, _unionCaseField) -> visitExpr handler unionExpr
+            | UnionCaseTest (unionExpr, _unionType, _unionCase) -> visitExpr handler unionExpr
+            | UnionCaseTag (unionExpr, _unionType) -> visitExpr handler unionExpr
+            | ObjectExpr (_objType, baseCallExpr, overrides, interfaceImplementations) ->
+                visitExpr handler baseCallExpr
+                List.iter (visitObjMember handler) overrides
+                List.iter (snd >> List.iter (visitObjMember handler)) interfaceImplementations
+            | TraitCall (_sourceTypes, _traitName, _typeArgs, _typeInstantiation, _argTypes, argExprs) ->
+                visitExprs handler argExprs
+            | ValueSet (_valToSet, valueExpr) -> visitExpr handler valueExpr
+            | WhileLoop (guardExpr, bodyExpr, _debugPointAtWhile) ->
+                visitExpr handler guardExpr
+                visitExpr handler bodyExpr
+            | BaseValue _baseType -> ()
+            | DefaultValue _defaultType -> ()
+            | ThisValue _thisType -> ()
+            | Const (_constValueObj, _constType) -> ()
+            | Value _valueToGet -> ()
+            | _ -> ()
+        with ex ->
+            printfn $"Expression at %s{e.Range.FileName}:%s{e.Range.ToString ()} not yet supported"
+            ()
 
     and visitExprs f exprs = List.iter (visitExpr f) exprs