From 02c1290a0b625b08947a6609bb287d3438490f34 Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 6 Oct 2023 17:31:54 +0200 Subject: [PATCH] handle compiler exception --- CHANGELOG.md | 5 + src/FSharp.Analyzers/TASTCollecting.fs | 171 +++++++++++++------------ 2 files changed, 93 insertions(+), 83 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c64f09f..5aad3d1 100644 --- 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 index c310179..8ecc132 100644 --- 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