From 7c9c95e0812035ff91c5a0d52583830d835a21ae Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Tue, 31 Jan 2023 13:44:19 -0800 Subject: [PATCH 1/8] Fable support --- .vscode/launch.json | 10 + buildtools/buildtools.targets | 4 +- fcs/build.sh | 40 + fcs/fcs-fable/.gitignore | 3 + fcs/fcs-fable/FSStrings.fs | 1013 +++++++++++++++++ fcs/fcs-fable/SR.fs | 28 + fcs/fcs-fable/System.Collections.fs | 174 +++ fcs/fcs-fable/System.IO.fs | 56 + fcs/fcs-fable/System.fs | 49 + fcs/fcs-fable/TcImports_shim.fs | 281 +++++ fcs/fcs-fable/ast_print.fs | 101 ++ fcs/fcs-fable/codegen/codegen.fsproj | 52 + fcs/fcs-fable/codegen/fssrgen.fsx | 495 ++++++++ fcs/fcs-fable/codegen/fssrgen.targets | 35 + fcs/fcs-fable/fcs-fable.fsproj | 388 +++++++ fcs/fcs-fable/service_slim.fs | 359 ++++++ fcs/fcs-fable/test/.gitignore | 7 + fcs/fcs-fable/test/Metadata.fs | 216 ++++ fcs/fcs-fable/test/Platform.fs | 105 ++ fcs/fcs-fable/test/ProjectParser.fs | 255 +++++ fcs/fcs-fable/test/bench/bench.fs | 108 ++ .../test/bench/fcs-fable-bench.fsproj | 27 + fcs/fcs-fable/test/fcs-fable-test.fsproj | 26 + fcs/fcs-fable/test/nuget.config | 8 + fcs/fcs-fable/test/package.json | 15 + fcs/fcs-fable/test/test.fs | 61 + fcs/fcs-fable/test/test_script.fsx | 9 + src/Compiler/AbstractIL/il.fs | 42 + src/Compiler/AbstractIL/il.fsi | 6 + src/Compiler/AbstractIL/illex.fsl | 19 +- src/Compiler/AbstractIL/ilread.fs | 526 +++++---- src/Compiler/AbstractIL/ilread.fsi | 9 +- src/Compiler/Checking/AttributeChecking.fs | 6 +- src/Compiler/Checking/ConstraintSolver.fs | 4 +- src/Compiler/Checking/MethodCalls.fs | 2 +- src/Compiler/Checking/MethodCalls.fsi | 2 +- src/Compiler/Checking/NicePrint.fs | 10 +- .../Checking/PatternMatchCompilation.fs | 10 + src/Compiler/Checking/QuotationTranslator.fs | 8 + src/Compiler/CodeGen/IlxGen.fs | 24 + src/Compiler/CodeGen/IlxGen.fsi | 2 + src/Compiler/Driver/CompilerConfig.fs | 65 ++ src/Compiler/Driver/CompilerConfig.fsi | 24 + src/Compiler/Driver/CompilerDiagnostics.fs | 21 + src/Compiler/Driver/CompilerDiagnostics.fsi | 6 + src/Compiler/Driver/CompilerImports.fs | 75 ++ src/Compiler/Driver/CompilerImports.fsi | 24 + src/Compiler/Driver/CompilerOptions.fs | 23 + src/Compiler/Driver/CompilerOptions.fsi | 4 + src/Compiler/Driver/GraphChecking/Graph.fs | 4 + .../Driver/GraphChecking/GraphProcessing.fs | 11 + .../Driver/GraphChecking/TrieMapping.fs | 2 + src/Compiler/Driver/OptimizeInputs.fs | 24 + src/Compiler/Driver/OptimizeInputs.fsi | 4 + src/Compiler/Driver/ParseAndCheckInputs.fs | 33 +- src/Compiler/Driver/ParseAndCheckInputs.fsi | 10 + src/Compiler/Driver/ScriptClosure.fs | 6 + src/Compiler/Driver/ScriptClosure.fsi | 6 + src/Compiler/Facilities/BuildGraph.fs | 4 + src/Compiler/Facilities/BuildGraph.fsi | 4 + .../Facilities/DiagnosticResolutionHints.fs | 6 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 26 + src/Compiler/Facilities/ReferenceResolver.fs | 21 + src/Compiler/Facilities/ReferenceResolver.fsi | 14 + src/Compiler/Facilities/TextLayoutRender.fs | 4 + src/Compiler/Facilities/TextLayoutRender.fsi | 4 + src/Compiler/Facilities/prim-lexing.fs | 60 +- src/Compiler/Facilities/prim-lexing.fsi | 22 +- src/Compiler/Facilities/prim-parsing.fs | 11 + src/Compiler/Facilities/prim-parsing.fsi | 4 +- .../Legacy/LegacyHostedCompilerForTesting.fs | 15 + src/Compiler/Optimize/Optimizer.fs | 17 + src/Compiler/Service/FSharpCheckerResults.fs | 44 + src/Compiler/Service/FSharpCheckerResults.fsi | 50 + src/Compiler/Service/FSharpSource.fs | 10 + src/Compiler/Service/FSharpSource.fsi | 4 + src/Compiler/Service/IncrementalBuild.fs | 18 + src/Compiler/Service/IncrementalBuild.fsi | 14 + src/Compiler/Service/QuickParse.fs | 10 + .../Service/SemanticClassification.fs | 4 + .../Service/ServiceAssemblyContent.fs | 5 +- .../Service/ServiceAssemblyContent.fsi | 5 + src/Compiler/Service/ServiceLexing.fs | 4 + src/Compiler/Service/ServiceLexing.fsi | 3 +- src/Compiler/Service/ServiceParsedInputOps.fs | 39 + src/Compiler/Service/service.fs | 10 + src/Compiler/Service/service.fsi | 4 + src/Compiler/Symbols/Exprs.fs | 8 + src/Compiler/Symbols/Exprs.fsi | 3 + src/Compiler/Symbols/FSharpDiagnostic.fs | 4 + src/Compiler/Symbols/SymbolHelpers.fs | 7 + src/Compiler/Symbols/Symbols.fs | 10 + src/Compiler/SyntaxTree/LexFilter.fsi | 6 +- src/Compiler/SyntaxTree/LexHelpers.fs | 25 + src/Compiler/SyntaxTree/ParseHelpers.fs | 11 +- src/Compiler/SyntaxTree/PrettyNaming.fs | 4 + src/Compiler/SyntaxTree/UnicodeLexing.fs | 19 +- src/Compiler/SyntaxTree/UnicodeLexing.fsi | 8 +- src/Compiler/SyntaxTree/XmlDoc.fs | 21 + src/Compiler/SyntaxTree/XmlDoc.fsi | 2 + src/Compiler/TypedTree/CompilerGlobalState.fs | 14 +- src/Compiler/TypedTree/QuotationPickler.fs | 12 + src/Compiler/TypedTree/TcGlobals.fs | 6 + src/Compiler/TypedTree/TypedTree.fs | 11 + src/Compiler/TypedTree/TypedTree.fsi | 12 + src/Compiler/TypedTree/TypedTreeBasics.fs | 3 +- src/Compiler/TypedTree/TypedTreeOps.fs | 26 + src/Compiler/TypedTree/TypedTreeOps.fsi | 8 + src/Compiler/TypedTree/TypedTreePickle.fs | 10 + src/Compiler/Utilities/Activity.fs | 19 + src/Compiler/Utilities/Activity.fsi | 2 + src/Compiler/Utilities/Cancellable.fs | 6 + src/Compiler/Utilities/FileSystem.fs | 88 ++ src/Compiler/Utilities/FileSystem.fsi | 75 ++ src/Compiler/Utilities/HashMultiMap.fs | 18 + src/Compiler/Utilities/HashMultiMap.fsi | 3 + src/Compiler/Utilities/PathMap.fs | 4 + src/Compiler/Utilities/TaggedCollections.fs | 17 + src/Compiler/Utilities/ildiag.fs | 10 + src/Compiler/Utilities/ildiag.fsi | 2 + src/Compiler/Utilities/illib.fs | 28 + src/Compiler/Utilities/illib.fsi | 6 + src/Compiler/Utilities/lib.fs | 19 + src/Compiler/Utilities/lib.fsi | 2 + src/Compiler/Utilities/range.fs | 15 + src/Compiler/Utilities/sformat.fs | 4 + src/Compiler/Utilities/sformat.fsi | 4 + src/Compiler/lex.fsl | 62 +- src/Compiler/pars.fsy | 4 +- 129 files changed, 5701 insertions(+), 290 deletions(-) create mode 100644 fcs/build.sh create mode 100644 fcs/fcs-fable/.gitignore create mode 100644 fcs/fcs-fable/FSStrings.fs create mode 100644 fcs/fcs-fable/SR.fs create mode 100644 fcs/fcs-fable/System.Collections.fs create mode 100644 fcs/fcs-fable/System.IO.fs create mode 100644 fcs/fcs-fable/System.fs create mode 100644 fcs/fcs-fable/TcImports_shim.fs create mode 100644 fcs/fcs-fable/ast_print.fs create mode 100644 fcs/fcs-fable/codegen/codegen.fsproj create mode 100644 fcs/fcs-fable/codegen/fssrgen.fsx create mode 100644 fcs/fcs-fable/codegen/fssrgen.targets create mode 100644 fcs/fcs-fable/fcs-fable.fsproj create mode 100644 fcs/fcs-fable/service_slim.fs create mode 100644 fcs/fcs-fable/test/.gitignore create mode 100644 fcs/fcs-fable/test/Metadata.fs create mode 100644 fcs/fcs-fable/test/Platform.fs create mode 100644 fcs/fcs-fable/test/ProjectParser.fs create mode 100644 fcs/fcs-fable/test/bench/bench.fs create mode 100644 fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj create mode 100644 fcs/fcs-fable/test/fcs-fable-test.fsproj create mode 100644 fcs/fcs-fable/test/nuget.config create mode 100644 fcs/fcs-fable/test/package.json create mode 100644 fcs/fcs-fable/test/test.fs create mode 100644 fcs/fcs-fable/test/test_script.fsx mode change 100644 => 100755 src/Compiler/Checking/NicePrint.fs diff --git a/.vscode/launch.json b/.vscode/launch.json index b93e358bbc1..3dec32505e3 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -92,6 +92,16 @@ "enableStepFiltering": false, "requireExactSource": false, "allowFastEvaluate": true + }, + { + "name": "FCS-Fable Test", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-fable-test/Debug/net9.0/fcs-fable-test.dll", + "args": [], + "cwd": "${workspaceFolder}/fcs/fcs-fable/test", + "console": "internalConsole", + "stopAtEntry": false } ] } diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index 86346fc2a15..b4160b714f2 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net8.0\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net8.0\fsyacc.dll diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 00000000000..f8eca34a882 --- /dev/null +++ b/fcs/build.sh @@ -0,0 +1,40 @@ +#!/usr/bin/env bash + +# cd to root +cd $(dirname $0)/.. + +# build fslex/fsyacc tools +dotnet build -c Release buildtools +# build FSharp.Compiler.Service (to make sure it's not broken) +dotnet build -c Release src/Compiler + +# build FCS-Fable codegen +cd fcs/fcs-fable/codegen +dotnet build -c Release +dotnet run -c Release -- ../../../src/Compiler/FSComp.txt FSComp.fs +dotnet run -c Release -- ../../../src/Compiler/Interactive/FSIstrings.txt FSIstrings.fs + +# cleanup comments +files="FSComp.fs FSIstrings.fs" +for file in $files; do + echo "Delete comments in $file" + sed -i '1s/^\xEF\xBB\xBF//' $file # remove BOM + sed -i '/^ *\/\//d' $file # delete all comment lines +done + +# replace all #line directives with comments +files="lex.fs pplex.fs illex.fs ilpars.fs pars.fs pppars.fs" +for file in $files; do + echo "Replace #line directives with comments in $file" + sed -i 's/^# [0-9]/\/\/\0/' $file # comment all #line directives + sed -i 's/^\(\/\/# [0-9]\{1,\} "\).*\/codegen\/\(\.\.\/\)*/\1/' $file # cleanup #line paths +done + +# build FCS-Fable +cd .. +dotnet build -c Release + +# run some tests +cd test +npm test +# npm run bench diff --git a/fcs/fcs-fable/.gitignore b/fcs/fcs-fable/.gitignore new file mode 100644 index 00000000000..db7b2bd5665 --- /dev/null +++ b/fcs/fcs-fable/.gitignore @@ -0,0 +1,3 @@ +# Codegen +codegen/*.fs +codegen/*.fsi diff --git a/fcs/fcs-fable/FSStrings.fs b/fcs/fcs-fable/FSStrings.fs new file mode 100644 index 00000000000..42257eecaca --- /dev/null +++ b/fcs/fcs-fable/FSStrings.fs @@ -0,0 +1,1013 @@ +module internal SR.Resources + +let resources = + dict [ + ( "SeeAlso", + ". See also {0}." + ); + ( "ConstraintSolverTupleDiffLengths", + "The tuples have differing lengths of {0} and {1}" + ); + ( "ConstraintSolverInfiniteTypes", + "The types '{0}' and '{1}' cannot be unified." + ); + ( "ConstraintSolverMissingConstraint", + "A type parameter is missing a constraint '{0}'" + ); + ( "ConstraintSolverTypesNotInEqualityRelation1", + "The unit of measure '{0}' does not match the unit of measure '{1}'" + ); + ( "ConstraintSolverTypesNotInEqualityRelation2", + "The type '{0}' does not match the type '{1}'" + ); + ( "ConstraintSolverTypesNotInSubsumptionRelation", + "The type '{0}' is not compatible with the type '{1}'{2}" + ); + ( "ErrorFromAddingTypeEquation1", + "This expression was expected to have type\n '{1}' \nbut here has type\n '{0}' {2}" + ); + ( "ErrorFromAddingTypeEquation2", + "Type mismatch. Expecting a\n '{0}' \nbut given a\n '{1}' {2}\n" + ); + ( "ErrorFromApplyingDefault1", + "Type constraint mismatch when applying the default type '{0}' for a type inference variable. " + ); + ( "ErrorFromApplyingDefault2", + " Consider adding further type constraints" + ); + ( "ErrorsFromAddingSubsumptionConstraint", + "Type constraint mismatch. The type \n '{0}' \nis not compatible with type\n '{1}' {2}\n" + ); + ( "UpperCaseIdentifierInPattern", + "Uppercase variable identifiers should not generally be used in patterns, and may indicate a missing open declaration or a misspelt pattern name." + ); + ( "NotUpperCaseConstructor", + "Discriminated union cases and exception labels must be uppercase identifiers" + ); + ( "FunctionExpected", + "This function takes too many arguments, or is used in a context where a function is not expected" + ); + ( "BakedInMemberConstraintName", + "Member constraints with the name '{0}' are given special status by the F# compiler as certain .NET types are implicitly augmented with this member. This may result in runtime failures if you attempt to invoke the member constraint from your own code." + ); + ( "BadEventTransformation", + "A definition to be compiled as a .NET event does not have the expected form. Only property members can be compiled as .NET events." + ); + ( "ParameterlessStructCtor", + "Implicit object constructors for structs must take at least one argument" + ); + ( "InterfaceNotRevealed", + "The type implements the interface '{0}' but this is not revealed by the signature. You should list the interface in the signature, as the interface will be discoverable via dynamic type casts and/or reflection." + ); + ( "TyconBadArgs", + "The type '{0}' expects {1} type argument(s) but is given {2}" + ); + ( "IndeterminateType", + "Lookup on object of indeterminate type based on information prior to this program point. A type annotation may be needed prior to this program point to constrain the type of the object. This may allow the lookup to be resolved." + ); + ( "NameClash1", + "Duplicate definition of {0} '{1}'" + ); + ( "NameClash2", + "The {0} '{1}' can not be defined because the name '{2}' clashes with the {3} '{4}' in this type or module" + ); + ( "Duplicate1", + "Two members called '{0}' have the same signature" + ); + ( "Duplicate2", + "Duplicate definition of {0} '{1}'" + ); + ( "UndefinedName2", + " A construct with this name was found in FSharp.PowerPack.dll, which contains some modules and types that were implicitly referenced in some previous versions of F#. You may need to add an explicit reference to this DLL in order to compile this code." + ); + ( "FieldNotMutable", + "This field is not mutable" + ); + ( "FieldsFromDifferentTypes", + "The fields '{0}' and '{1}' are from different types" + ); + ( "VarBoundTwice", + "'{0}' is bound twice in this pattern" + ); + ( "Recursion", + "A use of the function '{0}' does not match a type inferred elsewhere. The inferred type of the function is\n {1}. \nThe type of the function required at this point of use is\n {2} {3}\nThis error may be due to limitations associated with generic recursion within a 'let rec' collection or within a group of classes. Consider giving a full type signature for the targets of recursive calls including type annotations for both argument and return types." + ); + ( "InvalidRuntimeCoercion", + "Invalid runtime coercion or type test from type {0} to {1}\n{2}" + ); + ( "IndeterminateRuntimeCoercion", + "This runtime coercion or type test from type\n {0} \n to \n {1} \ninvolves an indeterminate type based on information prior to this program point. Runtime type tests are not allowed on some types. Further type annotations are needed." + ); + ( "IndeterminateStaticCoercion", + "The static coercion from type\n {0} \nto \n {1} \n involves an indeterminate type based on information prior to this program point. Static coercions are not allowed on some types. Further type annotations are needed." + ); + ( "StaticCoercionShouldUseBox", + "A coercion from the value type \n {0} \nto the type \n {1} \nwill involve boxing. Consider using 'box' instead" + ); + ( "TypeIsImplicitlyAbstract", + "This type is 'abstract' since some abstract members have not been given an implementation. If this is intentional then add the '[]' attribute to your type." + ); + ( "NonRigidTypar1", + "This construct causes code to be less generic than indicated by its type annotations. The type variable implied by the use of a '#', '_' or other type annotation at or near '{0}' has been constrained to be type '{1}'." + ); + ( "NonRigidTypar2", + "This construct causes code to be less generic than indicated by the type annotations. The unit-of-measure variable '{0} has been constrained to be measure '{1}'." + ); + ( "NonRigidTypar3", + "This construct causes code to be less generic than indicated by the type annotations. The type variable '{0} has been constrained to be type '{1}'." + ); + ( "Parser.TOKEN.IDENT", + "identifier" + ); + ( "Parser.TOKEN.INT", + "integer literal" + ); + ( "Parser.TOKEN.FLOAT", + "floating point literal" + ); + ( "Parser.TOKEN.DECIMAL", + "decimal literal" + ); + ( "Parser.TOKEN.CHAR", + "character literal" + ); + ( "Parser.TOKEN.BASE", + "keyword 'base'" + ); + ( "Parser.TOKEN.LPAREN.STAR.RPAREN", + "symbol '(*)'" + ); + ( "Parser.TOKEN.DOLLAR", + "symbol '$'" + ); + ( "Parser.TOKEN.INFIX.STAR.STAR.OP", + "infix operator" + ); + ( "Parser.TOKEN.INFIX.COMPARE.OP", + "infix operator" + ); + ( "Parser.TOKEN.COLON.GREATER", + "symbol ':>'" + ); + ( "Parser.TOKEN.COLON.COLON", + "symbol '::'" + ); + ( "Parser.TOKEN.PERCENT.OP", + "symbol '{0}" + ); + ( "Parser.TOKEN.INFIX.AT.HAT.OP", + "infix operator" + ); + ( "Parser.TOKEN.INFIX.BAR.OP", + "infix operator" + ); + ( "Parser.TOKEN.PLUS.MINUS.OP", + "infix operator" + ); + ( "Parser.TOKEN.PREFIX.OP", + "prefix operator" + ); + ( "Parser.TOKEN.COLON.QMARK.GREATER", + "symbol ':?>'" + ); + ( "Parser.TOKEN.INFIX.STAR.DIV.MOD.OP", + "infix operator" + ); + ( "Parser.TOKEN.INFIX.AMP.OP", + "infix operator" + ); + ( "Parser.TOKEN.AMP", + "symbol '&'" + ); + ( "Parser.TOKEN.AMP.AMP", + "symbol '&&'" + ); + ( "Parser.TOKEN.BAR.BAR", + "symbol '||'" + ); + ( "Parser.TOKEN.LESS", + "symbol '<'" + ); + ( "Parser.TOKEN.GREATER", + "symbol '>'" + ); + ( "Parser.TOKEN.QMARK", + "symbol '?'" + ); + ( "Parser.TOKEN.QMARK.QMARK", + "symbol '??'" + ); + ( "Parser.TOKEN.COLON.QMARK", + "symbol ':?'" + ); + ( "Parser.TOKEN.INT32.DOT.DOT", + "integer.." + ); + ( "Parser.TOKEN.DOT.DOT", + "symbol '..'" + ); + ( "Parser.TOKEN.DOT.DOT.HAT", + "symbol '..^'" + ); + ( "Parser.TOKEN.QUOTE", + "quote symbol" + ); + ( "Parser.TOKEN.STAR", + "symbol '*'" + ); + ( "Parser.TOKEN.HIGH.PRECEDENCE.TYAPP", + "type application " + ); + ( "Parser.TOKEN.COLON", + "symbol ':'" + ); + ( "Parser.TOKEN.COLON.EQUALS", + "symbol ':='" + ); + ( "Parser.TOKEN.LARROW", + "symbol '<-'" + ); + ( "Parser.TOKEN.EQUALS", + "symbol '='" + ); + ( "Parser.TOKEN.GREATER.BAR.RBRACK", + "symbol '>|]'" + ); + ( "Parser.TOKEN.MINUS", + "symbol '-'" + ); + ( "Parser.TOKEN.ADJACENT.PREFIX.OP", + "prefix operator" + ); + ( "Parser.TOKEN.FUNKY.OPERATOR.NAME", + "operator name" + ); + ( "Parser.TOKEN.COMMA", + "symbol ','" + ); + ( "Parser.TOKEN.DOT", + "symbol '.'" + ); + ( "Parser.TOKEN.BAR", + "symbol '|'" + ); + ( "Parser.TOKEN.HASH", + "symbol #" + ); + ( "Parser.TOKEN.UNDERSCORE", + "symbol '_'" + ); + ( "Parser.TOKEN.SEMICOLON", + "symbol ';'" + ); + ( "Parser.TOKEN.SEMICOLON.SEMICOLON", + "symbol ';;'" + ); + ( "Parser.TOKEN.LPAREN", + "symbol '('" + ); + ( "Parser.TOKEN.RPAREN", + "symbol ')'" + ); + ( "Parser.TOKEN.SPLICE.SYMBOL", + "symbol 'splice'" + ); + ( "Parser.TOKEN.LQUOTE", + "start of quotation" + ); + ( "Parser.TOKEN.LBRACK", + "symbol '['" + ); + ( "Parser.TOKEN.LBRACE.BAR", + "symbol '{|'" + ); + ( "Parser.TOKEN.LBRACK.BAR", + "symbol '[|'" + ); + ( "Parser.TOKEN.LBRACK.LESS", + "symbol '[<'" + ); + ( "Parser.TOKEN.LBRACE", + "symbol '{'" + ); + ( "Parser.TOKEN.LBRACE.LESS", + "symbol '{<'" + ); + ( "Parser.TOKEN.BAR.RBRACK", + "symbol '|]'" + ); + ( "Parser.TOKEN.BAR.RBRACE", + "symbol '|}'" + ); + ( "Parser.TOKEN.GREATER.RBRACE", + "symbol '>}'" + ); + ( "Parser.TOKEN.GREATER.RBRACK", + "symbol '>]'" + ); + ( "Parser.TOKEN.RQUOTE", + "end of quotation" + ); + ( "Parser.TOKEN.RBRACK", + "symbol ']'" + ); + ( "Parser.TOKEN.RBRACE", + "symbol '}'" + ); + ( "Parser.TOKEN.PUBLIC", + "keyword 'public'" + ); + ( "Parser.TOKEN.PRIVATE", + "keyword 'private'" + ); + ( "Parser.TOKEN.INTERNAL", + "keyword 'internal'" + ); + ( "Parser.TOKEN.FIXED", + "keyword 'fixed'" + ); + ( "Parser.TOKEN.INTERP.STRING.BEGIN.END", + "interpolated string" + ); + ( "Parser.TOKEN.INTERP.STRING.BEGIN.PART", + "interpolated string (first part)" + ); + ( "Parser.TOKEN.INTERP.STRING.PART", + "interpolated string (part)" + ); + ( "Parser.TOKEN.INTERP.STRING.END", + "interpolated string (final part)" + ); + ( "Parser.TOKEN.CONSTRAINT", + "keyword 'constraint'" + ); + ( "Parser.TOKEN.INSTANCE", + "keyword 'instance'" + ); + ( "Parser.TOKEN.DELEGATE", + "keyword 'delegate'" + ); + ( "Parser.TOKEN.INHERIT", + "keyword 'inherit'" + ); + ( "Parser.TOKEN.CONSTRUCTOR", + "keyword 'constructor'" + ); + ( "Parser.TOKEN.DEFAULT", + "keyword 'default'" + ); + ( "Parser.TOKEN.OVERRIDE", + "keyword 'override'" + ); + ( "Parser.TOKEN.ABSTRACT", + "keyword 'abstract'" + ); + ( "Parser.TOKEN.CLASS", + "keyword 'class'" + ); + ( "Parser.TOKEN.MEMBER", + "keyword 'member'" + ); + ( "Parser.TOKEN.STATIC", + "keyword 'static'" + ); + ( "Parser.TOKEN.NAMESPACE", + "keyword 'namespace'" + ); + ( "Parser.TOKEN.OBLOCKBEGIN", + "start of structured construct" + ); + ( "Parser.TOKEN.OBLOCKEND", + "incomplete structured construct at or before this point" + ); + ( "BlockEndSentence", + "Incomplete structured construct at or before this point" + ); + ( "Parser.TOKEN.OTHEN", + "keyword 'then'" + ); + ( "Parser.TOKEN.OELSE", + "keyword 'else'" + ); + ( "Parser.TOKEN.OLET", + "keyword 'let' or 'use'" + ); + ( "Parser.TOKEN.BINDER", + "binder keyword" + ); + ( "Parser.TOKEN.ODO", + "keyword 'do'" + ); + ( "Parser.TOKEN.CONST", + "keyword 'const'" + ); + ( "Parser.TOKEN.OWITH", + "keyword 'with'" + ); + ( "Parser.TOKEN.OFUNCTION", + "keyword 'function'" + ); + ( "Parser.TOKEN.OFUN", + "keyword 'fun'" + ); + ( "Parser.TOKEN.ORESET", + "end of input" + ); + ( "Parser.TOKEN.ODUMMY", + "internal dummy token" + ); + ( "Parser.TOKEN.ODO.BANG", + "keyword 'do!'" + ); + ( "Parser.TOKEN.YIELD", + "yield" + ); + ( "Parser.TOKEN.YIELD.BANG", + "yield!" + ); + ( "Parser.TOKEN.OINTERFACE.MEMBER", + "keyword 'interface'" + ); + ( "Parser.TOKEN.ELIF", + "keyword 'elif'" + ); + ( "Parser.TOKEN.RARROW", + "symbol '->'" + ); + ( "Parser.TOKEN.SIG", + "keyword 'sig'" + ); + ( "Parser.TOKEN.STRUCT", + "keyword 'struct'" + ); + ( "Parser.TOKEN.UPCAST", + "keyword 'upcast'" + ); + ( "Parser.TOKEN.DOWNCAST", + "keyword 'downcast'" + ); + ( "Parser.TOKEN.NULL", + "keyword 'null'" + ); + ( "Parser.TOKEN.RESERVED", + "reserved keyword" + ); + ( "Parser.TOKEN.MODULE", + "keyword 'module'" + ); + ( "Parser.TOKEN.AND", + "keyword 'and'" + ); + ( "Parser.TOKEN.AND.BANG", + "keyword 'and!'" + ); + ( "Parser.TOKEN.AS", + "keyword 'as'" + ); + ( "Parser.TOKEN.ASSERT", + "keyword 'assert'" + ); + ( "Parser.TOKEN.ASR", + "keyword 'asr'" + ); + ( "Parser.TOKEN.DOWNTO", + "keyword 'downto'" + ); + ( "Parser.TOKEN.EXCEPTION", + "keyword 'exception'" + ); + ( "Parser.TOKEN.FALSE", + "keyword 'false'" + ); + ( "Parser.TOKEN.FOR", + "keyword 'for'" + ); + ( "Parser.TOKEN.FUN", + "keyword 'fun'" + ); + ( "Parser.TOKEN.FUNCTION", + "keyword 'function'" + ); + ( "Parser.TOKEN.FINALLY", + "keyword 'finally'" + ); + ( "Parser.TOKEN.LAZY", + "keyword 'lazy'" + ); + ( "Parser.TOKEN.MATCH", + "keyword 'match'" + ); + ( "Parser.TOKEN.MATCH.BANG", + "keyword 'match!'" + ); + ( "Parser.TOKEN.MUTABLE", + "keyword 'mutable'" + ); + ( "Parser.TOKEN.NEW", + "keyword 'new'" + ); + ( "Parser.TOKEN.OF", + "keyword 'of'" + ); + ( "Parser.TOKEN.OPEN", + "keyword 'open'" + ); + ( "Parser.TOKEN.OR", + "keyword 'or'" + ); + ( "Parser.TOKEN.VOID", + "keyword 'void'" + ); + ( "Parser.TOKEN.EXTERN", + "keyword 'extern'" + ); + ( "Parser.TOKEN.INTERFACE", + "keyword 'interface'" + ); + ( "Parser.TOKEN.REC", + "keyword 'rec'" + ); + ( "Parser.TOKEN.TO", + "keyword 'to'" + ); + ( "Parser.TOKEN.TRUE", + "keyword 'true'" + ); + ( "Parser.TOKEN.TRY", + "keyword 'try'" + ); + ( "Parser.TOKEN.TYPE", + "keyword 'type'" + ); + ( "Parser.TOKEN.VAL", + "keyword 'val'" + ); + ( "Parser.TOKEN.INLINE", + "keyword 'inline'" + ); + ( "Parser.TOKEN.WHEN", + "keyword 'when'" + ); + ( "Parser.TOKEN.WHILE", + "keyword 'while'" + ); + ( "Parser.TOKEN.WITH", + "keyword 'with'" + ); + ( "Parser.TOKEN.IF", + "keyword 'if'" + ); + ( "Parser.TOKEN.DO", + "keyword 'do'" + ); + ( "Parser.TOKEN.GLOBAL", + "keyword 'global'" + ); + ( "Parser.TOKEN.DONE", + "keyword 'done'" + ); + ( "Parser.TOKEN.IN", + "keyword 'in'" + ); + ( "Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP", + "symbol '('" + ); + ( "Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP", + "symbol'['" + ); + ( "Parser.TOKEN.BEGIN", + "keyword 'begin'" + ); + ( "Parser.TOKEN.END", + "keyword 'end'" + ); + ( "Parser.TOKEN.HASH.ENDIF", + "directive" + ); + ( "Parser.TOKEN.INACTIVECODE", + "inactive code" + ); + ( "Parser.TOKEN.LEX.FAILURE", + "lex failure" + ); + ( "Parser.TOKEN.WHITESPACE", + "whitespace" + ); + ( "Parser.TOKEN.COMMENT", + "comment" + ); + ( "Parser.TOKEN.LINE.COMMENT", + "line comment" + ); + ( "Parser.TOKEN.STRING.TEXT", + "string text" + ); + ( "Parser.TOKEN.KEYWORD_STRING", + "compiler generated literal" + ); + ( "Parser.TOKEN.BYTEARRAY", + "byte array literal" + ); + ( "Parser.TOKEN.STRING", + "string literal" + ); + ( "Parser.TOKEN.EOF", + "end of input" + ); + ( "UnexpectedEndOfInput", + "Unexpected end of input" + ); + ( "Unexpected", + "Unexpected {0}" + ); + ( "NONTERM.interaction", + " in interaction" + ); + ( "NONTERM.hashDirective", + " in directive" + ); + ( "NONTERM.fieldDecl", + " in field declaration" + ); + ( "NONTERM.unionCaseRepr", + " in discriminated union case declaration" + ); + ( "NONTERM.localBinding", + " in binding" + ); + ( "NONTERM.hardwhiteLetBindings", + " in binding" + ); + ( "NONTERM.classDefnMember", + " in member definition" + ); + ( "NONTERM.defnBindings", + " in definitions" + ); + ( "NONTERM.classMemberSpfn", + " in member signature" + ); + ( "NONTERM.valSpfn", + " in value signature" + ); + ( "NONTERM.tyconSpfn", + " in type signature" + ); + ( "NONTERM.anonLambdaExpr", + " in lambda expression" + ); + ( "NONTERM.attrUnionCaseDecl", + " in union case" + ); + ( "NONTERM.cPrototype", + " in extern declaration" + ); + ( "NONTERM.objectImplementationMembers", + " in object expression" + ); + ( "NONTERM.ifExprCases", + " in if/then/else expression" + ); + ( "NONTERM.openDecl", + " in open declaration" + ); + ( "NONTERM.fileModuleSpec", + " in module or namespace signature" + ); + ( "NONTERM.patternClauses", + " in pattern matching" + ); + ( "NONTERM.beginEndExpr", + " in begin/end expression" + ); + ( "NONTERM.recdExpr", + " in record expression" + ); + ( "NONTERM.tyconDefn", + " in type definition" + ); + ( "NONTERM.exconCore", + " in exception definition" + ); + ( "NONTERM.typeNameInfo", + " in type name" + ); + ( "NONTERM.attributeList", + " in attribute list" + ); + ( "NONTERM.quoteExpr", + " in quotation literal" + ); + ( "NONTERM.typeConstraint", + " in type constraint" + ); + ( "NONTERM.Category.ImplementationFile", + " in implementation file" + ); + ( "NONTERM.Category.Definition", + " in definition" + ); + ( "NONTERM.Category.SignatureFile", + " in signature file" + ); + ( "NONTERM.Category.Pattern", + " in pattern" + ); + ( "NONTERM.Category.Expr", + " in expression" + ); + ( "NONTERM.Category.Type", + " in type" + ); + ( "NONTERM.typeArgsActual", + " in type arguments" + ); + ( "FixKeyword", + "keyword " + ); + ( "FixSymbol", + "symbol " + ); + ( "FixReplace", + " (due to indentation-aware syntax)" + ); + ( "TokenName1", + ". Expected {0} or other token." + ); + ( "TokenName1TokenName2", + ". Expected {0}, {1} or other token." + ); + ( "TokenName1TokenName2TokenName3", + ". Expected {0}, {1}, {2} or other token." + ); + ( "RuntimeCoercionSourceSealed1", + "The type '{0}' cannot be used as the source of a type test or runtime coercion" + ); + ( "RuntimeCoercionSourceSealed2", + "The type '{0}' does not have any proper subtypes and cannot be used as the source of a type test or runtime coercion." + ); + ( "CoercionTargetSealed", + "The type '{0}' does not have any proper subtypes and need not be used as the target of a static coercion" + ); + ( "UpcastUnnecessary", + "This upcast is unnecessary - the types are identical" + ); + ( "TypeTestUnnecessary", + "This type test or downcast will always hold" + ); + ( "OverrideDoesntOverride1", + "The member '{0}' does not have the correct type to override any given virtual method" + ); + ( "OverrideDoesntOverride2", + "The member '{0}' does not have the correct type to override the corresponding abstract method." + ); + ( "OverrideDoesntOverride3", + " The required signature is '{0}'." + ); + ( "OverrideDoesntOverride4", + "The member '{0}' is specialized with 'unit' but 'unit' can't be used as return type of an abstract method parameterized on return type." + ); + ( "OverrideShouldBeStatic", + " Static member is expected." + ); + ( "OverrideShouldBeInstance", + " Non-static member is expected." + ); + ( "UnionCaseWrongArguments", + "This constructor is applied to {0} argument(s) but expects {1}" + ); + ( "UnionPatternsBindDifferentNames", + "The two sides of this 'or' pattern bind different sets of variables" + ); + ( "ValueNotContained", + "Module '{0}' contains\n {1} \nbut its signature specifies\n {2} \n{3}." + ); + ( "RequiredButNotSpecified", + "Module '{0}' requires a {1} '{2}'" + ); + ( "UseOfAddressOfOperator", + "The use of native pointers may result in unverifiable .NET IL code" + ); + ( "DefensiveCopyWarning", + "{0}" + ); + ( "DeprecatedThreadStaticBindingWarning", + "Thread static and context static 'let' bindings are deprecated. Instead use a declaration of the form 'static val mutable : ' in a class. Add the 'DefaultValue' attribute to this declaration to indicate that the value is initialized to the default value on each new thread." + ); + ( "FunctionValueUnexpected", + "This expression is a function value, i.e. is missing arguments. Its type is {0}." + ); + ( "UnitTypeExpected", + "The result of this expression has type '{0}' and is implicitly ignored. Consider using 'ignore' to discard this value explicitly, e.g. 'expr |> ignore', or 'let' to bind the result to a name, e.g. 'let result = expr'." + ); + ( "UnitTypeExpectedWithEquality", + "The result of this equality expression has type '{0}' and is implicitly discarded. Consider using 'let' to bind the result to a name, e.g. 'let result = expression'." + ); + ( "UnitTypeExpectedWithPossiblePropertySetter", + "The result of this equality expression has type '{0}' and is implicitly discarded. Consider using 'let' to bind the result to a name, e.g. 'let result = expression'. If you intended to set a value to a property, then use the '<-' operator e.g. '{1}.{2} <- expression'." + ); + ( "UnitTypeExpectedWithPossibleAssignment", + "The result of this equality expression has type '{0}' and is implicitly discarded. Consider using 'let' to bind the result to a name, e.g. 'let result = expression'. If you intended to mutate a value, then mark the value 'mutable' and use the '<-' operator e.g. '{1} <- expression'." + ); + ( "UnitTypeExpectedWithPossibleAssignmentToMutable", + "The result of this equality expression has type '{0}' and is implicitly discarded. Consider using 'let' to bind the result to a name, e.g. 'let result = expression'. If you intended to mutate a value, then use the '<-' operator e.g. '{1} <- expression'." + ); + ( "RecursiveUseCheckedAtRuntime", + "This recursive use will be checked for initialization-soundness at runtime. This warning is usually harmless, and may be suppressed by using '#nowarn \"21\"' or '--nowarn:21'." + ); + ( "LetRecUnsound1", + "The value '{0}' will be evaluated as part of its own definition" + ); + ( "LetRecUnsound2", + "This value will be eventually evaluated as part of its own definition. You may need to make the value lazy or a function. Value '{0}'{1}." + ); + ( "LetRecUnsoundInner", + " will evaluate '{0}'" + ); + ( "LetRecEvaluatedOutOfOrder", + "Bindings may be executed out-of-order because of this forward reference." + ); + ( "LetRecCheckedAtRuntime", + "This and other recursive references to the object(s) being defined will be checked for initialization-soundness at runtime through the use of a delayed reference. This is because you are defining one or more recursive objects, rather than recursive functions. This warning may be suppressed by using '#nowarn \"40\"' or '--nowarn:40'." + ); + ( "SelfRefObjCtor1", + "Recursive references to the object being defined will be checked for initialization soundness at runtime through the use of a delayed reference. Consider placing self-references in members or within a trailing expression of the form ' then '." + ); + ( "SelfRefObjCtor2", + "Recursive references to the object being defined will be checked for initialization soundness at runtime through the use of a delayed reference. Consider placing self-references within 'do' statements after the last 'let' binding in the construction sequence." + ); + ( "VirtualAugmentationOnNullValuedType", + "The containing type can use 'null' as a representation value for its nullary union case. Invoking an abstract or virtual member or an interface implementation on a null value will lead to an exception. If necessary add a dummy data value to the nullary constructor to avoid 'null' being used as a representation for this type." + ); + ( "NonVirtualAugmentationOnNullValuedType", + "The containing type can use 'null' as a representation value for its nullary union case. This member will be compiled as a static member." + ); + ( "NonUniqueInferredAbstractSlot1", + "The member '{0}' doesn't correspond to a unique abstract slot based on name and argument count alone" + ); + ( "NonUniqueInferredAbstractSlot2", + ". Multiple implemented interfaces have a member with this name and argument count" + ); + ( "NonUniqueInferredAbstractSlot3", + ". Consider implementing interfaces '{0}' and '{1}' explicitly." + ); + ( "NonUniqueInferredAbstractSlot4", + ". Additional type annotations may be required to indicate the relevant override. This warning can be disabled using '#nowarn \"70\"' or '--nowarn:70'." + ); + ( "Failure1", + "parse error" + ); + ( "Failure2", + "parse error: unexpected end of file" + ); + ( "Failure3", + "{0}" + ); + ( "Failure4", + "internal error: {0}" + ); + ( "FullAbstraction", + "{0}" + ); + ( "MatchIncomplete1", + "Incomplete pattern matches on this expression." + ); + ( "MatchIncomplete2", + " For example, the value '{0}' may indicate a case not covered by the pattern(s)." + ); + ( "MatchIncomplete3", + " For example, the value '{0}' may indicate a case not covered by the pattern(s). However, a pattern rule with a 'when' clause might successfully match this value." + ); + ( "MatchIncomplete4", + " Unmatched elements will be ignored." + ); + ( "EnumMatchIncomplete1", + "Enums may take values outside known cases." + ); + ( "RuleNeverMatched", + "This rule will never be matched" + ); + ( "ValNotMutable", + "This value is not mutable. Consider using the mutable keyword, e.g. 'let mutable {0} = expression'." + ); + ( "ValNotLocal", + "This value is not local" + ); + ( "Obsolete1", + "This construct is deprecated" + ); + ( "Obsolete2", + ". {0}" + ); + ( "Experimental", + "{0}. This warning can be disabled using '--nowarn:57' or '#nowarn \"57\"'." + ); + ( "PossibleUnverifiableCode", + "Uses of this construct may result in the generation of unverifiable .NET IL code. This warning can be disabled using '--nowarn:9' or '#nowarn \"9\"'." + ); + ( "Deprecated", + "This construct is deprecated: {0}" + ); + ( "LibraryUseOnly", + "This construct is deprecated: it is only for use in the F# library" + ); + ( "MissingFields", + "The following fields require values: {0}" + ); + ( "ValueRestriction1", + "Value restriction. The value '{0}' has generic type\n {1} \nEither make the arguments to '{2}' explicit or, if you do not intend for it to be generic, add a type annotation." + ); + ( "ValueRestriction2", + "Value restriction. The value '{0}' has generic type\n {1} \nEither make '{2}' into a function with explicit arguments or, if you do not intend for it to be generic, add a type annotation." + ); + ( "ValueRestriction3", + "Value restriction. This member has been inferred to have generic type\n {0} \nConstructors and property getters/setters cannot be more generic than the enclosing type. Add a type annotation to indicate the exact types involved." + ); + ( "ValueRestriction4", + "Value restriction. The value '{0}' has been inferred to have generic type\n {1} \nEither make the arguments to '{2}' explicit or, if you do not intend for it to be generic, add a type annotation." + ); + ( "ValueRestriction5", + "Value restriction. The value '{0}' has been inferred to have generic type\n {1} \nEither define '{2}' as a simple data term, make it a function with explicit arguments or, if you do not intend for it to be generic, add a type annotation." + ); + ( "RecoverableParseError", + "syntax error" + ); + ( "ReservedKeyword", + "{0}" + ); + ( "IndentationProblem", + "{0}" + ); + ( "OverrideInIntrinsicAugmentation", + "Override implementations in augmentations are now deprecated. Override implementations should be given as part of the initial declaration of a type." + ); + ( "OverrideInExtrinsicAugmentation", + "Override implementations should be given as part of the initial declaration of a type." + ); + ( "IntfImplInIntrinsicAugmentation", + "Interface implementations should normally be given on the initial declaration of a type. Interface implementations in augmentations may lead to accessing static bindings before they are initialized, though only if the interface implementation is invoked during initialization of the static data, and in turn access the static data. You may remove this warning using #nowarn \"69\" if you have checked this is not the case." + ); + ( "IntfImplInExtrinsicAugmentation", + "Interface implementations should be given on the initial declaration of a type." + ); + ( "UnresolvedReferenceNoRange", + "A required assembly reference is missing. You must add a reference to assembly '{0}'." + ); + ( "UnresolvedPathReferenceNoRange", + "The type referenced through '{0}' is defined in an assembly that is not referenced. You must add a reference to assembly '{1}'." + ); + ( "HashIncludeNotAllowedInNonScript", + "#I directives may only occur in F# script files (extensions .fsx or .fsscript). Either move this code to a script file, add a '-I' compiler option for this reference or delimit the directive with delimit it with '#if INTERACTIVE'/'#endif'." + ); + ( "HashReferenceNotAllowedInNonScript", + "#r directives may only occur in F# script files (extensions .fsx or .fsscript). Either move this code to a script file or replace this reference with the '-r' compiler option. If this directive is being executed as user input, you may delimit it with '#if INTERACTIVE'/'#endif'." + ); + ( "HashDirectiveNotAllowedInNonScript", + "This directive may only be used in F# script files (extensions .fsx or .fsscript). Either remove the directive, move this code to a script file or delimit the directive with '#if INTERACTIVE'/'#endif'." + ); + ( "FileNameNotResolved", + "Unable to find the file '{0}' in any of\n {1}" + ); + ( "AssemblyNotResolved", + "Assembly reference '{0}' was not found or is invalid" + ); + ( "HashLoadedSourceHasIssues0", + "One or more informational messages in loaded file.\n" + ); + ( "HashLoadedSourceHasIssues1", + "One or more warnings in loaded file.\n" + ); + ( "HashLoadedSourceHasIssues2", + "One or more errors in loaded file.\n" + ); + ( "HashLoadedScriptConsideredSource", + "Loaded files may only be F# source files (extension .fs). This F# script file (.fsx or .fsscript) will be treated as an F# source file" + ); + ( "InvalidInternalsVisibleToAssemblyName1", + "Invalid assembly name '{0}' from InternalsVisibleTo attribute in {1}" + ); + ( "InvalidInternalsVisibleToAssemblyName2", + "Invalid assembly name '{0}' from InternalsVisibleTo attribute (assembly filename not available)" + ); + ( "LoadedSourceNotFoundIgnoring", + "Could not load file '{0}' because it does not exist or is inaccessible" + ); + ( "MSBuildReferenceResolutionError", + "{0} (Code={1})" + ); + ( "TargetInvocationExceptionWrapper", + "internal error: {0}" + ); + ( "NotUpperCaseConstructorWithoutRQA", + "Lowercase discriminated union cases are only allowed when using RequireQualifiedAccess attribute" + ); + ( "ErrorFromAddingTypeEquationTuples", + "Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n" + ); + ( "ArgumentsInSigAndImplMismatch", + "The argument names in the signature '{0}' and implementation '{1}' do not match. The argument name from the signature file will be used. This may cause problems when debugging or profiling." + ); + ( "Parser.TOKEN.WHILE.BANG", + "keyword 'while!'" + ); + ] \ No newline at end of file diff --git a/fcs/fcs-fable/SR.fs b/fcs/fcs-fable/SR.fs new file mode 100644 index 00000000000..39ca804f113 --- /dev/null +++ b/fcs/fcs-fable/SR.fs @@ -0,0 +1,28 @@ +//------------------------------------------------------------------------ +// From SR.fs +//------------------------------------------------------------------------ + +namespace FSharp.Compiler + +module SR = + let GetString(name: string) = + match SR.Resources.resources.TryGetValue(name) with + | true, value -> value + | _ -> "Missing FSStrings error message for: " + name + +module DiagnosticMessage = + type ResourceString<'T>(sfmt: string, fmt: string) = + member x.Format = + let a = fmt.Split('%') + |> Array.filter (fun s -> String.length s > 0) + |> Array.map (fun s -> box("%" + s)) + let tmp = System.String.Format(sfmt, a) + let fmt = Printf.StringFormat<'T>(tmp) + sprintf fmt + + let postProcessString (s: string) = + s.Replace("\\n","\n").Replace("\\t","\t") + + let DeclareResourceString (messageID: string, fmt: string) = + let messageString = SR.GetString(messageID) |> postProcessString + ResourceString<'T>(messageString, fmt) diff --git a/fcs/fcs-fable/System.Collections.fs b/fcs/fcs-fable/System.Collections.fs new file mode 100644 index 00000000000..b9776db3afa --- /dev/null +++ b/fcs/fcs-fable/System.Collections.fs @@ -0,0 +1,174 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System.Collections + +module Generic = + + type Queue<'T>() = + let xs = ResizeArray<'T>() + + member _.Clear () = xs.Clear() + + member _.Enqueue (item: 'T) = + xs.Add(item) + + member _.Dequeue () = + let item = xs.Item(0) + xs.RemoveAt(0) + item + + interface System.Collections.IEnumerable with + member _.GetEnumerator(): System.Collections.IEnumerator = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + + interface System.Collections.Generic.IEnumerable<'T> with + member _.GetEnumerator(): System.Collections.Generic.IEnumerator<'T> = + xs.GetEnumerator() + +module Immutable = + open System.Collections.Generic + + // not immutable, just a ResizeArray // TODO: immutable implementation + type ImmutableArray<'T> = + static member CreateBuilder() = ResizeArray<'T>() + + type ImmutableHashSet<'T>(values: 'T seq) = + let xs = HashSet<'T>(values) + + static member Create<'T>(values) = ImmutableHashSet<'T>(values) + static member Empty = ImmutableHashSet<'T>(Array.empty) + + member _.Add (value: 'T) = + let copy = HashSet<'T>(xs) + copy.Add(value) |> ignore + ImmutableHashSet<'T>(copy) + + member _.Union (values: seq<'T>) = + let copy = HashSet<'T>(xs) + copy.UnionWith(values) + ImmutableHashSet<'T>(copy) + + member _.Overlaps (values: seq<'T>) = + // xs.Overlaps(values) + values |> Seq.exists (fun x -> xs.Contains(x)) + + interface System.Collections.IEnumerable with + member _.GetEnumerator(): System.Collections.IEnumerator = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + + interface IEnumerable<'T> with + member _.GetEnumerator(): IEnumerator<'T> = + xs.GetEnumerator() + + type ImmutableDictionary<'Key, 'Value when 'Key: equality>(pairs: KeyValuePair<'Key, 'Value> seq) = + let xs = Dictionary<'Key, 'Value>() + do for pair in pairs do xs.Add(pair.Key, pair.Value) + + static member CreateRange(items) = ImmutableDictionary<'Key, 'Value>(items) + static member Empty = ImmutableDictionary<'Key, 'Value>(Array.empty) + + member _.Item with get (key: 'Key): 'Value = xs[key] + member _.ContainsKey (key: 'Key) = xs.ContainsKey(key) + + member _.Add (key: 'Key, value: 'Value) = + let copy = Dictionary<'Key, 'Value>(xs) + copy.Add(key, value) + ImmutableDictionary<'Key, 'Value>(copy) + + member _.SetItem (key: 'Key, value: 'Value) = + let copy = Dictionary<'Key, 'Value>(xs) + copy[key] <- value + ImmutableDictionary<'Key, 'Value>(copy) + + member _.TryGetValue (key: 'Key): bool * 'Value = + match xs.TryGetValue(key) with + | true, v -> (true, v) + | false, v -> (false, v) + + interface System.Collections.IEnumerable with + member _.GetEnumerator(): System.Collections.IEnumerator = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + + interface IEnumerable> with + member _.GetEnumerator(): IEnumerator> = + xs.GetEnumerator() + +module Concurrent = + open System.Collections.Generic + + // not thread safe, just a ResizeArray // TODO: threaded implementation + type ConcurrentStack<'T>() = + let xs = ResizeArray<'T>() + + member _.Push (item: 'T) = xs.Add(item) + member _.PushRange (items: 'T[]) = xs.AddRange(items) + member _.Clear () = xs.Clear() + member _.ToArray () = xs.ToArray() + + interface System.Collections.IEnumerable with + member _.GetEnumerator(): System.Collections.IEnumerator = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + interface IEnumerable<'T> with + member _.GetEnumerator(): IEnumerator<'T> = + xs.GetEnumerator() + + // not thread safe, just a Dictionary // TODO: threaded implementation + [] + type ConcurrentDictionary<'Key, 'Value>(comparer: IEqualityComparer<'Key>) = + inherit Dictionary<'Key, 'Value>(comparer) + + new () = + ConcurrentDictionary<'Key, 'Value>(EqualityComparer.Default) + new (_concurrencyLevel: int, _capacity: int) = + ConcurrentDictionary<'Key, 'Value>() + new (_concurrencyLevel: int, comparer: IEqualityComparer<'Key>) = + ConcurrentDictionary<'Key, 'Value>(comparer) + new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'Key>) = + ConcurrentDictionary<'Key, 'Value>(comparer) + + member x.TryAdd (key: 'Key, value: 'Value): bool = + if x.ContainsKey(key) + then false + else x.Add(key, value); true + + member x.TryRemove (key: 'Key): bool * 'Value = + match x.TryGetValue(key) with + | true, v -> (x.Remove(key), v) + | _ as res -> res + + member x.GetOrAdd (key: 'Key, value: 'Value): 'Value = + match x.TryGetValue(key) with + | true, v -> v + | _ -> let v = value in x.Add(key, v); v + + member x.GetOrAdd (key: 'Key, valueFactory: System.Func<'Key, 'Value>): 'Value = + match x.TryGetValue(key) with + | true, v -> v + | _ -> let v = valueFactory.Invoke(key) in x.Add(key, v); v + + // member x.GetOrAdd<'Arg> (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, arg: 'Arg): 'Value = + // match x.TryGetValue(key) with + // | true, v -> v + // | _ -> let v = valueFactory(key, arg) in x.Add(key, v); v + + member x.TryUpdate (key: 'Key, value: 'Value, comparisonValue: 'Value): bool = + match x.TryGetValue(key) with + | true, v when Unchecked.equals v comparisonValue -> x[key] <- value; true + | _ -> false + + member x.AddOrUpdate (key: 'Key, value: 'Value, updateFactory: System.Func<'Key, 'Value, 'Value>): 'Value = + match x.TryGetValue(key) with + | true, v -> let v = updateFactory.Invoke(key, v) in x[key] <- v; v + | _ -> let v = value in x.Add(key, v); v + + // member x.AddOrUpdate (key: 'Key, valueFactory: 'Key -> 'Value, updateFactory: 'Key * 'Value -> 'Value): 'Value = + // match x.TryGetValue(key) with + // | true, v -> let v = updateFactory(key, v) in x[key] <- v; v + // | _ -> let v = valueFactory(key) in x.Add(key, v); v + + // member x.AddOrUpdate (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, updateFactory: 'Key * 'Arg * 'Value -> 'Value, arg: 'Arg): 'Value = + // match x.TryGetValue(key) with + // | true, v -> let v = updateFactory(key, arg, v) in x[key] <- v; v + // | _ -> let v = valueFactory(key, arg) in x.Add(key, v); v \ No newline at end of file diff --git a/fcs/fcs-fable/System.IO.fs b/fcs/fcs-fable/System.IO.fs new file mode 100644 index 00000000000..3b3cc17b134 --- /dev/null +++ b/fcs/fcs-fable/System.IO.fs @@ -0,0 +1,56 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System.IO + +module Path = + let Combine (path1: string, path2: string) = //TODO: proper xplat implementation + let path1 = + if (String.length path1) = 0 then path1 + else (path1.TrimEnd [|'\\';'/'|]) + "/" + path1 + (path2.TrimStart [|'\\';'/'|]) + + let ChangeExtension (path: string, ext: string) = + let i = path.LastIndexOf(".") + if i < 0 then path + else path.Substring(0, i) + ext + + let HasExtension (path: string) = + let i = path.LastIndexOf(".") + i >= 0 + + let GetExtension (path: string) = + let i = path.LastIndexOf(".") + if i < 0 then "" + else path.Substring(i) + + let GetInvalidPathChars () = //TODO: proper xplat implementation + Seq.toArray "<>\"|?*\b\t" + + let GetInvalidFileNameChars () = //TODO: proper xplat implementation + Seq.toArray "<>:\"|\\/?*\b\t" + + let GetFileName (path: string) = + let normPath = path.Replace("\\", "/").TrimEnd('/') + let i = normPath.LastIndexOf("/") + normPath.Substring(i + 1) + + let GetFileNameWithoutExtension (path: string) = + let filename = GetFileName path + let i = filename.LastIndexOf(".") + if i < 0 then filename + else filename.Substring(0, i) + + let GetDirectoryName (path: string) = //TODO: proper xplat implementation + let normPath = path.Replace("\\", "/") + let i = normPath.LastIndexOf("/") + if i <= 0 then "" + else normPath.Substring(0, i) + + let DirectorySeparatorChar = '/' + let AltDirectorySeparatorChar = '/' + +module Directory = + let GetCurrentDirectory() = //TODO: proper xplat implementation + "." diff --git a/fcs/fcs-fable/System.fs b/fcs/fcs-fable/System.fs new file mode 100644 index 00000000000..6678445b20a --- /dev/null +++ b/fcs/fcs-fable/System.fs @@ -0,0 +1,49 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System + +type Environment() = + static member ProcessorCount = 1 + static member Exit(_exitcode) = () + static member GetEnvironmentVariable(_variable) = null + +module Diagnostics = + type Trace() = + static member TraceInformation(_s) = () //TODO: proper implementation + +module Reflection = + type AssemblyName(assemblyName: string) = + member x.Name = assemblyName //TODO: proper implementation + +module Threading = + type Interlocked() = + //TODO: threaded implementation + static member Increment(i: int32 byref): int32 = i <- i + 1; i + static member Increment(i: int64 byref): int64 = i <- i + 1L; i + static member Decrement(i: int32 byref): int32 = i <- i - 1; i + static member Decrement(i: int64 byref): int64 = i <- i - 1L; i + +type WeakReference<'T>(v: 'T) = + member x.TryGetTarget () = (true, v) + +type StringComparer(comp: System.StringComparison) = + static member Ordinal = StringComparer(System.StringComparison.Ordinal) + static member OrdinalIgnoreCase = StringComparer(System.StringComparison.OrdinalIgnoreCase) + interface System.Collections.Generic.IEqualityComparer with + member x.Equals(a,b) = System.String.Compare(a, b, comp) = 0 + member x.GetHashCode(a) = + match comp with + | System.StringComparison.Ordinal -> hash a + | System.StringComparison.OrdinalIgnoreCase -> hash (a.ToLowerInvariant()) + | _ -> failwithf "Unsupported StringComparison: %A" comp + interface System.Collections.Generic.IComparer with + member x.Compare(a,b) = System.String.Compare(a, b, comp) + +type ArraySegment<'T>(arr: 'T[]) = + member _.Array = arr + member _.Count = arr.Length + member _.Offset = 0 + new (arr: 'T[], offset: int, count: int) = + ArraySegment<'T>(Array.sub arr offset count) diff --git a/fcs/fcs-fable/TcImports_shim.fs b/fcs/fcs-fable/TcImports_shim.fs new file mode 100644 index 00000000000..226695c7aaf --- /dev/null +++ b/fcs/fcs-fable/TcImports_shim.fs @@ -0,0 +1,281 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +open Internal.Utilities.Collections +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras + +open FSharp.Compiler +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.CheckExpressions +open FSharp.Compiler.CheckDeclarations +open FSharp.Compiler.CompilerConfig +open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.CompilerGlobalState +open FSharp.Compiler.CompilerImports +open FSharp.Compiler.CompilerOptions +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.IO +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.ScriptClosure +open FSharp.Compiler.Symbols +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Range +open FSharp.Compiler.Tokenization +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypedTreePickle + +//------------------------------------------------------------------------- +// TcImports shim +//------------------------------------------------------------------------- + +module TcImports = + + let internal BuildTcImports (tcConfig: TcConfig, references: string[], readAllBytes: string -> byte[]) = + let tcImports = TcImports () + + let sigDataReaders ilModule = + [ for resource in ilModule.Resources.AsList() do + if IsSignatureDataResource resource then + let _ccuName, getBytes = GetResourceNameAndSignatureDataFunc resource + getBytes() ] + + let optDataReaders ilModule = + [ for resource in ilModule.Resources.AsList() do + if IsOptimizationDataResource resource then + let _ccuName, getBytes = GetResourceNameAndOptimizationDataFunc resource + getBytes() ] + + let LoadMod (ccuName: string) = + let fileName = + if ccuName.EndsWith(".dll", System.StringComparison.OrdinalIgnoreCase) + then ccuName + else ccuName + ".dll" + let bytes = readAllBytes fileName + let opts: ILReaderOptions = + { metadataOnly = MetadataOnlyFlag.Yes + reduceMemoryUsage = ReduceMemoryFlag.Yes + pdbDirPath = None + tryGetMetadataSnapshot = (fun _ -> None) } + + let reader = ILBinaryReader.OpenILModuleReaderFromBytes fileName bytes opts + reader.ILModuleDef //, reader.ILAssemblyRefs + + let GetSignatureData (fileName:string, ilScopeRef, ilModule:ILModuleDef option, bytes: ReadOnlyByteMemory) = + unpickleObjWithDanglingCcus fileName ilScopeRef ilModule unpickleCcuInfo bytes + + let GetOptimizationData (fileName:string, ilScopeRef, ilModule:ILModuleDef option, bytes: ReadOnlyByteMemory) = + unpickleObjWithDanglingCcus fileName ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo bytes + + let memoize_mod = new MemoizationTable<_,_> (LoadMod, keyComparer=HashIdentity.Structural) + + let LoadSigData ccuName = + let ilModule = memoize_mod.Apply ccuName + let ilShortAssemName = ilModule.ManifestOfAssembly.Name + let ilScopeRef = ILScopeRef.Assembly (mkSimpleAssemblyRef ilShortAssemName) + let fileName = ilModule.Name //TODO: try with ".sigdata" extension + match sigDataReaders ilModule with + | [] -> None + | bytes::_ -> Some (GetSignatureData (fileName, ilScopeRef, Some ilModule, bytes)) + + let LoadOptData ccuName = + let ilModule = memoize_mod.Apply ccuName + let ilShortAssemName = ilModule.ManifestOfAssembly.Name + let ilScopeRef = ILScopeRef.Assembly (mkSimpleAssemblyRef ilShortAssemName) + let fileName = ilModule.Name //TODO: try with ".optdata" extension + match optDataReaders ilModule with + | [] -> None + | bytes::_ -> Some (GetOptimizationData (fileName, ilScopeRef, Some ilModule, bytes)) + + let memoize_sig = new MemoizationTable<_,_> (LoadSigData, keyComparer=HashIdentity.Structural) + let memoize_opt = new MemoizationTable<_,_> (LoadOptData, keyComparer=HashIdentity.Structural) + + let GetCustomAttributesOfILModule (ilModule: ILModuleDef) = + (match ilModule.Manifest with Some m -> m.CustomAttrs | None -> ilModule.CustomAttrs).AsList() + + let GetAutoOpenAttributes ilModule = + ilModule |> GetCustomAttributesOfILModule |> List.choose TryFindAutoOpenAttr + + let GetInternalsVisibleToAttributes ilModule = + ilModule |> GetCustomAttributesOfILModule |> List.choose TryFindInternalsVisibleToAttr + + let HasAnyFSharpSignatureDataAttribute ilModule = + let attrs = GetCustomAttributesOfILModule ilModule + List.exists IsSignatureDataVersionAttr attrs + + let mkCcuInfo ilScopeRef ilModule ccu : ImportedAssembly = + { ILScopeRef = ilScopeRef + FSharpViewOfMetadata = ccu + AssemblyAutoOpenAttributes = GetAutoOpenAttributes ilModule + AssemblyInternalsVisibleToAttributes = GetInternalsVisibleToAttributes ilModule +#if !NO_TYPEPROVIDERS + IsProviderGenerated = false + TypeProviders = [] +#endif + FSharpOptimizationData = notlazy None } + + let GetCcuIL m ccuName = + let auxModuleLoader = function + | ILScopeRef.Local -> failwith "Unsupported reference" + | ILScopeRef.Module x -> memoize_mod.Apply x.Name + | ILScopeRef.Assembly x -> memoize_mod.Apply x.Name + | ILScopeRef.PrimaryAssembly -> failwith "Unsupported reference" + let ilModule = memoize_mod.Apply ccuName + let ilShortAssemName = ilModule.ManifestOfAssembly.Name + let ilScopeRef = ILScopeRef.Assembly (mkSimpleAssemblyRef ilShortAssemName) + let fileName = ilModule.Name + let invalidateCcu = new Event<_>() + let ccu = Import.ImportILAssembly( + tcImports.GetImportMap, m, auxModuleLoader, tcConfig.xmlDocInfoLoader, ilScopeRef, + tcConfig.implicitIncludeDir, Some fileName, ilModule, invalidateCcu.Publish) + let ccuInfo = mkCcuInfo ilScopeRef ilModule ccu + ccuInfo, None + + let GetCcuFS m ccuName = + let sigdata = memoize_sig.Apply ccuName + let ilModule = memoize_mod.Apply ccuName + let ilShortAssemName = ilModule.ManifestOfAssembly.Name + let ilScopeRef = ILScopeRef.Assembly (mkSimpleAssemblyRef ilShortAssemName) + let fileName = ilModule.Name + let GetRawTypeForwarders ilModule = + match ilModule.Manifest with + | Some manifest -> manifest.ExportedTypes + | None -> mkILExportedTypes [] +#if !NO_TYPEPROVIDERS + let invalidateCcu = new Event<_>() +#endif + let minfo: PickledCcuInfo = sigdata.Value.RawData //TODO: handle missing sigdata + let codeDir = minfo.compileTimeWorkingDir + let ccuData: CcuData = + { ILScopeRef = ilScopeRef + Stamp = newStamp() + FileName = Some fileName + QualifiedName = Some (ilScopeRef.QualifiedName) + SourceCodeDirectory = codeDir + IsFSharp = true + Contents = minfo.mspec +#if !NO_TYPEPROVIDERS + InvalidateEvent=invalidateCcu.Publish + IsProviderGenerated = false + ImportProvidedType = (fun ty -> Import.ImportProvidedType (tcImports.GetImportMap()) m ty) +#endif + UsesFSharp20PlusQuotations = minfo.usesQuotations + MemberSignatureEquality = (fun ty1 ty2 -> typeEquivAux EraseAll (tcImports.GetTcGlobals()) ty1 ty2) + TryGetILModuleDef = (fun () -> Some ilModule) + TypeForwarders = Import.ImportILAssemblyTypeForwarders(tcImports.GetImportMap, m, GetRawTypeForwarders ilModule) + XmlDocumentationInfo = None + } + + let optdata = lazy ( + match memoize_opt.Apply ccuName with + | None -> None + | Some data -> + let findCcuInfo name = tcImports.FindCcu (m, name) + Some (data.OptionalFixup findCcuInfo) ) + + let ccu = CcuThunk.Create(ilShortAssemName, ccuData) + let ccuInfo = mkCcuInfo ilScopeRef ilModule ccu + let ccuOptInfo = { ccuInfo with FSharpOptimizationData = optdata } + ccuOptInfo, sigdata + + let rec GetCcu m ccuName = + let ilModule = memoize_mod.Apply ccuName + if HasAnyFSharpSignatureDataAttribute ilModule then + GetCcuFS m ccuName + else + GetCcuIL m ccuName + + let fixupCcuInfo refCcusUnfixed = + let refCcus = refCcusUnfixed |> List.map fst + let findCcuInfo name = + refCcus + |> List.tryFind (fun (x: ImportedAssembly) -> x.FSharpViewOfMetadata.AssemblyName = name) + |> Option.map (fun x -> x.FSharpViewOfMetadata) + let fixup (data: PickledDataWithReferences<_>) = + data.OptionalFixup findCcuInfo |> ignore + refCcusUnfixed |> List.choose snd |> List.iter fixup + refCcus + + let m = range.Zero + let fsharpCoreAssemblyName = "FSharp.Core" + let primaryAssemblyName = PrimaryAssembly.Mscorlib.Name + let refCcusUnfixed = List.ofArray references |> List.map (GetCcu m) + let refCcus = fixupCcuInfo refCcusUnfixed + let sysCcuInfos = refCcus |> List.filter (fun x -> x.FSharpViewOfMetadata.AssemblyName <> fsharpCoreAssemblyName) + let fslibCcuInfo = refCcus |> List.find (fun x -> x.FSharpViewOfMetadata.AssemblyName = fsharpCoreAssemblyName) + let primaryCcuInfo = refCcus |> List.find (fun x -> x.FSharpViewOfMetadata.AssemblyName = primaryAssemblyName) + + let ccuInfos = [fslibCcuInfo] @ sysCcuInfos + let ccuMap = ccuInfos |> List.map (fun ccuInfo -> ccuInfo.FSharpViewOfMetadata.AssemblyName, ccuInfo) |> Map.ofList + + // search over all imported CCUs for each cached type + let ccuHasType (ccu: CcuThunk) (nsname: string list) (tname: string) (publicOnly: bool) = + let matchNameSpace (entityOpt: Entity option) n = + match entityOpt with + | None -> None + | Some entity -> entity.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind n + + match (Some ccu.Contents, nsname) ||> List.fold matchNameSpace with + | Some ns -> + match Map.tryFind tname ns.ModuleOrNamespaceType.TypesByMangledName with + | Some e -> + if publicOnly then + match e.TypeReprInfo with + | TILObjectRepr data -> + let (TILObjectReprData(_, _, tyDef)) = data + tyDef.Access = ILTypeDefAccess.Public + | _ -> false + else true + | None -> false + | None -> false + + // Search for a type + let tryFindSysTypeCcu path typeName publicOnly = + let search = sysCcuInfos |> List.tryFind (fun ccuInfo -> ccuHasType ccuInfo.FSharpViewOfMetadata path typeName publicOnly) + match search with + | Some x -> Some x.FSharpViewOfMetadata + | None -> +#if DEBUG + printfn "Cannot find type %s.%s" (String.concat "." path) typeName +#endif + None + + let primaryScopeRef = primaryCcuInfo.ILScopeRef + let fsharpCoreScopeRef = fslibCcuInfo.ILScopeRef + let assembliesThatForwardToPrimaryAssembly = [] + let ilGlobals = mkILGlobals (primaryScopeRef, assembliesThatForwardToPrimaryAssembly, fsharpCoreScopeRef) + + let tcGlobals = + TcGlobals( + tcConfig.compilingFSharpCore, + ilGlobals, + fslibCcuInfo.FSharpViewOfMetadata, + tcConfig.implicitIncludeDir, + tcConfig.mlCompatibility, + tcConfig.isInteractive, + tcConfig.useReflectionFreeCodeGen, + tryFindSysTypeCcu, + tcConfig.emitDebugInfoInQuotations, + tcConfig.noDebugAttributes, + tcConfig.pathMap, + tcConfig.langVersion + ) + +#if DEBUG + // the global_g reference cell is used only for debug printing + do global_g <- Some tcGlobals +#endif + // do this prior to parsing, since parsing IL assembly code may refer to mscorlib + do tcImports.SetCcuMap(ccuMap) + do tcImports.SetTcGlobals(tcGlobals) + tcGlobals, tcImports diff --git a/fcs/fcs-fable/ast_print.fs b/fcs/fcs-fable/ast_print.fs new file mode 100644 index 00000000000..cc89d332c8b --- /dev/null +++ b/fcs/fcs-fable/ast_print.fs @@ -0,0 +1,101 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +module AstPrint + +open FSharp.Compiler.Symbols + +//------------------------------------------------------------------------- +// AstPrint +//------------------------------------------------------------------------- + +let attribsOfSymbol (s: FSharpSymbol) = + [ match s with + | :? FSharpField as v -> + yield "field" + if v.IsCompilerGenerated then yield "compgen" + if v.IsDefaultValue then yield "default" + if v.IsMutable then yield "mutable" + if v.IsVolatile then yield "volatile" + if v.IsStatic then yield "static" + if v.IsLiteral then yield sprintf "%A" v.LiteralValue.Value + + | :? FSharpEntity as v -> + v.TryFullName |> ignore // check there is no failure here + match v.BaseType with + | Some t when t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome -> + yield sprintf "inherits %s" t.TypeDefinition.FullName + | _ -> () + if v.IsNamespace then yield "namespace" + if v.IsFSharpModule then yield "module" + if v.IsByRef then yield "byref" + if v.IsClass then yield "class" + if v.IsDelegate then yield "delegate" + if v.IsEnum then yield "enum" + if v.IsFSharpAbbreviation then yield "abbrev" + if v.IsFSharpExceptionDeclaration then yield "exception" + if v.IsFSharpRecord then yield "record" + if v.IsFSharpUnion then yield "union" + if v.IsInterface then yield "interface" + if v.IsMeasure then yield "measure" +#if !NO_TYPEPROVIDERS + if v.IsProvided then yield "provided" + if v.IsStaticInstantiation then yield "static_inst" + if v.IsProvidedAndErased then yield "erased" + if v.IsProvidedAndGenerated then yield "generated" +#endif + if v.IsUnresolved then yield "unresolved" + if v.IsValueType then yield "valuetype" + + | :? FSharpMemberOrFunctionOrValue as v -> + yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "" + if v.IsActivePattern then yield "active_pattern" + if v.IsDispatchSlot then yield "dispatch_slot" + if v.IsModuleValueOrMember && not v.IsMember then yield "val" + if v.IsMember then yield "member" + if v.IsProperty then yield "property" + if v.IsExtensionMember then yield "extension_member" + if v.IsPropertyGetterMethod then yield "property_getter" + if v.IsPropertySetterMethod then yield "property_setter" + if v.IsEvent then yield "event" + if v.EventForFSharpProperty.IsSome then yield "property_event" + if v.IsEventAddMethod then yield "event_add" + if v.IsEventRemoveMethod then yield "event_remove" + if v.IsTypeFunction then yield "type_func" + if v.IsCompilerGenerated then yield "compiler_gen" + if v.IsImplicitConstructor then yield "implicit_ctor" + if v.IsMutable then yield "mutable" + if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl" + if not v.IsInstanceMember then yield "static" + if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky" + if v.IsExplicitInterfaceImplementation then yield "interface_impl" + yield sprintf "%A" v.InlineAnnotation + // if v.IsConstructorThisValue then yield "ctorthis" + // if v.IsMemberThisValue then yield "this" + // if v.LiteralValue.IsSome then yield "literal" + | _ -> () ] + +let rec printFSharpDecls prefix decls = seq { + let mutable i = 0 + for decl in decls do + i <- i + 1 + match decl with + | FSharpImplementationFileDeclaration.Entity (e, sub) -> + yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e) + if not (Seq.isEmpty e.Attributes) then + yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes) + if not (Seq.isEmpty e.DeclaredInterfaces) then + yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces) + yield "" + yield! printFSharpDecls (prefix + "\t") sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) -> + yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth) + yield sprintf "%stype: %A" prefix meth.FullType + yield sprintf "%sargs: %A" prefix args + // if not meth.IsCompilerGenerated then + yield sprintf "%sbody: %A" prefix body + yield "" + | FSharpImplementationFileDeclaration.InitAction (expr) -> + yield sprintf "%s%i) ACTION" prefix i + yield sprintf "%s%A" prefix expr + yield "" +} diff --git a/fcs/fcs-fable/codegen/codegen.fsproj b/fcs/fcs-fable/codegen/codegen.fsproj new file mode 100644 index 00000000000..eb47fd55446 --- /dev/null +++ b/fcs/fcs-fable/codegen/codegen.fsproj @@ -0,0 +1,52 @@ + + + artifacts + $(MSBuildProjectDirectory)/../../../src/Compiler + + + + + Exe + net8.0 + + + + + + --module FSharp.Compiler.AbstractIL.AsciiLexer --internal --open Internal.Utilities.Text.Lexing --open FSharp.Compiler.AbstractIL.AsciiParser --unicode --lexlib Internal.Utilities.Text.Lexing + AbstractIL/illex.fsl + + + --module FSharp.Compiler.AbstractIL.AsciiParser --open FSharp.Compiler.AbstractIL.AsciiConstants --open FSharp.Compiler.AbstractIL.IL --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing --buffer-type-argument char + AbstractIL/ilpars.fsy + + + --module FSharp.Compiler.PPLexer --internal --open FSharp.Compiler.Lexhelp --open Internal.Utilities.Text.Lexing --open FSharp.Compiler.PPParser --unicode --lexlib Internal.Utilities.Text.Lexing + SyntaxTree/pplex.fsl + + + --module FSharp.Compiler.PPParser --open FSharp.Compiler.ParseHelpers --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing --buffer-type-argument char + SyntaxTree/pppars.fsy + + + --module FSharp.Compiler.Lexer --open FSharp.Compiler.Lexhelp --open Internal.Utilities.Text.Lexing --open FSharp.Compiler.Parser --open FSharp.Compiler.Text --open FSharp.Compiler.ParseHelpers --internal --unicode --lexlib Internal.Utilities.Text.Lexing + SyntaxTree/lex.fsl + + + --module FSharp.Compiler.Parser --open FSharp.Compiler --open FSharp.Compiler.Syntax --open FSharp.Compiler.Text --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing --buffer-type-argument char + SyntaxTree/pars.fsy + + + + + + + + + + \ No newline at end of file diff --git a/fcs/fcs-fable/codegen/fssrgen.fsx b/fcs/fcs-fable/codegen/fssrgen.fsx new file mode 100644 index 00000000000..529a0a1d543 --- /dev/null +++ b/fcs/fcs-fable/codegen/fssrgen.fsx @@ -0,0 +1,495 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +module FsSrGen +open System +open System.IO + +let PrintErr(filename, line, msg) = + printfn "%s(%d): error : %s" filename line msg + +let Err(filename, line, msg) = + PrintErr(filename, line, msg) + printfn "Note that the syntax of each line is one of these three alternatives:" + printfn "# comment" + printfn "ident,\"string\"" + printfn "errNum,ident,\"string\"" + failwith (sprintf "there were errors in the file '%s'" filename) + +let xmlBoilerPlateString = @" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + +" + + +type HoleType = string + + +// The kinds of 'holes' we can do +let ComputeHoles filename lineNum (txt:string) : ResizeArray * string = + // takes in a %d%s kind of string, returns array of HoleType and {0}{1} kind of string + let mutable i = 0 + let mutable holeNumber = 0 + let mutable holes = ResizeArray() // order + let sb = new System.Text.StringBuilder() + let AddHole holeType = + sb.Append(sprintf "{%d}" holeNumber) |> ignore + holeNumber <- holeNumber + 1 + holes.Add(holeType) + while i < txt.Length do + if txt.[i] = '%' then + if i+1 = txt.Length then + Err(filename, lineNum, "(at end of string) % must be followed by d, f, s, or %") + else + match txt.[i+1] with + | 'd' -> AddHole "System.Int32" + | 'f' -> AddHole "System.Double" + | 's' -> AddHole "System.String" + | '%' -> sb.Append('%') |> ignore + | c -> Err(filename, lineNum, sprintf "'%%%c' is not a valid sequence, only %%d %%f %%s or %%%%" c) + i <- i + 2 + else + match txt.[i] with + | '{' -> sb.Append "{{" |> ignore + | '}' -> sb.Append "}}" |> ignore + | c -> sb.Append c |> ignore + i <- i + 1 + //printfn "holes.Length = %d, lineNum = %d" holes.Length //lineNum txt + (holes, sb.ToString()) + +let Unquote (s : string) = + if s.StartsWith "\"" && s.EndsWith "\"" then s.Substring(1, s.Length - 2) + else failwith "error message string should be quoted" + +let ParseLine filename lineNum (txt:string) = + let mutable errNum = None + let identB = new System.Text.StringBuilder() + let mutable i = 0 + // parse optional error number + if i < txt.Length && System.Char.IsDigit txt.[i] then + let numB = new System.Text.StringBuilder() + while i < txt.Length && System.Char.IsDigit txt.[i] do + numB.Append txt.[i] |> ignore + i <- i + 1 + errNum <- Some(int (numB.ToString())) + if i = txt.Length || not(txt.[i] = ',') then + Err(filename, lineNum, sprintf "After the error number '%d' there should be a comma" errNum.Value) + // Skip the comma + i <- i + 1 + // parse short identifier + if i < txt.Length && not(System.Char.IsLetter(txt.[i])) then + Err(filename, lineNum, sprintf "The first character in the short identifier should be a letter, but found '%c'" txt.[i]) + while i < txt.Length && System.Char.IsLetterOrDigit txt.[i] do + identB.Append txt.[i] |> ignore + i <- i + 1 + let ident = identB.ToString() + if ident.Length = 0 then + Err(filename, lineNum, "Did not find the short identifier") + else + if i = txt.Length || not(txt.[i] = ',') then + Err(filename, lineNum, sprintf "After the identifier '%s' there should be a comma" ident) + else + // Skip the comma + i <- i + 1 + if i = txt.Length then + Err(filename, lineNum, sprintf "After the identifier '%s' and comma, there should be the quoted string resource" ident) + else + let str = + try + System.String.Format(Unquote(txt.Substring i)) // Format turns e.g '\n' into that char, but also requires that we 'escape' curlies in the original .txt file, e.g. "{{" + with + e -> Err(filename, lineNum, sprintf "Error calling System.String.Format (note that curly braces must be escaped, and there cannot be trailing space on the line): >>>%s<<< -- %s" (txt.Substring i) e.Message) + let holes, netFormatString = ComputeHoles filename lineNum str + (lineNum, (errNum,ident), str, holes.ToArray(), netFormatString) + +let stringBoilerPlatePrefix = @" +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Reflection +open System.Reflection +// (namespaces below for specific case of using the tool to compile FSharp.Core itself) +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Text +open Microsoft.FSharp.Collections +open Printf +" +let StringBoilerPlate filename = + + @" + // BEGIN BOILERPLATE + + static let getCurrentAssembly () = + #if FX_RESHAPED_REFLECTION + typeof.GetTypeInfo().Assembly + #else + System.Reflection.Assembly.GetExecutingAssembly() + #endif + + static let getTypeInfo (t: System.Type) = + #if FX_RESHAPED_REFLECTION + t.GetTypeInfo() + #else + t + #endif + + static let resources = lazy (new System.Resources.ResourceManager(""" + filename + @""", getCurrentAssembly())) + + static let GetString(name:string) = + let s = resources.Value.GetString(name, System.Globalization.CultureInfo.CurrentUICulture) + #if DEBUG + if null = s then + System.Diagnostics.Debug.Assert(false, sprintf ""**RESOURCE ERROR**: Resource token %s does not exist!"" name) + #endif + s + + static let mkFunctionValue (tys: System.Type[]) (impl:obj->obj) = + FSharpValue.MakeFunction(FSharpType.MakeFunctionType(tys.[0],tys.[1]), impl) + + static let funTyC = typeof<(obj -> obj)>.GetGenericTypeDefinition() + + static let isNamedType(ty:System.Type) = not (ty.IsArray || ty.IsByRef || ty.IsPointer) + static let isFunctionType (ty1:System.Type) = + isNamedType(ty1) && getTypeInfo(ty1).IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(funTyC) + + static let rec destFunTy (ty:System.Type) = + if isFunctionType ty then + ty, ty.GetGenericArguments() + else + match getTypeInfo(ty).BaseType with + | null -> failwith ""destFunTy: not a function type"" + | b -> destFunTy b + + static let buildFunctionForOneArgPat (ty: System.Type) impl = + let _,tys = destFunTy ty + let rty = tys.[1] + // PERF: this technique is a bit slow (e.g. in simple cases, like 'sprintf ""%x""') + mkFunctionValue tys (fun inp -> impl rty inp) + + static let capture1 (fmt:string) i args ty (go : obj list -> System.Type -> int -> obj) : obj = + match fmt.[i] with + | '%' -> go args ty (i+1) + | 'd' + | 'f' + | 's' -> buildFunctionForOneArgPat ty (fun rty n -> go (n::args) rty (i+1)) + | _ -> failwith ""bad format specifier"" + + // newlines and tabs get converted to strings when read from a resource file + // this will preserve their original intention + static let postProcessString (s : string) = + s.Replace(""\\n"",""\n"").Replace(""\\t"",""\t"").Replace(""\\r"",""\r"").Replace(""\\\"""", ""\"""") + + static let createMessageString (messageString : string) (fmt : Printf.StringFormat<'T>) : 'T = + let fmt = fmt.Value // here, we use the actual error string, as opposed to the one stored as fmt + let len = fmt.Length + + /// Function to capture the arguments and then run. + let rec capture args ty i = + if i >= len || (fmt.[i] = '%' && i+1 >= len) then + let b = new System.Text.StringBuilder() + b.AppendFormat(messageString, [| for x in List.rev args -> x |]) |> ignore + box(b.ToString()) + // REVIEW: For these purposes, this should be a nop, but I'm leaving it + // in incase we ever decide to support labels for the error format string + // E.g., ""%s%d"" + elif System.Char.IsSurrogatePair(fmt,i) then + capture args ty (i+2) + else + match fmt.[i] with + | '%' -> + let i = i+1 + capture1 fmt i args ty capture + | _ -> + capture args ty (i+1) + + (unbox (capture [] (typeof<'T>) 0) : 'T) + + static let mutable swallowResourceText = false + + static let GetStringFunc((messageID : string),(fmt : Printf.StringFormat<'T>)) : 'T = + if swallowResourceText then + sprintf fmt + else + let mutable messageString = GetString(messageID) + messageString <- postProcessString messageString + createMessageString messageString fmt + + /// If set to true, then all error messages will just return the filled 'holes' delimited by ',,,'s - this is for language-neutral testing (e.g. localization-invariant baselines). + static member SwallowResourceText with get () = swallowResourceText + and set (b) = swallowResourceText <- b + // END BOILERPLATE +" + +let RunMain(filename:string, outFilename, outXmlFilenameOpt, projectNameOpt) = + try + let justfilename = System.IO.Path.GetFileNameWithoutExtension(filename) + if justfilename |> Seq.exists (fun c -> not(System.Char.IsLetterOrDigit(c))) then + Err(filename, 0, sprintf "The filename '%s' is not allowed; only letters and digits can be used, as the filename also becomes the namespace for the SR class" justfilename) + + printfn "fssrgen.fsx: Reading %s" filename + let lines = System.IO.File.ReadAllLines(filename) + |> Array.mapi (fun i s -> i,s) // keep line numbers + |> Array.filter (fun (i,s) -> not(s.StartsWith "#")) // filter out comments + + printfn "fssrgen.fsx: Parsing %s" filename + let stringInfos = lines |> Array.map (fun (i,s) -> ParseLine filename i s) + // now we have array of (lineNum, ident, str, holes, netFormatString) // str has %d, netFormatString has {0} + + printfn "fssrgen.fsx: Validating %s" filename + // validate that all the idents are unique + let allIdents = new System.Collections.Generic.Dictionary() + for (line,(_,ident),_,_,_) in stringInfos do + if allIdents.ContainsKey(ident) then + Err(filename,line,sprintf "Identifier '%s' is already used previously on line %d - each identifier must be unique" ident allIdents.[ident]) + allIdents.Add(ident,line) + + printfn "fssrgen.fsx: Validating uniqueness of %s" filename + // validate that all the strings themselves are unique + let allStrs = new System.Collections.Generic.Dictionary() + for (line,(_,ident),str,_,_) in stringInfos do + if allStrs.ContainsKey(str) then + let prevLine,prevIdent = allStrs.[str] + Err(filename,line,sprintf "String '%s' already appears on line %d with identifier '%s' - each string must be unique" str prevLine prevIdent) + allStrs.Add(str,(line,ident)) + + printfn "fssrgen.fsx: Generating %s" outFilename + + use out = new System.IO.StringWriter() + fprintfn out "// This is a generated file; the original input is '%s'" filename + fprintfn out "namespace %s" justfilename + if Option.isNone outXmlFilenameOpt then + fprintfn out "type internal SR private() =" + else + fprintfn out "%s" stringBoilerPlatePrefix + fprintfn out "type internal SR private() =" + let theResourceName = match projectNameOpt with Some p -> sprintf "%s.%s" p justfilename | None -> justfilename + fprintfn out "%s" (StringBoilerPlate theResourceName) + + printfn "fssrgen.fsx: Generating resource methods for %s" outFilename + // gen each resource method + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + let formalArgs = System.Text.StringBuilder() + let actualArgs = System.Text.StringBuilder() + let firstTime = ref true + let n = ref 0 + formalArgs.Append "(" |> ignore + for hole in holes do + if !firstTime then + firstTime := false + else + formalArgs.Append ", " |> ignore + actualArgs.Append " " |> ignore + formalArgs.Append(sprintf "a%d : %s" !n hole) |> ignore + actualArgs.Append(sprintf "a%d" !n) |> ignore + n := !n + 1 + formalArgs.Append ")" |> ignore + fprintfn out " /// %s" str + fprintfn out " /// (Originally from %s:%d)" filename (lineNum+1) + let justPercentsFromFormatString = + (holes |> Array.fold (fun acc holeType -> + acc + match holeType with + | "System.Int32" -> ",,,%d" + | "System.Double" -> ",,,%f" + | "System.String" -> ",,,%s" + | _ -> failwith "unreachable") "") + ",,," + let errPrefix = match optErrNum with + | None -> "" + | Some n -> sprintf "%d, " n + if Option.isNone outXmlFilenameOpt then + fprintfn out " static member %s%s = (%ssprintf \"%s\" %s)" ident (formalArgs.ToString()) errPrefix str (actualArgs.ToString()) + else + fprintfn out " static member %s%s = (%sGetStringFunc(\"%s\",\"%s\") %s)" ident (formalArgs.ToString()) errPrefix ident justPercentsFromFormatString (actualArgs.ToString()) + ) + + if Option.isSome outXmlFilenameOpt then + printfn "fssrgen.fsx: Generating .resx for %s" outFilename + fprintfn out "" + // gen validation method + fprintfn out " /// Call this method once to validate that all known resources are valid; throws if not" + fprintfn out " static member RunStartupValidation() =" + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + fprintfn out " ignore(GetString(\"%s\"))" ident + ) + fprintfn out " ()" // in case there are 0 strings, we need the generated code to parse + + let outFileNewText = out.ToString() + let nothingChanged = try File.Exists(outFilename) && File.ReadAllText(outFilename) = outFileNewText with _ -> false + if not nothingChanged then + File.WriteAllText(outFilename, outFileNewText, System.Text.Encoding.UTF8) + + if Option.isSome outXmlFilenameOpt then + // gen resx + let xd = new System.Xml.XmlDocument() + xd.LoadXml(xmlBoilerPlateString) + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + let xn = xd.CreateElement("data") + xn.SetAttribute("name",ident) |> ignore + xn.SetAttribute("xml:space","preserve") |> ignore + let xnc = xd.CreateElement "value" + xn.AppendChild xnc |> ignore + xnc.AppendChild(xd.CreateTextNode netFormatString) |> ignore + xd.LastChild.AppendChild xn |> ignore + ) + let outXmlFileNewText = + use outXmlStream = new System.IO.StringWriter() + xd.Save outXmlStream + outXmlStream.ToString() + let outXmlFile = outXmlFilenameOpt.Value + let nothingChanged = try File.Exists(outXmlFile) && File.ReadAllText(outXmlFile) = outXmlFileNewText with _ -> false + if not nothingChanged then + File.WriteAllText(outXmlFile, outXmlFileNewText, System.Text.Encoding.Unicode) + + + printfn "fssrgen.fsx: Done %s" outFilename + 0 + with e -> + PrintErr(filename, 0, sprintf "An exception occurred when processing '%s'\n%s" filename (e.ToString())) + 1 + +#if COMPILED +[] +#endif +let Main args = + + match args |> List.ofArray with + | [ inputFile; outFile; ] -> + let filename = System.IO.Path.GetFullPath(inputFile) + let outFilename = System.IO.Path.GetFullPath(outFile) + + RunMain(filename, outFilename, None, None) + + | [ inputFile; outFile; outXml ] -> + let filename = System.IO.Path.GetFullPath inputFile + let outFilename = System.IO.Path.GetFullPath outFile + let outXmlFilename = System.IO.Path.GetFullPath outXml + + RunMain(filename, outFilename, Some outXmlFilename, None) + + | [ inputFile; outFile; outXml; projectName ] -> + let filename = System.IO.Path.GetFullPath inputFile + let outFilename = System.IO.Path.GetFullPath outFile + let outXmlFilename = System.IO.Path.GetFullPath outXml + + RunMain(filename, outFilename, Some outXmlFilename, Some projectName) + + | _ -> + printfn "Error: invalid arguments." + printfn "Usage: " + 1 +#if !COMPILED +printfn "fssrgen: args = %A" fsi.CommandLineArgs +Main (fsi.CommandLineArgs |> Seq.skip 1 |> Seq.toArray) +#endif diff --git a/fcs/fcs-fable/codegen/fssrgen.targets b/fcs/fcs-fable/codegen/fssrgen.targets new file mode 100644 index 00000000000..c28706b5d6a --- /dev/null +++ b/fcs/fcs-fable/codegen/fssrgen.targets @@ -0,0 +1,35 @@ + + + + + ProcessFsSrGen;$(PrepareForBuildDependsOn) + + + + + + + + + + + + false + + + diff --git a/fcs/fcs-fable/fcs-fable.fsproj b/fcs/fcs-fable/fcs-fable.fsproj new file mode 100644 index 00000000000..9099407ed47 --- /dev/null +++ b/fcs/fcs-fable/fcs-fable.fsproj @@ -0,0 +1,388 @@ + + + $(MSBuildProjectDirectory)/../../src/Compiler + $(MSBuildProjectDirectory)/codegen + + + + netstandard2.0 + $(DefineConstants);FABLE_COMPILER + $(DefineConstants);COMPILER + $(DefineConstants);FX_NO_WEAKTABLE + $(DefineConstants);NO_TYPEPROVIDERS + $(DefineConstants);NO_INLINE_IL_PARSER + $(DefineConstants);FSHARPCORE_USE_PACKAGE + $(OtherFlags) --nowarn:57 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/service_slim.fs b/fcs/fcs-fable/service_slim.fs new file mode 100644 index 00000000000..33643df0f48 --- /dev/null +++ b/fcs/fcs-fable/service_slim.fs @@ -0,0 +1,359 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +open System +open System.Collections.Concurrent +open System.IO +open System.Threading + +open Internal.Utilities.Collections +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras + +open FSharp.Compiler +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.CheckDeclarations +open FSharp.Compiler.CompilerConfig +open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.CompilerGlobalState +open FSharp.Compiler.CompilerImports +open FSharp.Compiler.CompilerOptions +// open FSharp.Compiler.DependencyManager +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.DiagnosticsLogger +// open FSharp.Compiler.Driver +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.ScriptClosure +open FSharp.Compiler.Symbols +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Range +open FSharp.Compiler.Tokenization +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.BuildGraph + +//------------------------------------------------------------------------- +// InteractiveChecker +//------------------------------------------------------------------------- + +type internal TcResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType +type internal TcErrors = FSharpDiagnostic[] + +type internal CompilerState = { + tcConfig: TcConfig + tcGlobals: TcGlobals + tcImports: TcImports + tcInitialState: TcState + projectOptions: FSharpProjectOptions + parseCache: ConcurrentDictionary + checkCache: ConcurrentDictionary +} + +// Cache to store current compiler state. +// In the case of type provider invalidation, +// compiler state needs to be reset to recognize TP changes. +type internal CompilerStateCache(readAllBytes: string -> byte[], projectOptions: FSharpProjectOptions) +#if !NO_TYPEPROVIDERS + as this = +#else + = +#endif + + let initializeCompilerState() = + let references = + projectOptions.OtherOptions + |> Array.filter (fun s -> s.StartsWith("-r:")) + |> Array.map (fun s -> s.Replace("-r:", "")) + + let tcConfig = + let tcConfigB = + TcConfigBuilder.CreateNew( + LegacyReferenceResolver.getResolver(), + defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir, + reduceMemoryUsage = ReduceMemoryFlag.Yes, + implicitIncludeDir = Path.GetDirectoryName(projectOptions.ProjectFileName), + isInteractive = false, +#if !NO_TYPEPROVIDERS + isInvalidationSupported = true, +#else + isInvalidationSupported = false, +#endif + defaultCopyFSharpCore = CopyFSharpCoreFlag.No, + tryGetMetadataSnapshot = (fun _ -> None), + sdkDirOverride = None, + rangeForErrors = range0 + ) + let sourceFiles = projectOptions.SourceFiles |> Array.toList + let argv = projectOptions.OtherOptions |> Array.toList + let _sourceFiles = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) + TcConfig.Create(tcConfigB, validate=false) + + // let tcConfigP = TcConfigProvider.Constant(tcConfig) + // let ctok = CompilationThreadToken() + // let dependencyProvider = new DependencyProvider() + let tcGlobals, tcImports = + // TcImports.BuildTcImports (ctok, tcConfigP, dependencyProvider) + // |> Cancellable.runWithoutCancellation + TcImports.BuildTcImports (tcConfig, references, readAllBytes) + +#if !NO_TYPEPROVIDERS + // Handle type provider invalidation by resetting compiler state + tcImports.GetCcusExcludingBase() + |> Seq.iter (fun ccu -> + ccu.Deref.InvalidateEvent.Add(fun _ -> this.Reset()) + ) +#endif + + let assemblyName = projectOptions.ProjectFileName |> Path.GetFileNameWithoutExtension + let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, tcInitial, openDecls0) + + // parse cache, keyed on file name and source hash + let parseCache = ConcurrentDictionary(HashIdentity.Structural) + // type check cache, keyed on file name + let checkCache = ConcurrentDictionary(HashIdentity.Structural) + + { + tcConfig = tcConfig + tcGlobals = tcGlobals + tcImports = tcImports + tcInitialState = tcInitialState + projectOptions = projectOptions + parseCache = parseCache + checkCache = checkCache + } + + // Lazily evaluated in case multiple TP invalidations are triggered before next compilation requested + let mutable compilerStateLazy = lazy initializeCompilerState() + // let lockObj = obj() + + member x.Get() = + // lock lockObj (fun () -> compilerStateLazy.Value) + compilerStateLazy.Value + member x.Reset() = + // lock lockObj (fun () -> compilerStateLazy <- lazy initializeCompilerState()) + compilerStateLazy <- lazy initializeCompilerState() + +[] +module internal ParseAndCheck = + + let userOpName = "Unknown" + let suggestNamesForErrors = true + let captureIdentifiersWhenParsing = false + + let MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpDiagnostic[], + topAttrsOpt: TopAttribs option, tcImplFilesOpt: CheckedImplFile list option, compilerState) = + let assemblyRef = mkSimpleAssemblyRef "stdin" + let access = tcState.TcEnvFromImpls.AccessRights + let symbolUses = Choice2Of2 TcSymbolUses.Empty + let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat + let getAssemblyData () = None + let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, + getAssemblyData, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) + let keepAssemblyContents = true + FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) + + let ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions, compilerState) = + let fileIndex = parsingOptions.SourceFiles |> Array.findIndex ((=) fileName) + let filesAbove = parsingOptions.SourceFiles |> Array.take fileIndex + // backup all cached typecheck entries above file + let cachedAbove = filesAbove |> Array.choose (fun key -> + match compilerState.checkCache.TryGetValue(key) with + | true, value -> Some (key, value) + | false, _ -> None) + // remove all parse cache entries with the same file name + let staleParseKeys = compilerState.parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray + staleParseKeys |> Array.iter (fun key -> compilerState.parseCache.TryRemove(key) |> ignore) + compilerState.checkCache.Clear(); // clear all typecheck cache + // restore all cached typecheck entries above file + cachedAbove |> Array.iter (fun (key, value) -> compilerState.checkCache.TryAdd(key, value) |> ignore) + + let ParseFile (fileName: string, source: string, parsingOptions: FSharpParsingOptions, compilerState, ct) = + let parseCacheKey = fileName, hash source + compilerState.parseCache.GetOrAdd(parseCacheKey, fun _ -> + ClearStaleCache(fileName, parsingOptions, compilerState) + let sourceText = SourceText.ofString source + let flatErrors = compilerState.tcConfig.flatErrors + let parseErrors, parseTreeOpt, anyErrors = + ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors, flatErrors, captureIdentifiersWhenParsing, ct) + let dependencyFiles = [||] // interactions have no dependencies + FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) + + let TypeCheckOneInputEntry (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let input = parseResults.ParseTree + let diagnosticsOptions = compilerState.tcConfig.diagnosticsOptions + let capturingLogger = CompilationDiagnosticLogger("TypeCheckFile", diagnosticsOptions) + let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, diagnosticsOptions, capturingLogger) + use _scope = new CompilationGlobalsScope (diagnosticsLogger, BuildPhase.TypeCheck) + + let checkForErrors () = parseResults.ParseHadErrors || diagnosticsLogger.ErrorCount > 0 + let prefixPathOpt = None + + let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict + let tcResult, tcState = + CheckOneInput (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input) + |> Cancellable.runWithoutCancellation + + let fileName = parseResults.FileName + let flatErrors = compilerState.tcConfig.flatErrors + let parseDiagnostics = capturingLogger.GetDiagnostics() + let tcErrors = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, parseDiagnostics, suggestNamesForErrors, flatErrors, None) + (tcResult, tcErrors), (tcState, moduleNamesDict) + + let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let sink = TcResultsSinkImpl(compilerState.tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + TypeCheckOneInputEntry (parseResults, tcSink, tcState, moduleNamesDict, compilerState) + let fileName = parseResults.FileName + compilerState.checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Diagnostics tcErrors + + let scope = TypeCheckInfo (compilerState.tcConfig, compilerState.tcGlobals, ccuSigForFile, tcState.Ccu, compilerState.tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) + + let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = + let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = + let checkCacheKey = parseRes.FileName + + let typeCheckOneInput _fileName = + TypeCheckOneInputEntry (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) + compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + + let results, (tcState, moduleNamesDict) = + ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck + + let tcResults, tcErrors = Array.unzip results + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState = + CheckMultipleInputsFinish(tcResults |> Array.toList, tcState) + + let tcState, declaredImpls, ccuContents = CheckClosedInputSetFinish (implFiles, tcState) + tcState.Ccu.Deref.Contents <- ccuContents + tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors + + /// Errors grouped by file, sorted by line, column + let ErrorsByFile (fileNames: string[], errorList: FSharpDiagnostic[] list) = + let errorMap = errorList |> Array.concat |> Array.groupBy (fun x -> x.FileName) |> Map.ofArray + let errors = fileNames |> Array.choose errorMap.TryFind + errors |> Array.iter (Array.sortInPlaceBy (fun x -> x.StartLine, x.StartColumn)) + errors |> Array.concat + +type InteractiveChecker internal (compilerStateCache) = + + static member Create(references: string[], readAllBytes: string -> byte[], defines: string[], optimize: bool) = + let otherOptions = [| + for d in defines do yield "-d:" + d + yield "--optimize" + (if optimize then "+" else "-") + |] + InteractiveChecker.Create(references, readAllBytes, otherOptions) + + static member Create(references: string[], readAllBytes: string -> byte[], otherOptions: string[]) = + let projectFileName = "Project" + let toRefOption (fileName: string) = + if fileName.EndsWith(".dll", System.StringComparison.OrdinalIgnoreCase) + then "-r:" + fileName + else "-r:" + fileName + ".dll" + let otherOptions = references |> Array.map toRefOption |> Array.append otherOptions + let projectOptions: FSharpProjectOptions = { + ProjectFileName = projectFileName + ProjectId = None + SourceFiles = [| |] + OtherOptions = otherOptions + ReferencedProjects = [| |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = System.DateTime.MaxValue + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None + } + InteractiveChecker.Create(readAllBytes, projectOptions) + + static member Create(readAllBytes: string -> byte[], projectOptions: FSharpProjectOptions) = + InteractiveChecker(CompilerStateCache(readAllBytes, projectOptions)) + + /// Clears parse and typecheck caches. + member _.ClearCache () = + let compilerState = compilerStateCache.Get() + compilerState.parseCache.Clear() + compilerState.checkCache.Clear() + + /// Parses and checks the whole project, good for compilers (Fable etc.) + /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). + /// Already parsed files will be cached so subsequent compilations will be faster. + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sources: string[]) = + let cts = new CancellationTokenSource() + let compilerState = compilerStateCache.Get() + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile (fileName, source) = ParseFile (fileName, source, parsingOptions, compilerState, cts.Token) + let parseResults = Array.zip fileNames sources |> Array.map parseFile + + // type check files + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + + // make project results + let parseErrors = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrors = tcErrors |> Array.concat + let errors = ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, Some topAttrs, Some tcImplFiles, compilerState) + + projectResults + + /// Parses and checks file in project, will compile and cache all the files up to this one + /// (if not already done before), or fetch them from cache. Returns partial project results, + /// up to and including the file requested. Returns parse and typecheck results containing + /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. + member _.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) = + let cts = new CancellationTokenSource() + let compilerState = compilerStateCache.Get() + // get files before file + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + let fileNamesBeforeFile = fileNames |> Array.take fileIndex + let sourcesBeforeFile = sources |> Array.take fileIndex + + // parse files before file + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile (fileName, source) = ParseFile (fileName, source, parsingOptions, compilerState, cts.Token) + let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + + // parse and type check file + let parseFileResults = parseFile (fileName, sources.[fileIndex]) + let checkFileResults = CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict, compilerState) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = compilerState.checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = checkFileResults.Diagnostics + let errors = ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ]) + + // make partial project results + let parseResults = Array.append parseResults [| parseFileResults |] + let tcImplFiles = List.append tcImplFiles (Option.toList implFile) + let topAttrs = CombineTopAttrs topAttrsFile topAttrs + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, Some topAttrs, Some tcImplFiles, compilerState) + + parseFileResults, checkFileResults, projectResults diff --git a/fcs/fcs-fable/test/.gitignore b/fcs/fcs-fable/test/.gitignore new file mode 100644 index 00000000000..66d36d51d64 --- /dev/null +++ b/fcs/fcs-fable/test/.gitignore @@ -0,0 +1,7 @@ +# Output +out*/ + +# Node +node_modules/ +package-lock.json +yarn.lock \ No newline at end of file diff --git a/fcs/fcs-fable/test/Metadata.fs b/fcs/fcs-fable/test/Metadata.fs new file mode 100644 index 00000000000..0ad926feaed --- /dev/null +++ b/fcs/fcs-fable/test/Metadata.fs @@ -0,0 +1,216 @@ +module Metadata + +let references_core = [| + "Fable.Core" + "FSharp.Core" + "mscorlib" + "netstandard" + "System.Collections" + "System.Collections.Concurrent" + "System.ComponentModel" + "System.ComponentModel.Primitives" + "System.ComponentModel.TypeConverter" + "System.Console" + "System.Core" + "System.Diagnostics.Debug" + "System.Diagnostics.Tools" + "System.Diagnostics.Tracing" + "System.Globalization" + "System" + "System.IO" + "System.Net.Requests" + "System.Net.WebClient" + "System.Numerics" + "System.Reflection" + "System.Reflection.Extensions" + "System.Reflection.Metadata" + "System.Reflection.Primitives" + "System.Reflection.TypeExtensions" + "System.Runtime" + "System.Runtime.Extensions" + "System.Runtime.Numerics" + "System.Text.Encoding" + "System.Text.Encoding.Extensions" + "System.Text.RegularExpressions" + "System.Threading" + "System.Threading.Tasks" + "System.Threading.Thread" + "System.ValueTuple" + |] + +let references_net45 = [| + "Fable.Core" + "Fable.Import.Browser" + "FSharp.Core" + "mscorlib" + "System" + "System.Core" + "System.Data" + "System.IO" + "System.Xml" + "System.Numerics" + |] + +let references_full = [| + "Fable.Core" + "FSharp.Core" + "mscorlib" + "netstandard" + "Microsoft.CSharp" + "Microsoft.VisualBasic.Core" + "Microsoft.VisualBasic" + "Microsoft.Win32.Primitives" + "Microsoft.Win32.Registry" + "System.AppContext" + "System.Buffers" + "System.Collections.Concurrent" + "System.Collections.Immutable" + "System.Collections.NonGeneric" + "System.Collections.Specialized" + "System.Collections" + "System.ComponentModel.Annotations" + "System.ComponentModel.DataAnnotations" + "System.ComponentModel.EventBasedAsync" + "System.ComponentModel.Primitives" + "System.ComponentModel.TypeConverter" + "System.ComponentModel" + "System.Configuration" + "System.Console" + "System.Core" + "System.Data.Common" + "System.Data.DataSetExtensions" + "System.Data" + "System.Diagnostics.Contracts" + "System.Diagnostics.Debug" + "System.Diagnostics.DiagnosticSource" + "System.Diagnostics.FileVersionInfo" + "System.Diagnostics.Process" + "System.Diagnostics.StackTrace" + "System.Diagnostics.TextWriterTraceListener" + "System.Diagnostics.Tools" + "System.Diagnostics.TraceSource" + "System.Diagnostics.Tracing" + "System.Drawing.Primitives" + "System.Drawing" + "System.Dynamic.Runtime" + "System.Formats.Asn1" + "System.Globalization.Calendars" + "System.Globalization.Extensions" + "System.Globalization" + "System.IO.Compression.Brotli" + "System.IO.Compression.FileSystem" + "System.IO.Compression.ZipFile" + "System.IO.Compression" + "System.IO.FileSystem.AccessControl" + "System.IO.FileSystem.DriveInfo" + "System.IO.FileSystem.Primitives" + "System.IO.FileSystem.Watcher" + "System.IO.FileSystem" + "System.IO.IsolatedStorage" + "System.IO.MemoryMappedFiles" + "System.IO.Pipes.AccessControl" + "System.IO.Pipes" + "System.IO.UnmanagedMemoryStream" + "System.IO" + "System.Linq.Expressions" + "System.Linq.Parallel" + "System.Linq.Queryable" + "System.Linq" + "System.Memory" + "System.Net.Http.Json" + "System.Net.Http" + "System.Net.HttpListener" + "System.Net.Mail" + "System.Net.NameResolution" + "System.Net.NetworkInformation" + "System.Net.Ping" + "System.Net.Primitives" + "System.Net.Requests" + "System.Net.Security" + "System.Net.ServicePoint" + "System.Net.Sockets" + "System.Net.WebClient" + "System.Net.WebHeaderCollection" + "System.Net.WebProxy" + "System.Net.WebSockets.Client" + "System.Net.WebSockets" + "System.Net" + "System.Numerics.Vectors" + "System.Numerics" + "System.ObjectModel" + "System.Reflection.DispatchProxy" + "System.Reflection.Emit.ILGeneration" + "System.Reflection.Emit.Lightweight" + "System.Reflection.Emit" + "System.Reflection.Extensions" + "System.Reflection.Metadata" + "System.Reflection.Primitives" + "System.Reflection.TypeExtensions" + "System.Reflection" + "System.Resources.Reader" + "System.Resources.ResourceManager" + "System.Resources.Writer" + "System.Runtime.CompilerServices.Unsafe" + "System.Runtime.CompilerServices.VisualC" + "System.Runtime.Extensions" + "System.Runtime.Handles" + "System.Runtime.InteropServices.RuntimeInformation" + "System.Runtime.InteropServices" + "System.Runtime.Intrinsics" + "System.Runtime.Loader" + "System.Runtime.Numerics" + "System.Runtime.Serialization.Formatters" + "System.Runtime.Serialization.Json" + "System.Runtime.Serialization.Primitives" + "System.Runtime.Serialization.Xml" + "System.Runtime.Serialization" + "System.Runtime" + "System.Security.AccessControl" + "System.Security.Claims" + "System.Security.Cryptography.Algorithms" + "System.Security.Cryptography.Cng" + "System.Security.Cryptography.Csp" + "System.Security.Cryptography.Encoding" + "System.Security.Cryptography.OpenSsl" + "System.Security.Cryptography.Primitives" + "System.Security.Cryptography.X509Certificates" + "System.Security.Principal.Windows" + "System.Security.Principal" + "System.Security.SecureString" + "System.Security" + "System.ServiceModel.Web" + "System.ServiceProcess" + "System.Text.Encoding.CodePages" + "System.Text.Encoding.Extensions" + "System.Text.Encoding" + "System.Text.Encodings.Web" + "System.Text.Json" + "System.Text.RegularExpressions" + "System.Threading.Channels" + "System.Threading.Overlapped" + "System.Threading.Tasks.Dataflow" + "System.Threading.Tasks.Extensions" + "System.Threading.Tasks.Parallel" + "System.Threading.Tasks" + "System.Threading.Thread" + "System.Threading.ThreadPool" + "System.Threading.Timer" + "System.Threading" + "System.Transactions.Local" + "System.Transactions" + "System.ValueTuple" + "System.Web.HttpUtility" + "System.Web" + "System.Windows" + "System.Xml.Linq" + "System.Xml.ReaderWriter" + "System.Xml.Serialization" + "System.Xml.XDocument" + "System.Xml.XPath.XDocument" + "System.Xml.XPath" + "System.Xml.XmlDocument" + "System.Xml.XmlSerializer" + "System.Xml" + "System" + "WindowsBase" + |] diff --git a/fcs/fcs-fable/test/Platform.fs b/fcs/fcs-fable/test/Platform.fs new file mode 100644 index 00000000000..b4efa099d69 --- /dev/null +++ b/fcs/fcs-fable/test/Platform.fs @@ -0,0 +1,105 @@ +module Fable.Compiler.Platform + +#if DOTNET_FILE_SYSTEM && !FABLE_COMPILER + +open System.IO + +let readAllBytes (filePath: string) = File.ReadAllBytes(filePath) +let readAllText (filePath: string) = File.ReadAllText(filePath, System.Text.Encoding.UTF8) +let writeAllText (filePath: string) (text: string) = File.WriteAllText(filePath, text) + +let measureTime (f: 'a -> 'b) x = + let sw = System.Diagnostics.Stopwatch.StartNew() + let res = f x + sw.Stop() + sw.ElapsedMilliseconds, res + +let normalizeFullPath (path: string) = + let path = if System.String.IsNullOrWhiteSpace path then "." else path + Path.GetFullPath(path).Replace('\\', '/') + +let getRelativePath (path: string) (pathTo: string) = + let path = if System.String.IsNullOrWhiteSpace path then "." else path + Path.GetRelativePath(path, pathTo).Replace('\\', '/') + +let getHomePath () = + System.Environment.GetFolderPath(System.Environment.SpecialFolder.UserProfile) + +#else + +open Fable.Core.JsInterop + +module JS = + type IFileSystem = + abstract readFileSync: string -> byte[] + abstract readFileSync: string * string -> string + abstract writeFileSync: string * string -> unit + + type IProcess = + abstract hrtime: unit -> float [] + abstract hrtime: float[] -> float[] + + type IPath = + abstract resolve: string -> string + abstract relative: string * string -> string + + type IOperSystem = + abstract homedir: unit -> string + abstract tmpdir: unit -> string + abstract platform: unit -> string + abstract arch: unit -> string + + let fs: IFileSystem = importAll "fs" + let os: IOperSystem = importAll "os" + let proc: IProcess = importAll "process" + let path: IPath = importAll "path" + +let readAllBytes (filePath: string) = JS.fs.readFileSync(filePath) +let readAllText (filePath: string) = JS.fs.readFileSync(filePath, "utf8").TrimStart('\uFEFF') +let writeAllText (filePath: string) (text: string) = JS.fs.writeFileSync(filePath, text) + +let measureTime (f: 'a -> 'b) x = + let startTime = JS.proc.hrtime() + let res = f x + let elapsed = JS.proc.hrtime(startTime) + int64 (elapsed.[0] * 1e3 + elapsed.[1] / 1e6), res + +let normalizeFullPath (path: string) = + JS.path.resolve(path).Replace('\\', '/') + +let getRelativePath (path: string) (pathTo: string) = + JS.path.relative(path, pathTo).Replace('\\', '/') + +let getHomePath () = + JS.os.homedir() + +#endif + +module Path = + + let Combine (path1: string, path2: string) = + let path1 = + if path1.Length = 0 then path1 + else (path1.TrimEnd [|'\\';'/'|]) + "/" + path1 + (path2.TrimStart [|'\\';'/'|]) + + let ChangeExtension (path: string, ext: string) = + let i = path.LastIndexOf(".") + if i < 0 then path + else path.Substring(0, i) + ext + + let GetFileName (path: string) = + let normPath = path.Replace("\\", "/").TrimEnd('/') + let i = normPath.LastIndexOf("/") + normPath.Substring(i + 1) + + let GetFileNameWithoutExtension (path: string) = + let path = GetFileName path + let i = path.LastIndexOf(".") + path.Substring(0, i) + + let GetDirectoryName (path: string) = + let normPath = path.Replace("\\", "/") + let i = normPath.LastIndexOf("/") + if i < 0 then "" + else normPath.Substring(0, i) diff --git a/fcs/fcs-fable/test/ProjectParser.fs b/fcs/fcs-fable/test/ProjectParser.fs new file mode 100644 index 00000000000..ef77b85ce17 --- /dev/null +++ b/fcs/fcs-fable/test/ProjectParser.fs @@ -0,0 +1,255 @@ +module Fable.Compiler.ProjectParser + +open Fable.Compiler.Platform +open System.Collections.Generic +open System.Text.RegularExpressions + +type ReferenceType = + | ProjectReference of string + | PackageReference of string * string + +let (|Regex|_|) (pattern: string) (input: string) = + let m = Regex.Match(input, pattern) + if m.Success then Some [for x in m.Groups -> x.Value] + else None + +let getXmlWithoutComments xml = + Regex.Replace(xml, @"", "") + +let getXmlTagContents tag xml = + let pattern = sprintf @"<%s[^>]*>([^<]*)<\/%s[^>]*>" tag tag + Regex.Matches(xml, pattern) + |> Seq.map (fun m -> m.Groups.[1].Value.Trim()) + +let getXmlTagContentsFirstOrDefault tag defaultValue xml = + defaultArg (getXmlTagContents tag xml |> Seq.tryHead) defaultValue + +let getXmlTagAttributes1 tag attr1 xml = + let pattern = sprintf """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)""" tag attr1 + Regex.Matches(xml, pattern) + |> Seq.map (fun m -> m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim()) + +let getXmlTagAttributes2 tag attr1 attr2 xml = + let pattern = sprintf """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)[^>]*%s\s*=\s*("[^"]*|'[^']*)""" tag attr1 attr2 + Regex.Matches(xml, pattern) + |> Seq.map (fun m -> + m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim(), + m.Groups.[2].Value.TrimStart('"').TrimStart(''').Trim()) + +let isSystemPackage (pkgName: string) = + pkgName.StartsWith("System.") + || pkgName.StartsWith("Microsoft.") + || pkgName.StartsWith("runtime.") + || pkgName = "NETStandard.Library" + || pkgName = "FSharp.Core" + || pkgName = "Fable.Core" + +let parsePackageSpec nuspecPath = + // get package spec xml + let packageXml = readAllText nuspecPath + // get package dependencies + let references = + packageXml + |> getXmlWithoutComments + |> getXmlTagAttributes2 "dependency" "id" "version" + |> Seq.map PackageReference + |> Seq.toArray + references + +// let resolvePackage (pkgName, pkgVersion) = +// if not (isSystemPackage pkgName) then +// let homePath = getHomePath().Replace('\\', '/') +// let nugetPath = sprintf ".nuget/packages/%s/%s" pkgName pkgVersion +// let pkgPath = Path.Combine(homePath, nugetPath.ToLowerInvariant()) +// let libPath = Path.Combine(pkgPath, "lib") +// let fablePath = Path.Combine(pkgPath, "fable") +// let binaryPaths = getDirFiles libPath ".dll" +// let nuspecPaths = getDirFiles pkgPath ".nuspec" +// let fsprojPaths = getDirFiles fablePath ".fsproj" +// if Array.isEmpty nuspecPaths then +// printfn "ERROR: Cannot find package %s" pkgPath +// let binaryOpt = binaryPaths |> Array.tryLast +// let dependOpt = nuspecPaths |> Array.tryLast |> Option.map parsePackageSpec +// let fsprojOpt = fsprojPaths |> Array.tryLast |> Option.map ProjectReference +// let pkgRefs, dllPaths = +// match binaryOpt, dependOpt, fsprojOpt with +// | _, _, Some projRef -> +// [| projRef |], [||] +// | Some dllRef, Some dependencies, _ -> +// dependencies, [| dllRef |] +// | _, _, _ -> [||], [||] +// pkgRefs, dllPaths +// else [||], [||] + +let parseCompilerOptions projectXml = + // get project settings, + let target = projectXml |> getXmlTagContentsFirstOrDefault "OutputType" "" + let langVersion = projectXml |> getXmlTagContentsFirstOrDefault "LangVersion" "" + let warnLevel = projectXml |> getXmlTagContentsFirstOrDefault "WarningLevel" "" + let treatWarningsAsErrors = projectXml |> getXmlTagContentsFirstOrDefault "TreatWarningsAsErrors" "" + + // get conditional defines + let defines = + projectXml + |> getXmlTagContents "DefineConstants" + |> Seq.collect (fun s -> s.Split(';')) + |> Seq.append ["FABLE_COMPILER"; "FABLE_COMPILER_JS"] + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(DefineConstants)"; ""] + |> Seq.toArray + + // get disabled warnings + let nowarns = + projectXml + |> getXmlTagContents "NoWarn" + |> Seq.collect (fun s -> s.Split(';')) + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(NoWarn)"; ""] + |> Seq.toArray + + // get warnings as errors + let warnAsErrors = + projectXml + |> getXmlTagContents "WarningsAsErrors" + |> Seq.collect (fun s -> s.Split(';')) + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(WarningsAsErrors)"; ""] + |> Seq.toArray + + // get other flags + let otherFlags = + projectXml + |> getXmlTagContents "OtherFlags" + |> Seq.collect (fun s -> s.Split(' ')) + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(OtherFlags)"; ""] + |> Seq.toArray + + let otherOptions = [| + if target.Length > 0 then + yield "--target:" + target + if langVersion.Length > 0 then + yield "--langversion:" + langVersion + if warnLevel.Length > 0 then + yield "--warn:" + warnLevel + if treatWarningsAsErrors = "true" then + yield "--warnaserror+" + for d in defines do yield "-d:" + d + for n in nowarns do yield "--nowarn:" + n + for e in warnAsErrors do yield "--warnaserror:" + e + for o in otherFlags do yield o + |] + otherOptions + +let makeFullPath projectFileDir (path: string) = + let path = path.Replace('\\', '/') + let isAbsolutePath (path: string) = + path.StartsWith('/') || path.IndexOf(':') = 1 + if isAbsolutePath path then path + else Path.Combine(projectFileDir, path) + |> normalizeFullPath + +let parseProjectScript projectFilePath = + let projectXml = readAllText projectFilePath + let projectDir = Path.GetDirectoryName projectFilePath + let dllRefs, srcFiles = + (([||], [||]), projectXml.Split('\n')) + ||> Array.fold (fun (dllRefs, srcFiles) line -> + match line.Trim() with + | Regex @"^#r\s+""(.*?)""$" [_;path] + when not(path.EndsWith("Fable.Core.dll")) -> + Array.append [| Path.Combine(projectDir, path) |] dllRefs, srcFiles + | Regex @"^#load\s+""(.*?)""$" [_;path] -> + dllRefs, Array.append [| Path.Combine(projectDir, path) |] srcFiles + | _ -> dllRefs, srcFiles) + let projectRefs = [||] + let sourceFiles = Array.append srcFiles [| Path.GetFileName projectFilePath |] + let otherOptions = [| "--define:FABLE_COMPILER"; "--define:FABLE_COMPILER_JS" |] + (projectRefs, dllRefs, sourceFiles, otherOptions) + +let parseProjectFile projectFilePath = + // get project xml without any comments + let projectXml = readAllText projectFilePath |> getXmlWithoutComments + let projectDir = Path.GetDirectoryName projectFilePath + + // get package references + let packageRefs = + projectXml + |> getXmlTagAttributes2 "PackageReference" "Include" "Version" + |> Seq.map PackageReference + |> Seq.toArray + + // get project references + let projectRefs = + projectXml + |> getXmlTagAttributes1 "ProjectReference" "Include" + |> Seq.map (makeFullPath projectDir >> ProjectReference) + |> Seq.toArray + + // replace some variables + let projectXml = projectXml.Replace("$(MSBuildProjectDirectory)", ".") + let sourceRoot = projectXml |> getXmlTagContentsFirstOrDefault "FSharpSourcesRoot" "" + let projectXml = projectXml.Replace("$(FSharpSourcesRoot)", sourceRoot.Replace('\\', '/')) + let yaccOutput = projectXml |> getXmlTagContentsFirstOrDefault "FsYaccOutputFolder" "" + let projectXml = projectXml.Replace("$(FsYaccOutputFolder)", yaccOutput.Replace('\\', '/')) + + // get source files + let sourceFiles = + projectXml + |> getXmlTagAttributes1 "Compile" "Include" + |> Seq.map (makeFullPath projectDir) + // |> Seq.collect getGlobFiles + |> Seq.toArray + + let dllRefs = [||] + let projectRefs = Array.append projectRefs packageRefs + let otherOptions = parseCompilerOptions projectXml + (projectRefs, dllRefs, sourceFiles, otherOptions) + +let makeHashSetIgnoreCase () = + let equalityComparerIgnoreCase = + { new IEqualityComparer with + member _.Equals(x, y) = x.ToLowerInvariant() = y.ToLowerInvariant() + member _.GetHashCode(x) = hash (x.ToLowerInvariant()) } + HashSet(equalityComparerIgnoreCase) + +let dedupReferences (refSet: HashSet) references = + let refName = function + | ProjectReference path -> path + | PackageReference (pkgName, pkgVersion) -> pkgName + "," + pkgVersion + let newRefs = references |> Array.filter (refName >> refSet.Contains >> not) + refSet.UnionWith(newRefs |> Array.map refName) + newRefs + +let parseProject projectFilePath = + + let rec parseProject (refSet: HashSet) (projectRef: ReferenceType) = + let projectRefs, dllPaths, sourcePaths, otherOptions = + match projectRef with + | ProjectReference path -> + if path.EndsWith(".fsx") + then parseProjectScript path + else parseProjectFile path + | PackageReference (pkgName, pkgVersion) -> + // let pkgRefs, dllPaths = resolvePackage (pkgName, pkgVersion) + // pkgRefs, dllPaths, [||], [||] + [||], [||], [||], [||] + + // parse and combine all referenced projects into one big project + let parseResult = projectRefs |> dedupReferences refSet |> Array.map (parseProject refSet) + let dllPaths = dllPaths |> Array.append (parseResult |> Array.collect (fun (x,_,_) -> x)) + let sourcePaths = sourcePaths |> Array.append (parseResult |> Array.collect (fun (_,x,_) -> x)) + let otherOptions = otherOptions |> Array.append (parseResult |> Array.collect (fun (_,_,x) -> x)) + + (dllPaths, sourcePaths, otherOptions) + + let refSet = makeHashSetIgnoreCase () + let projectRef = ProjectReference projectFilePath + let dllPaths, sourcePaths, otherOptions = parseProject refSet projectRef + (dllPaths |> Array.distinct, + sourcePaths |> Array.distinct, + otherOptions |> Array.distinct) diff --git a/fcs/fcs-fable/test/bench/bench.fs b/fcs/fcs-fable/test/bench/bench.fs new file mode 100644 index 00000000000..3c21093f434 --- /dev/null +++ b/fcs/fcs-fable/test/bench/bench.fs @@ -0,0 +1,108 @@ +module Fable.Compiler.App + +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.SourceCodeServices +open Fable.Compiler.Platform +open Fable.Compiler.ProjectParser + +let references = Metadata.references_core +let metadataPath = __SOURCE_DIRECTORY__ + "/../../../../../Fable/src/fable-metadata/lib/" // .NET BCL binaries + +let printErrors showWarnings (errors: FSharpDiagnostic[]) = + let isWarning (e: FSharpDiagnostic) = + e.Severity = FSharpDiagnosticSeverity.Warning + let printError (e: FSharpDiagnostic) = + let errorType = (if isWarning e then "Warning" else "Error") + printfn "%s (%d,%d): %s: %s" e.FileName e.StartLine e.StartColumn errorType e.Message + let warnings, errors = errors |> Array.partition isWarning + let hasErrors = not (Array.isEmpty errors) + if showWarnings then + warnings |> Array.iter printError + if hasErrors then + errors |> Array.iter printError + failwith "Too many errors." + +let parseFiles projectFileName outDir optimize = + // parse project + let (dllRefs, fileNames, otherOptions) = parseProject projectFileName + let sources = fileNames |> Array.map readAllText + + // create checker + let readAllBytes dllName = readAllBytes (metadataPath + dllName) + let optimizeFlag = "--optimize" + (if optimize then "+" else "-") + let otherOptions = otherOptions |> Array.append [| optimizeFlag |] + let createChecker () = InteractiveChecker.Create(references, readAllBytes, otherOptions) + let ms0, checker = measureTime createChecker () + printfn "--------------------------------------------" + printfn "InteractiveChecker created in %d ms" ms0 + + // parse F# files to AST + let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + let ms1, projectResults = measureTime parseFSharpProject () + printfn "Project: %s, FCS time: %d ms" projectFileName ms1 + printfn "--------------------------------------------" + let showWarnings = false // supress warnings for clarity + projectResults.Diagnostics |> printErrors showWarnings + + // // modify last file + // sources.[sources.Length - 1] <- sources.[sources.Length - 1] + "\n" + // let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + // let ms1, projectResults = measureTime parseFSharpProject () + // printfn "Project: %s, FCS time: %d ms (modified last file)" projectFileName ms1 + + // // modify middle file + // sources.[sources.Length / 2] <- sources.[sources.Length / 2] + "\n" + // let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + // let ms1, projectResults = measureTime parseFSharpProject () + // printfn "Project: %s, FCS time: %d ms (modified middle file)" projectFileName ms1 + + // // modify first file + // sources.[0] <- sources.[0] + "\n" + // let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + // let ms1, projectResults = measureTime parseFSharpProject () + // printfn "Project: %s, FCS time: %d ms (modified first file)" projectFileName ms1 + + // // clear cache + // checker.ClearCache() + + // // after clear cache + // sources.[0] <- sources.[0] + "\n" + // let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + // let ms1, projectResults = measureTime parseFSharpProject () + // printfn "Project: %s, FCS time: %d ms (after clear cache)" projectFileName ms1 + + // exclude signature files + let fileNames = fileNames |> Array.filter (fun x -> not (x.EndsWith(".fsi"))) + + // this is memory intensive, only do it once + let implFiles = if optimize + then projectResults.GetOptimizedAssemblyContents().ImplementationFiles + else projectResults.AssemblyContents.ImplementationFiles + + let fileCount = Seq.length implFiles + printfn "Typechecked %d files" fileCount + // // for each file + // for implFile in implFiles do + // printfn "%s" implFile.FileName + + // // printfn "--------------------------------------------" + // // let fsAst = implFile.Declarations |> AstPrint.printFSharpDecls "" |> String.concat "\n" + // // printfn "%s" fsAst + +let parseArguments (argv: string[]) = + let usage = "Usage: bench [--options]" + let opts, args = argv |> Array.partition (fun s -> s.StartsWith("--")) + match args with + | [| projectFileName |] -> + let outDir = "./out-test" + let optimize = opts |> Array.contains "--optimize" + parseFiles projectFileName outDir optimize + | _ -> printfn "%s" usage + +[] +let main argv = + try + parseArguments argv + with ex -> + printfn "Error: %A" ex.Message + 0 diff --git a/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj new file mode 100644 index 00000000000..a7ab44e1acd --- /dev/null +++ b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj @@ -0,0 +1,27 @@ + + + + Exe + net8.0 + $(DefineConstants);DOTNET_FILE_SYSTEM + + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/test/fcs-fable-test.fsproj b/fcs/fcs-fable/test/fcs-fable-test.fsproj new file mode 100644 index 00000000000..bcc9b5414e2 --- /dev/null +++ b/fcs/fcs-fable/test/fcs-fable-test.fsproj @@ -0,0 +1,26 @@ + + + + Exe + net8.0 + $(DefineConstants);DOTNET_FILE_SYSTEM + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/test/nuget.config b/fcs/fcs-fable/test/nuget.config new file mode 100644 index 00000000000..6ce97590acd --- /dev/null +++ b/fcs/fcs-fable/test/nuget.config @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/fcs/fcs-fable/test/package.json b/fcs/fcs-fable/test/package.json new file mode 100644 index 00000000000..ab5e66d407d --- /dev/null +++ b/fcs/fcs-fable/test/package.json @@ -0,0 +1,15 @@ +{ + "private": true, + "type": "module", + "scripts": { + "build-test": "dotnet build -c Release", + "build-bench": "dotnet build -c Release bench", + "build-node": "fable fcs-fable-test.fsproj out-test", + "test": "dotnet run -c Release", + "test-node": "node out-test/test", + "bench": "dotnet run -c Release --project bench ../fcs-fable.fsproj" + }, + "devDependencies": { + "fable-compiler-js": "^3.0.0" + } +} diff --git a/fcs/fcs-fable/test/test.fs b/fcs/fcs-fable/test/test.fs new file mode 100644 index 00000000000..d2405c6958b --- /dev/null +++ b/fcs/fcs-fable/test/test.fs @@ -0,0 +1,61 @@ +module Fable.Compiler.App + +open FSharp.Compiler +open FSharp.Compiler.EditorServices +open FSharp.Compiler.SourceCodeServices +open Fable.Compiler.Platform + +// let references = Metadata.references_full +// let metadataPath = "../../../../temp/metadata/" // .NET BCL binaries +let references = Metadata.references_core +let metadataPath = __SOURCE_DIRECTORY__ + "/../../../../Fable/src/fable-metadata/lib/" // .NET BCL binaries + +[] +let main _argv = + printfn "Parsing begins..." + + let defines = [||] + let optimize = false + let readAllBytes dllName = readAllBytes (metadataPath + dllName) + let checker = InteractiveChecker.Create(references, readAllBytes, defines, optimize) + + let projectFileName = "project" + let fileName = __SOURCE_DIRECTORY__ + "/test_script.fsx" + let source = readAllText fileName + + let parseResults, typeCheckResults, projectResults = + checker.ParseAndCheckFileInProject(fileName, projectFileName, [|fileName|], [|source|]) + + // print errors + projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + + printfn "Typed AST (optimize=%A):" optimize + // let implFiles = typeCheckResults.ImplementationFile |> Option.toArray + let implFiles = + let assemblyContents = + if not optimize then projectResults.AssemblyContents + else projectResults.GetOptimizedAssemblyContents() + assemblyContents.ImplementationFiles + let decls = implFiles + |> Seq.collect (fun file -> AstPrint.printFSharpDecls "" file.Declarations) + |> String.concat "\n" + decls |> printfn "%s" + // writeAllText (fileName + ".ast.txt") decls + + let inputLines = source.Split('\n') + + // Get tool tip at the specified location + let tip = typeCheckResults.GetToolTip(4, 7, inputLines.[3], ["foo"], Tokenization.FSharpTokenTag.IDENT) + (sprintf "%A" tip).Replace("\n","") |> printfn "\n---> ToolTip Text = %A" // should be "FSharpToolTipText [...]" + + // Get declarations (autocomplete) for msg + let partialName = { QualifyingIdents = []; PartialIdent = "msg"; EndColumn = 17; LastDotPos = None } + let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 6, inputLines.[5], partialName, (fun _ -> [])) + [ for item in decls.Items -> item.NameInList ] |> printfn "\n---> msg AutoComplete = %A" // should be string methods + + // Get declarations (autocomplete) for canvas + let partialName = { QualifyingIdents = []; PartialIdent = "canvas"; EndColumn = 10; LastDotPos = None } + let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 8, inputLines.[7], partialName, (fun _ -> [])) + [ for item in decls.Items -> item.NameInList ] |> printfn "\n---> canvas AutoComplete = %A" + + 0 diff --git a/fcs/fcs-fable/test/test_script.fsx b/fcs/fcs-fable/test/test_script.fsx new file mode 100644 index 00000000000..6474447f926 --- /dev/null +++ b/fcs/fcs-fable/test/test_script.fsx @@ -0,0 +1,9 @@ +open System +//open Fable.Import + +let foo() = + let msg = String.Concat("Hello"," ","world") + let len = msg.Length + // let canvas = Browser.document.createElement_canvas () + // canvas.width <- 1000. + () \ No newline at end of file diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 33a46ff0a23..41d57047de5 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -15,7 +15,9 @@ open System.Collections open System.Collections.Generic open System.Collections.Concurrent open System.Collections.ObjectModel +#if !FABLE_COMPILER open System.Linq +#endif open System.Reflection open System.Text open System.Threading @@ -498,6 +500,7 @@ type ILAssemblyRef(data) = assemRefLocale = locale } +#if !FABLE_COMPILER static member FromAssemblyName(aname: AssemblyName) = let locale = None @@ -521,6 +524,7 @@ type ILAssemblyRef(data) = let name = match aname.Name with | null -> aname.FullName | name -> name ILAssemblyRef.Create(name, None, publicKey, retargetable, version, locale) +#endif //!FABLE_COMPILER member aref.QualifiedName = let b = StringBuilder(100) @@ -2920,7 +2924,11 @@ and [] ILTypeDefs(f: unit -> ILPreTypeDef[]) = let key = pre.Namespace, pre.Name t[key] <- pre +#if FABLE_COMPILER + t +#else ReadOnlyDictionary t +#endif member x.AsArray() = [| for pre in x.GetArray() -> pre.GetTypeDef() |] @@ -3026,7 +3034,11 @@ type ILResourceAccess = [] type ILResourceLocation = +#if FABLE_COMPILER + | Local of ByteMemory +#else | Local of ByteStorage +#endif | File of ILModuleRef * int32 | Assembly of ILAssemblyRef @@ -3042,7 +3054,11 @@ type ILResource = /// Read the bytes from a resource local to an assembly member r.GetBytes() = match r.Location with +#if FABLE_COMPILER + | ILResourceLocation.Local bytes -> bytes.AsReadOnly() +#else | ILResourceLocation.Local bytes -> bytes.GetByteMemory() +#endif | _ -> failwith "GetBytes" member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex @@ -3279,7 +3295,11 @@ let formatCodeLabel (x: int) = "L" + string x // ++GLOBAL MUTABLE STATE (concurrency safe) let codeLabelCount = ref 0 +#if FABLE_COMPILER +let generateCodeLabel () = codeLabelCount.Value <- codeLabelCount.Value + 1; codeLabelCount.Value +#else let generateCodeLabel () = Interlocked.Increment codeLabelCount +#endif let instrIsRet i = match i with @@ -4811,6 +4831,11 @@ let parseILVersion (vstr: string) = versionComponents[3] <- defaultRevision.ToString() vstr <- String.Join(".", versionComponents) +#if FABLE_COMPILER + let parts = vstr.Split([|'.'|]) + let versions = Array.append (Array.map uint16 parts) [|0us;0us;0us;0us|] + ILVersionInfo (versions.[0], versions.[1], versions.[2], versions.[3]) +#else let version = Version vstr let zero32 n = if n < 0 then 0us else uint16 n // since the minor revision will be -1 if none is specified, we need to truncate to 0 to not break existing code @@ -4821,6 +4846,7 @@ let parseILVersion (vstr: string) = uint16 version.MinorRevision ILVersionInfo(zero32 version.Major, zero32 version.Minor, zero32 version.Build, minorRevision) +#endif let compareILVersions (version1: ILVersionInfo) (version2: ILVersionInfo) = let c = compare version1.Major version2.Major @@ -5137,7 +5163,11 @@ type ILTypeSigParser(tstring: string) = ] |> String.concat "," +#if FABLE_COMPILER + ILScopeRef.Assembly(mkSimpleAssemblyRef scope) +#else ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(AssemblyName scope)) +#endif else ILScopeRef.Local @@ -5309,7 +5339,11 @@ let decodeILAttribData (ca: ILAttribute) = let scoref = match rest with +#if FABLE_COMPILER + | Some aname -> ILScopeRef.Assembly(mkSimpleAssemblyRef aname) +#else | Some aname -> ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(AssemblyName aname)) +#endif | None -> PrimaryAssemblyILGlobals.primaryAssemblyScopeRef let tref = mkILTyRef (scoref, unqualified_tname) @@ -5680,11 +5714,19 @@ let computeILRefs ilg modul = refsOfILModule s modul { +#if FABLE_COMPILER + AssemblyReferences = s.refsA |> Seq.toArray + ModuleReferences = s.refsM |> Seq.toArray + TypeReferences = s.refsTs |> Seq.toArray + MethodReferences = s.refsMs |> Seq.toArray + FieldReferences = s.refsFs |> Seq.toArray +#else AssemblyReferences = s.refsA.ToArray() ModuleReferences = s.refsM.ToArray() TypeReferences = s.refsTs.ToArray() MethodReferences = s.refsMs.ToArray() FieldReferences = s.refsFs.ToArray() +#endif } let unscopeILTypeRef (x: ILTypeRef) = diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index f80c64b0c59..b8ed757c4d1 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -91,7 +91,9 @@ type ILAssemblyRef = locale: string option -> ILAssemblyRef +#if !FABLE_COMPILER static member FromAssemblyName: AssemblyName -> ILAssemblyRef +#endif member Name: string @@ -1743,7 +1745,11 @@ type internal ILResourceAccess = type internal ILResourceLocation = /// Represents a manifest resource that can be read or written to a PE file +#if FABLE_COMPILER + | Local of ByteMemory +#else | Local of ByteStorage +#endif /// Represents a manifest resource in an associated file | File of ILModuleRef * int32 diff --git a/src/Compiler/AbstractIL/illex.fsl b/src/Compiler/AbstractIL/illex.fsl index baf54ba0362..588d28af202 100644 --- a/src/Compiler/AbstractIL/illex.fsl +++ b/src/Compiler/AbstractIL/illex.fsl @@ -7,9 +7,25 @@ open Internal.Utilities.Library open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.AsciiConstants +#if FABLE_COMPILER + +let lexeme (lexbuf : LexBuffer<_>) = LexBuffer<_>.LexemeString lexbuf +let lexemeChar (lexbuf : LexBuffer<_>) n = lexbuf.LexemeChar n |> char + +let lexemeTrimBoth (lexbuf : LexBuffer<_>) (n:int) (m:int) = + LexBuffer<_>.LexemeString(lexbuf).Substring(n, lexbuf.LexemeLength - (n+m)) + +#else //!FABLE_COMPILER + let lexeme (lexbuf : LexBuffer) = LexBuffer.LexemeString lexbuf let lexemeChar (lexbuf : LexBuffer) n = lexbuf.LexemeChar n +let lexemeTrimBoth (lexbuf : LexBuffer<_>) (n:int) (m:int) = + let s = lexbuf.LexemeView + s.Slice(n, s.Length - (n+m)).ToString() + +#endif //!FABLE_COMPILER + let unexpectedChar _lexbuf = raise Parsing.RecoverableParseError ;; @@ -106,8 +122,7 @@ rule token = parse (* The problem is telling an integer-followed-by-ellipses from a floating-point-number-followed-by-dots *) | ((['0'-'9']) | (['0'-'9']['0'-'9']['0'-'9']+)) "..." - { let b = lexbuf.LexemeView in - VAL_INT32_ELLIPSES(int32(b.Slice(0, (b.Length - 3)).ToString())) } + { VAL_INT32_ELLIPSES(int32(lexemeTrimBoth lexbuf 0 3)) } | ['0'-'9' 'A'-'F' 'a'-'f' ] ['0'-'9' 'A'-'F' 'a'-'f' ] { let c1 = (lexemeChar lexbuf 0) in let c2 = (lexemeChar lexbuf 1) in diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 14af625419b..009f5d198cc 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -21,13 +21,17 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.BinaryConstants open Internal.Utilities.Library +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.Support +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open System.Reflection +#if !FABLE_COMPILER open System.Reflection.PortableExecutable open FSharp.NativeInterop +#endif #nowarn "9" @@ -38,6 +42,12 @@ let _ = if checking then dprintn "warning: ILBinaryReader.checking is on" +#if FABLE_COMPILER +let noStableFileHeuristic = false +let alwaysMemoryMapFSC = false +let stronglyHeldReaderCacheSizeDefault = 30 +let stronglyHeldReaderCacheSize = stronglyHeldReaderCacheSizeDefault +#else //!FABLE_COMPILER let noStableFileHeuristic = try not (isNull (Environment.GetEnvironmentVariable "FSharp_NoStableFileHeuristic")) @@ -59,6 +69,7 @@ let stronglyHeldReaderCacheSize = | s -> int32 s) with _ -> stronglyHeldReaderCacheSizeDefault +#endif //!FABLE_COMPILER let singleOfBits (x: int32) = BitConverter.ToSingle(BitConverter.GetBytes x, 0) @@ -145,6 +156,8 @@ type private BinaryView = ReadOnlyByteMemory type BinaryFile = abstract GetView: unit -> BinaryView +#if !FABLE_COMPILER + /// Gives views over a raw chunk of memory, for example those returned to us by the memory manager in Roslyn's /// Visual Studio integration. 'obj' must keep the memory alive. The object will capture it and thus also keep the memory alive for /// the lifetime of this object. @@ -182,6 +195,8 @@ type ByteMemoryFile(fileName: string, view: ByteMemory) = interface BinaryFile with override _.GetView() = view.AsReadOnly() +#endif //!FABLE_COMPILER + /// A BinaryFile backed by an array of bytes held strongly as managed memory [] type ByteFile(fileName: string, bytes: byte[]) = @@ -192,6 +207,8 @@ type ByteFile(fileName: string, bytes: byte[]) = interface BinaryFile with override bf.GetView() = view +#if !FABLE_COMPILER + type PEFile(fileName: string, peReader: PEReader) as this = // We store a weak byte memory reference so we do not constantly create a lot of byte memory objects. @@ -257,6 +274,8 @@ type WeakByteFile(fileName: string, chunk: (int * int) option) = ByteMemory.FromArray(strongBytes).AsReadOnly() +#endif //!FABLE_COMPILER + let seekReadByte (mdv: BinaryView) addr = mdv[addr] let seekReadBytes (mdv: BinaryView) addr len = mdv.ReadBytes(addr, len) let seekReadInt32 (mdv: BinaryView) addr = mdv.ReadInt32 addr @@ -1170,13 +1189,24 @@ type ILMetadataReader = } type ISeekReadIndexedRowReader<'RowT, 'KeyT, 'T when 'RowT: struct> = - abstract GetRow: int * byref<'RowT> -> unit - abstract GetKey: byref<'RowT> -> 'KeyT + abstract GetRow: int * ref<'RowT> -> unit + abstract GetKey: ref<'RowT> -> 'KeyT abstract CompareKey: 'KeyT -> int - abstract ConvertRow: byref<'RowT> -> 'T + abstract ConvertRow: ref<'RowT> -> 'T + +#if FABLE_COMPILER +[] +type CustomAttributeRow = + val mutable parentIndex: TaggedIndex + val mutable typeIndex: TaggedIndex + val mutable valueIndex: int +let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader) = + let mutable row = ref Unchecked.defaultof +#else let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = let mutable row = Unchecked.defaultof<'RowT> +#endif let mutable startRid = -1 let mutable endRid = -1 @@ -1192,8 +1222,8 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead fin <- true else let mid = (low + high) / 2 - reader.GetRow(mid, &row) - let c = reader.CompareKey(reader.GetKey(&row)) + reader.GetRow(mid, row) + let c = reader.CompareKey(reader.GetKey(row)) if c > 0 then low <- mid elif c < 0 then high <- mid @@ -1214,9 +1244,9 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead if curr = 0 then fin <- true else - reader.GetRow(curr, &row) + reader.GetRow(curr, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then + if reader.CompareKey(reader.GetKey(row)) = 0 then startRid <- curr else fin <- true @@ -1231,9 +1261,9 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead if curr > numRows then fin <- true else - reader.GetRow(curr, &row) + reader.GetRow(curr, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then + if reader.CompareKey(reader.GetKey(row)) = 0 then endRid <- curr else fin <- true @@ -1244,9 +1274,9 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead let mutable rid = 1 while rid <= numRows && startRid = -1 do - reader.GetRow(rid, &row) + reader.GetRow(rid, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then + if reader.CompareKey(reader.GetKey(row)) = 0 then startRid <- rid endRid <- rid @@ -1278,108 +1308,105 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR reader.GetRow(startRid + i, &row) reader.ConvertRow(&row)) -[] -type CustomAttributeRow = - val mutable parentIndex: TaggedIndex - val mutable typeIndex: TaggedIndex - val mutable valueIndex: int +let inline rowAddr (ctxt: ILMetadataReader) (tn: TableName) (idx: int) = + ref (ctxt.rowAddr tn idx) -let seekReadUInt16Adv mdv (addr: byref) = - let res = seekReadUInt16 mdv addr - addr <- addr + 2 +let seekReadUInt16Adv mdv (addr: ref) = + let res = seekReadUInt16 mdv addr.Value + addr.Value <- addr.Value + 2 res -let seekReadInt32Adv mdv (addr: byref) = - let res = seekReadInt32 mdv addr - addr <- addr + 4 +let seekReadInt32Adv mdv (addr: ref) = + let res = seekReadInt32 mdv addr.Value + addr.Value <- addr.Value + 4 res -let seekReadUInt16AsInt32Adv mdv (addr: byref) = - let res = seekReadUInt16AsInt32 mdv addr - addr <- addr + 2 +let seekReadUInt16AsInt32Adv mdv (addr: ref) = + let res = seekReadUInt16AsInt32 mdv addr.Value + addr.Value <- addr.Value + 2 res -let inline seekReadTaggedIdx f nbits big mdv (addr: byref) = +let inline seekReadTaggedIdx f nbits big mdv (addr: ref) = let tok = if big then - seekReadInt32Adv mdv &addr + seekReadInt32Adv mdv addr else - seekReadUInt16AsInt32Adv mdv &addr + seekReadUInt16AsInt32Adv mdv addr tokToTaggedIdx f nbits tok -let seekReadIdx big mdv (addr: byref) = +let seekReadIdx big mdv (addr: ref) = if big then - seekReadInt32Adv mdv &addr + seekReadInt32Adv mdv addr else - seekReadUInt16AsInt32Adv mdv &addr + seekReadUInt16AsInt32Adv mdv addr -let seekReadUntaggedIdx (tab: TableName) (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadIdx ctxt.tableBigness[tab.Index] mdv &addr +let seekReadUntaggedIdx (tab: TableName) (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadIdx ctxt.tableBigness[tab.Index] mdv addr -let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv &addr +let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv addr -let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv &addr +let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv addr -let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv &addr +let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv addr -let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv &addr +let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv addr -let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv &addr +let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv addr -let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv &addr +let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv addr -let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv &addr +let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv addr -let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv &addr +let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv addr -let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv &addr +let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv addr -let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv &addr +let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv addr -let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv &addr +let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv addr -let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv &addr +let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv addr -let seekReadCustomAttributeTypeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkILCustomAttributeTypeTag 3 ctxt.catBigness mdv &addr +let seekReadCustomAttributeTypeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkILCustomAttributeTypeTag 3 ctxt.catBigness mdv addr -let seekReadStringIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadIdx ctxt.stringsBigness mdv &addr +let seekReadStringIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadIdx ctxt.stringsBigness mdv addr -let seekReadGuidIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadIdx ctxt.guidsBigness mdv &addr -let seekReadBlobIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadIdx ctxt.blobsBigness mdv &addr +let seekReadGuidIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadIdx ctxt.guidsBigness mdv addr +let seekReadBlobIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadIdx ctxt.blobsBigness mdv addr let seekReadModuleRow (ctxt: ILMetadataReader) mdv idx = if idx = 0 then failwith "cannot read Module table row 0" - let mutable addr = ctxt.rowAddr TableNames.Module idx - let generation = seekReadUInt16Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let mvidIdx = seekReadGuidIdx ctxt mdv &addr - let encidIdx = seekReadGuidIdx ctxt mdv &addr - let encbaseidIdx = seekReadGuidIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Module idx + let generation = seekReadUInt16Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let mvidIdx = seekReadGuidIdx ctxt mdv addr + let encidIdx = seekReadGuidIdx ctxt mdv addr + let encbaseidIdx = seekReadGuidIdx ctxt mdv addr (generation, nameIdx, mvidIdx, encidIdx, encbaseidIdx) /// Read Table ILTypeRef. let seekReadTypeRefRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.TypeRef idx - let scopeIdx = seekReadResolutionScopeIdx ctxt mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let namespaceIdx = seekReadStringIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.TypeRef idx + let scopeIdx = seekReadResolutionScopeIdx ctxt mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let namespaceIdx = seekReadStringIdx ctxt mdv addr (scopeIdx, nameIdx, namespaceIdx) /// Read Table ILTypeDef. @@ -1388,54 +1415,54 @@ let seekReadTypeDefRow (ctxt: ILMetadataReader) idx = ctxt.seekReadTypeDefRow id let seekReadTypeDefRowUncached ctxtH idx = let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() - let mutable addr = ctxt.rowAddr TableNames.TypeDef idx - let flags = seekReadInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let namespaceIdx = seekReadStringIdx ctxt mdv &addr - let extendsIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr - let fieldsIdx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr - let methodsIdx = seekReadUntaggedIdx TableNames.Method ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.TypeDef idx + let flags = seekReadInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let namespaceIdx = seekReadStringIdx ctxt mdv addr + let extendsIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv addr + let fieldsIdx = seekReadUntaggedIdx TableNames.Field ctxt mdv addr + let methodsIdx = seekReadUntaggedIdx TableNames.Method ctxt mdv addr (flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) /// Read Table Field. let seekReadFieldRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.Field idx - let flags = seekReadUInt16AsInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let typeIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Field idx + let flags = seekReadUInt16AsInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let typeIdx = seekReadBlobIdx ctxt mdv addr (flags, nameIdx, typeIdx) /// Read Table Method. let seekReadMethodRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.Method idx - let codeRVA = seekReadInt32Adv mdv &addr - let implflags = seekReadUInt16AsInt32Adv mdv &addr - let flags = seekReadUInt16AsInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let typeIdx = seekReadBlobIdx ctxt mdv &addr - let paramIdx = seekReadUntaggedIdx TableNames.Param ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Method idx + let codeRVA = seekReadInt32Adv mdv addr + let implflags = seekReadUInt16AsInt32Adv mdv addr + let flags = seekReadUInt16AsInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let typeIdx = seekReadBlobIdx ctxt mdv addr + let paramIdx = seekReadUntaggedIdx TableNames.Param ctxt mdv addr (codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) /// Read Table Param. let seekReadParamRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.Param idx - let flags = seekReadUInt16AsInt32Adv mdv &addr - let seq = seekReadUInt16AsInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Param idx + let flags = seekReadUInt16AsInt32Adv mdv addr + let seq = seekReadUInt16AsInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr (flags, seq, nameIdx) /// Read Table InterfaceImpl. let private seekReadInterfaceIdx (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx - let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr - seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.InterfaceImpl idx + let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr + seekReadTypeDefOrRefOrSpecIdx ctxt mdv addr /// Read Table MemberRef. let seekReadMemberRefRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.MemberRef idx - let mrpIdx = seekReadMemberRefParentIdx ctxt mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let typeIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.MemberRef idx + let mrpIdx = seekReadMemberRefParentIdx ctxt mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let typeIdx = seekReadBlobIdx ctxt mdv addr (mrpIdx, nameIdx, typeIdx) /// Read Table Constant. @@ -1444,83 +1471,85 @@ let seekReadConstantRow (ctxt: ILMetadataReader) idx = ctxt.seekReadConstantRow let seekReadConstantRowUncached ctxtH idx = let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() - let mutable addr = ctxt.rowAddr TableNames.Constant idx - let kind = seekReadUInt16Adv mdv &addr - let parentIdx = seekReadHasConstantIdx ctxt mdv &addr - let valIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Constant idx + let kind = seekReadUInt16Adv mdv addr + let parentIdx = seekReadHasConstantIdx ctxt mdv addr + let valIdx = seekReadBlobIdx ctxt mdv addr (kind, parentIdx, valIdx) /// Read Table CustomAttribute. -let seekReadCustomAttributeRow (ctxt: ILMetadataReader) mdv idx (attrRow: byref) = - let mutable addr = ctxt.rowAddr TableNames.CustomAttribute idx - attrRow.parentIndex <- seekReadHasCustomAttributeIdx ctxt mdv &addr - attrRow.typeIndex <- seekReadCustomAttributeTypeIdx ctxt mdv &addr - attrRow.valueIndex <- seekReadBlobIdx ctxt mdv &addr +let seekReadCustomAttributeRow (ctxt: ILMetadataReader) mdv idx (attrRow: ref) = + let mutable addr = rowAddr ctxt TableNames.CustomAttribute idx + let mutable row = attrRow.Value + row.parentIndex <- seekReadHasCustomAttributeIdx ctxt mdv addr + row.typeIndex <- seekReadCustomAttributeTypeIdx ctxt mdv addr + row.valueIndex <- seekReadBlobIdx ctxt mdv addr + attrRow.Value <- row /// Read Table FieldMarshal. let seekReadFieldMarshalRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.FieldMarshal idx - let parentIdx = seekReadHasFieldMarshalIdx ctxt mdv &addr - let typeIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.FieldMarshal idx + let parentIdx = seekReadHasFieldMarshalIdx ctxt mdv addr + let typeIdx = seekReadBlobIdx ctxt mdv addr (parentIdx, typeIdx) /// Read Table Permission. let seekReadPermissionRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.Permission idx - let action = seekReadUInt16Adv mdv &addr - let parentIdx = seekReadHasDeclSecurityIdx ctxt mdv &addr - let typeIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Permission idx + let action = seekReadUInt16Adv mdv addr + let parentIdx = seekReadHasDeclSecurityIdx ctxt mdv addr + let typeIdx = seekReadBlobIdx ctxt mdv addr (action, parentIdx, typeIdx) /// Read Table ClassLayout. let seekReadClassLayoutRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.ClassLayout idx - let pack = seekReadUInt16Adv mdv &addr - let size = seekReadInt32Adv mdv &addr - let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.ClassLayout idx + let pack = seekReadUInt16Adv mdv addr + let size = seekReadInt32Adv mdv addr + let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr (pack, size, tidx) /// Read Table FieldLayout. let seekReadFieldLayoutRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.FieldLayout idx - let offset = seekReadInt32Adv mdv &addr - let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.FieldLayout idx + let offset = seekReadInt32Adv mdv addr + let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv addr (offset, fidx) //// Read Table StandAloneSig. let seekReadStandAloneSigRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.StandAloneSig idx - let sigIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.StandAloneSig idx + let sigIdx = seekReadBlobIdx ctxt mdv addr sigIdx /// Read Table EventMap. let seekReadEventMapRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.EventMap idx - let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr - let eventsIdx = seekReadUntaggedIdx TableNames.Event ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.EventMap idx + let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr + let eventsIdx = seekReadUntaggedIdx TableNames.Event ctxt mdv addr (tidx, eventsIdx) /// Read Table Event. let seekReadEventRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.Event idx - let flags = seekReadUInt16AsInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let typIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Event idx + let flags = seekReadUInt16AsInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let typIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv addr (flags, nameIdx, typIdx) /// Read Table PropertyMap. let seekReadPropertyMapRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.PropertyMap idx - let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr - let propsIdx = seekReadUntaggedIdx TableNames.Property ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.PropertyMap idx + let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr + let propsIdx = seekReadUntaggedIdx TableNames.Property ctxt mdv addr (tidx, propsIdx) /// Read Table Property. let seekReadPropertyRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.Property idx - let flags = seekReadUInt16AsInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let typIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Property idx + let flags = seekReadUInt16AsInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let typIdx = seekReadBlobIdx ctxt mdv addr (flags, nameIdx, typIdx) /// Read Table MethodSemantics. @@ -1529,101 +1558,101 @@ let seekReadMethodSemanticsRow (ctxt: ILMetadataReader) idx = ctxt.seekReadMetho let seekReadMethodSemanticsRowUncached ctxtH idx = let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() - let mutable addr = ctxt.rowAddr TableNames.MethodSemantics idx - let flags = seekReadUInt16AsInt32Adv mdv &addr - let midx = seekReadUntaggedIdx TableNames.Method ctxt mdv &addr - let assocIdx = seekReadHasSemanticsIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.MethodSemantics idx + let flags = seekReadUInt16AsInt32Adv mdv addr + let midx = seekReadUntaggedIdx TableNames.Method ctxt mdv addr + let assocIdx = seekReadHasSemanticsIdx ctxt mdv addr (flags, midx, assocIdx) /// Read Table MethodImpl. let seekReadMethodImplRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.MethodImpl idx - let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr - let mbodyIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr - let mdeclIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.MethodImpl idx + let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr + let mbodyIdx = seekReadMethodDefOrRefIdx ctxt mdv addr + let mdeclIdx = seekReadMethodDefOrRefIdx ctxt mdv addr (tidx, mbodyIdx, mdeclIdx) /// Read Table ILModuleRef. let seekReadModuleRefRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.ModuleRef idx - let nameIdx = seekReadStringIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.ModuleRef idx + let nameIdx = seekReadStringIdx ctxt mdv addr nameIdx /// Read Table ILTypeSpec. let seekReadTypeSpecRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.TypeSpec idx - let blobIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.TypeSpec idx + let blobIdx = seekReadBlobIdx ctxt mdv addr blobIdx /// Read Table ImplMap. let seekReadImplMapRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.ImplMap idx - let flags = seekReadUInt16AsInt32Adv mdv &addr - let forwardedIdx = seekReadMemberForwardedIdx ctxt mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let scopeIdx = seekReadUntaggedIdx TableNames.ModuleRef ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.ImplMap idx + let flags = seekReadUInt16AsInt32Adv mdv addr + let forwardedIdx = seekReadMemberForwardedIdx ctxt mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let scopeIdx = seekReadUntaggedIdx TableNames.ModuleRef ctxt mdv addr (flags, forwardedIdx, nameIdx, scopeIdx) /// Read Table FieldRVA. let seekReadFieldRVARow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.FieldRVA idx - let rva = seekReadInt32Adv mdv &addr - let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.FieldRVA idx + let rva = seekReadInt32Adv mdv addr + let fidx = seekReadUntaggedIdx TableNames.Field ctxt mdv addr (rva, fidx) /// Read Table Assembly. let seekReadAssemblyRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.Assembly idx - let hash = seekReadInt32Adv mdv &addr - let v1 = seekReadUInt16Adv mdv &addr - let v2 = seekReadUInt16Adv mdv &addr - let v3 = seekReadUInt16Adv mdv &addr - let v4 = seekReadUInt16Adv mdv &addr - let flags = seekReadInt32Adv mdv &addr - let publicKeyIdx = seekReadBlobIdx ctxt mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let localeIdx = seekReadStringIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Assembly idx + let hash = seekReadInt32Adv mdv addr + let v1 = seekReadUInt16Adv mdv addr + let v2 = seekReadUInt16Adv mdv addr + let v3 = seekReadUInt16Adv mdv addr + let v4 = seekReadUInt16Adv mdv addr + let flags = seekReadInt32Adv mdv addr + let publicKeyIdx = seekReadBlobIdx ctxt mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let localeIdx = seekReadStringIdx ctxt mdv addr (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) /// Read Table ILAssemblyRef. let seekReadAssemblyRefRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.AssemblyRef idx - let v1 = seekReadUInt16Adv mdv &addr - let v2 = seekReadUInt16Adv mdv &addr - let v3 = seekReadUInt16Adv mdv &addr - let v4 = seekReadUInt16Adv mdv &addr - let flags = seekReadInt32Adv mdv &addr - let publicKeyOrTokenIdx = seekReadBlobIdx ctxt mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let localeIdx = seekReadStringIdx ctxt mdv &addr - let hashValueIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.AssemblyRef idx + let v1 = seekReadUInt16Adv mdv addr + let v2 = seekReadUInt16Adv mdv addr + let v3 = seekReadUInt16Adv mdv addr + let v4 = seekReadUInt16Adv mdv addr + let flags = seekReadInt32Adv mdv addr + let publicKeyOrTokenIdx = seekReadBlobIdx ctxt mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let localeIdx = seekReadStringIdx ctxt mdv addr + let hashValueIdx = seekReadBlobIdx ctxt mdv addr (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) /// Read Table File. let seekReadFileRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.File idx - let flags = seekReadInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let hashValueIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.File idx + let flags = seekReadInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let hashValueIdx = seekReadBlobIdx ctxt mdv addr (flags, nameIdx, hashValueIdx) /// Read Table ILExportedTypeOrForwarder. let seekReadExportedTypeRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.ExportedType idx - let flags = seekReadInt32Adv mdv &addr - let tok = seekReadInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let namespaceIdx = seekReadStringIdx ctxt mdv &addr - let implIdx = seekReadImplementationIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.ExportedType idx + let flags = seekReadInt32Adv mdv addr + let tok = seekReadInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let namespaceIdx = seekReadStringIdx ctxt mdv addr + let implIdx = seekReadImplementationIdx ctxt mdv addr (flags, tok, nameIdx, namespaceIdx, implIdx) /// Read Table ManifestResource. let seekReadManifestResourceRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.ManifestResource idx - let offset = seekReadInt32Adv mdv &addr - let flags = seekReadInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let implIdx = seekReadImplementationIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.ManifestResource idx + let offset = seekReadInt32Adv mdv addr + let flags = seekReadInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let implIdx = seekReadImplementationIdx ctxt mdv addr (offset, flags, nameIdx, implIdx) /// Read Table Nested. @@ -1632,32 +1661,32 @@ let seekReadNestedRow (ctxt: ILMetadataReader) idx = ctxt.seekReadNestedRow idx let seekReadNestedRowUncached ctxtH idx = let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() - let mutable addr = ctxt.rowAddr TableNames.Nested idx - let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr - let enclIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Nested idx + let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr + let enclIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr (nestedIdx, enclIdx) /// Read Table GenericParam. let seekReadGenericParamRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.GenericParam idx - let seq = seekReadUInt16Adv mdv &addr - let flags = seekReadUInt16Adv mdv &addr - let ownerIdx = seekReadTypeOrMethodDefIdx ctxt mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.GenericParam idx + let seq = seekReadUInt16Adv mdv addr + let flags = seekReadUInt16Adv mdv addr + let ownerIdx = seekReadTypeOrMethodDefIdx ctxt mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr (idx, seq, flags, ownerIdx, nameIdx) // Read Table GenericParamConstraint. let seekReadGenericParamConstraintIdx (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.GenericParamConstraint idx - let _pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt mdv &addr - let constraintIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.GenericParamConstraint idx + let _pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt mdv addr + let constraintIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv addr constraintIdx /// Read Table ILMethodSpec. let seekReadMethodSpecRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.MethodSpec idx - let mdorIdx = seekReadMethodDefOrRefIdx ctxt mdv &addr - let instIdx = seekReadBlobIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.MethodSpec idx + let mdorIdx = seekReadMethodDefOrRefIdx ctxt mdv addr + let instIdx = seekReadBlobIdx ctxt mdv addr (mdorIdx, instIdx) let readUserStringHeapUncached ctxtH idx = @@ -1754,6 +1783,7 @@ let readNativeResources (pectxt: PEReader) = let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr) +#if !FABLE_COMPILER if pectxt.noFileOnDisk then let unlinkedResource = let linkedResource = @@ -1763,7 +1793,8 @@ let readNativeResources (pectxt: PEReader) = yield ILNativeResource.Out unlinkedResource else - yield ILNativeResource.In(pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize) +#endif //!FABLE_COMPILER + yield ILNativeResource.In(pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize) ] let getDataEndPointsDelayed (pectxt: PEReader) ctxtH = @@ -2150,9 +2181,9 @@ and typeDefReader ctxtH : ILTypeDefStored = member _.GetKey(rowIndex) = rowIndex member _.CompareKey(rowIndex) = - let mutable addr = ctxt.rowAddr TableNames.CustomAttribute rowIndex + let mutable addr = rowAddr ctxt TableNames.CustomAttribute rowIndex // read parentIndex - let key = seekReadHasCustomAttributeIdx ctxt mdv &addr + let key = seekReadHasCustomAttributeIdx ctxt mdv addr hcaCompare searchedKey key member _.ConvertRow(i) = i @@ -2170,10 +2201,10 @@ and typeDefReader ctxtH : ILTypeDefStored = let mutable attrIdx = attrsStartIdx while attrIdx <= attrsEndIdx && not containsExtensionMethods do - let mutable addr = ctxt.rowAddr TableNames.CustomAttribute attrIdx + let mutable addr = rowAddr ctxt TableNames.CustomAttribute attrIdx // skip parentIndex to read typeIndex - seekReadHasCustomAttributeIdx ctxt mdv &addr |> ignore - let attrTypeIndex = seekReadCustomAttributeTypeIdx ctxt mdv &addr + seekReadHasCustomAttributeIdx ctxt mdv addr |> ignore + let attrTypeIndex = seekReadCustomAttributeTypeIdx ctxt mdv addr let attrCtorIdx = attrTypeIndex.index let name = @@ -2183,8 +2214,8 @@ and typeDefReader ctxtH : ILTypeDefStored = let _, (_, nameIdx, namespaceIdx, _, _, _) = seekMethodDefParent ctxt attrCtorIdx readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) else - let mutable addr = ctxt.rowAddr TableNames.MemberRef attrCtorIdx - let mrpTag = seekReadMemberRefParentIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.MemberRef attrCtorIdx + let mrpTag = seekReadMemberRefParentIdx ctxt mdv addr if mrpTag.tag <> mrp_TypeRef then "" @@ -2261,8 +2292,8 @@ and seekReadInterfaceImpls (ctxt: ILMetadataReader) mdv numTypars tidx = id, id, (fun idx -> - let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx - let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.InterfaceImpl idx + let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr simpleIndexCompare tidx _tidx), isSorted ctxt TableNames.InterfaceImpl, (fun idx -> @@ -2326,8 +2357,8 @@ and seekReadGenericParamConstraints (ctxt: ILMetadataReader) mdv numTypars gpidx id, id, (fun idx -> - let mutable addr = ctxt.rowAddr TableNames.GenericParamConstraint idx - let pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.GenericParamConstraint idx + let pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt mdv addr simpleIndexCompare gpidx pidx), isSorted ctxt TableNames.GenericParamConstraint, (fun idx -> @@ -2355,8 +2386,8 @@ and seekReadTypeDefAsTypeRef (ctxt: ILMetadataReader) idx = id, id, (fun i -> - let mutable addr = ctxt.rowAddr TableNames.Nested i - let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Nested i + let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr simpleIndexCompare idx nestedIdx), isSorted ctxt TableNames.Nested, (fun i -> seekReadNestedRow ctxt i |> snd) @@ -3060,15 +3091,15 @@ and seekReadMethod (ctxt: ILMetadataReader) mdv numTypars (idx: int) = ) and seekReadParams (ctxt: ILMetadataReader) mdv (retTy, argTys) pidx1 pidx2 = - let mutable retRes = mkILReturn retTy + let mutable retRes = ref (mkILReturn retTy) let paramsRes = argTys |> List.toArray |> Array.map mkILParamAnon for i = pidx1 to pidx2 - 1 do - seekReadParamExtras ctxt mdv (&retRes, paramsRes) i + seekReadParamExtras ctxt mdv (retRes, paramsRes) i - retRes, List.ofArray paramsRes + retRes.Value, List.ofArray paramsRes -and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes: byref, paramsRes) (idx: int) = +and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes: ref, paramsRes) (idx: int) = let flags, seq, nameIdx = seekReadParamRow ctxt mdv idx let inOutMasked = (flags &&& 0x00FF) let hasMarshal = (flags &&& 0x2000) <> 0x0 @@ -3085,8 +3116,8 @@ and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes: byref, p ) if seq = 0 then - retRes <- - { retRes with + retRes.Value <- + { retRes.Value with Marshal = (if hasMarshal then Some(fmReader (TaggedIndex(hfm_ParamDef, idx))) @@ -3129,8 +3160,8 @@ and seekReadMethodImpls (ctxt: ILMetadataReader) numTypars tidx = id, id, (fun i -> - let mutable addr = ctxt.rowAddr TableNames.MethodImpl i - let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.MethodImpl i + let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr simpleIndexCompare tidx _tidx), isSorted ctxt TableNames.MethodImpl, seekReadMethodImplRow ctxt mdv @@ -3209,8 +3240,8 @@ and seekReadEvents (ctxt: ILMetadataReader) numTypars tidx = id, id, (fun i -> - let mutable addr = ctxt.rowAddr TableNames.EventMap i - let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.EventMap i + let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr simpleIndexCompare tidx _tidx), false, (fun i -> i, seekReadEventMapRow ctxt mdv i |> snd) @@ -3279,8 +3310,8 @@ and seekReadProperties (ctxt: ILMetadataReader) numTypars tidx = id, id, (fun i -> - let mutable addr = ctxt.rowAddr TableNames.PropertyMap i - let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.PropertyMap i + let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr simpleIndexCompare tidx _tidx), false, (fun i -> i, seekReadPropertyMapRow ctxt mdv i |> snd) @@ -3315,15 +3346,15 @@ and customAttrsReader ctxtH tag : ILAttributesStored = member _.GetKey(rowIndex) = rowIndex member _.CompareKey(rowIndex) = - let mutable addr = ctxt.rowAddr TableNames.CustomAttribute rowIndex + let mutable addr = rowAddr ctxt TableNames.CustomAttribute rowIndex // read parentIndex - let key = seekReadHasCustomAttributeIdx ctxt mdv &addr + let key = seekReadHasCustomAttributeIdx ctxt mdv addr hcaCompare searchedKey key member _.ConvertRow(rowIndex) = - let mutable attrRow = Unchecked.defaultof<_> - seekReadCustomAttributeRow ctxt mdv rowIndex &attrRow - seekReadCustomAttr ctxt (attrRow.typeIndex, attrRow.valueIndex) + let mutable attrRow = ref Unchecked.defaultof<_> + seekReadCustomAttributeRow ctxt mdv rowIndex attrRow + seekReadCustomAttr ctxt (attrRow.Value.typeIndex, attrRow.Value.valueIndex) } seekReadIndexedRowsByInterface (ctxt.getNumRows TableNames.CustomAttribute) (isSorted ctxt TableNames.CustomAttribute) reader) @@ -4095,7 +4126,12 @@ and seekReadManifestResources (ctxt: ILMetadataReader) canReduceMemory (mdv: Bin let byteStorage = let bytes = pevEager.Slice(offsetOfBytesFromStartOfPhysicalPEFile, resourceLength) +#if FABLE_COMPILER + ignore canReduceMemory + ByteMemory.FromArray(bytes.ToArray()) +#else ByteStorage.FromByteMemoryAndCopy(bytes, useBackingMemoryMappedFile = canReduceMemory) +#endif ILResourceLocation.Local(byteStorage) @@ -5013,6 +5049,8 @@ type ILModuleReaderImpl(ilModule: ILModuleDef, ilAssemblyRefs: Lazy BinaryFile +#endif //!FABLE_COMPILER + let OpenILModuleReaderFromBytes fileName assemblyContents options = let pefile = ByteFile(fileName, assemblyContents) :> BinaryFile @@ -5086,6 +5126,8 @@ let OpenILModuleReaderFromBytes fileName assemblyContents options = new ILModuleReaderImpl(ilModule, ilAssemblyRefs) :> ILModuleReader +#if !FABLE_COMPILER + let OpenILModuleReaderFromStream fileName (peStream: Stream) options = let peReader = new System.Reflection.PortableExecutable.PEReader(peStream, PEStreamOptions.PrefetchEntireImage) @@ -5247,3 +5289,5 @@ module Shim = OpenILModuleReader fileName readerOptions let mutable AssemblyReader = DefaultAssemblyReader() :> IAssemblyReader + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/AbstractIL/ilread.fsi b/src/Compiler/AbstractIL/ilread.fsi index f2b86266063..6332e6af451 100644 --- a/src/Compiler/AbstractIL/ilread.fsi +++ b/src/Compiler/AbstractIL/ilread.fsi @@ -68,7 +68,7 @@ type public ILModuleReader = // ILModuleReader objects only need to be explicitly disposed if memory mapping is used, i.e. reduceMemoryUsage = false inherit System.IDisposable - +#if !FABLE_COMPILER /// Open a binary reader, except first copy the entire contents of the binary into /// memory, close the file and ensure any subsequent reads happen from the in-memory store. /// PDB files may not be read with this option. @@ -76,15 +76,18 @@ type public ILModuleReader = val internal OpenILModuleReader: string -> ILReaderOptions -> ILModuleReader val internal ClearAllILModuleReaderCache : unit -> unit +#endif //!FABLE_COMPILER /// Open a binary reader based on the given bytes. /// This binary reader is not internally cached. val internal OpenILModuleReaderFromBytes: fileName:string -> assemblyContents: byte[] -> options: ILReaderOptions -> ILModuleReader +#if !FABLE_COMPILER /// Open a binary reader based on the given stream. /// This binary reader is not internally cached. /// The binary reader will own the given stream and the stream will be disposed when there are no references to the binary reader. val internal OpenILModuleReaderFromStream: fileName:string -> peStream: Stream -> options: ILReaderOptions -> ILModuleReader +#endif //!FABLE_COMPILER type internal Statistics = { mutable rawMemoryFileCount : int @@ -95,6 +98,8 @@ type internal Statistics = val internal GetStatistics : unit -> Statistics +#if !FABLE_COMPILER + /// The public API hook for changing the IL assembly reader, used by Resharper [] module public Shim = @@ -103,3 +108,5 @@ module public Shim = abstract GetILModuleReader: fileName: string * readerOptions: ILReaderOptions -> ILModuleReader val mutable AssemblyReader: IAssemblyReader + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 563af942829..d8fe2ff0973 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -312,7 +312,11 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = if g.compilingFSharpCore then true else +#if FABLE_COMPILER + g.langVersion.IsPreviewEnabled && (s.ToLower().IndexOf(langVersionPrefix.ToLower()) >= 0) +#else g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0) +#endif if not (isExperimentalAttributeDisabled s) then do! WarnD(Experimental(s, m)) | Some _ -> @@ -459,7 +463,7 @@ let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = Some res) #if !NO_TYPEPROVIDERS - (fun provAttribs -> Some (CheckProvidedAttributes g m provAttribs)) + (fun provAttribs -> Some (CheckProvidedAttributes g m provAttribs)) #else (fun _provAttribs -> None) #endif diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 82141080743..05561e1e520 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -3049,7 +3049,7 @@ and CanMemberSigsMatchUpToCheck match calledMeth.ParamArrayCallerArgs with | Some args -> args |> MapCombineTDCD (fun callerArg -> - subsumeOrConvertArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg + subsumeOrConvertArg (GetCalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg ) @@ -3081,7 +3081,7 @@ and CanMemberSigsMatchUpToCheck let calledArgTy = rfinfo.FieldType rfinfo.LogicalName, calledArgTy - subsumeOrConvertArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller + subsumeOrConvertArg (GetCalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller ) // - Always take the return type into account for resolving overloading of // -- op_Explicit, op_Implicit diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 4c561dd7fee..deb96c1ac9f 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -74,7 +74,7 @@ type CalledArg = NameOpt: Ident option CalledArgumentType : TType } -let CalledArg (pos, isParamArray, optArgInfo, callerInfo, isInArg, isOutArg, nameOpt, reflArgInfo, calledArgTy) = +let GetCalledArg (pos, isParamArray, optArgInfo, callerInfo, isInArg, isOutArg, nameOpt, reflArgInfo, calledArgTy) = { Position=pos IsParamArray=isParamArray OptArgInfo=optArgInfo diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index f167fbe3b03..9ddc593e4a4 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -53,7 +53,7 @@ type CalledArg = NameOpt: Ident option CalledArgumentType: TType } -val CalledArg: +val GetCalledArg: pos: struct (int * int) * isParamArray: bool * optArgInfo: OptionalArgInfo * diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs old mode 100644 new mode 100755 index a01802b1d7c..ac25ded7777 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -330,9 +330,13 @@ module internal PrintUtilities = else restL - let squashToWidth width layout = + let squashToWidth (width: int option) (layout: Layout) = match width with +#if FABLE_COMPILER + | Some w -> ignore w; layout +#else | Some w -> Display.squashTo w layout +#endif | None -> layout // When showing types in diagnostics, we don't show nullness annotations by default @@ -981,7 +985,11 @@ module PrintTypes = if not denv.includeStaticParametersInTypeNames then None, args else +#if FABLE_COMPILER + let regex = System.Text.RegularExpressions.Regex(@"`\d+") +#else let regex = System.Text.RegularExpressions.Regex(@"\`\d+") +#endif let path, skip = (0, tc.CompilationPath.DemangledPath) ||> List.mapFold (fun skip path -> diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs index 00b25756801..7fc4a4dcb19 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -23,7 +23,9 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint open FSharp.Compiler.TypeRelations +#if !FABLE_COMPILER open type System.MemoryExtensions +#endif open Import exception MatchIncomplete of bool * (string * bool) option * range @@ -769,7 +771,11 @@ let (|ConstNeedsDefaultCase|_|) c = /// switches, string switches and floating point switches are treated in the /// same way as DecisionTreeTest.IsInst. let rec BuildSwitch inpExprOpt g expr edges dflt m = +#if FABLE_COMPILER + if verbose then dprintf "--> BuildSwitch@%s, #edges = %A, dflt.IsSome = %A\n" (stringOfRange m) (List.length edges) (Option.isSome dflt) +#else if verbose then dprintf "--> BuildSwitch@%a, #edges = %A, dflt.IsSome = %A\n" outputRange m (List.length edges) (Option.isSome dflt) +#endif match edges, dflt with | [], None -> failwith "internal error: no edges and no default" | [], Some dflt -> dflt @@ -1693,7 +1699,11 @@ let isProblematicClause (clause: MatchClause) = // Look for multiple decision points. // We don't mind about the last logical decision point let ips = investigationPoints clause.Pattern +#if FABLE_COMPILER + ips.Length > 0 && Array.exists id ips[0..ips.Length-2] +#else ips.Length > 0 && Span.exists id (ips.AsSpan (0, ips.Length - 1)) +#endif let rec CompilePattern g denv amap tcVal infoReader mExpr mMatch warnOnUnused actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) (clausesL: MatchClause list) inputTy resultTy = match clausesL with diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index d5daa377540..4ffe3555815 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -22,7 +22,11 @@ open System.Collections.Generic module QP = QuotationPickler +#if FABLE_COMPILER +let verboseCReflect = false +#else let verboseCReflect = isEnvVarSet "VERBOSE_CREFLECT" +#endif [] type IsReflectedDefinition = @@ -716,9 +720,13 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let witnessArgInfo = if g.generateWitnesses && inWitnessPassingScope then let witnessInfo = traitInfo.GetWitnessInfo() +#if FABLE_COMPILER + env.witnessesInScope.TryFind witnessInfo +#else match env.witnessesInScope.TryGetValue witnessInfo with | true, storage -> Some storage | _ -> None +#endif else None diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 861caeea4ab..bfa09cd6228 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -200,9 +200,13 @@ let ReportStatistics (oc: TextWriter) = reports oc let NewCounter nm = let mutable count = 0 +#if FABLE_COMPILER + ignore nm +#else AddReport(fun oc -> if count <> 0 then oc.WriteLine(string count + " " + nm)) +#endif (fun () -> count <- count + 1) @@ -1320,7 +1324,11 @@ let AddTemplateReplacement eenv (tcref, ftyvs, ilTy, inst) = let AddStorageForLocalWitness eenv (w, s) = { eenv with +#if FABLE_COMPILER + witnessesInScope = eenv.witnessesInScope.Add (w, s) +#else witnessesInScope = eenv.witnessesInScope.SetItem(w, s) +#endif } let AddStorageForLocalWitnesses witnesses eenv = @@ -1355,9 +1363,13 @@ let ComputeGenerateWitnesses (g: TcGlobals) eenv = && not eenv.suppressWitnesses let TryStorageForWitness (_g: TcGlobals) eenv (w: TraitWitnessInfo) = +#if FABLE_COMPILER + eenv.witnessesInScope.TryFind w +#else match eenv.witnessesInScope.TryGetValue w with | true, storage -> Some storage | _ -> None +#endif let IsValRefIsDllImport g (vref: ValRef) = vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute @@ -1855,7 +1867,11 @@ let GenPossibleILDebugRange (cenv: cenv) m = // Helpers for merging property definitions //-------------------------------------------------------------------------- +#if FABLE_COMPILER +let HashRangeSorted (ht: IEnumerable>) = +#else let HashRangeSorted (ht: IDictionary<_, int * _>) = +#endif [ for KeyValue(_k, v) in ht -> v ] |> List.sortBy fst |> List.map snd let MergeOptions m o1 o2 = @@ -2731,7 +2747,11 @@ let GenConstArray cenv (cgbuf: CodeGenBuffer) eenv ilElementType (data: 'a[]) (w let g = cenv.g use buf = ByteBuffer.Create data.Length data |> Array.iter (write buf) +#if FABLE_COMPILER + let bytes = buf.Close() +#else let bytes = buf.AsMemory().ToArray() +#endif let ilArrayType = mkILArr1DTy ilElementType if data.Length = 0 then @@ -12169,6 +12189,8 @@ type ExecutionContext = LookupType: ILType -> Type } +#if !FABLE_COMPILER + // A helper to generate a default value for any System.Type. I couldn't find a System.Reflection // method to do this. let defaultOf = @@ -12346,3 +12368,5 @@ type IlxAssemblyGenerator(amap: ImportMap, g: TcGlobals, tcVal: ConstraintSolver /// Invert the compilation of the given value and return its current dynamic value and its compiled System.Type member _.LookupGeneratedValue(ctxt, v) = LookupGeneratedValue cenv ctxt ilxGenEnv v + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/CodeGen/IlxGen.fsi b/src/Compiler/CodeGen/IlxGen.fsi index 4658dd0693b..1e98f786bbf 100644 --- a/src/Compiler/CodeGen/IlxGen.fsi +++ b/src/Compiler/CodeGen/IlxGen.fsi @@ -91,6 +91,7 @@ type ExecutionContext = { LookupTypeRef: ILTypeRef -> Type LookupType: ILType -> Type } +#if !FABLE_COMPILER /// An incremental ILX code generator for a single assembly type public IlxAssemblyGenerator = /// Create an incremental ILX code generator for a single assembly @@ -115,6 +116,7 @@ type public IlxAssemblyGenerator = /// Invert the compilation of the given value and return its current dynamic value and its compiled System.Type member LookupGeneratedValue: ExecutionContext * Val -> (obj * Type) option +#endif //!FABLE_COMPILER val ReportStatistics: TextWriter -> unit diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 997f7a50aae..d74f439ce58 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -9,14 +9,18 @@ open System.Runtime.InteropServices open System.IO open FSharp.Compiler.Optimizer open Internal.Utilities +#if !FABLE_COMPILER open Internal.Utilities.FSharpEnvironment +#endif open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features @@ -62,6 +66,14 @@ exception FileNameNotResolved of searchedLocations: string * fileName: string * exception LoadedSourceNotFoundIgnoring of fileName: string * range: range +#if FABLE_COMPILER +type HashAlgorithm = + | Sha1 + | Sha256 +#endif + +#if !FABLE_COMPILER + /// Will return None if the fileName is not found. let TryResolveFileUsingPaths (paths, m, fileName) = let () = @@ -92,6 +104,8 @@ let ResolveFileUsingPaths (paths, m, fileName) = let searchMessage = String.concat "\n " paths raise (FileNameNotResolved(fileName, searchMessage, m)) +#endif //!FABLE_COMPILER + [] type WarningNumberSource = | CommandLineOption @@ -203,6 +217,10 @@ type VersionFlag = parseILVersion "0.0.0.0" member x.GetVersionString implicitIncludeDir = +#if FABLE_COMPILER + ignore implicitIncludeDir + "0.0.0.0" +#else match x with | VersionString s -> s | VersionFile s -> @@ -220,6 +238,7 @@ type VersionFlag = use is = new StreamReader(fs) !! is.ReadLine() | VersionNone -> "0.0.0.0" +#endif //!FABLE_COMPILER /// Represents a reference to an assembly. May be backed by a real assembly on disk, or a cross-project /// reference backed by information generated by the compiler service. @@ -273,7 +292,11 @@ type TimeStampCache(defaultTimeStamp: DateTime) = if ok then v else +#if FABLE_COMPILER + let v = defaultTimeStamp +#else let v = FileSystem.GetLastWriteTimeShim fileName +#endif files[fileName] <- v v @@ -822,7 +845,11 @@ type TcConfigBuilder = emitMetadataAssembly = MetadataAssemblyGeneration.None preferredUiLang = None lcid = None +#if FABLE_COMPILER + productNameForBannerText = "Microsoft (R) F# Compiler" +#else productNameForBannerText = FSharpProductName +#endif showBanner = true showTimes = false writeTimesToFile = None @@ -882,6 +909,9 @@ type TcConfigBuilder = // which may be later adjusted. match tcConfigB.fxResolver with | None -> +#if FABLE_COMPILER + FxResolver() +#else let useDotNetFramework = (tcConfigB.primaryAssembly = PrimaryAssembly.Mscorlib) let fxResolver = @@ -896,6 +926,7 @@ type TcConfigBuilder = tcConfigB.fxResolver <- Some fxResolver fxResolver +#endif //!FABLE_COMPILER | Some fxResolver -> fxResolver member tcConfigB.SetPrimaryAssembly primaryAssembly = @@ -906,6 +937,8 @@ type TcConfigBuilder = tcConfigB.useSdkRefs <- useSdkRefs tcConfigB.fxResolver <- None // this needs to be recreated when the primary assembly changes +#if !FABLE_COMPILER + member tcConfigB.ResolveSourceFile(m, nm, pathLoadedFrom) = use _ = UseBuildPhase BuildPhase.Parameter @@ -969,6 +1002,8 @@ type TcConfigBuilder = tcConfigB.outputFile <- Some outfile outfile, pdbfile, assemblyName +#endif //!FABLE_COMPILER + member tcConfigB.TurnWarningOff(m, s: string) = use _ = UseBuildPhase BuildPhase.Parameter @@ -1000,6 +1035,10 @@ type TcConfigBuilder = } member tcConfigB.AddIncludePath(m, path, pathIncludedFrom) = +#if FABLE_COMPILER + ignore (m, path, pathIncludedFrom) + () +#else //!FABLE_COMPILER let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path let ok = @@ -1020,8 +1059,13 @@ type TcConfigBuilder = if ok && not (List.contains absolutePath tcConfigB.includes) then tcConfigB.includes <- tcConfigB.includes ++ absolutePath +#endif //!FABLE_COMPILER member tcConfigB.AddLoadedSource(m, originalPath, pathLoadedFrom) = +#if FABLE_COMPILER + ignore (m, originalPath, pathLoadedFrom) + () +#else //!FABLE_COMPILER if FileSystem.IsInvalidPathShim originalPath then warning (Error(FSComp.SR.buildInvalidFilename originalPath, m)) else @@ -1040,6 +1084,7 @@ type TcConfigBuilder = if not (List.contains path (List.map (fun (_, _, path) -> path) tcConfigB.loadedSources)) then tcConfigB.loadedSources <- tcConfigB.loadedSources ++ (m, originalPath, path) +#endif //!FABLE_COMPILER member tcConfigB.AddEmbeddedSourceFile fileName = tcConfigB.embedSourceList <- tcConfigB.embedSourceList ++ fileName @@ -1071,6 +1116,7 @@ type TcConfigBuilder = tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs ++ AssemblyReference(m, path, projectReference) +#if !FABLE_COMPILER member tcConfigB.AddDependencyManagerText(packageManager: IDependencyManagerProvider, lt, m, path: string) = tcConfigB.packageManagerLines <- PackageManagerLine.AddLineWithKey packageManager.Key lt path m tcConfigB.packageManagerLines @@ -1101,6 +1147,7 @@ type TcConfigBuilder = | Null, Null when directive = Directive.Include -> errorR (Error(FSComp.SR.poundiNotSupportedByRegisteredDependencyManagers (), m)) | Null, Null -> errorR (Error(FSComp.SR.buildInvalidHashrDirective (), m)) +#endif //!FABLE_COMPILER member tcConfigB.RemoveReferencedAssemblyByPath(m, path) = tcConfigB.referencedDLLs <- @@ -1141,6 +1188,12 @@ type TcConfigBuilder = [] type TcConfig private (data: TcConfigBuilder, validate: bool) = +#if FABLE_COMPILER + let _ = validate + let clrRootValue, targetFrameworkVersionValue = None, "" + +#else //!FABLE_COMPILER + // Validate the inputs - this helps ensure errors in options are shown in visual studio rather than only when built // However we only validate a minimal number of options at the moment do @@ -1272,6 +1325,8 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = errorRecovery e range0 [] +#endif //!FABLE_COMPILER + member _.bufferWidth = data.bufferWidth member _.fsiMultiAssemblyEmit = data.fsiMultiAssemblyEmit member _.FxResolver = data.FxResolver @@ -1432,11 +1487,13 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = conditionalDefines = data.conditionalDefines } +#if !FABLE_COMPILER member tcConfig.ComputeCanContainEntryPoint(sourceFiles: string list) = let n = sourceFiles.Length in (sourceFiles |> List.mapi (fun i _ -> (i = n - 1)), tcConfig.target.IsExe) // This call can fail if no CLR is found (this is the path to mscorlib) member _.GetTargetFrameworkDirectories() = targetFrameworkDirectories +#endif //!FABLE_COMPILER member tcConfig.ComputeIndentationAwareSyntaxInitialStatus fileName = use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter @@ -1449,6 +1506,8 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = else (tcConfig.indentationAwareSyntax = Some true) +#if !FABLE_COMPILER + member tcConfig.GetAvailableLoadedSources() = use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter @@ -1540,4 +1599,10 @@ type TcConfigProvider = static member BasedOnMutableBuilder tcConfigB = TcConfigProvider(fun _ctok -> TcConfig.Create(tcConfigB, validate = false)) +#endif //!FABLE_COMPILER + +#if FABLE_COMPILER +let GetFSharpCoreLibraryName () = "FSharp.Core" +#else let GetFSharpCoreLibraryName () = getFSharpCoreLibraryName +#endif diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index 0e6c25727f8..a7785ef76bd 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -11,8 +11,10 @@ open FSharp.Compiler open FSharp.Compiler.Xml open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features @@ -25,6 +27,12 @@ exception FileNameNotResolved of searchedLocations: string * fileName: string * exception LoadedSourceNotFoundIgnoring of fileName: string * range: range +#if FABLE_COMPILER +type HashAlgorithm = + | Sha1 + | Sha256 +#endif + /// Represents a reference to an F# assembly. May be backed by a real assembly on disk (read by Abstract IL), or a cross-project /// reference in FSharp.Compiler.Service. type IRawFSharpAssemblyData = @@ -543,7 +551,9 @@ type TcConfigBuilder = rangeForErrors: range -> TcConfigBuilder +#if !FABLE_COMPILER member DecideNames: string list -> string * string option * string +#endif member TurnWarningOff: range * string -> unit @@ -568,8 +578,10 @@ type TcConfigBuilder = // Directories to start probing in for native DLLs for FSI dynamic loading member GetNativeProbingRoots: unit -> seq +#if !FABLE_COMPILER member AddReferenceDirective: dependencyProvider: DependencyProvider * m: range * path: string * directive: Directive -> unit +#endif member AddLoadedSource: m: range * originalPath: string * pathLoadedFrom: string -> unit @@ -825,6 +837,8 @@ type TcConfig = member ComputeIndentationAwareSyntaxInitialStatus: string -> bool +#if !FABLE_COMPILER + member GetTargetFrameworkDirectories: unit -> string list /// Get the loaded sources that exist and issue a warning for the ones that don't @@ -838,6 +852,8 @@ type TcConfig = /// File system query based on TcConfig settings member MakePathAbsolute: string -> string +#endif //!FABLE_COMPILER + member resolutionEnvironment: LegacyResolutionEnvironment member copyFSharpCore: CopyFSharpCoreFlag @@ -875,6 +891,8 @@ type TcConfig = /// if true - 'let mutable x = Span.Empty', the value 'x' is a stack referring span. Used for internal testing purposes only until we get true stack spans. member internalTestSpanStackReferring: bool +#if !FABLE_COMPILER + member GetSearchPathsForLibraryFiles: unit -> string list member IsSystemAssembly: string -> bool @@ -895,6 +913,8 @@ type TcConfig = /// Check if the primary assembly is mscorlib member assumeDotNetFramework: bool +#endif //!FABLE_COMPILER + member exiter: Exiter member parallelReferenceResolution: ParallelReferenceResolution @@ -909,6 +929,8 @@ type TcConfig = member compilationMode: TcGlobals.CompilationMode +#if !FABLE_COMPILER + /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. [] @@ -927,6 +949,8 @@ val TryResolveFileUsingPaths: paths: string seq * m: range * fileName: string -> val ResolveFileUsingPaths: paths: string seq * m: range * fileName: string -> string +#endif //!FABLE_COMPILER + [] type WarningNumberSource = | CommandLineOption diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 9dcf0b72ea3..6da9afecf65 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -6,7 +6,9 @@ module internal FSharp.Compiler.CompilerDiagnostics open System open System.Diagnostics open System.IO +#if !FABLE_COMPILER open System.Reflection +#endif open System.Text open Internal.Utilities.Library.Extras @@ -209,8 +211,10 @@ type Exception with | AssemblyNotResolved(_, m) | HashLoadedSourceHasIssues(_, _, _, m) | HashLoadedScriptConsideredSource m -> Some m +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).DiagnosticRange +#endif #if !NO_TYPEPROVIDERS | :? TypeProviderError as e -> e.Range |> Some #endif @@ -337,8 +341,10 @@ type Exception with | DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer _ -> 318 | ArgumentsInSigAndImplMismatch _ -> 3218 +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).DiagnosticNumber +#endif | WrappedError(e, _) -> e.DiagnosticNumber | DiagnosticWithText(n, _, _) -> n | DiagnosticWithSuggestions(n, _, _, _, _) -> n @@ -433,7 +439,9 @@ type PhasedDiagnostic with module OldStyleMessages = let Message (name, format) = DeclareResourceString(name, format) +#if !FABLE_COMPILER do FSComp.SR.RunStartupValidation() +#endif let SeeAlsoE () = Message("SeeAlso", "%s") let ConstraintSolverTupleDiffLengthsE () = Message("ConstraintSolverTupleDiffLengths", "%d%d") let ConstraintSolverInfiniteTypesE () = Message("ConstraintSolverInfiniteTypes", "%s%s") @@ -612,6 +620,13 @@ let (|InvalidArgument|_|) (exn: exn) = | :? ArgumentException as e -> ValueSome e.Message | _ -> ValueNone +#if FABLE_COMPILER +module Printf = + let bprintf (sb: StringBuilder) = + let f (s: string) = sb.AppendString(s) + Printf.kprintf f +#endif + let OutputNameSuggestions (os: StringBuilder) suggestNames suggestionsF idText = if suggestNames then let buffer = DiagnosticResolutionHints.SuggestionBuffer idText @@ -1921,6 +1936,7 @@ type Exception with s2 ) +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).Output(os, suggestNames) @@ -1935,6 +1951,7 @@ type Exception with | :? IOException as exn -> Printf.bprintf os "%s" exn.Message | :? UnauthorizedAccessException as exn -> Printf.bprintf os "%s" exn.Message +#endif //!FABLE_COMPILER | :? InvalidOperationException as exn when exn.Message.Contains "ControlledExecution.Run" -> Printf.bprintf os "%s" exn.Message @@ -1998,6 +2015,8 @@ let SanitizeFileName fileName implicitIncludeDir = with _ -> fileName +#if !FABLE_COMPILER + [] type FormattedDiagnosticLocation = { @@ -2272,6 +2291,8 @@ type PhasedDiagnostic with diagnostic.OutputContext(buf, prefix, fileLineFunction) diagnostic.Output(buf, tcConfig, severity)) +#endif //!FABLE_COMPILER + //---------------------------------------------------------------------------- // Scoped #nowarn pragmas diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index cdf559c301a..e7f744b2fb5 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -64,6 +64,7 @@ type PhasedDiagnostic with /// Compute new severity according to the various diagnostics options member AdjustSeverity: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> FSharpDiagnosticSeverity +#if !FABLE_COMPILER /// Output all of a diagnostic to a buffer, including range member Output: buf: StringBuilder * tcConfig: TcConfig * severity: FSharpDiagnosticSeverity -> unit @@ -75,6 +76,7 @@ type PhasedDiagnostic with tcConfig: TcConfig * severity: FSharpDiagnosticSeverity -> unit +#endif //!FABLE_COMPILER /// Get a diagnostics logger that filters the reporting of warnings based on scoped pragma information val GetDiagnosticsLoggerFilteringByScopedPragmas: @@ -87,6 +89,8 @@ val GetDiagnosticsLoggerFilteringByScopedPragmas: /// Remove 'implicitIncludeDir' from a file name before output val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string +#if !FABLE_COMPILER + /// Used internally and in LegacyHostedCompilerForTesting [] type FormattedDiagnosticLocation = @@ -121,3 +125,5 @@ type FormattedDiagnostic = val CollectFormattedDiagnostics: tcConfig: TcConfig * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> FormattedDiagnostic[] + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index c54ccc41c58..9b5ca6851f9 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -6,15 +6,21 @@ module internal FSharp.Compiler.CompilerImports open System open System.Collections.Generic +#if !FABLE_COMPILER open System.Collections.Immutable +#endif open System.Diagnostics open System.IO +#if !FABLE_COMPILER open System.IO.Compression +#endif open System.Reflection open Internal.Utilities open Internal.Utilities.Collections +#if !FABLE_COMPILER open Internal.Utilities.FSharpEnvironment +#endif open Internal.Utilities.Library open Internal.Utilities.Library.Extras @@ -25,7 +31,9 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.IO @@ -72,12 +80,16 @@ let IsOptimizationDataResourceB (r: ILResource) = || r.Name.StartsWithOrdinal FSharpOptimizationCompressedDataResourceNameB let decompressResource (r: ILResource) = +#if FABLE_COMPILER + r.GetBytes() // no support for gunzip +#else use raw = r.GetBytes().AsStream() use decompressed = new MemoryStream() use deflator = new DeflateStream(raw, CompressionMode.Decompress) deflator.CopyTo decompressed deflator.Close() ByteStorage.FromByteArray(decompressed.ToArray()).GetByteMemory() +#endif let GetSignatureDataResourceName (r: ILResource) = if r.Name.StartsWithOrdinal FSharpSignatureDataResourceName then @@ -141,6 +153,8 @@ let GetResourceNameAndOptimizationDataFuncs (resources: ILResource list) = let IsReflectedDefinitionsResource (r: ILResource) = r.Name.StartsWithOrdinal(QuotationPickler.SerializedReflectedDefinitionsResourceNameBase) +#if !FABLE_COMPILER + let ByteBufferToBytes compress (bytes: ByteBuffer) = if compress then let raw = new MemoryStream(bytes.AsMemory().ToArray()) @@ -337,12 +351,16 @@ let EncodeOptimizationData (tcGlobals, tcConfig: TcConfig, outfile, exportRemapp else [] +#endif //!FABLE_COMPILER + exception AssemblyNotResolved of originalName: string * range: range exception MSBuildReferenceResolutionWarning of message: string * warningCode: string * range: range exception MSBuildReferenceResolutionError of message: string * warningCode: string * range: range +#if !FABLE_COMPILER + let OpenILBinary (fileName, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, tryGetMetadataSnapshot) = let opts: ILReaderOptions = { @@ -365,6 +383,8 @@ let OpenILBinary (fileName, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, AssemblyReader.GetILModuleReader(location, opts) +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = | Speculative @@ -398,6 +418,8 @@ type AssemblyResolution = override this.ToString() = sprintf "%s%s" (if this.sysdir then "[sys]" else "") this.resolvedPath +#if !FABLE_COMPILER + member this.ProjectReference = this.originalReference.ProjectReference /// Compute the ILAssemblyRef for a resolved assembly. This is done by reading the binary if necessary. The result @@ -427,6 +449,8 @@ type AssemblyResolution = this.ilAssemblyRef <- Some assemblyRef assemblyRef +#endif //!FABLE_COMPILER + type ImportedBinary = { FileName: string @@ -464,6 +488,8 @@ type CcuLoadFailureAction = type TcImportsLockToken() = interface LockToken +#if !FABLE_COMPILER + type TcImportsLock = Lock let RequireTcImportsLock (_tcitok: TcImportsLockToken, _thingProtected: 'T) = () @@ -1091,10 +1117,57 @@ type RawFSharpAssemblyData(ilModule: ILModuleDef, ilAssemblyRefs) = let attrs = GetCustomAttributesOfILModule ilModule List.exists (IsMatchingSignatureDataVersionAttr(parseILVersion FSharpBinaryMetadataFormatRevision)) attrs +#endif //!FABLE_COMPILER + //---------------------------------------------------------------------------- // TcImports //-------------------------------------------------------------------------- +#if FABLE_COMPILER + +// trimmed-down version of TcImports +[] +type TcImports() = + let mutable tcGlobalsOpt = None + let mutable ccuMap = Map([]) + + // This is the main "assembly reference --> assembly" resolution routine. + let FindCcuInfo (_m, assemblyName) = + match ccuMap |> Map.tryFind assemblyName with + | Some ccuInfo -> ResolvedCcu(ccuInfo.FSharpViewOfMetadata) + | None -> UnresolvedCcu(assemblyName) + + member x.FindCcu (_m: range, assemblyName) = + match ccuMap |> Map.tryFind assemblyName with + | Some ccuInfo -> Some ccuInfo.FSharpViewOfMetadata + | None -> None + + member x.SetTcGlobals g = + tcGlobalsOpt <- Some g + member x.GetTcGlobals() = + tcGlobalsOpt.Value + member x.SetCcuMap m = + ccuMap <- m + member x.GetImportedAssemblies() = + ccuMap.Values |> Seq.toList + + member x.GetImportMap() = + let loaderInterface = + { new Import.AssemblyLoader with + member _.FindCcuFromAssemblyRef (_ctok, m, ilAssemblyRef) = + FindCcuInfo(m, ilAssemblyRef.Name) + member _.TryFindXmlDocumentationInfo (_assemblyName) = + None + } + new Import.ImportMap (tcGlobalsOpt.Value, loaderInterface) + + member x.GetCcusExcludingBase() = + //TODO: excludes any framework imports (which may be shared between multiple builds) + x.GetImportedAssemblies() + |> List.map (fun x -> x.FSharpViewOfMetadata) + +#else //!FABLE_COMPILER + [] type TcImportsSafeDisposal ( @@ -2724,3 +2797,5 @@ let RequireReferences (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, reso let asms = asms |> List.map fst tcEnv, asms + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/CompilerImports.fsi b/src/Compiler/Driver/CompilerImports.fsi index 2a95347ecbf..cb5d7449111 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/src/Compiler/Driver/CompilerImports.fsi @@ -10,7 +10,9 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CheckBasics open FSharp.Compiler.CompilerConfig +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Optimizer open FSharp.Compiler.TypedTree @@ -52,6 +54,8 @@ val IsReflectedDefinitionsResource: ILResource -> bool val GetResourceNameAndSignatureDataFuncs: ILResource list -> (string * ((unit -> ReadOnlyByteMemory) * (unit -> ReadOnlyByteMemory) option)) list +#if !FABLE_COMPILER + /// Encode the F# interface data into a set of IL attributes and resources val EncodeSignatureData: tcConfig: TcConfig * @@ -71,6 +75,8 @@ val EncodeOptimizationData: isIncrementalBuild: bool -> ILResource list +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = | Speculative @@ -125,6 +131,22 @@ type ImportedAssembly = #endif FSharpOptimizationData: InterruptibleLazy } +#if FABLE_COMPILER + +/// trimmed-down version of TcImports +[] +type TcImports = + internal new: unit -> TcImports + member FindCcu: range * string -> CcuThunk option + member SetTcGlobals: TcGlobals -> unit + member GetTcGlobals: unit -> TcGlobals + member SetCcuMap: Map -> unit + member GetImportedAssemblies: unit -> ImportedAssembly list + member GetImportMap: unit -> Import.ImportMap + member GetCcusExcludingBase: unit -> CcuThunk list + +#else //!FABLE_COMPILER + /// Tables of assembly resolutions [] type TcAssemblyResolutions = @@ -224,3 +246,5 @@ val RequireReferences: thisAssemblyName: string * resolutions: AssemblyResolution list -> TcEnv * ImportedAssembly list + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 7c4c81efd40..b5c9090b98f 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -11,7 +11,9 @@ open FSharp.Compiler.Optimizer open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILPdbWriter +#endif open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics @@ -125,9 +127,11 @@ let getCompilerOption (CompilerOption(_s, _tag, _spec, _, help) as compilerOptio let lineWidth = match width with | None -> +#if !FABLE_COMPILER try Console.BufferWidth with _ -> +#endif defaultLineWidth | Some w -> w @@ -234,6 +238,7 @@ module ResponseFile = | CompilerOptionSpec of string | Comment of string +#if !FABLE_COMPILER let parseFile path : Choice = let parseLine (l: string) = match l with @@ -256,6 +261,7 @@ module ResponseFile = Choice1Of2 data with e -> Choice2Of2 e +#endif //!FABLE_COMPILER let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: CompilerOptionBlock list, args) = use _ = UseBuildPhase BuildPhase.Parameter @@ -333,6 +339,10 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler match args with | [] -> () | opt: string :: t when opt.StartsWithOrdinal("@") -> +#if FABLE_COMPILER + ignore t + () +#else let responseFileOptions = let fullpath = try @@ -361,6 +371,7 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler rspData |> List.choose onlyOptions processArg (responseFileOptions @ t) +#endif //!FABLE_COMPILER | opt :: t -> let option, optToken, argString = parseOption opt @@ -1139,6 +1150,10 @@ let mlCompatibilityFlag (tcConfigB: TcConfigBuilder) = Some(FSComp.SR.optsMlcompatibility ()) ) +#if FABLE_COMPILER +let exit _code = () +#endif + let GetLanguageVersions () = seq { FSComp.SR.optsSupportedLangVersions () @@ -1219,10 +1234,12 @@ let codePageFlag (tcConfigB: TcConfigBuilder) = "codepage", tagInt, OptionInt(fun n -> +#if !FABLE_COMPILER try System.Text.Encoding.GetEncoding n |> ignore with :? ArgumentException as err -> error (Error(FSComp.SR.optsProblemWithCodepage (n, err.Message), rangeCmdArgs)) +#endif tcConfigB.inputCodePage <- Some n), None, @@ -1422,7 +1439,9 @@ let testFlag tcConfigB = { tcConfigB.optSettings with reportHasEffect = true } +#if !FABLE_COMPILER | "NoErrorText" -> FSComp.SR.SwallowResourceText <- true +#endif | "EmitFeeFeeAs100001" -> tcConfigB.testFlagEmitFeeFeeAs100001 <- true | "DumpDebugInfo" -> tcConfigB.dumpDebugInfo <- true | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true @@ -2404,6 +2423,8 @@ let ApplyCommandLineArgs (tcConfigB: TcConfigBuilder, sourceFiles: string list, errorRecovery e range0 sourceFiles +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // ReportTime //---------------------------------------------------------------------------- @@ -2502,3 +2523,5 @@ let DoWithDiagnosticColor severity f = | _ -> infoColor DoWithColor color f + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/CompilerOptions.fsi b/src/Compiler/Driver/CompilerOptions.fsi index 7baefaa5aa1..3fa454118df 100644 --- a/src/Compiler/Driver/CompilerOptions.fsi +++ b/src/Compiler/Driver/CompilerOptions.fsi @@ -78,6 +78,8 @@ val SetTailcallSwitch: TcConfigBuilder -> OptionSwitch -> unit val SetDebugSwitch: TcConfigBuilder -> string option -> OptionSwitch -> unit +#if !FABLE_COMPILER + val PrintOptionInfo: TcConfigBuilder -> unit val SetTargetProfile: TcConfigBuilder -> string -> unit @@ -98,3 +100,5 @@ val ReportTime: (TcConfig -> string -> unit) val GetAbbrevFlagSet: TcConfigBuilder -> bool -> Set val PostProcessCompilerArgs: Set -> string[] -> string list + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/GraphChecking/Graph.fs b/src/Compiler/Driver/GraphChecking/Graph.fs index 6bfb1199181..96c76ae3ec7 100644 --- a/src/Compiler/Driver/GraphChecking/Graph.fs +++ b/src/Compiler/Driver/GraphChecking/Graph.fs @@ -104,7 +104,11 @@ module internal Graph = sb.ToString() let writeMermaidToFile path (graph: Graph) = +#if FABLE_COMPILER + ignore (path: string) +#else use out = FileSystem.OpenFileForWriteShim(path, fileMode = System.IO.FileMode.Create) graph |> serialiseToMermaid |> out.WriteAllText +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 33dd1c42c46..1ecf477f040 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -47,7 +47,9 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> let dependents = graph |> Graph.reverse // Cancellation source used to signal either an exception in one of the items or end of processing. use localCts = new CancellationTokenSource() +#if !FABLE_COMPILER use cts = CancellationTokenSource.CreateLinkedTokenSource(parentCt, localCts.Token) +#endif let makeNode (item: 'Item) : GraphNode<'Item, 'Result> = let info = @@ -115,6 +117,12 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> localCts.Cancel() let rec queueNode node = +#if FABLE_COMPILER + try + processNode node + with ex -> + raiseExn (Some(node.Info.Item, ex)) +#else //!FABLE_COMPILER Async.Start( async { let! res = async { processNode node } |> Async.Catch @@ -125,6 +133,7 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> }, cts.Token ) +#endif //!FABLE_COMPILER and processNode (node: GraphNode<'Item, 'Result>) : unit = @@ -148,8 +157,10 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> leaves |> Array.iter queueNode +#if !FABLE_COMPILER // Wait for end of processing, an exception, or an external cancellation request. cts.Token.WaitHandle.WaitOne() |> ignore +#endif // If we stopped early due to external cancellation, throw. parentCt.ThrowIfCancellationRequested() diff --git a/src/Compiler/Driver/GraphChecking/TrieMapping.fs b/src/Compiler/Driver/GraphChecking/TrieMapping.fs index 215f8a2dae6..37369302618 100644 --- a/src/Compiler/Driver/GraphChecking/TrieMapping.fs +++ b/src/Compiler/Driver/GraphChecking/TrieMapping.fs @@ -348,7 +348,9 @@ let serializeToMermaid (path: string) (filesInProject: FileInProject array) (tri appendLine "```" +#if !FABLE_COMPILER use out = FileSystem.OpenFileForWriteShim(path, fileMode = System.IO.FileMode.Create) out.WriteAllText(sb.ToString()) +#endif diff --git a/src/Compiler/Driver/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index 36eae5734ce..2d9fbbb106b 100644 --- a/src/Compiler/Driver/OptimizeInputs.fs +++ b/src/Compiler/Driver/OptimizeInputs.fs @@ -20,6 +20,8 @@ open FSharp.Compiler.IO open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps +#if !FABLE_COMPILER + let mutable showTermFileCount = 0 let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr = @@ -39,6 +41,8 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr = LayoutRender.outL stderr (Display.squashTo 192 (DebugPrint.implFilesL expr)) dprintf "\n------------------\n" +#endif //!FABLE_COMPILER + let AddExternalCcuToOptimizationEnv tcGlobals optEnv (ccuinfo: ImportedAssembly) = match ccuinfo.FSharpOptimizationData.Force() with | None -> optEnv @@ -132,6 +136,7 @@ module private ParallelOptimization = finalFileResults, lastFileFirstLoopEnv +#if !FABLE_COMPILER let optimizeFilesInParallel (env0: IncrementalOptimizationEnv) (phases: PhaseInfo[]) @@ -249,6 +254,7 @@ module private ParallelOptimization = raise ex.InnerExceptions[0] collectFinalResults lastPhaseResults +#endif //!FABLE_COMPILER let optimizeFilesSequentially optEnv (phases: PhaseInfo[]) implFiles = let results, (optEnvFirstLoop, _, _, _) = @@ -322,6 +328,9 @@ let ApplyAllOptimizations // Always optimize once - the results of this step give the x-module optimization // info. Subsequent optimization steps choose representations etc. which we don't // want to save in the x-module info (i.e. x-module info is currently "high level"). +#if FABLE_COMPILER + ignore outfile +#else //!FABLE_COMPILER PrintWholeAssemblyImplementation tcConfig outfile "pass-start" implFiles #if DEBUG if tcConfig.showOptimizationData then @@ -330,8 +339,11 @@ let ApplyAllOptimizations if tcConfig.showOptimizationData then dprintf "CCU prior to optimization:\n%s\n" (LayoutRender.showL (Display.squashTo 192 (DebugPrint.entityL ccu.Contents))) #endif +#endif //!FABLE_COMPILER +#if !FABLE_COMPILER ReportTime tcConfig "Optimizations" +#endif let firstLoopSettings = { tcConfig.optSettings with @@ -522,12 +534,14 @@ let ApplyAllOptimizations let results, optEnvFirstLoop = match tcConfig.optSettings.processingMode with +#if !FABLE_COMPILER // Parallel optimization breaks determinism - turn it off in deterministic builds. | Optimizer.OptimizationProcessingMode.Parallel when (not tcConfig.deterministic) -> let results, optEnvFirstPhase = ParallelOptimization.optimizeFilesInParallel optEnv phases implFiles results |> Array.toList, optEnvFirstPhase +#endif | Optimizer.OptimizationProcessingMode.Parallel | Optimizer.OptimizationProcessingMode.Sequential -> optimizeFilesSequentially optEnv phases implFiles @@ -537,7 +551,11 @@ let ApplyAllOptimizations |> List.map snd |> List.iter (fun implFileOptData -> let str = +#if FABLE_COMPILER + (LayoutRender.showL (Optimizer.moduleInfoL tcGlobals implFileOptData)) +#else (LayoutRender.showL (Display.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData))) +#endif dprintf $"Optimization implFileOptData:\n{str}\n") #endif @@ -545,10 +563,14 @@ let ApplyAllOptimizations let implFiles, implFileOptDatas = List.unzip results let assemblyOptData = Optimizer.UnionOptimizationInfos implFileOptDatas let tassembly = CheckedAssemblyAfterOptimization implFiles +#if !FABLE_COMPILER PrintWholeAssemblyImplementation tcConfig outfile "pass-end" (implFiles |> List.map (fun implFile -> implFile.ImplFile)) ReportTime tcConfig "Ending Optimizations" +#endif tassembly, assemblyOptData, optEnvFirstLoop +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // ILX generation //---------------------------------------------------------------------------- @@ -619,6 +641,8 @@ let NormalizeAssemblyRefs (ctok, ilGlobals: ILGlobals, tcImports: TcImports) sco | ILScopeRef.PrimaryAssembly -> normalizeAssemblyRefByName ilGlobals.primaryAssemblyName | ILScopeRef.Assembly aref -> normalizeAssemblyRefByName aref.Name +#endif //!FABLE_COMPILER + let GetGeneratedILModuleName (t: CompilerTarget) (s: string) = // return the name of the file as a module name let ext = diff --git a/src/Compiler/Driver/OptimizeInputs.fsi b/src/Compiler/Driver/OptimizeInputs.fsi index d5c731ba05d..4d90a7212c1 100644 --- a/src/Compiler/Driver/OptimizeInputs.fsi +++ b/src/Compiler/Driver/OptimizeInputs.fsi @@ -32,6 +32,8 @@ val ApplyAllOptimizations: implFiles: CheckedImplFile list -> CheckedAssemblyAfterOptimization * LazyModuleInfo * IncrementalOptimizationEnv +#if !FABLE_COMPILER + val CreateIlxAssemblyGenerator: TcConfig * TcImports * TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxAssemblyGenerator @@ -49,3 +51,5 @@ val GenerateIlxCode: val NormalizeAssemblyRefs: CompilationThreadToken * ILGlobals * TcImports -> (ILScopeRef -> ILScopeRef) val GetGeneratedILModuleName: CompilerTarget -> string -> string + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 22ea3c7f033..01169728293 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -515,7 +515,7 @@ let ParseInput type Tokenizer = unit -> Parser.token // Show all tokens in the stream, for testing purposes -let ShowAllTokensAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: Exiter) = +let ShowAllTokensAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: Exiter) = let mutable indent = 0 while true do @@ -542,10 +542,14 @@ let ShowAllTokensAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: printf "!!! at end of stream\n" // Test one of the parser entry points, just for testing purposes -let TestInteractionParserAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: Exiter) = +let TestInteractionParserAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: Exiter) = while true do match (Parser.interaction (fun _ -> tokenizer ()) lexbuf) with +#if FABLE_COMPILER + | ParsedScriptInteraction.Definitions(l, m) -> printfn "Parsed OK, got %d defs @ %s" l.Length (stringOfRange m) +#else | ParsedScriptInteraction.Definitions(l, m) -> printfn "Parsed OK, got %d defs @ %a" l.Length outputRange m +#endif exiter.Exit 0 @@ -695,6 +699,8 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileNam let ValidSuffixes = FSharpSigFileSuffixes @ FSharpImplFileSuffixes +#if !FABLE_COMPILER + let checkInputFile (tcConfig: TcConfig) fileName = if List.exists (FileSystemUtils.checkSuffix fileName) ValidSuffixes then if not (FileSystem.FileExistsShim fileName) then @@ -1056,6 +1062,8 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig: TcConfig, inp: ParsedInput, ProcessMetaCommandsFromInput (getWarningNumber, addReferenceDirective, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) TcConfig.Create(tcConfigB, validate = false) +#endif //!FABLE_COMPILER + /// Build the initial type checking environment let GetInitialTcEnv (assemblyName: string, initm: range, tcConfig: TcConfig, tcImports: TcImports, tcGlobals) = let initm = initm.StartRange @@ -1084,6 +1092,8 @@ let GetInitialTcEnv (assemblyName: string, initm: range, tcConfig: TcConfig, tcI else tcEnv, openDecls0 +#if !FABLE_COMPILER + /// Inject faults into checking let CheckSimulateException (tcConfig: TcConfig) = match tcConfig.simulateException with @@ -1108,6 +1118,8 @@ let CheckSimulateException (tcConfig: TcConfig) = | Some("tc-fail") -> failwith "simulated" | _ -> () +#endif //!FABLE_COMPILER + //---------------------------------------------------------------------------- // Type-check sets of files //-------------------------------------------------------------------------- @@ -1264,7 +1276,11 @@ let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlob use _ = Activity.start "ParseAndCheckInputs.SkippedImplFilePlaceholder" [| Activity.Tags.fileName, input.FileName |] +#if FABLE_COMPILER + ignore tcConfig +#else CheckSimulateException tcConfig +#endif match input with | ParsedInput.ImplFile file -> @@ -1318,7 +1334,9 @@ let CheckOneInput use _ = Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] +#if !FABLE_COMPILER CheckSimulateException tcConfig +#endif let m = input.Range let amap = tcImports.GetImportMap() @@ -1481,6 +1499,8 @@ let CheckMultipleInputsSequential (ctok, checkForErrors, tcConfig, tcImports, tc (tcState, inputs) ||> List.mapFold (CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) +#if !FABLE_COMPILER + open FSharp.Compiler.GraphChecking type State = TcState * bool @@ -1959,10 +1979,16 @@ let CheckMultipleInputsUsingGraphMode partialResults, tcState) -let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) = +#endif //!FABLE_COMPILER + +let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat: (PhasedDiagnostic -> PhasedDiagnostic), inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions +#if FABLE_COMPILER + ignore eagerFormat +#endif let results, tcState = match tcConfig.typeCheckingConfig.Mode with +#if !FABLE_COMPILER | TypeCheckingMode.Graph when (not tcConfig.isInteractive && not tcConfig.compilingFSharpCore) -> CheckMultipleInputsUsingGraphMode( ctok, @@ -1975,6 +2001,7 @@ let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tc eagerFormat, inputs ) +#endif //!FABLE_COMPILER | _ -> CheckMultipleInputsSequential(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index fb32a4557cd..f701e8cd991 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -11,7 +11,9 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.GraphChecking open FSharp.Compiler.NameResolution @@ -76,6 +78,8 @@ val ParseInput: userOpName: string option -> ParsedInput +#if !FABLE_COMPILER + /// A general routine to process hash directives val ProcessMetaCommandsFromInput: ('T -> range * string -> 'T) * ('T -> range * string * Directive -> 'T) * ('T -> range * string -> unit) -> @@ -128,8 +132,12 @@ val ParseOneInputLexbuf: diagnosticsLogger: DiagnosticsLogger -> ParsedInput +#endif //!FABLE_COMPILER + val EmptyParsedInput: fileName: string * isLastCompiland: (bool * bool) -> ParsedInput +#if !FABLE_COMPILER + /// Parse multiple input files from disk val ParseInputFiles: tcConfig: TcConfig * @@ -139,6 +147,8 @@ val ParseInputFiles: retryLocked: bool -> (ParsedInput * string) list +#endif //!FABLE_COMPILER + /// Get the initial type checking environment including the loading of mscorlib/System.Core, FSharp.Core /// applying the InternalsVisibleTo in referenced assemblies and opening 'Checked' if requested. val GetInitialTcEnv: assemblyName: string * range * TcConfig * TcImports * TcGlobals -> TcEnv * OpenDeclaration list diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index 0e22231abb8..46102d53ab9 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -14,7 +14,9 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO @@ -79,6 +81,8 @@ type CodeContext = | Compilation // in fsc.exe | Editing // in VS +#if !FABLE_COMPILER + module ScriptPreprocessClosure = /// Represents an input to the closure finding process @@ -787,3 +791,5 @@ type LoadClosure with use _ = UseBuildPhase BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptFiles(tcConfig, files, implicitDefines, lexResourceManager, dependencyProvider) + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/ScriptClosure.fsi b/src/Compiler/Driver/ScriptClosure.fsi index 6f764b299a9..a32cc5f2595 100644 --- a/src/Compiler/Driver/ScriptClosure.fsi +++ b/src/Compiler/Driver/ScriptClosure.fsi @@ -7,7 +7,9 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis @@ -70,6 +72,8 @@ type LoadClosure = LoadClosureRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list } +#if !FABLE_COMPILER + /// Analyze a script text and find the closure of its references. /// Used from FCS, when editing a script file. // @@ -102,3 +106,5 @@ type LoadClosure = lexResourceManager: Lexhelp.LexResourceManager * dependencyProvider: DependencyProvider -> LoadClosure + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index db77f52ea10..c2d8457462c 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -5,6 +5,8 @@ module FSharp.Compiler.BuildGraph open System.Threading open System.Globalization +#if !FABLE_COMPILER + [] module GraphNode = @@ -78,3 +80,5 @@ type GraphNode<'T> private (computation: Async<'T>, cachedResult: ValueOption<'T GraphNode(nodeResult, ValueSome result, nodeResult) new(computation) = GraphNode(computation, ValueNone, Unchecked.defaultof<_>) + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index 2b3016bf99b..c06c61ac820 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -2,6 +2,8 @@ module internal FSharp.Compiler.BuildGraph +#if !FABLE_COMPILER + /// Contains helpers related to the build graph [] module internal GraphNode = @@ -37,3 +39,5 @@ type internal GraphNode<'T> = /// Return 'true' if the computation is in-progress. member IsComputing: bool + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/DiagnosticResolutionHints.fs b/src/Compiler/Facilities/DiagnosticResolutionHints.fs index e605ace0b5c..add44b77efb 100644 --- a/src/Compiler/Facilities/DiagnosticResolutionHints.fs +++ b/src/Compiler/Facilities/DiagnosticResolutionHints.fs @@ -41,7 +41,7 @@ type SuggestionBufferEnumerator(tail: int, data: KeyValuePair[]) interface IEnumerator with member _.Current = - let kvpr = &data[current] + let kvpr = data[current] kvpr.Value interface IEnumerator with @@ -66,11 +66,11 @@ type SuggestionBuffer(idText: string) = let insert (k, v) = let mutable pos = tail - while pos < maxSuggestions && (let kv = &data[pos] in kv.Key < k) do + while pos < maxSuggestions && (let kv = data[pos] in kv.Key < k) do pos <- pos + 1 if pos > 0 then - if pos >= maxSuggestions || (let kv = &data[pos] in k <> kv.Key || v <> kv.Value) then + if pos >= maxSuggestions || (let kv = data[pos] in k <> kv.Key || v <> kv.Value) then if tail < pos - 1 then for i = tail to pos - 2 do data[i] <- data[i + 1] diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 69d1f4fc306..a92734b0a3b 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -176,12 +176,16 @@ let rec AttachRange m (exn: exn) = exn else match exn with +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? TargetInvocationException as e when isNotNull e.InnerException -> AttachRange m !!exn.InnerException +#endif | UnresolvedReferenceNoRange a -> UnresolvedReferenceError(a, m) | UnresolvedPathReferenceNoRange(a, p) -> UnresolvedPathReference(a, p, m) +#if !FABLE_COMPILER | :? NotSupportedException -> exn | :? SystemException -> InternalException(exn, exn.Message, m) +#endif | _ -> exn type Exiter = @@ -190,10 +194,12 @@ type Exiter = let QuitProcessExiter = { new Exiter with member _.Exit n = +#if !FABLE_COMPILER try Environment.Exit n with _ -> () +#endif failwith (FSComp.SR.elSysEnvExitDidntExit ()) } @@ -416,14 +422,22 @@ module DiagnosticsLoggerExtensions = // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV // This uses a simple heuristic to detect it (the vsversion is < 16.0) let tryAndDetectDev15 = +#if FABLE_COMPILER + false +#else let vsVersion = Environment.GetEnvironmentVariable("VisualStudioVersion") match Double.TryParse vsVersion with | true, v -> v < 16.0 | _ -> false +#endif /// Instruct the exception not to reset itself when thrown again. let PreserveStackTrace exn = +#if FABLE_COMPILER + ignore exn + () +#else try if not tryAndDetectDev15 then let preserveStackTrace = @@ -435,16 +449,19 @@ module DiagnosticsLoggerExtensions = // This is probably only the mono case. Debug.Assert(false, "Could not preserve stack trace for watson exception.") () +#endif type DiagnosticsLogger with member x.EmitDiagnostic(exn, severity) = +#if !FABLE_COMPILER match exn with | InternalError(s, _) | InternalException(_, s, _) | Failure s as exn -> Debug.Assert(false, sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) | _ -> () +#endif match exn with | StopProcessing @@ -474,9 +491,11 @@ module DiagnosticsLoggerExtensions = // Never throws ReportedError. // Throws StopProcessing and exceptions raised by the DiagnosticSink(exn) handler. match exn with +#if !FABLE_COMPILER // Don't send ThreadAbortException down the error channel | :? System.Threading.ThreadAbortException | WrappedError(:? System.Threading.ThreadAbortException, _) -> () +#endif | ReportedError _ | WrappedError(ReportedError _, _) -> () | StopProcessing @@ -875,6 +894,12 @@ type StackGuard(maxDepth: int, name: string) = [] path: string, [] line: int ) = +#if FABLE_COMPILER + ignore depth + ignore maxDepth + ignore name + f () +#else //!FABLE_COMPILER use _ = Activity.start "DiagnosticsLogger.StackGuard.Guard" @@ -902,6 +927,7 @@ type StackGuard(maxDepth: int, name: string) = f () finally depth <- depth - 1 +#endif //!FABLE_COMPILER [] member x.GuardCancellable(original: Cancellable<'T>) = diff --git a/src/Compiler/Facilities/ReferenceResolver.fs b/src/Compiler/Facilities/ReferenceResolver.fs index 7e825741942..4f5c5b41bd5 100644 --- a/src/Compiler/Facilities/ReferenceResolver.fs +++ b/src/Compiler/Facilities/ReferenceResolver.fs @@ -59,3 +59,24 @@ type ILegacyReferenceResolver = [] type LegacyReferenceResolver(impl: ILegacyReferenceResolver) = member internal _.Impl = impl + +#if FABLE_COMPILER + static member getResolver () = + { new ILegacyReferenceResolver with + member _.HighestInstalledNetFrameworkVersion() = "v4.8" + member _.DotNetFrameworkReferenceAssembliesRootDirectory = "" + member _.Resolve(resolutionEnvironment, references, targetFrameworkVersion, + targetFrameworkDirectories, targetProcessorArchitecture, fsharpCoreDir, + explicitIncludeDirs, implicitIncludeDir, logMessage, logDiagnostic) = + Array.empty + } + |> LegacyReferenceResolver + +type FxResolver() = + class end + +namespace Internal.Utilities + +module internal FSharpEnvironment = + let isRunningOnCoreClr = true +#endif //FABLE_COMPILER diff --git a/src/Compiler/Facilities/ReferenceResolver.fsi b/src/Compiler/Facilities/ReferenceResolver.fsi index 8371775f956..6201f136b1a 100644 --- a/src/Compiler/Facilities/ReferenceResolver.fsi +++ b/src/Compiler/Facilities/ReferenceResolver.fsi @@ -57,7 +57,21 @@ type ILegacyReferenceResolver = // Note, two implementations of this are provided, and no further implementations can be added from // outside FSharp.Compiler.Service +#if !FABLE_COMPILER [] +#endif type LegacyReferenceResolver = new: impl: ILegacyReferenceResolver -> LegacyReferenceResolver member internal Impl: ILegacyReferenceResolver + +#if FABLE_COMPILER + static member getResolver: unit -> LegacyReferenceResolver + +type FxResolver = + internal new: unit -> FxResolver + +namespace Internal.Utilities + +module internal FSharpEnvironment = + val isRunningOnCoreClr: bool +#endif //FABLE_COMPILER diff --git a/src/Compiler/Facilities/TextLayoutRender.fs b/src/Compiler/Facilities/TextLayoutRender.fs index 735d44b82ad..a6d06ffe414 100644 --- a/src/Compiler/Facilities/TextLayoutRender.fs +++ b/src/Compiler/Facilities/TextLayoutRender.fs @@ -162,6 +162,7 @@ module LayoutRender = member _.Finish rstrs = NoResult } +#if !FABLE_COMPILER /// channel LayoutRenderer let channelR (chan: TextWriter) = { new LayoutRenderer with @@ -179,6 +180,7 @@ module LayoutRender = member r.AddTag z (tag, attrs, start) = z member r.Finish z = NoResult } +#endif //!FABLE_COMPILER /// buffer render let bufferR os = @@ -200,8 +202,10 @@ module LayoutRender = let showL layout = renderL stringR layout +#if !FABLE_COMPILER let outL (chan: TextWriter) layout = renderL (channelR chan) layout |> ignore +#endif let bufferL os layout = renderL (bufferR os) layout |> ignore diff --git a/src/Compiler/Facilities/TextLayoutRender.fsi b/src/Compiler/Facilities/TextLayoutRender.fsi index 96d4b13a184..3d9608d0430 100644 --- a/src/Compiler/Facilities/TextLayoutRender.fsi +++ b/src/Compiler/Facilities/TextLayoutRender.fsi @@ -34,7 +34,9 @@ module internal LayoutRender = val internal showL: Layout -> string +#if !FABLE_COMPILER val internal outL: TextWriter -> Layout -> unit +#endif val internal bufferL: StringBuilder -> Layout -> unit @@ -44,8 +46,10 @@ module internal LayoutRender = /// Render layout to string val internal stringR: LayoutRenderer +#if !FABLE_COMPILER /// Render layout to channel val internal channelR: TextWriter -> LayoutRenderer +#endif /// Render layout to StringBuilder val internal bufferR: StringBuilder -> LayoutRenderer diff --git a/src/Compiler/Facilities/prim-lexing.fs b/src/Compiler/Facilities/prim-lexing.fs index c305052587c..36e0196c3c2 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -43,6 +43,9 @@ type ISourceTextNew = type StringText(str: string) = let getLines (str: string) = +#if FABLE_COMPILER + System.Text.RegularExpressions.Regex.Split(str, "\r\n|\r|\n"); +#else use reader = new StringReader(str) [| @@ -57,6 +60,7 @@ type StringText(str: string) = // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak yield String.Empty |] +#endif //!FABLE_COMPILER let getLines = // This requires allocating and getting all the lines. @@ -107,7 +111,11 @@ type StringText(str: string) = if lastIndex <= startIndex || lastIndex >= str.Length then invalidArg "target" "Too big." +#if FABLE_COMPILER + str.IndexOf(target, startIndex) <> -1 +#else str.IndexOfOrdinal(target, startIndex, target.Length) <> -1 +#endif member _.Length = str.Length @@ -117,7 +125,11 @@ type StringText(str: string) = | _ -> false member _.CopyTo(sourceIndex, destination, destinationIndex, count) = +#if FABLE_COMPILER + Array.blit (str.ToCharArray()) sourceIndex destination destinationIndex count +#else str.CopyTo(sourceIndex, destination, destinationIndex, count) +#endif member this.GetSubTextFromRange(range) = let totalAmountOfLines = getLines.Value.Length @@ -246,6 +258,12 @@ type internal Position = static member FirstLine fileIdx = Position(fileIdx, 1, 1, 0, 0) +#if FABLE_COMPILER + type internal LexBufferChar = uint16 +#else + type internal LexBufferChar = char +#endif + type internal LexBufferFiller<'Char> = LexBuffer<'Char> -> unit and [] internal LexBuffer<'Char> @@ -291,8 +309,10 @@ and [] internal LexBuffer<'Char> with get () = endPos and set b = endPos <- b +#if !FABLE_COMPILER member lexbuf.LexemeView = System.ReadOnlySpan<'Char>(buffer, bufferScanStart, lexemeLength) +#endif member lexbuf.LexemeChar n = buffer[n + bufferScanStart] @@ -327,8 +347,13 @@ and [] internal LexBuffer<'Char> member lexbuf.RefillBuffer() = filler lexbuf - static member LexemeString(lexbuf: LexBuffer) = + static member LexemeString(lexbuf: LexBuffer) = +#if FABLE_COMPILER + let chars = Array.init lexbuf.LexemeLength (lexbuf.LexemeChar >> char) + new System.String(chars) +#else System.String(lexbuf.Buffer, lexbuf.BufferScanStart, lexbuf.LexemeLength) +#endif member lexbuf.IsPastEndOfStream with get () = eof @@ -393,6 +418,10 @@ and [] internal LexBuffer<'Char> LexBuffer.FromArrayNoCopy(reportLibraryOnlyFeatures, langVersion, strictIndentation, arr) static member FromSourceText(reportLibraryOnlyFeatures, langVersion, strictIndentation, sourceText: ISourceText) = +#if FABLE_COMPILER + let arr = Array.init sourceText.Length (fun i -> uint16 (sourceText.Item i)) + LexBuffer.FromArrayNoCopy (reportLibraryOnlyFeatures, langVersion, strictIndentation, arr) +#else let mutable currentSourceIndex = 0 LexBuffer @@ -414,16 +443,25 @@ and [] internal LexBuffer<'Char> currentSourceIndex <- currentSourceIndex + lengthToCopy lengthToCopy ) +#endif //!FABLE_COMPILER + + static member FromString (reportLibraryOnlyFeatures, langVersion, strictIndentation, s: string) = +#if FABLE_COMPILER + let arr = Array.init s.Length (fun i -> uint16 s.[i]) + LexBuffer.FromArrayNoCopy (reportLibraryOnlyFeatures, langVersion, strictIndentation, arr) +#else + LexBuffer.FromArrayNoCopy (reportLibraryOnlyFeatures, langVersion, strictIndentation, s.ToCharArray()) +#endif module GenericImplFragments = - let startInterpret (lexBuffer: LexBuffer) = + let startInterpret (lexBuffer: LexBuffer) = lexBuffer.BufferScanStart <- lexBuffer.BufferScanStart + lexBuffer.LexemeLength lexBuffer.BufferMaxScanLength <- lexBuffer.BufferMaxScanLength - lexBuffer.LexemeLength lexBuffer.BufferScanLength <- 0 lexBuffer.LexemeLength <- 0 lexBuffer.BufferAcceptAction <- -1 - let afterRefill (trans: uint16[][], sentinel, lexBuffer: LexBuffer, scanUntilSentinel, endOfScan, state, eofPos) = + let afterRefill (trans: uint16[][], sentinel, lexBuffer: LexBuffer, scanUntilSentinel, endOfScan, state, eofPos) = // end of file occurs if we couldn't extend the buffer if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then let snew = int trans[state].[eofPos] // == EOF @@ -440,7 +478,7 @@ module GenericImplFragments = else scanUntilSentinel lexBuffer state - let onAccept (lexBuffer: LexBuffer, a) = + let onAccept (lexBuffer: LexBuffer, a) = lexBuffer.LexemeLength <- lexBuffer.BufferScanLength lexBuffer.BufferAcceptAction <- a @@ -455,7 +493,7 @@ type internal UnicodeTables(trans: uint16[] array, accept: uint16[]) = let numSpecificUnicodeChars = (trans[0].Length - 1 - numLowUnicodeChars - numUnicodeCategories) / 2 - let lookupUnicodeCharacters state inp = + let lookupUnicodeCharacters state (inp: LexBufferChar) = let inpAsInt = int inp // Is it a fast ASCII character? if inpAsInt < numLowUnicodeChars then @@ -470,15 +508,19 @@ type internal UnicodeTables(trans: uint16[] array, accept: uint16[]) = // which covers all Unicode characters not covered in other // ways let baseForUnicodeCategories = numLowUnicodeChars + numSpecificUnicodeChars * 2 - let unicodeCategory = System.Char.GetUnicodeCategory(inp) + let unicodeCategory = System.Char.GetUnicodeCategory(char inp) //System.Console.WriteLine("inp = {0}, unicodeCategory = {1}", [| box inp; box unicodeCategory |]); int trans[state].[baseForUnicodeCategories + int32 unicodeCategory] else // This is the specific unicode character - let c = char (int trans[state].[baseForSpecificUnicodeChars + i * 2]) + let c = (int trans[state].[baseForSpecificUnicodeChars + i * 2]) //System.Console.WriteLine("c = {0}, inp = {1}, i = {2}", [| box c; box inp; box i |]); // OK, have we found the entry for a specific unicode character? - if c = inp then +#if FABLE_COMPILER + if c = int inp then +#else + if char c = inp then +#endif int trans[state].[baseForSpecificUnicodeChars + i * 2 + 1] else loop (i + 1) @@ -519,7 +561,7 @@ type internal UnicodeTables(trans: uint16[] array, accept: uint16[]) = // 30 entries, one for each UnicodeCategory // 1 entry for EOF - member tables.Interpret(initialState, lexBuffer: LexBuffer) = + member tables.Interpret(initialState, lexBuffer: LexBuffer) = startInterpret (lexBuffer) scanUntilSentinel lexBuffer initialState diff --git a/src/Compiler/Facilities/prim-lexing.fsi b/src/Compiler/Facilities/prim-lexing.fsi index ff13f96c9e1..950c7dfaeb8 100644 --- a/src/Compiler/Facilities/prim-lexing.fsi +++ b/src/Compiler/Facilities/prim-lexing.fsi @@ -110,6 +110,12 @@ type internal Position = static member FirstLine: fileIdx: int -> Position +#if FABLE_COMPILER +type internal LexBufferChar = uint16 +#else +type internal LexBufferChar = char +#endif + /// Input buffers consumed by lexers generated by fslex.exe. /// The type must be generic to match the code generated by FsLex and FsYacc (if you would like to /// fix this, please submit a PR to the FsLexYacc repository allowing for optional emit of a non-generic type reference). @@ -121,8 +127,10 @@ type internal LexBuffer<'Char> = /// The end position for the lexeme. member EndPos: Position with get, set +#if !FABLE_COMPILER /// The currently matched text as a Span, it is only valid until the lexer is advanced member LexemeView: System.ReadOnlySpan<'Char> +#endif /// Get single character of matched string member LexemeChar: int -> 'Char @@ -130,8 +138,13 @@ type internal LexBuffer<'Char> = /// Determine if Lexeme contains a specific character member LexemeContains: 'Char -> bool +#if FABLE_COMPILER + /// The length of the lexeme. + member LexemeLength: int with get, set +#endif + /// Fast helper to turn the matched characters into a string, avoiding an intermediate array. - static member LexemeString: LexBuffer -> string + static member LexemeString: LexBuffer -> string /// Dynamically typed, non-lexically scoped parameter table. member BufferLocalStore: IDictionary @@ -159,6 +172,9 @@ type internal LexBuffer<'Char> = reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * strictIndentation: bool option * char[] -> LexBuffer + /// Create a lex buffer suitable for Unicode lexing that reads characters from the given string. + static member FromString: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * strictIndentation: bool option * string -> LexBuffer + /// Create a lex buffer that reads character or byte inputs by using the given function. static member FromFunction: reportLibraryOnlyFeatures: bool * @@ -170,7 +186,7 @@ type internal LexBuffer<'Char> = /// Create a lex buffer backed by source text. static member FromSourceText: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * strictIndentation: bool option * ISourceText -> - LexBuffer + LexBuffer /// The type of tables for an unicode lexer generated by fslex.exe. [] @@ -180,4 +196,4 @@ type internal UnicodeTables = static member Create: uint16[][] * uint16[] -> UnicodeTables /// Interpret tables for a unicode lexer generated by fslex.exe. - member Interpret: initialState: int * LexBuffer -> int + member Interpret: initialState: int * LexBuffer -> int diff --git a/src/Compiler/Facilities/prim-parsing.fs b/src/Compiler/Facilities/prim-parsing.fs index 7fb0d7fca41..803da99661d 100644 --- a/src/Compiler/Facilities/prim-parsing.fs +++ b/src/Compiler/Facilities/prim-parsing.fs @@ -7,14 +7,20 @@ namespace Internal.Utilities.Text.Parsing open Internal.Utilities.Text.Lexing open System +#if !FABLE_COMPILER open System.Buffers +#endif exception RecoverableParseError exception Accept of obj [] type internal IParseState +#if FABLE_COMPILER + (ruleStartPoss: Position[], ruleEndPoss: Position[], lhsPos: Position[], ruleValues: objnull[], lexbuf: LexBuffer) = +#else (ruleStartPoss: Position[], ruleEndPoss: Position[], lhsPos: Position[], ruleValues: objnull[], lexbuf: LexBuffer) = +#endif member _.LexBuffer = lexbuf member _.InputRange index = @@ -276,6 +282,10 @@ module internal Implementation = let lhsPos = (Array.zeroCreate 2: Position[]) let reductions = tables.reductions let cacheSize = 7919 // the 1000'th prime +#if FABLE_COMPILER + let actionTableCache = Array.zeroCreate (cacheSize * 2) + let gotoTableCache = Array.zeroCreate (cacheSize * 2) +#else let actionTableCache = ArrayPool.Shared.Rent(cacheSize * 2) let gotoTableCache = ArrayPool.Shared.Rent(cacheSize * 2) @@ -285,6 +295,7 @@ module internal Implementation = ArrayPool.Shared.Return actionTableCache ArrayPool.Shared.Return gotoTableCache } +#endif //!FABLE_COMPILER let actionTable = AssocTable(tables.actionTableElements, tables.actionTableRowOffsets, actionTableCache) diff --git a/src/Compiler/Facilities/prim-parsing.fsi b/src/Compiler/Facilities/prim-parsing.fsi index 4177d66e9a9..4284b3f4564 100644 --- a/src/Compiler/Facilities/prim-parsing.fsi +++ b/src/Compiler/Facilities/prim-parsing.fsi @@ -34,7 +34,7 @@ type internal IParseState = member RaiseError<'b> : unit -> 'b /// Return the LexBuffer for this parser instance. - member LexBuffer : LexBuffer + member LexBuffer : LexBuffer /// The context provided when a parse error occurs. @@ -115,7 +115,7 @@ type internal Tables<'Token> = /// Interpret the parser table taking input from the given lexer, using the given lex buffer, and the given start state. /// Returns an object indicating the final synthesized value for the parse. - member Interpret : lexer:(LexBuffer -> 'Token) * lexbuf:LexBuffer * initialState:int -> obj + member Interpret : lexer:(LexBuffer -> 'Token) * lexbuf:LexBuffer * initialState:int -> obj /// Indicates an accept action has occurred. exception internal Accept of obj diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index a3885384b73..d814232b18d 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -184,24 +184,39 @@ type internal FscCompiler(legacyReferenceResolver) = /// test if --test:ErrorRanges flag is set let errorRangesArg = +#if FABLE_COMPILER + arg.Equals(@"/test:ErrorRanges", StringComparison.OrdinalIgnoreCase) || + arg.Equals(@"--test:ErrorRanges", StringComparison.OrdinalIgnoreCase) +#else let regex = Regex(@"^(/|--)test:ErrorRanges$", RegexOptions.Compiled ||| RegexOptions.IgnoreCase) fun (arg: string) -> regex.IsMatch(arg) +#endif /// test if --vserrors flag is set let vsErrorsArg = +#if FABLE_COMPILER + arg.Equals(@"/vserrors", StringComparison.OrdinalIgnoreCase) || + arg.Equals(@"--vserrors", StringComparison.OrdinalIgnoreCase) +#else let regex = Regex(@"^(/|--)vserrors$", RegexOptions.Compiled ||| RegexOptions.IgnoreCase) fun (arg: string) -> regex.IsMatch(arg) +#endif /// test if an arg is a path to fsc.exe let fscExeArg = +#if FABLE_COMPILER + arg.EndsWith(@"fsc", StringComparison.OrdinalIgnoreCase) || + arg.EndsWith(@"fsc.exe", StringComparison.OrdinalIgnoreCase) +#else let regex = Regex(@"fsc(\.exe)?$", RegexOptions.Compiled ||| RegexOptions.IgnoreCase) fun (arg: string) -> regex.IsMatch(arg) +#endif /// do compilation as if args was argv to fsc.exe member _.Compile(args: string[]) = diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 51d889f5691..9216330cb0f 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -155,7 +155,11 @@ type ValInfos(entries) = if dict.ContainsKey vkey then failwithf "dictionary already contains key %A" vkey dict.Add(vkey, p) +#if FABLE_COMPILER + dict), id) +#else ReadOnlyDictionary dict), id) +#endif member x.Entries = valInfoTable.Force().Values @@ -663,6 +667,11 @@ let GetInfoForNonLocalVal cenv env (vref: ValRef) = if vref.IsDispatchSlot then UnknownValInfo +#if FABLE_COMPILER + // no inlining for FSharp.Core + elif vref.ToString().StartsWith("Microsoft.FSharp.") then + UnknownValInfo +#endif // REVIEW: optionally turn x-module on/off on per-module basis or elif cenv.settings.crossAssemblyOpt () || vref.ShouldInline then match TryGetInfoForNonLocalEntityRef env vref.nlr.EnclosingEntity.nlr with @@ -1740,6 +1749,9 @@ let TryEliminateBinding cenv _env bind e2 _m = // Immediate consumption of value by a pattern match 'let x = e in match x with ...' | Expr.Match (spMatch, _exprm, TDSwitch(DebugPoints(Expr.Val (VRefLocal vspec2, _, _), recreate1), cases, dflt, _), targets, m, ty2) when (valEq vspec1 vspec2 && +#if FABLE_COMPILER + not (ExprHasEffect cenv.g e1) && +#endif let fvs = accFreeInTargets CollectLocals targets (accFreeInSwitchCases CollectLocals cases dflt emptyFreeVars) not (Zset.contains vspec1 fvs.FreeLocals)) -> @@ -3136,7 +3148,12 @@ and OptimizeVal cenv env expr (v: ValRef, m) = e, AddValEqualityInfo g m v einfo | None -> +#if FABLE_COMPILER + // no inlining for FSharp.Core + if v.ShouldInline && not (v.ToString().StartsWith("Microsoft.FSharp.")) then +#else if v.ShouldInline then +#endif match valInfoForVal.ValExprInfo with | UnknownValue -> error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) | _ -> warning(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 1c7878c6df8..9b2f6a8bc08 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -84,6 +84,9 @@ type DelayedILModuleReader = member this.OutputFile = this.name member this.TryGetILModuleReader() = +#if FABLE_COMPILER + cancellable.Return(None) +#else // fast path match box this.result with | null -> @@ -119,6 +122,7 @@ type DelayedILModuleReader = | _ -> Some this.result) } | _ -> cancellable.Return(Some this.result) +#endif //!FABLE_COMPILER [] type FSharpReferencedProject = @@ -202,6 +206,9 @@ module internal FSharpCheckerResultsSettings = GetEnvInteger "FCS_MaxErrorsOutOfProjectContext" 3 // Look for DLLs in the location of the service DLL first. +#if FABLE_COMPILER + let defaultFSharpBinariesDir = "." +#else let defaultFSharpBinariesDir = FSharpEnvironment .BinFolderOfDefaultFSharpCompiler( @@ -209,6 +216,7 @@ module internal FSharpCheckerResultsSettings = |> Option.ofObj ) .Value +#endif [] type FSharpSymbolUse(denv: DisplayEnv, symbol: FSharpSymbol, inst: TyparInstantiation, itemOcc, range: range) = @@ -2791,7 +2799,9 @@ module internal ParseAndCheckFile = // the formatting of types in it may change (for example, 'a to obj) // // So we'll create a diagnostic later, but cache the FormatCore message now +#if !FABLE_COMPILER diagnostic.Exception.Data["CachedFormatCore"] <- diagnostic.FormatCore(flatErrors, suggestNamesForErrors) +#endif diagnosticsCollector.Add(struct (diagnostic, severity)) if severity = FSharpDiagnosticSeverity.Error then @@ -2903,7 +2913,11 @@ module internal ParseAndCheckFile = let tokenizer = LexFilter.LexFilter(indentationSyntaxStatus, options.CompilingFSharpCore, Lexer.token lexargs true, lexbuf, false) +#if FABLE_COMPILER + if false then +#else if ct.CanBeCanceled then +#endif (fun _ -> ct.ThrowIfCancellationRequested() tokenizer.GetToken()) @@ -3074,6 +3088,8 @@ module internal ParseAndCheckFile = errHandler.CollectedDiagnostics(None), parseResult, errHandler.AnyErrors +#if !FABLE_COMPILER + let ApplyLoadClosure ( tcConfig, @@ -3175,6 +3191,8 @@ module internal ParseAndCheckFile = ) |> ignore +#endif //!FABLE_COMPILER + // Type check a single file against an initial context, gleaning both errors and intellisense information. let CheckOneFile ( @@ -3219,15 +3237,19 @@ module internal ParseAndCheckFile = use _unwindBP = UseBuildPhase BuildPhase.TypeCheck +#if !FABLE_COMPILER // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) let tcConfig = ApplyNoWarnsToTcConfig(tcConfig, parsedMainInput, !! Path.GetDirectoryName(mainInputFileName)) +#endif // update the error handler with the modified tcConfig errHandler.DiagnosticOptions <- tcConfig.diagnosticsOptions +#if !FABLE_COMPILER // If additional references were brought in by the preprocessor then we need to process them ApplyLoadClosure(tcConfig, parsedMainInput, mainInputFileName, loadClosure, tcImports, backgroundDiagnostics) +#endif // Typecheck the real input. let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) @@ -3532,7 +3554,11 @@ type FSharpCheckFileResults match pageWidth with | None -> layout +#if FABLE_COMPILER + | Some _pageWidth -> layout +#else | Some pageWidth -> Display.squashTo pageWidth layout +#endif |> LayoutRender.showL |> SourceText.ofString) @@ -3644,6 +3670,8 @@ type FSharpCheckFileResults FSharpCheckFileResults(mainInputFileName, errors, Some tcFileInfo, dependencyFiles, builder, keepAssemblyContents) +#if !FABLE_COMPILER + static member CheckOneFile ( parseResults: FSharpParseFileResults, @@ -3693,6 +3721,8 @@ type FSharpCheckFileResults return results } +#endif //!FABLE_COMPILER + [] // 'details' is an option because the creation of the tcGlobals etc. for the project may have failed. type FSharpCheckProjectResults @@ -3812,6 +3842,10 @@ type FSharpCheckProjectResults let results = match builderOrSymbolUses with | Choice1Of2 builder -> +#if FABLE_COMPILER + ignore builder + [||] +#else builder.SourceFiles |> Array.ofList |> Array.collect (fun x -> @@ -3822,6 +3856,7 @@ type FSharpCheckProjectResults | _ -> [||] | _ -> [||]) |> Array.toSeq +#endif //!FABLE_COMPILER | Choice2Of2 task -> Async.RunSynchronously( async { @@ -3856,6 +3891,10 @@ type FSharpCheckProjectResults let tcSymbolUses = match builderOrSymbolUses with | Choice1Of2 builder -> +#if FABLE_COMPILER + ignore builder + [||] +#else builder.SourceFiles |> Array.ofList |> Array.map (fun x -> @@ -3866,6 +3905,7 @@ type FSharpCheckProjectResults | _ -> TcSymbolUses.Empty | _ -> TcSymbolUses.Empty) |> Array.toSeq +#endif //!FABLE_COMPILER | Choice2Of2 tcSymbolUses -> Async.RunSynchronously(tcSymbolUses, ?cancellationToken = cancellationToken) [| @@ -3901,6 +3941,8 @@ type FSharpCheckProjectResults override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" +#if !FABLE_COMPILER + type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, tcState) = let keepAssemblyContents = false @@ -4017,6 +4059,8 @@ type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobal return parseResults, typeCheckResults, projectResults } +#endif //!FABLE_COMPILER + /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. [] type public FSharpCheckFileAnswer = diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 6b0a7f49135..cba41faac2d 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -245,9 +245,51 @@ type public FSharpParsingOptions = static member internal FromTcConfigBuilder: tcConfigB: TcConfigBuilder * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions +#if FABLE_COMPILER + +[] +type internal TypeCheckInfo = + internal new : + _sTcConfig: TcConfig * + g: TcGlobals * + ccuSigForFile: ModuleOrNamespaceType * + thisCcu: CcuThunk * + tcImports: TcImports * + tcAccessRights: AccessorDomain * + projectFileName: string * + mainInputFileName: string * + projectOptions: FSharpProjectOptions * + sResolutions: TcResolutions * + sSymbolUses: TcSymbolUses * + sFallback: NameResolutionEnv * + loadClosure: LoadClosure option * + implFileOpt: CheckedImplFile option * + openDeclarations: OpenDeclaration[] + -> TypeCheckInfo + member ScopeResolutions: TcResolutions + member ScopeSymbolUses: TcSymbolUses + member TcGlobals: TcGlobals + member TcImports: TcImports + member CcuSigForFile: ModuleOrNamespaceType + member ThisCcu: CcuThunk + member ImplementationFile: CheckedImplFile option + +#endif //FABLE_COMPILER + /// A handle to the results of CheckFileInProject. [] type public FSharpCheckFileResults = +#if FABLE_COMPILER + internal new : + fileName: string * + errors: FSharpDiagnostic[] * + scopeOptX: TypeCheckInfo option * + dependencyFiles: string[] * + builderX: IncrementalBuilder option * + keepAssemblyContents: bool + -> FSharpCheckFileResults +#endif //FABLE_COMPILER + /// The errors returned by parsing a source file. member Diagnostics: FSharpDiagnostic[] @@ -261,8 +303,10 @@ type public FSharpCheckFileResults = /// an unrecoverable error in earlier checking/parsing/resolution steps. member HasFullTypeCheckInfo: bool +#if !FABLE_COMPILER /// Tries to get the current successful TcImports. This is only used in testing. Do not use it for other stuff. member internal TryGetCurrentTcImports: unit -> TcImports option +#endif /// Indicates the set of files which must be watched to accurately track changes that affect these results, /// Clients interested in reacting to updates to these files should watch these files and take actions as described @@ -472,6 +516,7 @@ type public FSharpCheckFileResults = openDeclarations: OpenDeclaration[] -> FSharpCheckFileResults +#if !FABLE_COMPILER /// Internal constructor - check a file and collect errors static member internal CheckOneFile: parseResults: FSharpParseFileResults * @@ -494,6 +539,7 @@ type public FSharpCheckFileResults = keepAssemblyContents: bool * suggestNamesForErrors: bool -> Cancellable +#endif //!FABLE_COMPILER /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. and [] public FSharpCheckFileAnswer = @@ -602,6 +648,8 @@ module internal ParseAndCheckFile = member CollectedDiagnostics: symbolEnv: SymbolEnv option -> FSharpDiagnostic array +#if !FABLE_COMPILER + // An object to typecheck source in a given typechecking environment. // Used internally to provide intellisense over F# Interactive. type internal FsiInteractiveChecker = @@ -613,5 +661,7 @@ type internal FsiInteractiveChecker = sourceText: ISourceText * ?userOpName: string -> Cancellable +#endif //!FABLE_COMPILER + module internal FSharpCheckerResultsSettings = val defaultFSharpBinariesDir: string diff --git a/src/Compiler/Service/FSharpSource.fs b/src/Compiler/Service/FSharpSource.fs index fdcf70c28b9..f7cc8868fff 100644 --- a/src/Compiler/Service/FSharpSource.fs +++ b/src/Compiler/Service/FSharpSource.fs @@ -11,14 +11,18 @@ open FSharp.Compiler.Text [] type TextContainer = | OnDisk +#if !FABLE_COMPILER | Stream of Stream +#endif | SourceText of ISourceText interface IDisposable with member this.Dispose() = match this with +#if !FABLE_COMPILER | Stream stream -> stream.Dispose() +#endif | _ -> () [] @@ -30,6 +34,8 @@ type FSharpSource internal () = abstract GetTextContainer: unit -> Async +#if !FABLE_COMPILER + type private FSharpSourceMemoryMappedFile(filePath: string, timeStamp: DateTime, openStream: unit -> Stream) = inherit FSharpSource() @@ -60,6 +66,8 @@ type private FSharpSourceFromFile(filePath: string) = override _.GetTextContainer() = TextContainer.OnDisk |> async.Return +#endif //!FABLE_COMPILER + type private FSharpSourceCustom(filePath: string, getTimeStamp, getSourceText) = inherit FSharpSource() @@ -82,6 +90,7 @@ type FSharpSource with static member Create(filePath, getTimeStamp, getSourceText) = FSharpSourceCustom(filePath, getTimeStamp, getSourceText) :> FSharpSource +#if !FABLE_COMPILER static member CreateFromFile(filePath: string) = FSharpSourceFromFile(filePath) :> FSharpSource @@ -92,3 +101,4 @@ type FSharpSource with fun () -> FileSystem.OpenFileForReadShim(filePath, useMemoryMappedFile = true, shouldShadowCopy = true) FSharpSourceMemoryMappedFile(filePath, timeStamp, openStream) :> FSharpSource +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Service/FSharpSource.fsi b/src/Compiler/Service/FSharpSource.fsi index 6bdabbdedf1..2475f68f3a8 100644 --- a/src/Compiler/Service/FSharpSource.fsi +++ b/src/Compiler/Service/FSharpSource.fsi @@ -9,7 +9,9 @@ open FSharp.Compiler.Text [] type internal TextContainer = | OnDisk +#if !FABLE_COMPILER | Stream of Stream +#endif | SourceText of ISourceText interface IDisposable @@ -28,11 +30,13 @@ type internal FSharpSource = /// Gets the internal text container. Text may be on-disk, in a stream, or a source text. abstract GetTextContainer: unit -> Async +#if !FABLE_COMPILER /// Creates a FSharpSource from disk. Only used internally. static member internal CreateFromFile: filePath: string -> FSharpSource /// Creates a FSharpSource from the specified file path by shadow-copying the file. static member CreateCopyFromFile: filePath: string -> FSharpSource +#endif //!FABLE_COMPILER /// Creates a FSharpSource. static member Create: diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 872b27fdcd9..1814573d161 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -19,8 +19,10 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions +#if !FABLE_COMPILER open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.DiagnosticsLogger @@ -38,6 +40,20 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.BuildGraph +#if FABLE_COMPILER + +// stub +type IncrementalBuilder() = + member x.IncrementUsageCount () = + { new System.IDisposable with member _.Dispose() = () } + member x.IsAlive = false + static member KeepBuilderAlive (builderOpt: IncrementalBuilder option) = + match builderOpt with + | Some builder -> builder.IncrementUsageCount() + | None -> { new System.IDisposable with member _.Dispose() = () } + +#else //!FABLE_COMPILER + [] module internal IncrementalBuild = @@ -1675,3 +1691,5 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc return builderOpt, diagnostics } + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index 0f8ed5582da..f35c860cb65 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -10,7 +10,9 @@ open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.DiagnosticsLogger @@ -35,6 +37,16 @@ type internal FrameworkImportsCacheKey = interface ICacheKey +#if FABLE_COMPILER +// stub +[] +type internal IncrementalBuilder = + member IncrementUsageCount : unit -> IDisposable + member IsAlive : bool + static member KeepBuilderAlive : IncrementalBuilder option -> IDisposable + +#else //!FABLE_COMPILER + /// Lookup the global static cache for building the FrameworkTcImports type internal FrameworkImportsCache = new: size: int -> FrameworkImportsCache @@ -304,3 +316,5 @@ module internal IncrementalBuild = /// Used for unit testing. Causes all steps of underlying incremental graph evaluation to cancel val LocallyInjectCancellationFault: unit -> IDisposable + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Service/QuickParse.fs b/src/Compiler/Service/QuickParse.fs index ddb7d13f126..391eff0fe19 100644 --- a/src/Compiler/Service/QuickParse.fs +++ b/src/Compiler/Service/QuickParse.fs @@ -61,7 +61,12 @@ module QuickParse = else tokenTag + +#if FABLE_COMPILER + let rec isValidStrippedName (name: string) idx = +#else let rec isValidStrippedName (name: ReadOnlySpan) idx = +#endif if idx = name.Length then false elif IsIdentifierPartCharacter name[idx] then true else isValidStrippedName name (idx + 1) @@ -74,8 +79,13 @@ module QuickParse = // Strip the surrounding bars (e.g. from "|xyz|_|") to get "xyz" match name.StartsWithOrdinal("|"), name.EndsWithOrdinal("|_|"), name.EndsWithOrdinal("|") with +#if FABLE_COMPILER + | true, true, _ when name.Length > 4 -> isValidStrippedName (name.Substring(1, name.Length - 4)) 0 + | true, _, true when name.Length > 2 -> isValidStrippedName (name.Substring(1, name.Length - 2)) 0 +#else | true, true, _ when name.Length > 4 -> isValidStrippedName (name.AsSpan(1, name.Length - 4)) 0 | true, _, true when name.Length > 2 -> isValidStrippedName (name.AsSpan(1, name.Length - 2)) 0 +#endif | _ -> false let GetCompleteIdentifierIslandImplAux (lineStr: string) (index: int) : (string * int * bool) option = diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index 3de24222311..fc45cb6fd3d 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -392,7 +392,11 @@ module TcResolutionsExtensions = formatSpecifierLocations |> Array.map (fun (m, _) -> SemanticClassificationItem((m, SemanticClassificationType.Printf))) +#if FABLE_COMPILER + results.AddRange(locs :> IEnumerable) +#else results.AddRange(locs) +#endif results.ToArray()) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetSemanticClassification: '%s'" msg) diff --git a/src/Compiler/Service/ServiceAssemblyContent.fs b/src/Compiler/Service/ServiceAssemblyContent.fs index f1b3bf2ee16..49c63aa31bd 100644 --- a/src/Compiler/Service/ServiceAssemblyContent.fs +++ b/src/Compiler/Service/ServiceAssemblyContent.fs @@ -118,6 +118,8 @@ type IAssemblyContentCache = abstract TryGet: AssemblyPath -> AssemblyContentCacheEntry option abstract Set: AssemblyPath -> AssemblyContentCacheEntry -> unit +#if !FABLE_COMPILER + module AssemblyContent = let UnresolvedSymbol (topRequireQualifiedAccessParent: ShortIdents option) (cleanedIdents: ShortIdents) (fullName: string) ns = @@ -314,6 +316,8 @@ module AssemblyContent = | Full -> true | Public -> entity.Symbol.Accessibility.IsPublic) +#endif //!FABLE_COMPILER + type EntityCache() = let dic = Dictionary() interface IAssemblyContentCache with @@ -325,4 +329,3 @@ type EntityCache() = member _.Clear() = dic.Clear() member x.Locking f = lock dic <| fun _ -> f (x :> IAssemblyContentCache) - diff --git a/src/Compiler/Service/ServiceAssemblyContent.fsi b/src/Compiler/Service/ServiceAssemblyContent.fsi index 09756eee2e5..5346fc3eab2 100644 --- a/src/Compiler/Service/ServiceAssemblyContent.fsi +++ b/src/Compiler/Service/ServiceAssemblyContent.fsi @@ -88,6 +88,8 @@ type public EntityCache = /// Performs an operation on the cache in thread safe manner. member Locking: (IAssemblyContentCache -> 'T) -> 'T +#if !FABLE_COMPILER + /// Provides assembly content. module public AssemblyContent = @@ -101,3 +103,6 @@ module public AssemblyContent = fileName: string option -> assemblies: FSharpAssembly list -> AssemblySymbol list + +#endif //!FABLE_COMPILER + diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index 083bae1d6d8..91498ea7999 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -874,7 +874,11 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi // Process: anywhite* # let processDirective (str: string) directiveLength delay cont = +#if FABLE_COMPILER + let hashIdx = str.IndexOf("#") +#else let hashIdx = str.IndexOf("#", StringComparison.Ordinal) +#endif if (hashIdx <> 0) then delay (WHITESPACE cont, 0, hashIdx - 1) diff --git a/src/Compiler/Service/ServiceLexing.fsi b/src/Compiler/Service/ServiceLexing.fsi index ee2ab7411d5..f2d85b80a96 100755 --- a/src/Compiler/Service/ServiceLexing.fsi +++ b/src/Compiler/Service/ServiceLexing.fsi @@ -7,6 +7,7 @@ open System.Threading open FSharp.Compiler open FSharp.Compiler.Text open FSharp.Compiler.Features +open Internal.Utilities.Text.Lexing #nowarn "57" @@ -337,7 +338,7 @@ type FSharpSourceTokenizer = member CreateLineTokenizer: lineText: string -> FSharpLineTokenizer /// Create a tokenizer for a line of this source file using a buffer filler - member CreateBufferTokenizer: bufferFiller: (char[] * int * int -> int) -> FSharpLineTokenizer + member CreateBufferTokenizer: bufferFiller: (LexBufferChar[] * int * int -> int) -> FSharpLineTokenizer module internal TestExpose = val TokenInfo: Parser.token -> FSharpTokenColorKind * FSharpTokenCharKind * FSharpTokenTriggerClass diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 2ed457116b6..e9bca75e148 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -1006,9 +1006,23 @@ module ParsedInput = //-------------------------------------------------------------------------------------------- // TryGetCompletionContext +#if FABLE_COMPILER + let rec findMatches (prefix: string) (suffix: string) (str: string) (startIndex: int) = seq { + let i1 = str.IndexOf(prefix, startIndex) + if i1 >= 0 then + let i2 = str.IndexOf(suffix, i1 + prefix.Length) + if i2 >= 0 then + let index = i1 + prefix.Length + let count = i2 - index + let start = i2 + suffix.Length + yield index, count + yield! findMatches prefix suffix str start + } +#else /// Matches the most nested [< and >] pair. let insideAttributeApplicationRegex = Regex(@"(?<=\[\<)(?(.*?))(?=\>\])", RegexOptions.Compiled ||| RegexOptions.ExplicitCapture) +#endif // Categorise via attributes let (|Class|Interface|Struct|Unknown|Invalid|) synAttributes = @@ -1238,6 +1252,26 @@ module ParsedInput = let isLongIdent (lid: string) = lid |> Seq.forall (fun c -> IsIdentifierPartCharacter c || c = '.' || c = ':') // ':' may occur in "[]" +#if FABLE_COMPILER + // match the most nested paired [< and >] first + let matches = + findMatches "[<" ">]" lineStr 0 + |> Seq.filter (fun (m_Index, m_Length) -> m_Index <= pos.Column && m_Index + m_Length >= pos.Column) + |> Seq.toArray + + if not (Array.isEmpty matches) then + matches + |> Seq.tryPick (fun (m_Index, m_Length) -> + let col = pos.Column - m_Index + if col >= 0 && col < m_Length then + let str = lineStr.Substring(m_Index, m_Length) + let str = str.Substring(0, col).TrimStart() // cut other rhs attributes + let str = cutLeadingAttributes str + if isLongIdent str then + Some CompletionContext.AttributeApplication + else None + else None) +#else //!FABLE_COMPILER // match the most nested paired [< and >] first let matches = insideAttributeApplicationRegex.Matches lineStr @@ -1261,9 +1295,14 @@ module ParsedInput = None else None) +#endif //!FABLE_COMPILER else // Paired [< and >] were not found, try to determine that we are after [< without closing >] +#if FABLE_COMPILER + match lineStr.LastIndexOf("[<") with +#else match lineStr.LastIndexOf("[<", StringComparison.Ordinal) with +#endif | -1 -> None | openParenIndex when pos.Column >= openParenIndex + 2 -> let str = lineStr[openParenIndex + 2 .. pos.Column - 1].TrimStart() diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 4835b784bf8..1145e896698 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -15,16 +15,22 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILDynamicAssemblyWriter +#endif open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CodeAnalysis.TransparentCompiler open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics +#if !FABLE_COMPILER open FSharp.Compiler.Driver +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.ParseAndCheckInputs @@ -37,6 +43,8 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TcGlobals open FSharp.Compiler.BuildGraph +#if !FABLE_COMPILER + /// Callback that indicates whether a requested result has become obsolete. [] type IsResultObsolete = IsResultObsolete of (unit -> bool) @@ -754,3 +762,5 @@ type CompilerEnvironment() = singleFileProjectExtensions |> List.exists (fun e -> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index 58c4a8c1dfb..d06f95a2065 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -19,6 +19,8 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Tokenization +#if !FABLE_COMPILER + /// Used to parse and check F# source code. [] type public FSharpChecker = @@ -547,3 +549,5 @@ type public CompilerEnvironment = /// Whether or not this file should be a single-file project static member MustBeSingleFileProject: string -> bool + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index 5ec81f6861d..b5c6e894b96 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -516,6 +516,9 @@ module FSharpExprConvert = // let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) // in FSharp.Core. | ErrorResult _ when vref.LogicalName = "op_LeftShift" && List.isSingleton tyargs -> [] +#if FABLE_COMPILER + | ErrorResult (warns, err) -> ReportWarnings (err::warns); [] // temporary, ignores the error +#endif | res -> CommitOperationResult res let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> @@ -1252,8 +1255,13 @@ module FSharpExprConvert = | Const.UInt32 i -> E.Const(box i, tyR) | Const.Int64 i -> E.Const(box i, tyR) | Const.UInt64 i -> E.Const(box i, tyR) +#if FABLE_COMPILER + | Const.IntPtr i -> E.Const(box i, tyR) + | Const.UIntPtr i -> E.Const(box i, tyR) +#else | Const.IntPtr i -> E.Const(box (nativeint i), tyR) | Const.UIntPtr i -> E.Const(box (unativeint i), tyR) +#endif | Const.Decimal i -> E.Const(box i, tyR) | Const.Double i -> E.Const(box i, tyR) | Const.Single i -> E.Const(box i, tyR) diff --git a/src/Compiler/Symbols/Exprs.fsi b/src/Compiler/Symbols/Exprs.fsi index fddc3d0ea4e..c0d21e4773c 100644 --- a/src/Compiler/Symbols/Exprs.fsi +++ b/src/Compiler/Symbols/Exprs.fsi @@ -11,6 +11,9 @@ open FSharp.Compiler.TypedTree /// Represents the definitional contents of an assembly, as seen by the F# language type public FSharpAssemblyContents = +#if FABLE_COMPILER + internal new : cenv: SymbolEnv * mimpls: CheckedImplFile list -> FSharpAssemblyContents +#endif internal new: tcGlobals: TcGlobals * thisCcu: CcuThunk * diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index 31ec0536c3e..78283463ff1 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -204,9 +204,13 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str | _ -> None let msg = +#if FABLE_COMPILER + diagnostic.FormatCore(flatErrors, suggestNames) +#else match diagnostic.Exception.Data["CachedFormatCore"] with | :? string as message -> message | _ -> diagnostic.FormatCore(flatErrors, suggestNames) +#endif let errorNum = diagnostic.Number FSharpDiagnostic(m, severity, msg, diagnostic.Subcategory(), errorNum, "FS", extendedData) diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index 1fedee2968a..4ecdf648691 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -221,6 +221,12 @@ module internal SymbolHelpers = let fileNameOfItem (g: TcGlobals) qualProjectDir (m: range) h = let file = m.FileName if verbose then dprintf "file stored in metadata is '%s'\n" file +#if FABLE_COMPILER + ignore g + ignore qualProjectDir + ignore h + file +#else if not (FileSystem.IsPathRootedShim file) then match ccuOfItem g h with | Some ccu -> @@ -230,6 +236,7 @@ module internal SymbolHelpers = | None -> file | Some dir -> Path.Combine(dir, file) else file +#endif let ParamNameAndTypesOfUnaryCustomOperation g minfo = match minfo with diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 36823f65dc0..1220a777293 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -82,7 +82,11 @@ module Impl = f let makeReadOnlyCollection (arr: seq<'T>) = +#if FABLE_COMPILER + System.Collections.Generic.List<_>(arr) :> IList<_> +#else System.Collections.ObjectModel.ReadOnlyCollection<_>(Seq.toArray arr) :> IList<_> +#endif let makeXmlDoc (doc: XmlDoc) = FSharpXmlDoc.FromXmlText doc @@ -2305,7 +2309,9 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member _.IsValCompiledAsMethod = match d with +#if !FABLE_COMPILER | V vref -> IlxGen.IsFSharpValCompiledAsMethod cenv.g vref.Deref +#endif | _ -> false member _.IsValue = @@ -2811,7 +2817,11 @@ type FSharpAttribute(cenv: SymbolEnv, attrib: AttribInfo) = member attr.IsAttribute<'T> () = // CompiledName throws exception on DataContractAttribute generated by SQLProvider +#if FABLE_COMPILER + try attr.AttributeType.CompiledName.EndsWith("Attribute") with _ -> false +#else try attr.AttributeType.CompiledName = typeof<'T>.Name with _ -> false +#endif #if !NO_TYPEPROVIDERS type FSharpStaticParameter(cenv, sp: Tainted< TypeProviders.ProvidedParameterInfo >, m) = diff --git a/src/Compiler/SyntaxTree/LexFilter.fsi b/src/Compiler/SyntaxTree/LexFilter.fsi index 7d39b8325df..0e469a9a362 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fsi +++ b/src/Compiler/SyntaxTree/LexFilter.fsi @@ -21,13 +21,13 @@ type LexFilter = new: indentationSyntaxStatus: IndentationAwareSyntaxStatus * compilingFSharpCore: bool * - lexer: (LexBuffer -> token) * - lexbuf: LexBuffer * + lexer: (LexBuffer -> token) * + lexbuf: LexBuffer * debug: bool -> LexFilter /// The LexBuffer associated with the filter - member LexBuffer: LexBuffer + member LexBuffer: LexBuffer /// Get the next token member GetToken: unit -> token diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index f7f090a6b00..ca9a361e33e 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -130,7 +130,11 @@ let usingLexbufForParsing (lexbuf: Lexbuf, fileName) f = //----------------------------------------------------------------------- let stringBufferAsString (buf: ByteBuffer) = +#if FABLE_COMPILER + let buf = buf.Close() +#else let buf = buf.AsMemory() +#endif if buf.Length % 2 <> 0 then failwith "Expected even number of bytes" @@ -138,8 +142,13 @@ let stringBufferAsString (buf: ByteBuffer) = let chars: char[] = Array.zeroCreate (buf.Length / 2) for i = 0 to (buf.Length / 2) - 1 do +#if FABLE_COMPILER + let hi = buf[i*2+1] + let lo = buf[i*2] +#else let hi = buf.Span[i * 2 + 1] let lo = buf.Span[i * 2] +#endif let c = char (((int hi) * 256) + (int lo)) chars[i] <- c @@ -151,8 +160,13 @@ let stringBufferAsString (buf: ByteBuffer) = /// we just take every second byte we stored. Note all bytes > 127 should have been /// stored using addIntChar let stringBufferAsBytes (buf: ByteBuffer) = +#if FABLE_COMPILER + let bytes = buf.Close() + Array.init (bytes.Length / 2) (fun i -> bytes[i*2]) +#else let bytes = buf.AsMemory() Array.init (bytes.Length / 2) (fun i -> bytes.Span[i * 2]) +#endif [] type LexerStringFinisherContext = @@ -226,7 +240,11 @@ type LargerThan127ButInsideByte = int /// Sanity check that high bytes are zeros. Further check each low byte <= 127 let errorsInByteStringBuffer (buf: ByteBuffer) = +#if FABLE_COMPILER + let bytes = buf.Close() +#else let bytes = buf.AsMemory() +#endif assert (bytes.Length % 2 = 0) // Enhancement?: return faulty values? @@ -238,10 +256,17 @@ let errorsInByteStringBuffer (buf: ByteBuffer) = let mutable largerThan127ButSingleByteCount = 0 for i = 0 to bytes.Length / 2 - 1 do +#if FABLE_COMPILER + if bytes[i * 2 + 1] <> 0uy then + largerThanOneByteCount <- largerThanOneByteCount + 1 + elif bytes[i * 2] > 127uy then + largerThan127ButSingleByteCount <- largerThan127ButSingleByteCount + 1 +#else if bytes.Span[i * 2 + 1] <> 0uy then largerThanOneByteCount <- largerThanOneByteCount + 1 elif bytes.Span[i * 2] > 127uy then largerThan127ButSingleByteCount <- largerThan127ButSingleByteCount + 1 +#endif if largerThanOneByteCount + largerThan127ButSingleByteCount > 0 then Some(largerThanOneByteCount, largerThan127ButSingleByteCount) diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index 1c0428eb835..f46002caa0f 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -199,10 +199,11 @@ and LexCont = LexerContinuation // Parse IL assembly code //------------------------------------------------------------------------ -let ParseAssemblyCodeInstructions s reportLibraryOnlyFeatures langVersion strictIndentation m : IL.ILInstr[] = +let ParseAssemblyCodeInstructions (s: string) (reportLibraryOnlyFeatures: bool) (langVersion: LanguageVersion) (strictIndentation: bool option) m : IL.ILInstr[] = #if NO_INLINE_IL_PARSER ignore s - ignore isFeatureSupported + ignore reportLibraryOnlyFeatures + ignore langVersion errorR (Error((193, "Inline IL not valid in a hosted environment"), m)) [||] @@ -214,10 +215,14 @@ let ParseAssemblyCodeInstructions s reportLibraryOnlyFeatures langVersion strict [||] #endif -let ParseAssemblyCodeType s reportLibraryOnlyFeatures langVersion strictIndentation m = +let ParseAssemblyCodeType (s: string) (reportLibraryOnlyFeatures: bool) (langVersion: LanguageVersion) (strictIndentation: bool option) m = ignore s #if NO_INLINE_IL_PARSER + ignore s + ignore reportLibraryOnlyFeatures + ignore langVersion + errorR (Error((193, "Inline IL not valid in a hosted environment"), m)) IL.PrimaryAssemblyILGlobals.typ_Object #else diff --git a/src/Compiler/SyntaxTree/PrettyNaming.fs b/src/Compiler/SyntaxTree/PrettyNaming.fs index 8ea10266de8..10712039e15 100755 --- a/src/Compiler/SyntaxTree/PrettyNaming.fs +++ b/src/Compiler/SyntaxTree/PrettyNaming.fs @@ -817,7 +817,11 @@ let CompilerGeneratedName nm = nm + compilerGeneratedMarker let GetBasicNameOfPossibleCompilerGeneratedName (name: string) = +#if FABLE_COMPILER + match name.IndexOf(compilerGeneratedMarker) with +#else match name.IndexOf(compilerGeneratedMarker, StringComparison.Ordinal) with +#endif | -1 | 0 -> name | n -> name[0 .. n - 1] diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fs b/src/Compiler/SyntaxTree/UnicodeLexing.fs index 5a2d4393ee7..8af188efa8e 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fs +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fs @@ -6,20 +6,35 @@ module internal FSharp.Compiler.UnicodeLexing open System.IO open Internal.Utilities.Text.Lexing -type Lexbuf = LexBuffer +type Lexbuf = LexBuffer let StringAsLexbuf (reportLibraryOnlyFeatures, langVersion, strictIndentation, s: string) = +#if FABLE_COMPILER + LexBuffer + .FromString(reportLibraryOnlyFeatures, langVersion, strictIndentation, s) +#else LexBuffer .FromChars(reportLibraryOnlyFeatures, langVersion, strictIndentation, s.ToCharArray()) +#endif let FunctionAsLexbuf (reportLibraryOnlyFeatures, langVersion, strictIndentation, bufferFiller) = +#if FABLE_COMPILER + LexBuffer +#else LexBuffer +#endif .FromFunction(reportLibraryOnlyFeatures, langVersion, strictIndentation, bufferFiller) let SourceTextAsLexbuf (reportLibraryOnlyFeatures, langVersion, strictIndentation, sourceText) = +#if FABLE_COMPILER + LexBuffer +#else LexBuffer +#endif .FromSourceText(reportLibraryOnlyFeatures, langVersion, strictIndentation, sourceText) +#if !FABLE_COMPILER + let StreamReaderAsLexbuf (reportLibraryOnlyFeatures, langVersion, strictIndentation, reader: StreamReader) = let mutable isFinished = false @@ -39,3 +54,5 @@ let StreamReaderAsLexbuf (reportLibraryOnlyFeatures, langVersion, strictIndentat else nBytesRead ) + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fsi b/src/Compiler/SyntaxTree/UnicodeLexing.fsi index 80d772e03e1..46c9980ade0 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fsi +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fsi @@ -7,7 +7,7 @@ open FSharp.Compiler.Features open FSharp.Compiler.Text open Internal.Utilities.Text.Lexing -type Lexbuf = LexBuffer +type Lexbuf = LexBuffer val StringAsLexbuf: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * strictIndentation: bool option * string -> Lexbuf @@ -16,7 +16,7 @@ val FunctionAsLexbuf: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * strictIndentation: bool option * - bufferFiller: (char[] * int * int -> int) -> + bufferFiller: (LexBufferChar[] * int * int -> int) -> Lexbuf val SourceTextAsLexbuf: @@ -26,6 +26,8 @@ val SourceTextAsLexbuf: sourceText: ISourceText -> Lexbuf +#if !FABLE_COMPILER + /// Will not dispose of the stream reader. val StreamReaderAsLexbuf: reportLibraryOnlyFeatures: bool * @@ -33,3 +35,5 @@ val StreamReaderAsLexbuf: strictIndentation: bool option * reader: StreamReader -> Lexbuf + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/SyntaxTree/XmlDoc.fs b/src/Compiler/SyntaxTree/XmlDoc.fs index a366a69a8a6..9d91417ae69 100644 --- a/src/Compiler/SyntaxTree/XmlDoc.fs +++ b/src/Compiler/SyntaxTree/XmlDoc.fs @@ -4,9 +4,11 @@ namespace FSharp.Compiler.Xml open System open System.Collections.Generic +#if !FABLE_COMPILER open System.IO open System.Xml open System.Xml.Linq +#endif open Internal.Utilities.Library open Internal.Utilities.Collections open FSharp.Compiler.DiagnosticsLogger @@ -65,6 +67,7 @@ type XmlDoc(unprocessedLines: string[], range: range) = else doc.GetElaboratedXmlLines() |> String.concat Environment.NewLine +#if !FABLE_COMPILER member doc.Check(paramNamesOpt: string list option) = try // We must wrap with in order to have only one root element @@ -117,6 +120,7 @@ type XmlDoc(unprocessedLines: string[], range: range) = with e -> warning (Error(FSComp.SR.xmlDocBadlyFormed (e.Message), doc.Range)) +#endif //!FABLE_COMPILER // Discriminated unions can't contain statics, so we use a separate type and XmlDocStatics() = @@ -225,8 +229,10 @@ type PreXmlDoc = let m = Array.reduce unionRanges (Array.map snd preLines) let doc = XmlDoc(lines, m) +#if !FABLE_COMPILER if check then doc.Check(paramNamesOpt) +#endif doc @@ -262,6 +268,19 @@ type PreXmlDoc = static member Merge a b = PreXmlMerge(a, b) +#if FABLE_COMPILER + +[] +type XmlDocumentationInfo () = + member _.TryGetXmlDocBySig(xmlDocSig: string): XmlDoc option = + ignore xmlDocSig + None + static member TryCreateFromFile(xmlFileName: string): XmlDocumentationInfo option = + ignore xmlFileName + None + +#else //!FABLE_COMPILER + [] type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument option) = @@ -337,6 +356,8 @@ type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument option Some(XmlDocumentationInfo(tryGetXmlDocument)) +#endif //!FABLE_COMPILER + type IXmlDocumentationInfoLoader = abstract TryLoad: assemblyFileName: string -> XmlDocumentationInfo option diff --git a/src/Compiler/SyntaxTree/XmlDoc.fsi b/src/Compiler/SyntaxTree/XmlDoc.fsi index 33b168786cc..3f06817b5d6 100644 --- a/src/Compiler/SyntaxTree/XmlDoc.fsi +++ b/src/Compiler/SyntaxTree/XmlDoc.fsi @@ -13,8 +13,10 @@ type public XmlDoc = /// Merge two XML documentation static member Merge: doc1: XmlDoc -> doc2: XmlDoc -> XmlDoc +#if !FABLE_COMPILER /// Check the XML documentation member internal Check: paramNamesOpt: string list option -> unit +#endif /// Get the lines after insertion of implicit summary tags and encoding member GetElaboratedXmlLines: unit -> string[] diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index 12dda2b08d8..86b01bce713 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -67,12 +67,24 @@ type internal CompilerGlobalState () = type Unique = int64 //++GLOBAL MUTABLE STATE (concurrency-safe) +#if FABLE_COMPILER +let newUnique = + let i = ref 0L + fun () -> i.Value <- i.Value + 1L; i.Value +#else let mutable private uniqueCount = 0L let newUnique() = System.Threading.Interlocked.Increment &uniqueCount +#endif /// Unique name generator for stamps attached to to val_specs, tycon_specs etc. //++GLOBAL MUTABLE STATE (concurrency-safe) +#if FABLE_COMPILER +let newStamp = + let i = ref 0L + fun () -> i.Value <- i.Value + 1L; i.Value +#else let mutable private stampCount = 0L let newStamp() = let stamp = System.Threading.Interlocked.Increment &stampCount - stamp \ No newline at end of file + stamp +#endif diff --git a/src/Compiler/TypedTree/QuotationPickler.fs b/src/Compiler/TypedTree/QuotationPickler.fs index f2a58203ec6..5580a5120a9 100644 --- a/src/Compiler/TypedTree/QuotationPickler.fs +++ b/src/Compiler/TypedTree/QuotationPickler.fs @@ -317,10 +317,12 @@ module SimplePickle = p_int32 len st st.os.EmitBytes s +#if !FABLE_COMPILER let p_memory (s:ReadOnlyMemory) st = let len = s.Length p_int32 len st st.os.EmitMemory s +#endif let prim_pstring (s:string) st = let bytes = Encoding.UTF8.GetBytes s @@ -379,7 +381,11 @@ module SimplePickle = ostrings=Table<_>.Create() } let stringTab, phase1bytes = p x st1 +#if FABLE_COMPILER + st1.ostrings.AsList, st1.os.Close() +#else st1.ostrings.AsList, st1.os.AsMemory() +#endif let phase2data = (stringTab, phase1bytes) @@ -387,6 +393,11 @@ module SimplePickle = { os = ByteBuffer.Create(PickleBufferCapacity, useArrayPool = true) ostrings=Table<_>.Create() } let phase2bytes = +#if FABLE_COMPILER + p_tup2 (p_list prim_pstring) p_bytes phase2data st2 + st2.os.Close() + phase2bytes +#else p_tup2 (p_list prim_pstring) p_memory phase2data st2 st2.os.AsMemory() @@ -394,6 +405,7 @@ module SimplePickle = (st1.os :> IDisposable).Dispose() (st2.os :> IDisposable).Dispose() finalBytes +#endif open SimplePickle diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 4f4a45c735e..7a51c6d7160 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -9,7 +9,9 @@ module internal FSharp.Compiler.TcGlobals open System.Collections.Concurrent +#if !FABLE_COMPILER open System.Linq +#endif open System.Diagnostics open Internal.Utilities.Library @@ -1112,7 +1114,11 @@ type TcGlobals( member _.tryFindSysTypeCcuHelper: string list -> string -> bool -> FSharp.Compiler.TypedTree.CcuThunk option = tryFindSysTypeCcuHelper member _.tryRemoveEmbeddedILTypeDefs () = [ +#if FABLE_COMPILER + for key in embeddedILTypeDefs.Keys do +#else for key in embeddedILTypeDefs.Keys.OrderBy id do +#endif match (embeddedILTypeDefs.TryRemove(key)) with | true, ilTypeDef -> yield ilTypeDef | false, _ -> () diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 11ff117cc25..839f1f72643 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2546,7 +2546,11 @@ type TyparConstraint = override x.ToString() = sprintf "%+A" x +#if FABLE_COMPILER +[] +#else [] +#endif type TraitWitnessInfo = | TraitWitnessInfo of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTy: TType option @@ -2561,6 +2565,13 @@ type TraitWitnessInfo = override x.ToString() = "TraitWitnessInfo(" + x.MemberName + ")" +#if FABLE_COMPILER + override x.GetHashCode() = hash x.MemberName + override x.Equals(_y: obj) = false // not used + interface System.IComparable with + member x.CompareTo(_y: obj) = -1 // not used +#endif + /// The specification of a member constraint that must be solved [] type TraitConstraintInfo = diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 82a0a8d84c4..4410bca2bc1 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -13,7 +13,9 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text +#if !FABLE_COMPILER open FSharp.Compiler.TypeProviders +#endif open FSharp.Compiler.Xml open FSharp.Core.CompilerServices @@ -1705,7 +1707,11 @@ type TyparConstraint = override ToString: unit -> string +#if FABLE_COMPILER +[] +#else [] +#endif type TraitWitnessInfo = | TraitWitnessInfo of tys: TTypes * @@ -1716,6 +1722,12 @@ type TraitWitnessInfo = override ToString: unit -> string +#if FABLE_COMPILER + override Equals: System.Object -> bool + override GetHashCode: unit -> int + interface System.IComparable +#endif + [] member DebugText: string diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index 582d6767d7e..1899f7b81d7 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -13,7 +13,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Syntax open FSharp.Compiler.TypedTree -#if DEBUG +#if DEBUG && !FABLE_COMPILER assert (sizeof = 8) assert (sizeof = 8) assert (sizeof = 4) @@ -555,4 +555,3 @@ let combineAccess access1 access2 = exception Duplicate of string * string * range exception NameClash of string * string * string * range * string * string * range - diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index e2bc362c784..e43fcd3ad68 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10215,7 +10215,11 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = match v1, v2 with | Expr.Const (Const.Char x1, m, ty), Expr.Const (Const.Char x2, _, _) -> +#if FABLE_COMPILER + Expr.Const (Const.Char (char (int x1 - int x2)), m, ty) +#else Expr.Const (Const.Char (x1 - x2), m, ty) +#endif | _ -> EvalArithBinOp (Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-)) v1 v2 | SpecificBinopExpr g g.unchecked_multiply_vref (arg1, arg2) -> @@ -11424,6 +11428,23 @@ let CombineCcuContentFragments l = /// An immutable mapping from witnesses to some data. /// /// Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see EmptyTraitWitnessInfoHashMap +#if FABLE_COMPILER +type TraitWitnessInfoHashMap<'T> = Internal.Utilities.Collections.Tagged.Map + +/// Create an empty immutable mapping from witnesses to some data +let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = + let comparer = + { new IComparer with + member _.Compare(x, y) = + let xhash = hash x + let yhash = hash y + let equals x y = traitKeysAEquiv g TypeEquivEnv.Empty x y + if xhash = yhash + then if equals x y then 0 else -1 + else if xhash < yhash then -1 else 1 + } + Internal.Utilities.Collections.Tagged.Map<_,_>.FromList(comparer, []) +#else //!FABLE_COMPILER type TraitWitnessInfoHashMap<'T> = ImmutableDictionary /// Create an empty immutable mapping from witnesses to some data @@ -11433,6 +11454,7 @@ let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = member _.Equals(a, b) = nullSafeEquality a b (fun a b -> traitKeysAEquiv g TypeEquivEnv.Empty a b) member _.GetHashCode(a) = hash a.MemberName }) +#endif //!FABLE_COMPILER [] let (|WhileExpr|_|) expr = @@ -11849,6 +11871,8 @@ and visitVal (v: Val) : TypedTreeNode = Children = Seq.toList children } +#if !FABLE_COMPILER + let rec serializeNode (writer: IndentedTextWriter) (addTrailingComma:bool) (node: TypedTreeNode) = writer.WriteLine("{") // Add indent after opening { @@ -11915,6 +11939,8 @@ let updateSeqTypeIsPrefix (fsharpCoreMSpec: ModuleOrNamespace) = ) ) +#endif //!FABLE_COMPILER + let isTyparOrderMismatch (tps: Typars) (argInfos: CurriedArgInfos) = let rec getTyparName (ty: TType) : string list = match ty with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 10f66bf63bf..4ff2084049b 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2726,7 +2726,11 @@ val GetTraitWitnessInfosOfTypars: TcGlobals -> numParentTypars: int -> typars: T /// An immutable mapping from witnesses to some data. /// /// Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see EmptyTraitWitnessInfoHashMap +#if FABLE_COMPILER +type TraitWitnessInfoHashMap<'T> = Internal.Utilities.Collections.Tagged.Map +#else type TraitWitnessInfoHashMap<'T> = ImmutableDictionary +#endif /// Create an empty immutable mapping from witnesses to some data val EmptyTraitWitnessInfoHashMap: TcGlobals -> TraitWitnessInfoHashMap<'T> @@ -2913,6 +2917,8 @@ val tryAddExtensionAttributeIfNotAlreadyPresentForType: typeEntity: Entity -> Entity +#if !FABLE_COMPILER + /// Serialize an entity to a very basic json structure. val serializeEntity: path: string -> entity: Entity -> unit @@ -2920,6 +2926,8 @@ val serializeEntity: path: string -> entity: Entity -> unit /// Meant to be called with the FSharp.Core module spec right after it was unpickled. val updateSeqTypeIsPrefix: fsharpCoreMSpec: ModuleOrNamespace -> unit +#endif //!FABLE_COMPILER + /// Check if the order of defined typars is different from the order of used typars in the curried arguments. /// If this is the case, a generated signature would require explicit typars. /// See https://github.com/dotnet/fsharp/issues/15175 diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index d2b3bd0ec79..0e3c3550de0 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -239,10 +239,12 @@ let p_bytes (s: byte[]) st = p_int32 len st st.os.EmitBytes s +#if !FABLE_COMPILER let p_memory (s: System.ReadOnlyMemory) st = let len = s.Length p_int32 len st st.os.EmitMemory s +#endif let p_prim_string (s: string) st = let bytes = Encoding.UTF8.GetBytes s @@ -751,7 +753,11 @@ let pickleObjWithDanglingCcus inMem file g scope p x = st1.otypars.Size, st1.ovals.Size, st1.oanoninfos.Size +#if FABLE_COMPILER + st1.occus, sizes, st1.ostrings, st1.opubpaths, st1.onlerefs, st1.osimpletys, st1.os.Close(), st1.osB +#else st1.occus, sizes, st1.ostrings, st1.opubpaths, st1.onlerefs, st1.osimpletys, st1.os.AsMemory(), st1.osB +#endif let st2 = { os = ByteBuffer.Create(PickleBufferCapacity, useArrayPool = true) @@ -784,7 +790,11 @@ let pickleObjWithDanglingCcus inMem file g scope p x = (p_array p_encoded_pubpath) (p_array p_encoded_nleref) (p_array p_encoded_simpletyp) +#if FABLE_COMPILER + p_bytes +#else p_memory +#endif (stringTab.AsArray, pubpathTab.AsArray, nlerefTab.AsArray, simpleTyTab.AsArray, phase1bytes) st2 diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index b6fafe1c1b9..a7e2aa54d52 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -69,6 +69,23 @@ module internal Activity = module Events = let cacheHit = "cacheHit" +#if FABLE_COMPILER + + let start (name: string) (tags: (string * string) seq) : IDisposable = + ignore name + ignore tags + null + + let startNoTags (name: string) : IDisposable = + ignore name + null + + let addEvent (name: string) = + ignore name + () + +#else //!FABLE_COMPILER + type Diagnostics.Activity with member this.RootId = @@ -272,3 +289,5 @@ module internal Activity = (msgQueue :> IDisposable).Dispose() // Wait for the msg queue to be written out sw.Dispose() // Only then flush the messages and close the file } + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index ec6a9fbf6f8..c1f896a75f5 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -45,9 +45,11 @@ module internal Activity = val addEvent: name: string -> unit +#if !FABLE_COMPILER module Profiling = val startAndMeasureEnvironmentStats: name: string -> IDisposable val addConsoleListener: unit -> IDisposable module CsvExport = val addCsvFileListener: pathToFile: string -> IDisposable +#endif diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 8f14b5ddbfe..605977f83a4 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -172,7 +172,13 @@ type CancellableBuilder() = match compRes with | ValueOrCancelled.Value res -> +#if FABLE_COMPILER + match box resource with + | null -> () + | _ -> resource.Dispose() +#else Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource +#endif match res with | Choice1Of2 r -> ValueOrCancelled.Value r diff --git a/src/Compiler/Utilities/FileSystem.fs b/src/Compiler/Utilities/FileSystem.fs index a541234199e..f931c5a842b 100644 --- a/src/Compiler/Utilities/FileSystem.fs +++ b/src/Compiler/Utilities/FileSystem.fs @@ -3,12 +3,14 @@ namespace FSharp.Compiler.IO open System open System.IO +#if !FABLE_COMPILER open System.IO.MemoryMappedFiles open System.Buffers open System.Reflection open System.Threading open System.Runtime.InteropServices open FSharp.NativeInterop +#endif open Internal.Utilities.Library open System.Text @@ -57,11 +59,15 @@ type ByteMemory() = abstract ReadUInt16: pos: int -> uint16 abstract ReadUtf8String: pos: int * count: int -> string abstract Slice: pos: int * count: int -> ByteMemory +#if !FABLE_COMPILER abstract CopyTo: Stream -> unit +#endif abstract Copy: srcOffset: int * dest: byte[] * destOffset: int * count: int -> unit abstract ToArray: unit -> byte[] +#if !FABLE_COMPILER abstract AsStream: unit -> Stream abstract AsReadOnlyStream: unit -> Stream +#endif [] [] @@ -124,9 +130,11 @@ type ByteArrayMemory(bytes: byte[], offset, length) = else ByteArrayMemory(Array.empty, 0, 0) :> ByteMemory +#if !FABLE_COMPILER override _.CopyTo stream = if length > 0 then stream.Write(bytes, offset, length) +#endif override _.Copy(srcOffset, dest, destOffset, count) = checkCount count @@ -140,6 +148,8 @@ type ByteArrayMemory(bytes: byte[], offset, length) = else Array.empty +#if !FABLE_COMPILER + override _.AsStream() = if length > 0 then new MemoryStream(bytes, offset, length) :> Stream @@ -319,6 +329,8 @@ type RawByteMemory(addr: nativeptr, length: int, holder: obj) = else new MemoryStream([||], 0, 0, false) :> Stream +#endif //!FABLE_COMPILER + [] type ReadOnlyByteMemory(bytes: ByteMemory) = @@ -340,16 +352,22 @@ type ReadOnlyByteMemory(bytes: ByteMemory) = member _.Slice(pos, count) = bytes.Slice(pos, count) |> ReadOnlyByteMemory +#if !FABLE_COMPILER member _.CopyTo stream = bytes.CopyTo stream +#endif member _.Copy(srcOffset, dest, destOffset, count) = bytes.Copy(srcOffset, dest, destOffset, count) member _.ToArray() = bytes.ToArray() +#if !FABLE_COMPILER member _.AsStream() = bytes.AsReadOnlyStream() member _.Underlying = bytes +#endif + +#if !FABLE_COMPILER [] module MemoryMappedFileExtensions = @@ -395,6 +413,8 @@ module MemoryMappedFileExtensions = bytes.Span.CopyTo(span) stream.Position <- stream.Position + length) +#endif //!FABLE_COMPILER + [] module internal FileSystemUtils = let checkPathForIllegalChars = @@ -446,6 +466,50 @@ module internal FileSystemUtils = let isDll fileName = checkSuffix fileName ".dll" +#if FABLE_COMPILER + +[] +type FileSystem = + + static member GetFullPathShim (fileName: string) = + fileName // not getting a full path, unless it already is + + static member IsPathRootedShim (path: string) = + path.StartsWith("/") || path.StartsWith("\\") || path.IndexOf(':') = 1 + + static member NormalizePathShim (path: string) = + let path = + if FileSystem.IsPathRootedShim path + then FileSystem.GetFullPathShim path + else path + path.Replace('\\', '/') + + static member GetFullFilePathInDirectoryShim (dir: string) (fileName: string) = + let path = + if FileSystem.IsPathRootedShim(fileName) + then fileName + else Path.Combine(dir, fileName) + FileSystem.GetFullPathShim(path) + + static member IsInvalidPathShim(path: string) = + let isInvalidPath(p: string) = + String.IsNullOrEmpty p || p.IndexOfAny(Path.GetInvalidPathChars()) <> -1 + let isInvalidFilename(p: string) = + String.IsNullOrEmpty p || p.IndexOfAny(Path.GetInvalidFileNameChars()) <> -1 + let isInvalidDirectory(d: string) = + d=null || d.IndexOfAny(Path.GetInvalidPathChars()) <> -1 + isInvalidPath path || + let directory = Path.GetDirectoryName path + let filename = Path.GetFileName path + isInvalidDirectory directory || isInvalidFilename filename + + static member GetTempPathShim() = "." + + static member GetDirectoryNameShim(path: string) = + Path.GetDirectoryName(path) + +#else //!FABLE_COMPILER + [] type IAssemblyLoader = @@ -861,18 +925,22 @@ module public FileSystemAutoOpens = /// The global hook into the file system let mutable FileSystem: IFileSystem = DefaultFileSystem() :> IFileSystem +#endif //!FABLE_COMPILER + type ByteMemory with member x.AsReadOnly() = ReadOnlyByteMemory x static member Empty = ByteArrayMemory([||], 0, 0) :> ByteMemory +#if !FABLE_COMPILER static member FromMemoryMappedFile(mmf: MemoryMappedFile) = let accessor = mmf.CreateViewAccessor() RawByteMemory.FromUnsafePointer(accessor.SafeMemoryMappedViewHandle.DangerousGetHandle(), int accessor.Capacity, (mmf, accessor)) static member FromUnsafePointer(addr, length, holder: obj) = RawByteMemory(NativePtr.ofNativeInt addr, length, holder) :> ByteMemory +#endif //!FABLE_COMPILER static member FromArray(bytes, offset, length) = ByteArrayMemory(bytes, offset, length) :> ByteMemory @@ -944,19 +1012,27 @@ type internal ByteBuffer = let old = buf.bbArray buf.bbArray <- +#if !FABLE_COMPILER if buf.useArrayPool then ArrayPool.Shared.Rent(max newSize (oldBufSize * 2)) else +#endif Bytes.zeroCreate (max newSize (oldBufSize * 2)) Bytes.blit old 0 buf.bbArray 0 buf.bbCurrent +#if !FABLE_COMPILER if buf.useArrayPool then ArrayPool.Shared.Return old +#endif +#if FABLE_COMPILER + member buf.Close () = Array.sub buf.bbArray 0 buf.bbCurrent +#else member buf.AsMemory() = buf.CheckDisposed() ReadOnlyMemory(buf.bbArray, 0, buf.bbCurrent) +#endif member buf.EmitIntAsByte(i: int) = buf.CheckDisposed() @@ -1004,6 +1080,7 @@ type internal ByteBuffer = Bytes.blit i 0 buf.bbArray buf.bbCurrent n buf.bbCurrent <- newSize +#if !FABLE_COMPILER member buf.EmitMemory(i: ReadOnlyMemory) = buf.CheckDisposed() let n = i.Length @@ -1019,6 +1096,7 @@ type internal ByteBuffer = buf.Ensure newSize i.Copy(0, buf.bbArray, buf.bbCurrent, n) buf.bbCurrent <- newSize +#endif //!FABLE_COMPILER member buf.EmitInt32AsUInt16 n = buf.CheckDisposed() @@ -1051,11 +1129,15 @@ type internal ByteBuffer = { useArrayPool = useArrayPool isDisposed = false +#if FABLE_COMPILER + bbArray = Bytes.zeroCreate capacity +#else bbArray = if useArrayPool then ArrayPool.Shared.Rent capacity else Bytes.zeroCreate capacity +#endif bbCurrent = 0 } @@ -1065,8 +1147,12 @@ type internal ByteBuffer = if not this.isDisposed then this.isDisposed <- true +#if !FABLE_COMPILER if this.useArrayPool then ArrayPool.Shared.Return this.bbArray +#endif + +#if !FABLE_COMPILER [] type ByteStorage(getByteMemory: unit -> ReadOnlyByteMemory) = @@ -1115,3 +1201,5 @@ type ByteStorage(getByteMemory: unit -> ReadOnlyByteMemory) = static member FromByteArrayAndCopy(bytes: byte[], useBackingMemoryMappedFile: bool) = ByteStorage.FromByteMemoryAndCopy(ByteMemory.FromArray(bytes).AsReadOnly(), useBackingMemoryMappedFile) + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Utilities/FileSystem.fsi b/src/Compiler/Utilities/FileSystem.fsi index a41460e49c2..cb746208dcd 100644 --- a/src/Compiler/Utilities/FileSystem.fsi +++ b/src/Compiler/Utilities/FileSystem.fsi @@ -3,11 +3,13 @@ namespace FSharp.Compiler.IO open System +#if !FABLE_COMPILER open System.IO open System.IO.MemoryMappedFiles open System.Reflection open System.Text open System.Runtime.CompilerServices +#endif exception internal IllegalFileNameChar of string * char @@ -48,12 +50,15 @@ type public ByteMemory = abstract Slice: pos: int * count: int -> ByteMemory +#if !FABLE_COMPILER abstract CopyTo: Stream -> unit +#endif abstract Copy: srcOffset: int * dest: byte[] * destOffset: int * count: int -> unit abstract ToArray: unit -> byte[] +#if !FABLE_COMPILER /// Get a stream representation of the backing memory. /// Disposing this will not free up any of the backing memory. abstract AsStream: unit -> Stream @@ -62,6 +67,7 @@ type public ByteMemory = /// Disposing this will not free up any of the backing memory. /// Stream cannot be written to. abstract AsReadOnlyStream: unit -> Stream +#endif [] type internal ReadOnlyByteMemory = @@ -84,12 +90,15 @@ type internal ReadOnlyByteMemory = member Slice: pos: int * count: int -> ReadOnlyByteMemory +#if !FABLE_COMPILER member CopyTo: Stream -> unit +#endif member Copy: srcOffset: int * dest: byte[] * destOffset: int * count: int -> unit member ToArray: unit -> byte[] +#if !FABLE_COMPILER member AsStream: unit -> Stream /// MemoryMapped extensions @@ -99,6 +108,7 @@ module internal MemoryMappedFileExtensions = static member TryFromByteMemory: bytes: ReadOnlyByteMemory -> MemoryMappedFile option static member TryFromMemory: bytes: ReadOnlyMemory -> MemoryMappedFile option +#endif //!FABLE_COMPILER /// Filesystem helpers module internal FileSystemUtils = @@ -130,6 +140,39 @@ module internal FileSystemUtils = /// Checks whether file is dll (ends in .dll) val isDll: fileName: string -> bool +#if FABLE_COMPILER + +/// Represents a shim for the file system +[] +type FileSystem = + + /// Take in a filename with an absolute path, and return the same filename + /// but canonicalized with respect to extra path separators (e.g. C:\\\\foo.txt) + /// and '..' portions + static member GetFullPathShim: fileName:string -> string + + /// Take in a directory, filename, and return canonicalized path to the filename in directory. + /// If filename path is rooted, ignores directory and returns filename path. + /// Otherwise, combines directory with filename and gets full path via GetFullPathShim(string). + static member GetFullFilePathInDirectoryShim: dir: string -> fileName: string -> string + + /// A shim over Path.IsPathRooted + static member IsPathRootedShim: path:string -> bool + + /// Removes relative parts from any full paths + static member NormalizePathShim: path: string -> string + + /// A shim over Path.IsInvalidPath + static member IsInvalidPathShim: path:string -> bool + + /// A shim over Path.GetTempPath + static member GetTempPathShim: unit -> string + + /// A shim for getting directory name from path + static member GetDirectoryNameShim: path: string -> string + +#else //!FABLE_COMPILER + /// Type which we use to load assemblies. type public IAssemblyLoader = /// Used to load a dependency for F# Interactive and in an unused corner-case of type provider loading @@ -315,6 +358,8 @@ module public FileSystemAutoOpens = /// The global hook into the file system val mutable FileSystem: IFileSystem +#endif //!FABLE_COMPILER + type internal ByteMemory with member AsReadOnly: unit -> ReadOnlyByteMemory @@ -322,12 +367,14 @@ type internal ByteMemory with /// Empty byte memory. static member Empty: ByteMemory +#if !FABLE_COMPILER /// Create a ByteMemory object that has a backing memory mapped file. static member FromMemoryMappedFile: MemoryMappedFile -> ByteMemory /// Creates a ByteMemory object that is backed by a raw pointer. /// Use with care. static member FromUnsafePointer: addr: nativeint * length: int * holder: obj -> ByteMemory +#endif //!FABLE_COMPILER /// Creates a ByteMemory object that is backed by a byte array with the specified offset and length. static member FromArray: bytes: byte[] * offset: int * length: int -> ByteMemory @@ -353,6 +400,32 @@ type internal ByteStream = static member FromBytes: ReadOnlyByteMemory * start: int * length: int -> ByteStream +#if FABLE_COMPILER + +/// Imperative buffers and streams of byte[] +/// Not thread safe. +[] +type internal ByteBuffer = + interface IDisposable + member Close : unit -> byte[] + // member AsMemory : unit -> ReadOnlyMemory + member EmitIntAsByte : int -> unit + member EmitIntsAsBytes : int[] -> unit + member EmitByte : byte -> unit + member EmitBytes : byte[] -> unit + // member EmitMemory : ReadOnlyMemory -> unit + // member EmitByteMemory : ReadOnlyByteMemory -> unit + member EmitInt32 : int32 -> unit + member EmitInt64 : int64 -> unit + member FixupInt32 : pos: int -> value: int32 -> unit + member EmitInt32AsUInt16 : int32 -> unit + member EmitBoolAsByte : bool -> unit + member EmitUInt16 : uint16 -> unit + member Position : int + static member Create : capacity: int * ?useArrayPool: bool -> ByteBuffer + +#else //!FABLE_COMPILER + /// Imperative buffers and streams of byte[] /// Not thread safe. [] @@ -420,3 +493,5 @@ type internal ByteStorage = /// Creates a ByteStorage that has a copy of the given byte array. static member FromByteArrayAndCopy: byte[] * useBackingMemoryMappedFile: bool -> ByteStorage + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Utilities/HashMultiMap.fs b/src/Compiler/Utilities/HashMultiMap.fs index c0fc897121d..f0eea8fa895 100644 --- a/src/Compiler/Utilities/HashMultiMap.fs +++ b/src/Compiler/Utilities/HashMultiMap.fs @@ -133,6 +133,22 @@ type internal HashMultiMap<'Key, 'Value member _.Count = firstEntries.Count +#if FABLE_COMPILER + interface System.Collections.IEnumerable with + member s.GetEnumerator() = ((s :> IEnumerable>).GetEnumerator() :> System.Collections.IEnumerator) + + interface IEnumerable> with + member s.GetEnumerator() = + let elems = seq { + for kvp in firstEntries do + yield kvp + for z in s.GetRest(kvp.Key) do + yield KeyValuePair(kvp.Key, z) + } + elems.GetEnumerator() + +#else //!FABLE_COMPILER + interface IEnumerable> with member s.GetEnumerator() = @@ -177,6 +193,8 @@ type internal HashMultiMap<'Key, 'Value s.Remove(k) res +#endif //!FABLE_COMPILER + interface ICollection> with member s.Add(x) = s[x.Key] <- x.Value diff --git a/src/Compiler/Utilities/HashMultiMap.fsi b/src/Compiler/Utilities/HashMultiMap.fsi index 6a4ba2ce119..3ffbeff9993 100644 --- a/src/Compiler/Utilities/HashMultiMap.fsi +++ b/src/Compiler/Utilities/HashMultiMap.fsi @@ -19,6 +19,7 @@ type internal HashMultiMap<'Key, 'Value /// and with the given key hash/equality functions. new: size: int * comparer: IEqualityComparer<'Key> * ?useConcurrentDictionary: bool -> HashMultiMap<'Key, 'Value> +#if !FABLE_COMPILER /// Build a map that contains the bindings of the given IEnumerable. new: entries: seq<'Key * 'Value> * comparer: IEqualityComparer<'Key> * ?useConcurrentDictionary: bool -> HashMultiMap<'Key, 'Value> @@ -60,7 +61,9 @@ type internal HashMultiMap<'Key, 'Value /// Apply the given function to each binding in the hash table. member Iterate: ('Key -> 'Value -> unit) -> unit +#if !FABLE_COMPILER interface IDictionary<'Key, 'Value> +#endif interface ICollection> interface IEnumerable> interface System.Collections.IEnumerable diff --git a/src/Compiler/Utilities/PathMap.fs b/src/Compiler/Utilities/PathMap.fs index 50319ea7079..af2525953e3 100644 --- a/src/Compiler/Utilities/PathMap.fs +++ b/src/Compiler/Utilities/PathMap.fs @@ -20,7 +20,11 @@ module internal PathMap = let addMapping (src: string) (dst: string) (PathMap map) : PathMap = // Normalise the path +#if FABLE_COMPILER + let normalSrc = src // no file system +#else let normalSrc = FileSystem.GetFullPathShim src +#endif let oldPrefix = if normalSrc.EndsWithOrdinal dirSepStr then diff --git a/src/Compiler/Utilities/TaggedCollections.fs b/src/Compiler/Utilities/TaggedCollections.fs index 253b38a196d..295e4be4252 100644 --- a/src/Compiler/Utilities/TaggedCollections.fs +++ b/src/Compiler/Utilities/TaggedCollections.fs @@ -659,10 +659,14 @@ type internal Set<'T, 'ComparerTag> when 'ComparerTag :> IComparer<'T>(comparer: member s.ToArray() = SetTree.toArray tree override this.Equals(that) = +#if FABLE_COMPILER + ((this :> System.IComparable).CompareTo(that) = 0) +#else match that with // Cast to the exact same type as this, otherwise not equal. | :? Set<'T, 'ComparerTag> as that -> ((this :> System.IComparable).CompareTo(that) = 0) | _ -> false +#endif interface System.IComparable with // Cast s2 to the exact same type as s1, see 4884. @@ -821,7 +825,16 @@ module MapTree = true else match m with +#if FABLE_COMPILER + | :? MapTreeNode<'Key, 'Value> as mn -> + // Temporary workaround for Fable issue with passing byref + let mutable t = v + let res = tryGetValue comparer k &t (if c < 0 then mn.Left else mn.Right) + v <- t + res +#else | :? MapTreeNode<'Key, 'Value> as mn -> tryGetValue comparer k &v (if c < 0 then mn.Left else mn.Right) +#endif | _ -> false let find (comparer: IComparer<'Key>) (k: 'Key) (m: MapTree<'Key, 'Value>) = @@ -1233,10 +1246,14 @@ type internal Map<'Key, 'T, 'ComparerTag> when 'ComparerTag :> IComparer<'Key>(c (MapTree.toSeq tree :> System.Collections.IEnumerator) override this.Equals(that) = +#if FABLE_COMPILER + ((this :> System.IComparable).CompareTo(that) = 0) +#else match that with // Cast to the exact same type as this, otherwise not equal. | :? Map<'Key, 'T, 'ComparerTag> as that -> ((this :> System.IComparable).CompareTo(that) = 0) | _ -> false +#endif interface System.IComparable with member m1.CompareTo(m2: objnull) = diff --git a/src/Compiler/Utilities/ildiag.fs b/src/Compiler/Utilities/ildiag.fs index e5f3b069bbb..bb71f31e129 100644 --- a/src/Compiler/Utilities/ildiag.fs +++ b/src/Compiler/Utilities/ildiag.fs @@ -4,6 +4,14 @@ module internal FSharp.Compiler.AbstractIL.Diagnostics +#if FABLE_COMPILER + +let dprintf fmt = printf fmt +let dprintfn fmt = printfn fmt +let dprintn s = printfn "%s" s + +#else + let mutable diagnosticsLog = Some stdout let setDiagnosticsChannel s = diagnosticsLog <- s @@ -43,3 +51,5 @@ let dprintfn (fmt: Format<_, _, _, _>) = | None -> System.IO.TextWriter.Null | Some d -> d) fmt + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Utilities/ildiag.fsi b/src/Compiler/Utilities/ildiag.fsi index 6f5fb86849a..6aec4952319 100644 --- a/src/Compiler/Utilities/ildiag.fsi +++ b/src/Compiler/Utilities/ildiag.fsi @@ -11,7 +11,9 @@ module internal FSharp.Compiler.AbstractIL.Diagnostics open System.IO open Microsoft.FSharp.Core.Printf +#if !FABLE_COMPILER val public setDiagnosticsChannel: TextWriter option -> unit +#endif val public dprintfn: TextWriterFormat<'a> -> 'a val public dprintf: TextWriterFormat<'a> -> 'a diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index e09c650e39b..8a297239e60 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -128,12 +128,17 @@ module internal PervasiveAutoOpens = tPrev <- null if descr <> "Finish" then +#if FABLE_COMPILER + tPrev <- null +#else tPrev <- FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr +#endif let foldOn p f z x = f z (p x) let notFound () = raise (KeyNotFoundException()) +#if !FABLE_COMPILER type Async with static member RunImmediate(computation: Async<'T>, ?cancellationToken) = @@ -149,6 +154,7 @@ module internal PervasiveAutoOpens = task.Result with :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> raise (ex.InnerExceptions[0]) +#endif //!FABLE_COMPILER [] type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue>(f: unit -> 'T[]) = @@ -462,7 +468,9 @@ module List = | _ -> true let mapq (f: 'T -> 'T) inp = +#if !FABLE_COMPILER assert not typeof<'T>.IsValueType +#endif match inp with | [] -> inp @@ -696,7 +704,11 @@ module ResizeArray = /// This is done to help prevent a stop-the-world collection of the single large array, instead allowing for a greater /// probability of smaller collections. Stop-the-world is still possible, just less likely. let mapToSmallArrayChunks f (inp: ResizeArray<'t>) = +#if FABLE_COMPILER + let itemSizeBytes = 8 +#else let itemSizeBytes = sizeof<'t> +#endif // rounding down here is good because it ensures we don't go over let maxArrayItemCount = LOH_SIZE_THRESHOLD_BYTES / itemSizeBytes @@ -704,6 +716,7 @@ module ResizeArray = // in order to prevent long-term storage of those values chunkBySize maxArrayItemCount f inp +#if !FABLE_COMPILER module Span = let inline exists ([] predicate: 'T -> bool) (span: Span<'T>) = let mutable state = false @@ -714,6 +727,7 @@ module Span = i <- i + 1 state +#endif module ValueOptionInternal = @@ -817,6 +831,9 @@ module String = else None let getLines (str: string) = +#if FABLE_COMPILER + System.Text.RegularExpressions.Regex.Split(str, "\r\n|\r|\n"); +#else use reader = new StringReader(str) [| @@ -831,6 +848,7 @@ module String = // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak yield String.Empty |] +#endif //!FABLE_COMPILER module Dictionary = let inline newWithSize (size: int) = @@ -909,12 +927,14 @@ module internal LockAutoOpens = let AssumeLockWithoutEvidence<'LockTokenType when 'LockTokenType :> LockToken> () = Unchecked.defaultof<'LockTokenType> +#if !FABLE_COMPILER /// Encapsulates a lock associated with a particular token-type representing the acquisition of that lock. type Lock<'LockTokenType when 'LockTokenType :> LockToken>() = let lockObj = obj () member _.AcquireLock f = lock lockObj (fun () -> f (AssumeLockWithoutEvidence<'LockTokenType>())) +#endif //--------------------------------------------------- // Misc @@ -966,7 +986,11 @@ type UniqueStampGenerator<'T when 'T: equality member _.Encode str = encodeTable.GetOrAdd(str, computeFunc).Value +#if FABLE_COMPILER + member _.Table = encodeTable.Keys :> ICollection<'T> +#else member _.Table = encodeTable.Keys +#endif /// memoize tables (all entries cached, never collected) type MemoizationTable<'T, 'U @@ -1070,6 +1094,9 @@ type LazyWithContext<'T, 'Ctxt> = match x.funcOrException with | null -> x.value | _ -> +#if FABLE_COMPILER + x.UnsynchronizedForce(ctxt) +#else // Enter the lock in case another thread is in the process of evaluating the result Monitor.Enter x @@ -1077,6 +1104,7 @@ type LazyWithContext<'T, 'Ctxt> = x.UnsynchronizedForce ctxt finally Monitor.Exit x +#endif member x.UnsynchronizedForce ctxt = match x.funcOrException with diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index be4edea38f9..abfa2b1334f 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -66,10 +66,12 @@ module internal PervasiveAutoOpens = member inline IndexOfOrdinal: value: string * startIndex: int * count: int -> int +#if !FABLE_COMPILER type Async with /// Runs the computation synchronously, always starting on the current thread. static member RunImmediate: computation: Async<'T> * ?cancellationToken: CancellationToken -> 'T +#endif val foldOn: p: ('a -> 'b) -> f: ('c -> 'b -> 'd) -> z: 'c -> x: 'a -> 'd @@ -240,8 +242,10 @@ module internal ResizeArray = /// probability of smaller collections. Stop-the-world is still possible, just less likely. val mapToSmallArrayChunks: f: ('t -> 'a) -> inp: ResizeArray<'t> -> 'a[][] +#if !FABLE_COMPILER module internal Span = val inline exists: predicate: ('T -> bool) -> span: Span<'T> -> bool +#endif module internal ValueOptionInternal = @@ -339,11 +343,13 @@ type internal LockToken = inherit ExecutionToken end +#if !FABLE_COMPILER /// Encapsulates a lock associated with a particular token-type representing the acquisition of that lock. type internal Lock<'LockTokenType when 'LockTokenType :> LockToken> = new: unit -> Lock<'LockTokenType> member AcquireLock: f: ('LockTokenType -> 'a) -> 'a +#endif [] module internal LockAutoOpens = diff --git a/src/Compiler/Utilities/lib.fs b/src/Compiler/Utilities/lib.fs index 921b0a6dba3..a4531be92d6 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -19,10 +19,15 @@ let mutable progress = false // Intended to be a general hook to control diagnostic output when tracking down bugs let mutable tracking = false +#if FABLE_COMPILER +let isEnvVarSet (s: string) = ignore s; false +let GetEnvInteger (e: string) (dflt: int) = ignore e; dflt +#else let isEnvVarSet s = try not(isNull(Environment.GetEnvironmentVariable s)) with _ -> false let GetEnvInteger e dflt = match Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt +#endif let dispose (x: IDisposable MaybeNull) = match x with @@ -286,11 +291,13 @@ let buildString f = f buf buf.ToString() +#if !FABLE_COMPILER /// Writing to output stream via a string buffer. let writeViaBuffer (os: TextWriter) f = let buf = StringBuilder 100 f buf os.Write(buf.ToString()) +#endif type StringBuilder with @@ -400,10 +407,18 @@ let inline vsnd ((_, y): struct('T * 'T)) = y /// Track a set of resources to cleanup type DisposablesTracker() = +#if FABLE_COMPILER + let items = List() +#else let items = Stack() +#endif /// Register some items to dispose +#if FABLE_COMPILER + member _.Register i = items.Add i +#else member _.Register i = items.Push i +#endif interface IDisposable with @@ -420,6 +435,9 @@ type DisposablesTracker() = module ArrayParallel = let inline iteri f (arr: 'T []) = +#if FABLE_COMPILER + Array.iteri f arr +#else let parallelOptions = ParallelOptions(MaxDegreeOfParallelism = max (min Environment.ProcessorCount arr.Length) 1) try Parallel.For(0, arr.Length, parallelOptions, fun i -> @@ -428,6 +446,7 @@ module ArrayParallel = with | :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> raise(ex.InnerExceptions[0]) +#endif let inline iter f (arr: 'T []) = arr |> iteri (fun _ item -> f item) diff --git a/src/Compiler/Utilities/lib.fsi b/src/Compiler/Utilities/lib.fsi index cbdb893c5b8..0421a919e53 100644 --- a/src/Compiler/Utilities/lib.fsi +++ b/src/Compiler/Utilities/lib.fsi @@ -209,8 +209,10 @@ module Zset = /// Buffer printing utility val buildString: f: (StringBuilder -> unit) -> string +#if !FABLE_COMPILER /// Writing to output stream via a string buffer. val writeViaBuffer: os: TextWriter -> f: (StringBuilder -> unit) -> unit +#endif type StringBuilder with diff --git a/src/Compiler/Utilities/range.fs b/src/Compiler/Utilities/range.fs index f9940461a32..ae5f9ab6f9a 100755 --- a/src/Compiler/Utilities/range.fs +++ b/src/Compiler/Utilities/range.fs @@ -197,11 +197,16 @@ type FileIndexTable() = | true, idx -> idx | _ -> // Try again looking for a normalized entry. +#if FABLE_COMPILER + ignore normalize + let normalizedFilePath = filePath +#else let normalizedFilePath = if normalize then FileSystem.NormalizePathShim filePath else filePath +#endif match fileToIndexTable.TryGetValue normalizedFilePath with | true, idx -> @@ -213,7 +218,11 @@ type FileIndexTable() = idx | _ -> +#if FABLE_COMPILER + ( +#else lock indexToFileTable (fun () -> +#endif // See if it was added on another thread match fileToIndexTable.TryGetValue normalizedFilePath with | true, idx -> idx @@ -345,6 +354,9 @@ type Range(code1: int64, code2: int64) = member _.Code2 = code2 member m.DebugCode = +#if FABLE_COMPILER + "" +#else let name = m.FileName if @@ -371,6 +383,7 @@ type Range(code1: int64, code2: int64) = |> fun s -> s.Substring(startCol + 1, s.LastIndexOf("\n", StringComparison.Ordinal) + 1 - startCol + endCol) with e -> e.ToString() +#endif //!FABLE_COMPILER member _.Equals(m2: range) = let code2 = code2 &&& ~~~(debugPointKindMask ||| isSyntheticMask) @@ -549,6 +562,7 @@ module Range = } let mkFirstLineOfFile (file: string) = +#if !FABLE_COMPILER try if not (FileSystem.FileExistsShim file) then mkRange file (mkPos 1 0) (mkPos 1 80) @@ -568,4 +582,5 @@ module Range = | Some(i, s) -> mkRange file (mkPos (i + 1) 0) (mkPos (i + 1) s.Length) | None -> mkRange file (mkPos 1 0) (mkPos 1 80) with _ -> +#endif //!FABLE_COMPILER mkRange file (mkPos 1 0) (mkPos 1 80) diff --git a/src/Compiler/Utilities/sformat.fs b/src/Compiler/Utilities/sformat.fs index f6fc27b1e51..80ca1dbf5b2 100644 --- a/src/Compiler/Utilities/sformat.fs +++ b/src/Compiler/Utilities/sformat.fs @@ -416,6 +416,8 @@ module Layout = let unfoldL selector folder state count = boundedUnfoldL selector folder (fun _ -> false) state count +#if !FABLE_COMPILER + /// These are a typical set of options used to control structured formatting. [] type FormatOptions = @@ -1646,3 +1648,5 @@ module Display = let formatter = ObjectGraphFormatter(options, bindingFlags) formatter.Format(ShowAll, value, typValue) |> layout_to_string options #endif + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Utilities/sformat.fsi b/src/Compiler/Utilities/sformat.fsi index af5b1e2f7d6..d8146b46a0b 100644 --- a/src/Compiler/Utilities/sformat.fsi +++ b/src/Compiler/Utilities/sformat.fsi @@ -348,6 +348,8 @@ module internal Layout = count: int -> Layout list +#if !FABLE_COMPILER + /// A record of options to control structural formatting. /// For F# Interactive properties matching those of this value can be accessed via the 'fsi' /// value. @@ -409,3 +411,5 @@ module internal Display = #if COMPILER val fsi_any_to_layout: options: FormatOptions -> value: 'T * typValue: Type -> Layout #endif + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/lex.fsl b/src/Compiler/lex.fsl index 34bfe4bfe17..8e0504a56a8 100644 --- a/src/Compiler/lex.fsl +++ b/src/Compiler/lex.fsl @@ -39,8 +39,12 @@ let lexeme (lexbuf : UnicodeLexing.Lexbuf) = UnicodeLexing.Lexbuf.LexemeString l /// Trim n chars from both sides of lexbuf, return string let lexemeTrimBoth (lexbuf : UnicodeLexing.Lexbuf) (n:int) (m:int) = +#if FABLE_COMPILER + LexBuffer<_>.LexemeString(lexbuf).Substring(n, lexbuf.LexemeLength - (n+m)) +#else let s = lexbuf.LexemeView s.Slice(n, s.Length - (n+m)).ToString() +#endif /// Trim n chars from the right of lexbuf, return string let lexemeTrimRight lexbuf n = lexemeTrimBoth lexbuf 0 n @@ -62,10 +66,17 @@ let fail args (lexbuf:UnicodeLexing.Lexbuf) msg dflt = // version of the F# core library parsing code with the call to "Trim" // removed, which appears in profiling runs as a small but significant cost. +#if FABLE_COMPILER +let getSign32 (s:string) (p:int) l = + if (l >= p + 1 && s.[p] = '-') + then -1, p + 1 + else 1, p +#else let getSign32 (s:string) (p:byref) l = if (l >= p + 1 && s.[p] = '-') then p <- p + 1; -1 else 1 +#endif let isOXB c = let c = Char.ToLowerInvariant c @@ -74,10 +85,17 @@ let isOXB c = let is0OXB (s:string) p l = l >= p + 2 && s.[p] = '0' && isOXB s.[p+1] +#if FABLE_COMPILER +let get0OXB (s:string) (p:int) l = + if is0OXB s p l + then let r = Char.ToLowerInvariant s.[p+1] in r, p + 2 + else 'd', p +#else let get0OXB (s:string) (p:byref) l = if is0OXB s p l then let r = Char.ToLowerInvariant s.[p+1] in p <- p + 2; r else 'd' +#endif let parseBinaryUInt64 (s:string) = Convert.ToUInt64(s, 2) @@ -91,6 +109,16 @@ let removeUnderscores (s:string) = let parseInt32 (s:string) = let s = removeUnderscores s let l = s.Length +#if FABLE_COMPILER + let p = 0 + let sign, p = getSign32 s p l + let specifier, p = get0OXB s p l + match Char.ToLowerInvariant(specifier) with + | 'x' -> sign * Convert.ToInt32(s.Substring(p), 16) + | 'b' -> sign * (int32 (Convert.ToUInt32(parseBinaryUInt64 (s.Substring(p))))) + | 'o' -> sign * (int32 (Convert.ToUInt32(parseOctalUInt64 (s.Substring(p))))) + | _ -> Convert.ToInt32(s) +#else let mutable p = 0 let sign = getSign32 s &p l let specifier = get0OXB s &p l @@ -99,6 +127,7 @@ let parseInt32 (s:string) = | 'b' -> sign * (int32 (Convert.ToUInt32(parseBinaryUInt64 (s.Substring(p))))) | 'o' -> sign * (int32 (Convert.ToUInt32(parseOctalUInt64 (s.Substring(p))))) | _ -> Int32.Parse(s, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture) +#endif let lexemeTrimRightToInt32 args lexbuf n = try parseInt32 (lexemeTrimRight lexbuf n) @@ -108,13 +137,24 @@ let lexemeTrimRightToInt32 args lexbuf n = // Checks let checkExprOp (lexbuf:UnicodeLexing.Lexbuf) = +#if FABLE_COMPILER + if lexbuf.LexemeContains (uint16 ':') then + deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(":")) lexbuf.LexemeRange + if lexbuf.LexemeContains (uint16 '$') then + deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames("$")) lexbuf.LexemeRange +#else if lexbuf.LexemeContains ':' then deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(":")) lexbuf.LexemeRange if lexbuf.LexemeContains '$' then deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames("$")) lexbuf.LexemeRange +#endif let checkExprGreaterColonOp (lexbuf:UnicodeLexing.Lexbuf) = +#if FABLE_COMPILER + if lexbuf.LexemeContains (uint16 '$') then +#else if lexbuf.LexemeContains '$' then +#endif deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames("$")) lexbuf.LexemeRange let unexpectedChar lexbuf = @@ -180,7 +220,11 @@ let startString args (lexbuf: UnicodeLexing.Lexbuf) = // Utility functions for processing XML documentation +#if FABLE_COMPILER +let trySaveXmlDoc (lexbuf: LexBuffer<_>) (buff: (range * StringBuilder) option) = +#else let trySaveXmlDoc (lexbuf: LexBuffer) (buff: (range * StringBuilder) option) = +#endif match buff with | None -> () | Some (start, sb) -> @@ -202,7 +246,11 @@ let shouldStartFile args lexbuf (m:range) err tok = else tok let evalIfDefExpression startPos reportLibraryOnlyFeatures langVersion strictIndentation args (lookup: string -> bool) (lexed: string) = +#if FABLE_COMPILER + let lexbuf = LexBuffer<_>.FromString (reportLibraryOnlyFeatures, langVersion, strictIndentation, lexed) +#else let lexbuf = LexBuffer.FromChars (reportLibraryOnlyFeatures, langVersion, strictIndentation, lexed.ToCharArray ()) +#endif lexbuf.StartPos <- startPos lexbuf.EndPos <- startPos let tokenStream = FSharp.Compiler.PPLexer.tokenstream args @@ -497,16 +545,26 @@ rule token (args: LexArgs) (skip: bool) = parse } | xieee32 { +#if FABLE_COMPILER + fail args lexbuf (FSComp.SR.lexInvalidFloat()) (IEEE32 0.0f) +#else let s = removeUnderscores (lexemeTrimRight lexbuf 2) // Even though the intermediate step is an int64, display the "invalid float" message, since it will be less confusing to the user let n64 = (try (int64 s) with _ -> fail args lexbuf (FSComp.SR.lexInvalidFloat()) 0L) if n64 > 0xFFFFFFFFL || n64 < 0L then fail args lexbuf (FSComp.SR.lexOutsideThirtyTwoBitFloat()) (IEEE32 0.0f) else - IEEE32 (System.BitConverter.ToSingle(System.BitConverter.GetBytes(int32 (uint32 (uint64 n64))),0)) } + IEEE32 (System.BitConverter.ToSingle(System.BitConverter.GetBytes(int32 (uint32 (uint64 n64))),0)) +#endif + } | xieee64 { +#if FABLE_COMPILER + fail args lexbuf (FSComp.SR.lexInvalidFloat()) (IEEE64 0.0) +#else let n64 = (try int64 (removeUnderscores (lexemeTrimRight lexbuf 2)) with _ -> fail args lexbuf (FSComp.SR.lexInvalidFloat()) 0L) - IEEE64 (System.BitConverter.Int64BitsToDouble(n64)) } + IEEE64 (System.BitConverter.Int64BitsToDouble(n64)) +#endif + } | bignum { let s = lexeme lexbuf diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 7cac0ad0dc0..7c48c8a8954 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -162,9 +162,9 @@ let parse_error_rich = Some(fun (ctxt: ParseErrorContext<_>) -> %type ident %type typ typEOF %type tyconSpfnList -%type atomicPatsOrNamePatPairs +%type atomicPatsOrNamePatPairs %type atomicPatterns -%type patternResult +%type patternResult %type declExpr %type minusExpr %type appExpr From 8e6cdc38c41d2ea674d047d3e257665a3dc93ff8 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Tue, 31 Jan 2023 14:20:17 -0800 Subject: [PATCH 2/8] Don't lose attributes of method parameters (#12) Temporary fix, remove when upstream dotnet#13786 is fixed. --- .../Expressions/CheckComputationExpressions.fs | 2 +- .../Checking/Expressions/CheckExpressions.fs | 7 ++++--- src/Compiler/Checking/MethodCalls.fs | 2 +- src/Compiler/Checking/NicePrint.fs | 4 +++- src/Compiler/Checking/PostInferenceChecks.fs | 4 ++-- src/Compiler/Checking/infos.fs | 14 +++++++------- src/Compiler/Checking/infos.fsi | 6 +++--- src/Compiler/Service/FSharpCheckerResults.fs | 2 +- src/Compiler/Service/ServiceDeclarationLists.fs | 2 +- src/Compiler/Symbols/Symbols.fs | 6 ++---- 10 files changed, 25 insertions(+), 24 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 22b603d211a..1f70a0fcfdd 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -460,7 +460,7 @@ let tryGetArgAttribsForCustomOperator ceenv (nm: Ident) = _joinConditionWord, methInfo) -> match methInfo.GetParamAttribs(ceenv.cenv.amap, ceenv.mWhole) with - | [ curriedArgInfo ] -> Some curriedArgInfo // one for the actual argument group + | [ curriedArgInfo ] -> Some (List.map fst curriedArgInfo) // one for the actual argument group | _ -> None) |> Some | _ -> None diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 9987f02759c..e67df927f99 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -4188,7 +4188,7 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m = let logicalCompiledName = ComputeLogicalName id memberFlags for argInfos in curriedArgInfos do for argInfo in argInfos do - let info = CrackParamAttribsInfo g argInfo + let info, _ = CrackParamAttribsInfo g argInfo let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info if isParamArrayArg || isInArg || isOutArg || optArgInfo.IsOptional || callerInfo <> CallerInfo.NoCallerInfo || reflArgInfo <> ReflectedArgInfo.None then if g.langVersion.SupportsFeature(LanguageFeature.InterfacesWithAbstractStaticMembers) then @@ -9799,6 +9799,7 @@ and GenerateMatchingSimpleArgumentTypes (cenv: cenv) (calledMeth: MethInfo) mIte let g = cenv.g let curriedMethodArgAttribs = calledMeth.GetParamAttribs(cenv.amap, mItem) curriedMethodArgAttribs + |> List.map (List.map fst) |> List.map (List.filter isSimpleFormalArg >> NewInferenceTypes g) and UnifyMatchingSimpleArgumentTypes (cenv: cenv) (env: TcEnv) exprTy (calledMeth: MethInfo) mMethExpr mItem = @@ -9852,7 +9853,7 @@ and TcMethodApplication_SplitSynArguments let singleMethodCurriedArgs = match candidates with | [calledMeth] when List.forall isNil namedCurriedCallerArgs -> - let curriedCalledArgs = calledMeth.GetParamAttribs(cenv.amap, mItem) + let curriedCalledArgs = calledMeth.GetParamAttribs(cenv.amap, mItem) |> List.map (List.map fst) match curriedCalledArgs with | [arg :: _] when isSimpleFormalArg arg -> Some(curriedCalledArgs) | _ -> None @@ -10097,7 +10098,7 @@ and TcAdhocChecksOnLibraryMethods (cenv: cenv) (env: TcEnv) isInstance (finalCal if HasHeadType g g.tcref_System_Collections_Generic_Dictionary finalCalledMethInfo.ApparentEnclosingType && finalCalledMethInfo.IsConstructor && not (finalCalledMethInfo.GetParamDatas(cenv.amap, mItem, finalCalledMeth.CalledTyArgs) - |> List.existsSquared (fun (ParamData(_, _, _, _, _, _, _, ty)) -> + |> List.existsSquared (fun (ParamData(_, _, _, _, _, _, _, ty), _) -> HasHeadType g g.tcref_System_Collections_Generic_IEqualityComparer ty)) then match argsOfAppTy g finalCalledMethInfo.ApparentEnclosingType with diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index deb96c1ac9f..29792a43a7d 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -492,7 +492,7 @@ type CalledMethArgSet<'T> = let MakeCalledArgs amap m (minfo: MethInfo) minst = // Mark up the arguments with their position, so we can sort them back into order later let paramDatas = minfo.GetParamDatas(amap, m, minst) - paramDatas |> List.mapiSquared (fun i j (ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfoFlags, nmOpt, reflArgInfo, calledArgTy)) -> + paramDatas |> List.mapiSquared (fun i j (ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfoFlags, nmOpt, reflArgInfo, calledArgTy), _) -> { Position=(i,j) IsParamArray=isParamArrayArg OptArgInfo=optArgInfo diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index ac25ded7777..6e5ae8e75ce 100755 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1650,7 +1650,7 @@ module InfoMemberPrinting = let layout = layoutXmlDocOfMethInfo denv infoReader minfo layout let paramsL = - let paramDatas = minfo.GetParamDatas(amap, m, minst) + let paramDatas = minfo.GetParamDatas(amap, m, minst) |> List.map (List.map fst) if List.forall isNil paramDatas then WordL.structUnit else @@ -1702,6 +1702,7 @@ module InfoMemberPrinting = |> PrintTypes.layoutCsharpCodeAnalysisIlAttributes denv (mi.RawMetadata.Return.CustomAttrs) (squareAngleReturn >> (@@)) let paramLayouts = minfo.GetParamDatas (amap, m, minst) + |> List.map (List.map fst) |> List.head |> List.zip (mi.ParamMetadata) |> List.map(fun (ilParams,paramData) -> @@ -1712,6 +1713,7 @@ module InfoMemberPrinting = | _ -> layout, minfo.GetParamDatas (amap, m, minst) + |> List.map (List.map fst) |> List.concat |> List.map (layoutParamData denv) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 645f43fe3cb..99a8e893560 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2393,13 +2393,13 @@ let CheckEntityDefn cenv env (tycon: Entity) = if numCurriedArgSets > 1 && (minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst) - |> List.existsSquared (fun (ParamData(isParamArrayArg, _isInArg, isOutArg, optArgInfo, callerInfo, _, reflArgInfo, ty)) -> + |> List.existsSquared (fun (ParamData(isParamArrayArg, _isInArg, isOutArg, optArgInfo, callerInfo, _, reflArgInfo, ty), _) -> isParamArrayArg || isOutArg || reflArgInfo.AutoQuote || optArgInfo.IsOptional || callerInfo <> NoCallerInfo || isByrefLikeTy g m ty)) then errorR(Error(FSComp.SR.chkCurriedMethodsCantHaveOutParams(), m)) if numCurriedArgSets = 1 then minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst) - |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, _, _, ty)) -> + |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, _, _, ty), _) -> ignore isInArg match (optArgInfo, callerInfo) with | _, NoCallerInfo -> () diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 18add6588d0..666963ac6f6 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -337,7 +337,7 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = | ValueSome optTy when typeEquiv g g.int32_ty optTy -> CallerFilePath | _ -> CallerLineNumber - ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo), argInfo.Attribs #if !NO_TYPEPROVIDERS @@ -1293,7 +1293,7 @@ type MethInfo = if p.Type.TypeRef.FullName = "System.Int32" then CallerFilePath else CallerLineNumber - ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) ] ] + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo), [] ] ] | FSMeth(g, _, vref, _) -> GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref @@ -1315,7 +1315,7 @@ type MethInfo = | None -> ReflectedArgInfo.None let isOutArg = p.PUntaint((fun p -> p.IsOut && not p.IsIn), m) let isInArg = p.PUntaint((fun p -> p.IsIn && not p.IsOut), m) - ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, NoCallerInfo, reflArgInfo)] ] + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, NoCallerInfo, reflArgInfo), [] ] ] #endif /// Get the signature of an abstract method slot. @@ -1426,13 +1426,13 @@ type MethInfo = #endif let paramAttribs = x.GetParamAttribs(amap, m) - (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun info (ParamNameAndType(nmOpt, pty)) -> - let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info - ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, nmOpt, reflArgInfo, pty))) + (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun (info, attribs) (ParamNameAndType(nmOpt, pty)) -> + let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info + ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, nmOpt, reflArgInfo, pty), attribs)) /// Get the ParamData objects for the parameters of a MethInfo member x.HasParamArrayArg(amap, m, minst) = - x.GetParamDatas(amap, m, minst) |> List.existsSquared (fun (ParamData(isParamArrayArg, _, _, _, _, _, _, _)) -> isParamArrayArg) + x.GetParamDatas(amap, m, minst) |> List.existsSquared (fun (ParamData(isParamArrayArg, _, _, _, _, _, _, _), _) -> isParamArrayArg) /// Select all the type parameters of the declaring type of a method. /// diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index 9ab99a8346b..0a5389ca88e 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -146,7 +146,7 @@ type ParamAttribs = callerInfo: CallerInfo * reflArgInfo: ReflectedArgInfo -val CrackParamAttribsInfo: TcGlobals -> ty: TType * argInfo: ArgReprInfo -> ParamAttribs +val CrackParamAttribsInfo: TcGlobals -> ty: TType * argInfo: ArgReprInfo -> ParamAttribs * Attribs /// Describes an F# use of an IL type, including the type instantiation associated with the type at a particular usage point. [] @@ -524,10 +524,10 @@ type MethInfo = member GetCustomAttrs: unit -> ILAttributes /// Get the parameter attributes of a method info, which get combined with the parameter names and types - member GetParamAttribs: amap: ImportMap * m: range -> ParamAttribs list list + member GetParamAttribs: amap: ImportMap * m: range -> (ParamAttribs * Attribs) list list /// Get the ParamData objects for the parameters of a MethInfo - member GetParamDatas: amap: ImportMap * m: range * minst: TType list -> ParamData list list + member GetParamDatas: amap: ImportMap * m: range * minst: TType list -> (ParamData * Attribs) list list /// Get the parameter names of a MethInfo member GetParamNames: unit -> string option list list diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 9b2f6a8bc08..867e93fb275 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -662,7 +662,7 @@ type internal TypeCheckInfo match meth.GetParamDatas(amap, m, meth.FormalMethodInst) with | x :: _ -> x - |> List.choose (fun (ParamData(_isParamArray, _isInArg, _isOutArg, _optArgInfo, _callerInfo, name, _, ty)) -> + |> List.choose (fun (ParamData(_isParamArray, _isInArg, _isOutArg, _optArgInfo, _callerInfo, name, _, ty), _) -> match name with | Some id -> Some(Item.OtherName(Some id, ty, None, Some(ArgumentContainer.Method meth), id.idRange)) | None -> None) diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index e0bce073607..acae7acdeae 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -799,7 +799,7 @@ module internal DescriptionListsImpl = | Item.CtorGroup(_, minfo :: _) | Item.MethodGroup(_, minfo :: _, _) -> - let paramDatas = minfo.GetParamDatas(amap, m, minfo.FormalMethodInst) |> List.head + let paramDatas = minfo.GetParamDatas(amap, m, minfo.FormalMethodInst) |> List.head |> List.map fst let retTy = minfo.GetFSharpReturnType(amap, m, minfo.FormalMethodInst) let _prettyTyparInst, prettyParams, prettyRetTyL, _prettyConstraintsL = PrettyParamsOfParamDatas g denv item.TyparInstantiation paramDatas retTy // FUTURE: prettyTyparInst is the pretty version of the known instantiations of type parameters in the output. It could be returned diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 1220a777293..4e15bd4a0b7 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -2124,10 +2124,8 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | M m | C m -> [ for argTys in m.GetParamDatas(cenv.amap, range0, m.FormalMethodInst) do yield - [ for ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty) in argTys do - // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for - // either .NET or F# parameters - let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=[]; OtherRange=None } + [ for ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty), attribs in argTys do + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=attribs; OtherRange=None } let m = match nmOpt with | Some v -> v.idRange From 4af42165f2bf9708ec6a88fabbef28fb0b573727 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Fri, 8 Dec 2023 15:06:44 -0800 Subject: [PATCH 3/8] Fixed merge --- fcs/fcs-fable/System.Collections.fs | 19 ++++++++++++++----- fcs/fcs-fable/TcImports_shim.fs | 2 +- fcs/fcs-fable/fcs-fable.fsproj | 4 ++-- fcs/fcs-fable/test/fcs-fable-test.fsproj | 2 +- src/Compiler/AbstractIL/ilread.fs | 19 +++++++------------ src/Compiler/Checking/QuotationTranslator.fs | 4 ---- src/Compiler/CodeGen/IlxGen.fs | 4 ---- src/Compiler/TypedTree/TypedTreeOps.fs | 18 ------------------ src/Compiler/TypedTree/TypedTreeOps.fsi | 4 ---- src/Compiler/Utilities/Cancellable.fs | 8 ++++++++ 10 files changed, 33 insertions(+), 51 deletions(-) diff --git a/fcs/fcs-fable/System.Collections.fs b/fcs/fcs-fable/System.Collections.fs index b9776db3afa..c9cb4b270a3 100644 --- a/fcs/fcs-fable/System.Collections.fs +++ b/fcs/fcs-fable/System.Collections.fs @@ -34,6 +34,7 @@ module Immutable = type ImmutableArray<'T> = static member CreateBuilder() = ResizeArray<'T>() + [] type ImmutableHashSet<'T>(values: 'T seq) = let xs = HashSet<'T>(values) @@ -62,13 +63,21 @@ module Immutable = member _.GetEnumerator(): IEnumerator<'T> = xs.GetEnumerator() - type ImmutableDictionary<'Key, 'Value when 'Key: equality>(pairs: KeyValuePair<'Key, 'Value> seq) = - let xs = Dictionary<'Key, 'Value>() - do for pair in pairs do xs.Add(pair.Key, pair.Value) + [] + type ImmutableDictionary<'Key, 'Value when 'Key: equality>(xs: Dictionary<'Key, 'Value>) = + static member Create(comparer: IEqualityComparer<'Key>) = + ImmutableDictionary<'Key, 'Value>(Dictionary(comparer)) - static member CreateRange(items) = ImmutableDictionary<'Key, 'Value>(items) - static member Empty = ImmutableDictionary<'Key, 'Value>(Array.empty) + static member CreateRange(items: IEnumerable>) = + let xs = Dictionary<'Key, 'Value>() + for pair in items do + xs.Add(pair.Key, pair.Value) + ImmutableDictionary<'Key, 'Value>(xs) + static member Empty = + ImmutableDictionary<'Key, 'Value>(Dictionary()) + + member _.IsEmpty = xs.Count = 0 member _.Item with get (key: 'Key): 'Value = xs[key] member _.ContainsKey (key: 'Key) = xs.ContainsKey(key) diff --git a/fcs/fcs-fable/TcImports_shim.fs b/fcs/fcs-fable/TcImports_shim.fs index 226695c7aaf..b3eda77d9a2 100644 --- a/fcs/fcs-fable/TcImports_shim.fs +++ b/fcs/fcs-fable/TcImports_shim.fs @@ -176,7 +176,7 @@ module TcImports = XmlDocumentationInfo = None } - let optdata = lazy ( + let optdata = InterruptibleLazy(fun _ -> match memoize_opt.Apply ccuName with | None -> None | Some data -> diff --git a/fcs/fcs-fable/fcs-fable.fsproj b/fcs/fcs-fable/fcs-fable.fsproj index 9099407ed47..f12e26d9774 100644 --- a/fcs/fcs-fable/fcs-fable.fsproj +++ b/fcs/fcs-fable/fcs-fable.fsproj @@ -93,8 +93,8 @@ - - + + diff --git a/fcs/fcs-fable/test/fcs-fable-test.fsproj b/fcs/fcs-fable/test/fcs-fable-test.fsproj index bcc9b5414e2..ccaf13c1aaa 100644 --- a/fcs/fcs-fable/test/fcs-fable-test.fsproj +++ b/fcs/fcs-fable/test/fcs-fable-test.fsproj @@ -20,7 +20,7 @@ - + diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 009f5d198cc..49c404fb83e 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -1194,19 +1194,14 @@ type ISeekReadIndexedRowReader<'RowT, 'KeyT, 'T when 'RowT: struct> = abstract CompareKey: 'KeyT -> int abstract ConvertRow: ref<'RowT> -> 'T -#if FABLE_COMPILER [] type CustomAttributeRow = val mutable parentIndex: TaggedIndex val mutable typeIndex: TaggedIndex val mutable valueIndex: int -let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader) = +let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader) = let mutable row = ref Unchecked.defaultof -#else -let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = - let mutable row = Unchecked.defaultof<'RowT> -#endif let mutable startRid = -1 let mutable endRid = -1 @@ -1285,9 +1280,9 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead let mutable fin = false while rid <= numRows && not fin do - reader.GetRow(rid, &row) + reader.GetRow(rid, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then + if reader.CompareKey(reader.GetKey(row)) = 0 then endRid <- rid else fin <- true @@ -1296,7 +1291,7 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead startRid, endRid -let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = +let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader) = let startRid, endRid = seekReadIndexedRowsRange numRows binaryChop reader if startRid <= 0 || endRid < startRid then @@ -1304,9 +1299,9 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR else Array.init (endRid - startRid + 1) (fun i -> - let mutable row = Unchecked.defaultof<'RowT> - reader.GetRow(startRid + i, &row) - reader.ConvertRow(&row)) + let mutable row = ref Unchecked.defaultof + reader.GetRow(startRid + i, row) + reader.ConvertRow(row)) let inline rowAddr (ctxt: ILMetadataReader) (tn: TableName) (idx: int) = ref (ctxt.rowAddr tn idx) diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index 4ffe3555815..ba5e118eaca 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -720,13 +720,9 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let witnessArgInfo = if g.generateWitnesses && inWitnessPassingScope then let witnessInfo = traitInfo.GetWitnessInfo() -#if FABLE_COMPILER - env.witnessesInScope.TryFind witnessInfo -#else match env.witnessesInScope.TryGetValue witnessInfo with | true, storage -> Some storage | _ -> None -#endif else None diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index bfa09cd6228..95bb2c20e50 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1363,13 +1363,9 @@ let ComputeGenerateWitnesses (g: TcGlobals) eenv = && not eenv.suppressWitnesses let TryStorageForWitness (_g: TcGlobals) eenv (w: TraitWitnessInfo) = -#if FABLE_COMPILER - eenv.witnessesInScope.TryFind w -#else match eenv.witnessesInScope.TryGetValue w with | true, storage -> Some storage | _ -> None -#endif let IsValRefIsDllImport g (vref: ValRef) = vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index e43fcd3ad68..7bd5f37c8f6 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -11428,23 +11428,6 @@ let CombineCcuContentFragments l = /// An immutable mapping from witnesses to some data. /// /// Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see EmptyTraitWitnessInfoHashMap -#if FABLE_COMPILER -type TraitWitnessInfoHashMap<'T> = Internal.Utilities.Collections.Tagged.Map - -/// Create an empty immutable mapping from witnesses to some data -let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = - let comparer = - { new IComparer with - member _.Compare(x, y) = - let xhash = hash x - let yhash = hash y - let equals x y = traitKeysAEquiv g TypeEquivEnv.Empty x y - if xhash = yhash - then if equals x y then 0 else -1 - else if xhash < yhash then -1 else 1 - } - Internal.Utilities.Collections.Tagged.Map<_,_>.FromList(comparer, []) -#else //!FABLE_COMPILER type TraitWitnessInfoHashMap<'T> = ImmutableDictionary /// Create an empty immutable mapping from witnesses to some data @@ -11454,7 +11437,6 @@ let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = member _.Equals(a, b) = nullSafeEquality a b (fun a b -> traitKeysAEquiv g TypeEquivEnv.Empty a b) member _.GetHashCode(a) = hash a.MemberName }) -#endif //!FABLE_COMPILER [] let (|WhileExpr|_|) expr = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 4ff2084049b..e644c7bb459 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2726,11 +2726,7 @@ val GetTraitWitnessInfosOfTypars: TcGlobals -> numParentTypars: int -> typars: T /// An immutable mapping from witnesses to some data. /// /// Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see EmptyTraitWitnessInfoHashMap -#if FABLE_COMPILER -type TraitWitnessInfoHashMap<'T> = Internal.Utilities.Collections.Tagged.Map -#else type TraitWitnessInfoHashMap<'T> = ImmutableDictionary -#endif /// Create an empty immutable mapping from witnesses to some data val EmptyTraitWitnessInfoHashMap: TcGlobals -> TraitWitnessInfoHashMap<'T> diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 605977f83a4..6e8040c73d6 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -59,11 +59,15 @@ module Cancellable = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled(OperationCanceledException ct) else +#if FABLE_COMPILER + oper ct +#else try use _ = Cancellable.UsingToken(ct) oper ct with :? OperationCanceledException as e -> ValueOrCancelled.Cancelled(OperationCanceledException e.CancellationToken) +#endif let fold f acc seq = Cancellable(fun ct -> @@ -155,7 +159,11 @@ type CancellableBuilder() = | Choice2Of2 err -> Cancellable.run ct (handler err) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) +#if FABLE_COMPILER + member inline _.Using(resource: 'Resource when 'Resource :> IDisposable, [] comp) = +#else member inline _.Using(resource, [] comp) = +#endif Cancellable(fun ct -> #if !FSHARPCORE_USE_PACKAGE __debugPoint "" From 29c9fffab983e5a9c1d7be748046664b49537264 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Sun, 7 Apr 2024 11:30:11 -0700 Subject: [PATCH 4/8] Updated collections shims --- fcs/fcs-fable/System.Collections.fs | 102 +++++++++++++++++----------- 1 file changed, 63 insertions(+), 39 deletions(-) diff --git a/fcs/fcs-fable/System.Collections.fs b/fcs/fcs-fable/System.Collections.fs index c9cb4b270a3..fb953ff3b3c 100644 --- a/fcs/fcs-fable/System.Collections.fs +++ b/fcs/fcs-fable/System.Collections.fs @@ -20,11 +20,11 @@ module Generic = item interface System.Collections.IEnumerable with - member _.GetEnumerator(): System.Collections.IEnumerator = + member _.GetEnumerator() = (xs.GetEnumerator() :> System.Collections.IEnumerator) interface System.Collections.Generic.IEnumerable<'T> with - member _.GetEnumerator(): System.Collections.Generic.IEnumerator<'T> = + member _.GetEnumerator() = xs.GetEnumerator() module Immutable = @@ -56,11 +56,11 @@ module Immutable = values |> Seq.exists (fun x -> xs.Contains(x)) interface System.Collections.IEnumerable with - member _.GetEnumerator(): System.Collections.IEnumerator = + member _.GetEnumerator() = (xs.GetEnumerator() :> System.Collections.IEnumerator) interface IEnumerable<'T> with - member _.GetEnumerator(): IEnumerator<'T> = + member _.GetEnumerator() = xs.GetEnumerator() [] @@ -97,11 +97,11 @@ module Immutable = | false, v -> (false, v) interface System.Collections.IEnumerable with - member _.GetEnumerator(): System.Collections.IEnumerator = + member _.GetEnumerator() = (xs.GetEnumerator() :> System.Collections.IEnumerator) interface IEnumerable> with - member _.GetEnumerator(): IEnumerator> = + member _.GetEnumerator() = xs.GetEnumerator() module Concurrent = @@ -117,16 +117,17 @@ module Concurrent = member _.ToArray () = xs.ToArray() interface System.Collections.IEnumerable with - member _.GetEnumerator(): System.Collections.IEnumerator = + member _.GetEnumerator() = (xs.GetEnumerator() :> System.Collections.IEnumerator) + interface IEnumerable<'T> with - member _.GetEnumerator(): IEnumerator<'T> = + member _.GetEnumerator() = xs.GetEnumerator() // not thread safe, just a Dictionary // TODO: threaded implementation [] type ConcurrentDictionary<'Key, 'Value>(comparer: IEqualityComparer<'Key>) = - inherit Dictionary<'Key, 'Value>(comparer) + let xs = Dictionary(comparer) new () = ConcurrentDictionary<'Key, 'Value>(EqualityComparer.Default) @@ -137,47 +138,70 @@ module Concurrent = new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'Key>) = ConcurrentDictionary<'Key, 'Value>(comparer) - member x.TryAdd (key: 'Key, value: 'Value): bool = - if x.ContainsKey(key) + member _.Keys = xs.Keys + member _.Values = xs.Values + + member _.Item + with get (key: 'Key): 'Value = xs[key] + and set (key: 'Key) (value: 'Value) = xs[key] <- value + + member _.Clear () = xs.Clear() + member _.ContainsKey (key: 'Key) = xs.ContainsKey(key) + + member _.TryGetValue (key: 'Key): bool * 'Value = + match xs.TryGetValue(key) with + | true, v -> (true, v) + | false, v -> (false, v) + + member _.TryAdd (key: 'Key, value: 'Value): bool = + if xs.ContainsKey(key) then false - else x.Add(key, value); true + else xs.Add(key, value); true - member x.TryRemove (key: 'Key): bool * 'Value = - match x.TryGetValue(key) with - | true, v -> (x.Remove(key), v) + member _.TryRemove (key: 'Key): bool * 'Value = + match xs.TryGetValue(key) with + | true, v -> (xs.Remove(key), v) | _ as res -> res - member x.GetOrAdd (key: 'Key, value: 'Value): 'Value = - match x.TryGetValue(key) with + member _.GetOrAdd (key: 'Key, value: 'Value): 'Value = + match xs.TryGetValue(key) with | true, v -> v - | _ -> let v = value in x.Add(key, v); v + | _ -> let v = value in xs.Add(key, v); v - member x.GetOrAdd (key: 'Key, valueFactory: System.Func<'Key, 'Value>): 'Value = - match x.TryGetValue(key) with + member _.GetOrAdd (key: 'Key, valueFactory: System.Func<'Key, 'Value>): 'Value = + match xs.TryGetValue(key) with | true, v -> v - | _ -> let v = valueFactory.Invoke(key) in x.Add(key, v); v + | _ -> let v = valueFactory.Invoke(key) in xs.Add(key, v); v - // member x.GetOrAdd<'Arg> (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, arg: 'Arg): 'Value = - // match x.TryGetValue(key) with + // member _.GetOrAdd<'Arg> (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, arg: 'Arg): 'Value = + // match xs.TryGetValue(key) with // | true, v -> v - // | _ -> let v = valueFactory(key, arg) in x.Add(key, v); v + // | _ -> let v = valueFactory(key, arg) in xs.Add(key, v); v - member x.TryUpdate (key: 'Key, value: 'Value, comparisonValue: 'Value): bool = - match x.TryGetValue(key) with - | true, v when Unchecked.equals v comparisonValue -> x[key] <- value; true + member _.TryUpdate (key: 'Key, value: 'Value, comparisonValue: 'Value): bool = + match xs.TryGetValue(key) with + | true, v when Unchecked.equals v comparisonValue -> xs[key] <- value; true | _ -> false - member x.AddOrUpdate (key: 'Key, value: 'Value, updateFactory: System.Func<'Key, 'Value, 'Value>): 'Value = - match x.TryGetValue(key) with - | true, v -> let v = updateFactory.Invoke(key, v) in x[key] <- v; v - | _ -> let v = value in x.Add(key, v); v + member _.AddOrUpdate (key: 'Key, value: 'Value, updateFactory: System.Func<'Key, 'Value, 'Value>): 'Value = + match xs.TryGetValue(key) with + | true, v -> let v = updateFactory.Invoke(key, v) in xs[key] <- v; v + | _ -> let v = value in xs.Add(key, v); v + + // member _.AddOrUpdate (key: 'Key, valueFactory: 'Key -> 'Value, updateFactory: 'Key * 'Value -> 'Value): 'Value = + // match xs.TryGetValue(key) with + // | true, v -> let v = updateFactory(key, v) in xs[key] <- v; v + // | _ -> let v = valueFactory(key) in xs.Add(key, v); v - // member x.AddOrUpdate (key: 'Key, valueFactory: 'Key -> 'Value, updateFactory: 'Key * 'Value -> 'Value): 'Value = - // match x.TryGetValue(key) with - // | true, v -> let v = updateFactory(key, v) in x[key] <- v; v - // | _ -> let v = valueFactory(key) in x.Add(key, v); v + // member _.AddOrUpdate (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, updateFactory: 'Key * 'Arg * 'Value -> 'Value, arg: 'Arg): 'Value = + // match xs.TryGetValue(key) with + // | true, v -> let v = updateFactory(key, arg, v) in xs[key] <- v; v + // | _ -> let v = valueFactory(key, arg) in xs.Add(key, v); v - // member x.AddOrUpdate (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, updateFactory: 'Key * 'Arg * 'Value -> 'Value, arg: 'Arg): 'Value = - // match x.TryGetValue(key) with - // | true, v -> let v = updateFactory(key, arg, v) in x[key] <- v; v - // | _ -> let v = valueFactory(key, arg) in x.Add(key, v); v \ No newline at end of file + interface System.Collections.IEnumerable with + member _.GetEnumerator() = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + + interface IEnumerable> with + member _.GetEnumerator() = + xs.GetEnumerator() From 4a9a2213d04daab356ec015c01bab01dcab1d98a Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Fri, 15 Nov 2024 08:54:36 -0800 Subject: [PATCH 5/8] Updated System.Collections --- fcs/fcs-fable/System.Collections.fs | 142 ++++++++++++---------------- src/Compiler/Symbols/Exprs.fs | 5 - 2 files changed, 62 insertions(+), 85 deletions(-) diff --git a/fcs/fcs-fable/System.Collections.fs b/fcs/fcs-fable/System.Collections.fs index fb953ff3b3c..5da3b027d95 100644 --- a/fcs/fcs-fable/System.Collections.fs +++ b/fcs/fcs-fable/System.Collections.fs @@ -4,29 +4,6 @@ namespace System.Collections -module Generic = - - type Queue<'T>() = - let xs = ResizeArray<'T>() - - member _.Clear () = xs.Clear() - - member _.Enqueue (item: 'T) = - xs.Add(item) - - member _.Dequeue () = - let item = xs.Item(0) - xs.RemoveAt(0) - item - - interface System.Collections.IEnumerable with - member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) - - interface System.Collections.Generic.IEnumerable<'T> with - member _.GetEnumerator() = - xs.GetEnumerator() - module Immutable = open System.Collections.Generic @@ -35,7 +12,7 @@ module Immutable = static member CreateBuilder() = ResizeArray<'T>() [] - type ImmutableHashSet<'T>(values: 'T seq) = + type ImmutableHashSet<'T when 'T: equality>(values: 'T seq) = let xs = HashSet<'T>(values) static member Create<'T>(values) = ImmutableHashSet<'T>(values) @@ -48,61 +25,63 @@ module Immutable = member _.Union (values: seq<'T>) = let copy = HashSet<'T>(xs) - copy.UnionWith(values) + // copy.UnionWith(values) + for value in values do + copy.Add(value) |> ignore ImmutableHashSet<'T>(copy) member _.Overlaps (values: seq<'T>) = // xs.Overlaps(values) values |> Seq.exists (fun x -> xs.Contains(x)) - interface System.Collections.IEnumerable with - member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) - interface IEnumerable<'T> with member _.GetEnumerator() = xs.GetEnumerator() + interface System.Collections.IEnumerable with + member _.GetEnumerator() = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + [] - type ImmutableDictionary<'Key, 'Value when 'Key: equality>(xs: Dictionary<'Key, 'Value>) = - static member Create(comparer: IEqualityComparer<'Key>) = - ImmutableDictionary<'Key, 'Value>(Dictionary(comparer)) + type ImmutableDictionary<'K, 'V when 'K: equality>(xs: Dictionary<'K, 'V>) = + static member Create(comparer: IEqualityComparer<'K>) = + ImmutableDictionary<'K, 'V>(Dictionary(comparer)) - static member CreateRange(items: IEnumerable>) = - let xs = Dictionary<'Key, 'Value>() + static member CreateRange(items: IEnumerable>) = + let xs = Dictionary<'K, 'V>() for pair in items do xs.Add(pair.Key, pair.Value) - ImmutableDictionary<'Key, 'Value>(xs) + ImmutableDictionary<'K, 'V>(xs) static member Empty = - ImmutableDictionary<'Key, 'Value>(Dictionary()) + ImmutableDictionary<'K, 'V>(Dictionary()) member _.IsEmpty = xs.Count = 0 - member _.Item with get (key: 'Key): 'Value = xs[key] - member _.ContainsKey (key: 'Key) = xs.ContainsKey(key) + member _.Item with get (key: 'K): 'V = xs[key] + member _.ContainsKey (key: 'K) = xs.ContainsKey(key) - member _.Add (key: 'Key, value: 'Value) = - let copy = Dictionary<'Key, 'Value>(xs) + member _.Add (key: 'K, value: 'V) = + let copy = Dictionary<'K, 'V>(xs) copy.Add(key, value) - ImmutableDictionary<'Key, 'Value>(copy) + ImmutableDictionary<'K, 'V>(copy) - member _.SetItem (key: 'Key, value: 'Value) = - let copy = Dictionary<'Key, 'Value>(xs) + member _.SetItem (key: 'K, value: 'V) = + let copy = Dictionary<'K, 'V>(xs) copy[key] <- value - ImmutableDictionary<'Key, 'Value>(copy) + ImmutableDictionary<'K, 'V>(copy) - member _.TryGetValue (key: 'Key): bool * 'Value = + member _.TryGetValue (key: 'K): bool * 'V = match xs.TryGetValue(key) with | true, v -> (true, v) | false, v -> (false, v) - interface System.Collections.IEnumerable with + interface IEnumerable> with member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) + xs.GetEnumerator() - interface IEnumerable> with + interface System.Collections.IEnumerable with member _.GetEnumerator() = - xs.GetEnumerator() + (xs.GetEnumerator() :> System.Collections.IEnumerator) module Concurrent = open System.Collections.Generic @@ -116,92 +95,95 @@ module Concurrent = member _.Clear () = xs.Clear() member _.ToArray () = xs.ToArray() - interface System.Collections.IEnumerable with - member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) - interface IEnumerable<'T> with member _.GetEnumerator() = xs.GetEnumerator() + interface System.Collections.IEnumerable with + member _.GetEnumerator() = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + // not thread safe, just a Dictionary // TODO: threaded implementation [] - type ConcurrentDictionary<'Key, 'Value>(comparer: IEqualityComparer<'Key>) = + type ConcurrentDictionary<'K, 'V>(comparer: IEqualityComparer<'K>) = let xs = Dictionary(comparer) new () = - ConcurrentDictionary<'Key, 'Value>(EqualityComparer.Default) + ConcurrentDictionary<'K, 'V>(EqualityComparer.Default) new (_concurrencyLevel: int, _capacity: int) = - ConcurrentDictionary<'Key, 'Value>() - new (_concurrencyLevel: int, comparer: IEqualityComparer<'Key>) = - ConcurrentDictionary<'Key, 'Value>(comparer) - new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'Key>) = - ConcurrentDictionary<'Key, 'Value>(comparer) + ConcurrentDictionary<'K, 'V>() + new (_concurrencyLevel: int, comparer: IEqualityComparer<'K>) = + ConcurrentDictionary<'K, 'V>(comparer) + new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'K>) = + ConcurrentDictionary<'K, 'V>(comparer) + member _.Comparer = comparer member _.Keys = xs.Keys member _.Values = xs.Values member _.Item - with get (key: 'Key): 'Value = xs[key] - and set (key: 'Key) (value: 'Value) = xs[key] <- value + with get (key: 'K): 'V = xs[key] + and set (key: 'K) (value: 'V) = xs[key] <- value member _.Clear () = xs.Clear() - member _.ContainsKey (key: 'Key) = xs.ContainsKey(key) + member _.ContainsKey (key: 'K) = xs.ContainsKey(key) - member _.TryGetValue (key: 'Key): bool * 'Value = + member _.TryGetValue (key: 'K): bool * 'V = match xs.TryGetValue(key) with | true, v -> (true, v) | false, v -> (false, v) - member _.TryAdd (key: 'Key, value: 'Value): bool = + member _.TryAdd (key: 'K, value: 'V): bool = if xs.ContainsKey(key) then false else xs.Add(key, value); true - member _.TryRemove (key: 'Key): bool * 'Value = + member _.TryRemove (key: 'K): bool * 'V = match xs.TryGetValue(key) with | true, v -> (xs.Remove(key), v) | _ as res -> res - member _.GetOrAdd (key: 'Key, value: 'Value): 'Value = + member _.GetOrAdd (key: 'K, value: 'V): 'V = match xs.TryGetValue(key) with | true, v -> v | _ -> let v = value in xs.Add(key, v); v - member _.GetOrAdd (key: 'Key, valueFactory: System.Func<'Key, 'Value>): 'Value = + member _.GetOrAdd (key: 'K, valueFactory: System.Func<'K, 'V>): 'V = match xs.TryGetValue(key) with | true, v -> v | _ -> let v = valueFactory.Invoke(key) in xs.Add(key, v); v - // member _.GetOrAdd<'Arg> (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, arg: 'Arg): 'Value = + // member _.GetOrAdd<'Arg> (key: 'K, valueFactory: 'K * 'Arg -> 'V, arg: 'Arg): 'V = // match xs.TryGetValue(key) with // | true, v -> v // | _ -> let v = valueFactory(key, arg) in xs.Add(key, v); v - member _.TryUpdate (key: 'Key, value: 'Value, comparisonValue: 'Value): bool = - match xs.TryGetValue(key) with - | true, v when Unchecked.equals v comparisonValue -> xs[key] <- value; true - | _ -> false + member _.TryUpdate (key: 'K, value: 'V, comparisonValue: 'V): bool = + // match xs.TryGetValue(key) with + // | true, v when Unchecked.equals v comparisonValue -> xs[key] <- value; true + // | _ -> false + xs[key] <- value + true - member _.AddOrUpdate (key: 'Key, value: 'Value, updateFactory: System.Func<'Key, 'Value, 'Value>): 'Value = + member _.AddOrUpdate (key: 'K, value: 'V, updateFactory: System.Func<'K, 'V, 'V>): 'V = match xs.TryGetValue(key) with | true, v -> let v = updateFactory.Invoke(key, v) in xs[key] <- v; v | _ -> let v = value in xs.Add(key, v); v - // member _.AddOrUpdate (key: 'Key, valueFactory: 'Key -> 'Value, updateFactory: 'Key * 'Value -> 'Value): 'Value = + // member _.AddOrUpdate (key: 'K, valueFactory: 'K -> 'V, updateFactory: 'K * 'V -> 'V): 'V = // match xs.TryGetValue(key) with // | true, v -> let v = updateFactory(key, v) in xs[key] <- v; v // | _ -> let v = valueFactory(key) in xs.Add(key, v); v - // member _.AddOrUpdate (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, updateFactory: 'Key * 'Arg * 'Value -> 'Value, arg: 'Arg): 'Value = + // member _.AddOrUpdate (key: 'K, valueFactory: 'K * 'Arg -> 'V, updateFactory: 'K * 'Arg * 'V -> 'V, arg: 'Arg): 'V = // match xs.TryGetValue(key) with // | true, v -> let v = updateFactory(key, arg, v) in xs[key] <- v; v // | _ -> let v = valueFactory(key, arg) in xs.Add(key, v); v - interface System.Collections.IEnumerable with + interface IEnumerable> with member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) + xs.GetEnumerator() - interface IEnumerable> with + interface System.Collections.IEnumerable with member _.GetEnumerator() = - xs.GetEnumerator() + (xs.GetEnumerator() :> System.Collections.IEnumerator) diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index b5c6e894b96..c32a1398b4e 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -1255,13 +1255,8 @@ module FSharpExprConvert = | Const.UInt32 i -> E.Const(box i, tyR) | Const.Int64 i -> E.Const(box i, tyR) | Const.UInt64 i -> E.Const(box i, tyR) -#if FABLE_COMPILER - | Const.IntPtr i -> E.Const(box i, tyR) - | Const.UIntPtr i -> E.Const(box i, tyR) -#else | Const.IntPtr i -> E.Const(box (nativeint i), tyR) | Const.UIntPtr i -> E.Const(box (unativeint i), tyR) -#endif | Const.Decimal i -> E.Const(box i, tyR) | Const.Double i -> E.Const(box i, tyR) | Const.Single i -> E.Const(box i, tyR) From cbb34c1e8d321a542f78004eedf3a82766170778 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Wed, 15 Jan 2025 09:16:23 -0800 Subject: [PATCH 6/8] Fixed merge issues --- buildtools/buildtools.targets | 4 +- fcs/build.sh | 4 +- fcs/fcs-fable/FSStrings.fs | 45 +++-- fcs/fcs-fable/SR.fs | 9 +- .../System.Collections.Concurrent.fs | 83 ++++++++ fcs/fcs-fable/System.Collections.Generic.fs | 121 +++++++++++ fcs/fcs-fable/System.Collections.Immutable.fs | 87 ++++++++ fcs/fcs-fable/System.Collections.fs | 189 ------------------ fcs/fcs-fable/System.fs | 5 + fcs/fcs-fable/TcImports_shim.fs | 48 +++-- fcs/fcs-fable/codegen/codegen.fsproj | 6 +- fcs/fcs-fable/fcs-fable.fsproj | 48 ++++- fcs/fcs-fable/service_slim.fs | 2 +- .../test/bench/fcs-fable-bench.fsproj | 6 +- fcs/fcs-fable/test/fcs-fable-test.fsproj | 6 +- src/Compiler/AbstractIL/ilread.fs | 28 +-- .../Checking/Expressions/CheckExpressions.fs | 15 ++ .../Checking/PatternMatchCompilation.fs | 2 + src/Compiler/Driver/CompilerDiagnostics.fs | 14 +- src/Compiler/Driver/CompilerImports.fsi | 3 + .../Driver/GraphChecking/GraphProcessing.fs | 2 + .../Driver/GraphChecking/GraphProcessing.fsi | 2 + src/Compiler/Driver/ParseAndCheckInputs.fsi | 6 + src/Compiler/Facilities/DiagnosticsLogger.fs | 2 + src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 + src/Compiler/Facilities/prim-lexing.fs | 10 + src/Compiler/Service/FSharpCheckerResults.fs | 6 +- src/Compiler/Service/IncrementalBuild.fsi | 20 +- src/Compiler/Service/SynExpr.fs | 29 ++- src/Compiler/Service/service.fs | 2 + src/Compiler/Service/service.fsi | 2 + src/Compiler/SyntaxTree/LexFilter.fs | 24 +++ src/Compiler/TypedTree/TcGlobals.fs | 54 ++--- src/Compiler/TypedTree/TypedTreePickle.fs | 4 + src/Compiler/Utilities/HashMultiMap.fs | 2 + src/Compiler/Utilities/HashMultiMap.fsi | 1 + src/Compiler/Utilities/TypeHashing.fs | 5 + 37 files changed, 592 insertions(+), 306 deletions(-) create mode 100644 fcs/fcs-fable/System.Collections.Concurrent.fs create mode 100644 fcs/fcs-fable/System.Collections.Generic.fs create mode 100644 fcs/fcs-fable/System.Collections.Immutable.fs delete mode 100644 fcs/fcs-fable/System.Collections.fs diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index b4160b714f2..ed0259f01c7 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fslex\Release\net8.0\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net9.0\linux-x64\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fsyacc\Release\net8.0\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net9.0\linux-x64\fsyacc.dll diff --git a/fcs/build.sh b/fcs/build.sh index f8eca34a882..cd18cd8cb9d 100644 --- a/fcs/build.sh +++ b/fcs/build.sh @@ -4,7 +4,9 @@ cd $(dirname $0)/.. # build fslex/fsyacc tools -dotnet build -c Release buildtools +dotnet build -c Release buildtools/fslex +dotnet build -c Release buildtools/fsyacc + # build FSharp.Compiler.Service (to make sure it's not broken) dotnet build -c Release src/Compiler diff --git a/fcs/fcs-fable/FSStrings.fs b/fcs/fcs-fable/FSStrings.fs index 42257eecaca..e827a1b585a 100644 --- a/fcs/fcs-fable/FSStrings.fs +++ b/fcs/fcs-fable/FSStrings.fs @@ -14,6 +14,18 @@ let resources = ( "ConstraintSolverMissingConstraint", "A type parameter is missing a constraint '{0}'" ); + ( "ConstraintSolverNullnessWarningEquivWithTypes", + "Nullness warning: A non-nullable '{0}' was expected but this expression is nullable. Consider either changing the target to also be nullable, or use pattern matching to safely handle the null case of this expression." + ); + ( "ConstraintSolverNullnessWarningWithTypes", + "Nullness warning: The types '{0}' and '{1}' do not have compatible nullability." + ); + ( "ConstraintSolverNullnessWarningWithType", + "Nullness warning: The type '{0}' does not support 'null'." + ); + ( "ConstraintSolverNullnessWarning", + "Nullness warning: {0}." + ); ( "ConstraintSolverTypesNotInEqualityRelation1", "The unit of measure '{0}' does not match the unit of measure '{1}'" ); @@ -69,7 +81,7 @@ let resources = "Duplicate definition of {0} '{1}'" ); ( "NameClash2", - "The {0} '{1}' can not be defined because the name '{2}' clashes with the {3} '{4}' in this type or module" + "The {0} '{1}' cannot be defined because the name '{2}' clashes with the {3} '{4}' in this type or module" ); ( "Duplicate1", "Two members called '{0}' have the same signature" @@ -105,7 +117,7 @@ let resources = "A coercion from the value type \n {0} \nto the type \n {1} \nwill involve boxing. Consider using 'box' instead" ); ( "TypeIsImplicitlyAbstract", - "This type is 'abstract' since some abstract members have not been given an implementation. If this is intentional then add the '[]' attribute to your type." + "Non-abstract classes cannot contain abstract members. Either provide a default member implementation or add the '[]' attribute to your type." ); ( "NonRigidTypar1", "This construct causes code to be less generic than indicated by its type annotations. The type variable implied by the use of a '#', '_' or other type annotation at or near '{0}' has been constrained to be type '{1}'." @@ -299,6 +311,9 @@ let resources = ( "Parser.TOKEN.BAR.RBRACE", "symbol '|}'" ); + ( "Parser.TOKEN.BAR_JUST_BEFORE_NULL", + "symbol '|' (directly before 'null')" + ); ( "Parser.TOKEN.GREATER.RBRACE", "symbol '>}'" ); @@ -914,20 +929,11 @@ let resources = ( "MissingFields", "The following fields require values: {0}" ); - ( "ValueRestriction1", - "Value restriction. The value '{0}' has generic type\n {1} \nEither make the arguments to '{2}' explicit or, if you do not intend for it to be generic, add a type annotation." + ( "ValueRestrictionFunction", + """Value restriction: The value '{0}' has an inferred generic function type\n {1}\nHowever, values cannot have generic type variables like '_a in "let f: '_a". You should define '{2}' as a function instead by doing one of the following:\n- Add an explicit parameter that is applied instead of using a partial application "let f param"\n- Add a unit parameter like "let f()"\n- Write explicit type parameters like "let f<'a>"\nor if you do not intend for it to be generic, either:\n- Add an explicit type annotation like "let f : obj -> obj"\n- Apply arguments of non-generic types to the function value in later code for type inference like "do f()".\nThis error is because a let binding without parameters defines a value, not a function. Values cannot be generic because reading a value is assumed to result in the same everywhere but generic type parameters may invalidate this assumption by enabling type-dependent results.""" ); - ( "ValueRestriction2", - "Value restriction. The value '{0}' has generic type\n {1} \nEither make '{2}' into a function with explicit arguments or, if you do not intend for it to be generic, add a type annotation." - ); - ( "ValueRestriction3", - "Value restriction. This member has been inferred to have generic type\n {0} \nConstructors and property getters/setters cannot be more generic than the enclosing type. Add a type annotation to indicate the exact types involved." - ); - ( "ValueRestriction4", - "Value restriction. The value '{0}' has been inferred to have generic type\n {1} \nEither make the arguments to '{2}' explicit or, if you do not intend for it to be generic, add a type annotation." - ); - ( "ValueRestriction5", - "Value restriction. The value '{0}' has been inferred to have generic type\n {1} \nEither define '{2}' as a simple data term, make it a function with explicit arguments or, if you do not intend for it to be generic, add a type annotation." + ( "ValueRestriction", + """Value restriction: The value '{0}' has an inferred generic type\n {1}\nHowever, values cannot have generic type variables like '_a in "let x: '_a". You can do one of the following:\n- Define it as a simple data term like an integer literal, a string literal or a union case like "let x = 1"\n- Add an explicit type annotation like "let x : int"\n- Use the value as a non-generic type in later code for type inference like "do x"\nor if you still want type-dependent results, you can define '{2}' as a function instead by doing either:\n- Add a unit parameter like "let x()"\n- Write explicit type parameters like "let x<'a>".\nThis error is because a let binding without parameters defines a value, not a function. Values cannot be generic because reading a value is assumed to result in the same everywhere but generic type parameters may invalidate this assumption by enabling type-dependent results.""" ); ( "RecoverableParseError", "syntax error" @@ -945,7 +951,7 @@ let resources = "Override implementations should be given as part of the initial declaration of a type." ); ( "IntfImplInIntrinsicAugmentation", - "Interface implementations should normally be given on the initial declaration of a type. Interface implementations in augmentations may lead to accessing static bindings before they are initialized, though only if the interface implementation is invoked during initialization of the static data, and in turn access the static data. You may remove this warning using #nowarn \"69\" if you have checked this is not the case." + "Interface implementations should normally be given on the initial declaration of a type. Interface implementations in augmentations may lead to accessing static bindings before they are initialized, though only if the interface implementation is invoked during initialization of the static data, and in turn access the static data. You may remove this warning using '#nowarn \"69\"' if you have checked this is not the case." ); ( "IntfImplInExtrinsicAugmentation", "Interface implementations should be given on the initial declaration of a type." @@ -957,10 +963,10 @@ let resources = "The type referenced through '{0}' is defined in an assembly that is not referenced. You must add a reference to assembly '{1}'." ); ( "HashIncludeNotAllowedInNonScript", - "#I directives may only occur in F# script files (extensions .fsx or .fsscript). Either move this code to a script file, add a '-I' compiler option for this reference or delimit the directive with delimit it with '#if INTERACTIVE'/'#endif'." + "#I directives may only be used in F# script files (extensions .fsx or .fsscript). Either move this code to a script file, add a '-I' compiler option for this reference or delimit the directive with delimit it with '#if INTERACTIVE'/'#endif'." ); ( "HashReferenceNotAllowedInNonScript", - "#r directives may only occur in F# script files (extensions .fsx or .fsscript). Either move this code to a script file or replace this reference with the '-r' compiler option. If this directive is being executed as user input, you may delimit it with '#if INTERACTIVE'/'#endif'." + "#r directives may only be used in F# script files (extensions .fsx or .fsscript). Either move this code to a script file or replace this reference with the '-r' compiler option. If this directive is being executed as user input, you may delimit it with '#if INTERACTIVE'/'#endif'." ); ( "HashDirectiveNotAllowedInNonScript", "This directive may only be used in F# script files (extensions .fsx or .fsscript). Either remove the directive, move this code to a script file or delimit the directive with '#if INTERACTIVE'/'#endif'." @@ -1007,6 +1013,9 @@ let resources = ( "ArgumentsInSigAndImplMismatch", "The argument names in the signature '{0}' and implementation '{1}' do not match. The argument name from the signature file will be used. This may cause problems when debugging or profiling." ); + ( "DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer", + "The {0} definitions for type '{1}' in the signature and implementation are not compatible because the abbreviations differ:\n {2}\nversus\n {3}" + ); ( "Parser.TOKEN.WHILE.BANG", "keyword 'while!'" ); diff --git a/fcs/fcs-fable/SR.fs b/fcs/fcs-fable/SR.fs index 39ca804f113..7d7cc160f4a 100644 --- a/fcs/fcs-fable/SR.fs +++ b/fcs/fcs-fable/SR.fs @@ -5,11 +5,18 @@ namespace FSharp.Compiler module SR = - let GetString(name: string) = + let GetString (name: string) = match SR.Resources.resources.TryGetValue(name) with | true, value -> value | _ -> "Missing FSStrings error message for: " + name +module FSComp = + module SR = + let GetTextOpt (name: string) = + match SR.Resources.resources.TryGetValue(name) with + | true, value -> Some value + | _ -> None + module DiagnosticMessage = type ResourceString<'T>(sfmt: string, fmt: string) = member x.Format = diff --git a/fcs/fcs-fable/System.Collections.Concurrent.fs b/fcs/fcs-fable/System.Collections.Concurrent.fs new file mode 100644 index 00000000000..778ba19afa4 --- /dev/null +++ b/fcs/fcs-fable/System.Collections.Concurrent.fs @@ -0,0 +1,83 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System.Collections.Concurrent + +open System.Collections.Generic + +// not thread safe, just a ResizeArray // TODO: threaded implementation +type ConcurrentStack<'T>() = + let xs = ResizeArray<'T>() + + member _.Push (item: 'T) = xs.Add(item) + member _.PushRange (items: 'T[]) = xs.AddRange(items) + member _.Clear () = xs.Clear() + member _.ToArray () = xs.ToArray() + + interface IEnumerable<'T> with + member _.GetEnumerator() = + xs.GetEnumerator() + + interface System.Collections.IEnumerable with + member _.GetEnumerator() = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + +// not thread safe, just a Dictionary // TODO: threaded implementation +[] +type ConcurrentDictionary<'K, 'V>(comparer: IEqualityComparer<'K>) = + inherit Dictionary<'K, 'V>(comparer) + + new () = + ConcurrentDictionary<'K, 'V>(EqualityComparer.Default) + new (_concurrencyLevel: int, _capacity: int) = + ConcurrentDictionary<'K, 'V>() + new (_concurrencyLevel: int, comparer: IEqualityComparer<'K>) = + ConcurrentDictionary<'K, 'V>(comparer) + new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'K>) = + ConcurrentDictionary<'K, 'V>(comparer) + + member x.TryAdd (key: 'K, value: 'V): bool = + if x.ContainsKey(key) + then false + else x.Add(key, value); true + + member x.TryRemove (key: 'K): bool * 'V = + match x.TryGetValue(key) with + | true, v -> (x.Remove(key), v) + | _ as res -> res + + member x.GetOrAdd (key: 'K, value: 'V): 'V = + match x.TryGetValue(key) with + | true, v -> v + | _ -> let v = value in x.Add(key, v); v + + member x.GetOrAdd (key: 'K, valueFactory: System.Func<'K, 'V>): 'V = + match x.TryGetValue(key) with + | true, v -> v + | _ -> let v = valueFactory.Invoke(key) in x.Add(key, v); v + + // member x.GetOrAdd<'Arg> (key: 'K, valueFactory: 'K * 'Arg -> 'V, arg: 'Arg): 'V = + // match x.TryGetValue(key) with + // | true, v -> v + // | _ -> let v = valueFactory(key, arg) in x.Add(key, v); v + + member x.TryUpdate (key: 'K, value: 'V, comparisonValue: 'V): bool = + match x.TryGetValue(key) with + | true, v when Unchecked.equals v comparisonValue -> x[key] <- value; true + | _ -> false + + member x.AddOrUpdate (key: 'K, value: 'V, updateFactory: System.Func<'K, 'V, 'V>): 'V = + match x.TryGetValue(key) with + | true, v -> let v = updateFactory.Invoke(key, v) in x[key] <- v; v + | _ -> let v = value in x.Add(key, v); v + + // member x.AddOrUpdate (key: 'K, valueFactory: 'K -> 'V, updateFactory: 'K * 'V -> 'V): 'V = + // match x.TryGetValue(key) with + // | true, v -> let v = updateFactory(key, v) in x[key] <- v; v + // | _ -> let v = valueFactory(key) in x.Add(key, v); v + + // member x.AddOrUpdate (key: 'K, valueFactory: 'K * 'Arg -> 'V, updateFactory: 'K * 'Arg * 'V -> 'V, arg: 'Arg): 'V = + // match x.TryGetValue(key) with + // | true, v -> let v = updateFactory(key, arg, v) in x[key] <- v; v + // | _ -> let v = valueFactory(key, arg) in x.Add(key, v); v diff --git a/fcs/fcs-fable/System.Collections.Generic.fs b/fcs/fcs-fable/System.Collections.Generic.fs new file mode 100644 index 00000000000..d907ac689d5 --- /dev/null +++ b/fcs/fcs-fable/System.Collections.Generic.fs @@ -0,0 +1,121 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System.Collections.Generic + +[] +type LinkedListNode<'T>(value: 'T) = + member val Value = value with get, set + member val Previous: LinkedListNode<'T> = null with get, set + member val Next: LinkedListNode<'T> = null with get, set + +type LinkedList<'T>() = + let mutable head: LinkedListNode<'T> = null + let mutable tail: LinkedListNode<'T> = null + + // Get the first node in the list + member _.First = head + + // Get the last node in the list + member _.Last = tail + + // Get the number of nodes in the list + member _.Count = + let rec loop (currentNode: LinkedListNode<'T>) count = + if currentNode = null then count + else loop currentNode.Next (count + 1) + loop head 0 + + // Clear the list + member _.Clear() = + head <- null + tail <- null + + // Add a new node to the end of the list + member _.AddLast(value: 'T) = + let newNode = LinkedListNode(value) + if tail = null then + head <- newNode + tail <- newNode + else + tail.Next <- newNode + newNode.Previous <- tail + tail <- newNode + newNode + + // Add a node to the end of the list + member _.AddLast(node: LinkedListNode<'T>) = + if tail = null then + node.Next <- null + node.Previous <- null + head <- node + tail <- node + else + tail.Next <- node + node.Next <- null + node.Previous <- tail + tail <- node + + // Add a new node to the beginning of the list + member _.AddFirst(value: 'T) = + let newNode = LinkedListNode(value) + if head = null then + head <- newNode + tail <- newNode + else + head.Previous <- newNode + newNode.Next <- head + head <- newNode + newNode + + // Add a node to the beginning of the list + member _.AddFirst(node: LinkedListNode<'T>) = + if head = null then + node.Next <- null + node.Previous <- null + head <- node + tail <- node + else + head.Previous <- node + node.Next <- head + node.Previous <- null + head <- node + + // Remove a node from the list + member _.Remove(node: LinkedListNode<'T>) = + match node.Previous, node.Next with + | null, null -> + head <- null + tail <- null + | null, nextNode -> + nextNode.Previous <- null + head <- nextNode + | prevNode, null -> + prevNode.Next <- null + tail <- prevNode + | prevNode, nextNode -> + prevNode.Next <- nextNode + nextNode.Previous <- prevNode + + // Find a node by value + member _.Find(value: 'T) = + let rec loop (currentNode: LinkedListNode<'T>) = + if currentNode = null then null + elif Unchecked.equals currentNode.Value value then currentNode + else loop currentNode.Next + loop head + + // Implement IEnumerable interface + interface System.Collections.Generic.IEnumerable<'T> with + member _.GetEnumerator() = + let rec loop (currentNode: LinkedListNode<'T>) = + seq { + if currentNode <> null then + yield currentNode.Value + yield! loop currentNode.Next + } + (loop head).GetEnumerator() + + member this.GetEnumerator() : System.Collections.IEnumerator = + (this :> System.Collections.Generic.IEnumerable<'T>).GetEnumerator() :> System.Collections.IEnumerator diff --git a/fcs/fcs-fable/System.Collections.Immutable.fs b/fcs/fcs-fable/System.Collections.Immutable.fs new file mode 100644 index 00000000000..5d7a89275df --- /dev/null +++ b/fcs/fcs-fable/System.Collections.Immutable.fs @@ -0,0 +1,87 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System.Collections.Immutable + +open System.Collections.Generic + +// not immutable, just an Array // TODO: immutable implementation +type ImmutableArray<'T> = 'T array + +module ImmutableArray = + let CreateBuilder<'T>() = ResizeArray<'T>() + let Create<'T>(items: 'T[], start: int, length: int) = + items[start..(start + length - 1)] + +[] +type ImmutableHashSet<'T when 'T: equality>(values: 'T seq) = + let xs = HashSet<'T>(values) + + static member Create<'T>(values: 'T seq) = ImmutableHashSet<'T>(values) + static member Empty = ImmutableHashSet<'T>(Array.empty) + + member _.Add (value: 'T) = + let copy = HashSet<'T>(xs) + copy.Add(value) |> ignore + ImmutableHashSet<'T>(copy) + + member _.Union (values: seq<'T>) = + let copy = HashSet<'T>(xs) + // copy.UnionWith(values) + for value in values do + copy.Add(value) |> ignore + ImmutableHashSet<'T>(copy) + + member _.Overlaps (values: seq<'T>) = + // xs.Overlaps(values) + values |> Seq.exists (fun x -> xs.Contains(x)) + + interface IEnumerable<'T> with + member _.GetEnumerator() = + xs.GetEnumerator() + + interface System.Collections.IEnumerable with + member _.GetEnumerator() = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + +[] +type ImmutableDictionary<'K, 'V when 'K: equality>(xs: Dictionary<'K, 'V>) = + static member Create(comparer: IEqualityComparer<'K>) = + ImmutableDictionary<'K, 'V>(Dictionary(comparer)) + + static member CreateRange(items: IEnumerable>) = + let xs = Dictionary<'K, 'V>() + for pair in items do + xs.Add(pair.Key, pair.Value) + ImmutableDictionary<'K, 'V>(xs) + + static member Empty = + ImmutableDictionary<'K, 'V>(Dictionary()) + + member _.IsEmpty = xs.Count = 0 + member _.Item with get (key: 'K): 'V = xs[key] + member _.ContainsKey (key: 'K) = xs.ContainsKey(key) + + member _.Add (key: 'K, value: 'V) = + let copy = Dictionary<'K, 'V>(xs) + copy.Add(key, value) + ImmutableDictionary<'K, 'V>(copy) + + member _.SetItem (key: 'K, value: 'V) = + let copy = Dictionary<'K, 'V>(xs) + copy[key] <- value + ImmutableDictionary<'K, 'V>(copy) + + member _.TryGetValue (key: 'K): bool * 'V = + match xs.TryGetValue(key) with + | true, v -> (true, v) + | false, v -> (false, v) + + interface IEnumerable> with + member _.GetEnumerator() = + xs.GetEnumerator() + + interface System.Collections.IEnumerable with + member _.GetEnumerator() = + (xs.GetEnumerator() :> System.Collections.IEnumerator) diff --git a/fcs/fcs-fable/System.Collections.fs b/fcs/fcs-fable/System.Collections.fs deleted file mode 100644 index 5da3b027d95..00000000000 --- a/fcs/fcs-fable/System.Collections.fs +++ /dev/null @@ -1,189 +0,0 @@ -//------------------------------------------------------------------------ -// shims for things not yet implemented in Fable -//------------------------------------------------------------------------ - -namespace System.Collections - -module Immutable = - open System.Collections.Generic - - // not immutable, just a ResizeArray // TODO: immutable implementation - type ImmutableArray<'T> = - static member CreateBuilder() = ResizeArray<'T>() - - [] - type ImmutableHashSet<'T when 'T: equality>(values: 'T seq) = - let xs = HashSet<'T>(values) - - static member Create<'T>(values) = ImmutableHashSet<'T>(values) - static member Empty = ImmutableHashSet<'T>(Array.empty) - - member _.Add (value: 'T) = - let copy = HashSet<'T>(xs) - copy.Add(value) |> ignore - ImmutableHashSet<'T>(copy) - - member _.Union (values: seq<'T>) = - let copy = HashSet<'T>(xs) - // copy.UnionWith(values) - for value in values do - copy.Add(value) |> ignore - ImmutableHashSet<'T>(copy) - - member _.Overlaps (values: seq<'T>) = - // xs.Overlaps(values) - values |> Seq.exists (fun x -> xs.Contains(x)) - - interface IEnumerable<'T> with - member _.GetEnumerator() = - xs.GetEnumerator() - - interface System.Collections.IEnumerable with - member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) - - [] - type ImmutableDictionary<'K, 'V when 'K: equality>(xs: Dictionary<'K, 'V>) = - static member Create(comparer: IEqualityComparer<'K>) = - ImmutableDictionary<'K, 'V>(Dictionary(comparer)) - - static member CreateRange(items: IEnumerable>) = - let xs = Dictionary<'K, 'V>() - for pair in items do - xs.Add(pair.Key, pair.Value) - ImmutableDictionary<'K, 'V>(xs) - - static member Empty = - ImmutableDictionary<'K, 'V>(Dictionary()) - - member _.IsEmpty = xs.Count = 0 - member _.Item with get (key: 'K): 'V = xs[key] - member _.ContainsKey (key: 'K) = xs.ContainsKey(key) - - member _.Add (key: 'K, value: 'V) = - let copy = Dictionary<'K, 'V>(xs) - copy.Add(key, value) - ImmutableDictionary<'K, 'V>(copy) - - member _.SetItem (key: 'K, value: 'V) = - let copy = Dictionary<'K, 'V>(xs) - copy[key] <- value - ImmutableDictionary<'K, 'V>(copy) - - member _.TryGetValue (key: 'K): bool * 'V = - match xs.TryGetValue(key) with - | true, v -> (true, v) - | false, v -> (false, v) - - interface IEnumerable> with - member _.GetEnumerator() = - xs.GetEnumerator() - - interface System.Collections.IEnumerable with - member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) - -module Concurrent = - open System.Collections.Generic - - // not thread safe, just a ResizeArray // TODO: threaded implementation - type ConcurrentStack<'T>() = - let xs = ResizeArray<'T>() - - member _.Push (item: 'T) = xs.Add(item) - member _.PushRange (items: 'T[]) = xs.AddRange(items) - member _.Clear () = xs.Clear() - member _.ToArray () = xs.ToArray() - - interface IEnumerable<'T> with - member _.GetEnumerator() = - xs.GetEnumerator() - - interface System.Collections.IEnumerable with - member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) - - // not thread safe, just a Dictionary // TODO: threaded implementation - [] - type ConcurrentDictionary<'K, 'V>(comparer: IEqualityComparer<'K>) = - let xs = Dictionary(comparer) - - new () = - ConcurrentDictionary<'K, 'V>(EqualityComparer.Default) - new (_concurrencyLevel: int, _capacity: int) = - ConcurrentDictionary<'K, 'V>() - new (_concurrencyLevel: int, comparer: IEqualityComparer<'K>) = - ConcurrentDictionary<'K, 'V>(comparer) - new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'K>) = - ConcurrentDictionary<'K, 'V>(comparer) - - member _.Comparer = comparer - member _.Keys = xs.Keys - member _.Values = xs.Values - - member _.Item - with get (key: 'K): 'V = xs[key] - and set (key: 'K) (value: 'V) = xs[key] <- value - - member _.Clear () = xs.Clear() - member _.ContainsKey (key: 'K) = xs.ContainsKey(key) - - member _.TryGetValue (key: 'K): bool * 'V = - match xs.TryGetValue(key) with - | true, v -> (true, v) - | false, v -> (false, v) - - member _.TryAdd (key: 'K, value: 'V): bool = - if xs.ContainsKey(key) - then false - else xs.Add(key, value); true - - member _.TryRemove (key: 'K): bool * 'V = - match xs.TryGetValue(key) with - | true, v -> (xs.Remove(key), v) - | _ as res -> res - - member _.GetOrAdd (key: 'K, value: 'V): 'V = - match xs.TryGetValue(key) with - | true, v -> v - | _ -> let v = value in xs.Add(key, v); v - - member _.GetOrAdd (key: 'K, valueFactory: System.Func<'K, 'V>): 'V = - match xs.TryGetValue(key) with - | true, v -> v - | _ -> let v = valueFactory.Invoke(key) in xs.Add(key, v); v - - // member _.GetOrAdd<'Arg> (key: 'K, valueFactory: 'K * 'Arg -> 'V, arg: 'Arg): 'V = - // match xs.TryGetValue(key) with - // | true, v -> v - // | _ -> let v = valueFactory(key, arg) in xs.Add(key, v); v - - member _.TryUpdate (key: 'K, value: 'V, comparisonValue: 'V): bool = - // match xs.TryGetValue(key) with - // | true, v when Unchecked.equals v comparisonValue -> xs[key] <- value; true - // | _ -> false - xs[key] <- value - true - - member _.AddOrUpdate (key: 'K, value: 'V, updateFactory: System.Func<'K, 'V, 'V>): 'V = - match xs.TryGetValue(key) with - | true, v -> let v = updateFactory.Invoke(key, v) in xs[key] <- v; v - | _ -> let v = value in xs.Add(key, v); v - - // member _.AddOrUpdate (key: 'K, valueFactory: 'K -> 'V, updateFactory: 'K * 'V -> 'V): 'V = - // match xs.TryGetValue(key) with - // | true, v -> let v = updateFactory(key, v) in xs[key] <- v; v - // | _ -> let v = valueFactory(key) in xs.Add(key, v); v - - // member _.AddOrUpdate (key: 'K, valueFactory: 'K * 'Arg -> 'V, updateFactory: 'K * 'Arg * 'V -> 'V, arg: 'Arg): 'V = - // match xs.TryGetValue(key) with - // | true, v -> let v = updateFactory(key, arg, v) in xs[key] <- v; v - // | _ -> let v = valueFactory(key, arg) in xs.Add(key, v); v - - interface IEnumerable> with - member _.GetEnumerator() = - xs.GetEnumerator() - - interface System.Collections.IEnumerable with - member _.GetEnumerator() = - (xs.GetEnumerator() :> System.Collections.IEnumerator) diff --git a/fcs/fcs-fable/System.fs b/fcs/fcs-fable/System.fs index 6678445b20a..5656f49fabd 100644 --- a/fcs/fcs-fable/System.fs +++ b/fcs/fcs-fable/System.fs @@ -8,6 +8,7 @@ type Environment() = static member ProcessorCount = 1 static member Exit(_exitcode) = () static member GetEnvironmentVariable(_variable) = null + static member StackTrace = "" module Diagnostics = type Trace() = @@ -18,6 +19,10 @@ module Reflection = member x.Name = assemblyName //TODO: proper implementation module Threading = + type AsyncLocal<'T>() = + let mutable value: 'T = Unchecked.defaultof<'T> + member val Value = value with get, set + type Interlocked() = //TODO: threaded implementation static member Increment(i: int32 byref): int32 = i <- i + 1; i diff --git a/fcs/fcs-fable/TcImports_shim.fs b/fcs/fcs-fable/TcImports_shim.fs index b3eda77d9a2..cddf4c5c62c 100644 --- a/fcs/fcs-fable/TcImports_shim.fs +++ b/fcs/fcs-fable/TcImports_shim.fs @@ -45,16 +45,14 @@ module TcImports = let tcImports = TcImports () let sigDataReaders ilModule = - [ for resource in ilModule.Resources.AsList() do - if IsSignatureDataResource resource then - let _ccuName, getBytes = GetResourceNameAndSignatureDataFunc resource - getBytes() ] + ilModule.Resources.AsList() + |> GetResourceNameAndSignatureDataFuncs + |> List.map snd let optDataReaders ilModule = - [ for resource in ilModule.Resources.AsList() do - if IsOptimizationDataResource resource then - let _ccuName, getBytes = GetResourceNameAndOptimizationDataFunc resource - getBytes() ] + ilModule.Resources.AsList() + |> GetResourceNameAndOptimizationDataFuncs + |> List.map snd let LoadMod (ccuName: string) = let fileName = @@ -71,11 +69,25 @@ module TcImports = let reader = ILBinaryReader.OpenILModuleReaderFromBytes fileName bytes opts reader.ILModuleDef //, reader.ILAssemblyRefs - let GetSignatureData (fileName:string, ilScopeRef, ilModule:ILModuleDef option, bytes: ReadOnlyByteMemory) = - unpickleObjWithDanglingCcus fileName ilScopeRef ilModule unpickleCcuInfo bytes + let GetSignatureData (file, ilScopeRef, ilModule, byteReaderA, byteReaderB) : PickledDataWithReferences = + let memA = byteReaderA () - let GetOptimizationData (fileName:string, ilScopeRef, ilModule:ILModuleDef option, bytes: ReadOnlyByteMemory) = - unpickleObjWithDanglingCcus fileName ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo bytes + let memB = + (match byteReaderB with + | None -> ByteMemory.Empty.AsReadOnly() + | Some br -> br ()) + + unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleCcuInfo memA memB + + let GetOptimizationData (file:string, ilScopeRef, ilModule, byteReaderA, byteReaderB) = + let memA = byteReaderA () + + let memB = + (match byteReaderB with + | None -> ByteMemory.Empty.AsReadOnly() + | Some br -> br ()) + + unpickleObjWithDanglingCcus file ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo memA memB let memoize_mod = new MemoizationTable<_,_> (LoadMod, keyComparer=HashIdentity.Structural) @@ -86,7 +98,7 @@ module TcImports = let fileName = ilModule.Name //TODO: try with ".sigdata" extension match sigDataReaders ilModule with | [] -> None - | bytes::_ -> Some (GetSignatureData (fileName, ilScopeRef, Some ilModule, bytes)) + | (readerA, readerB)::_ -> Some (GetSignatureData (fileName, ilScopeRef, Some ilModule, readerA, readerB)) let LoadOptData ccuName = let ilModule = memoize_mod.Apply ccuName @@ -95,7 +107,7 @@ module TcImports = let fileName = ilModule.Name //TODO: try with ".optdata" extension match optDataReaders ilModule with | [] -> None - | bytes::_ -> Some (GetOptimizationData (fileName, ilScopeRef, Some ilModule, bytes)) + | (readerA, readerB)::_ -> Some (GetOptimizationData (fileName, ilScopeRef, Some ilModule, readerA, readerB)) let memoize_sig = new MemoizationTable<_,_> (LoadSigData, keyComparer=HashIdentity.Structural) let memoize_opt = new MemoizationTable<_,_> (LoadOptData, keyComparer=HashIdentity.Structural) @@ -250,6 +262,7 @@ module TcImports = #endif None + let fslibCcu = fslibCcuInfo.FSharpViewOfMetadata let primaryScopeRef = primaryCcuInfo.ILScopeRef let fsharpCoreScopeRef = fslibCcuInfo.ILScopeRef let assembliesThatForwardToPrimaryAssembly = [] @@ -259,16 +272,19 @@ module TcImports = TcGlobals( tcConfig.compilingFSharpCore, ilGlobals, - fslibCcuInfo.FSharpViewOfMetadata, + fslibCcu, tcConfig.implicitIncludeDir, tcConfig.mlCompatibility, tcConfig.isInteractive, + tcConfig.checkNullness, tcConfig.useReflectionFreeCodeGen, tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations, tcConfig.noDebugAttributes, tcConfig.pathMap, - tcConfig.langVersion + tcConfig.langVersion, + tcConfig.realsig, + tcConfig.compilationMode ) #if DEBUG diff --git a/fcs/fcs-fable/codegen/codegen.fsproj b/fcs/fcs-fable/codegen/codegen.fsproj index eb47fd55446..3a0aac2a097 100644 --- a/fcs/fcs-fable/codegen/codegen.fsproj +++ b/fcs/fcs-fable/codegen/codegen.fsproj @@ -7,7 +7,7 @@ Exe - net8.0 + net9.0 @@ -30,11 +30,11 @@ SyntaxTree/pplex.fsl - --module FSharp.Compiler.PPParser --open FSharp.Compiler.ParseHelpers --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing --buffer-type-argument char + --module FSharp.Compiler.PPParser --open FSharp.Compiler.ParseHelpers --open FSharp.Compiler.LexerStore --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing --buffer-type-argument char SyntaxTree/pppars.fsy - --module FSharp.Compiler.Lexer --open FSharp.Compiler.Lexhelp --open Internal.Utilities.Text.Lexing --open FSharp.Compiler.Parser --open FSharp.Compiler.Text --open FSharp.Compiler.ParseHelpers --internal --unicode --lexlib Internal.Utilities.Text.Lexing + --module FSharp.Compiler.Lexer --open FSharp.Compiler.Lexhelp --open Internal.Utilities.Text.Lexing --open FSharp.Compiler.Parser --open FSharp.Compiler.Text --open FSharp.Compiler.ParseHelpers --open FSharp.Compiler.LexerStore --internal --unicode --lexlib Internal.Utilities.Text.Lexing SyntaxTree/lex.fsl diff --git a/fcs/fcs-fable/fcs-fable.fsproj b/fcs/fcs-fable/fcs-fable.fsproj index f12e26d9774..6db4eddb218 100644 --- a/fcs/fcs-fable/fcs-fable.fsproj +++ b/fcs/fcs-fable/fcs-fable.fsproj @@ -6,6 +6,7 @@ netstandard2.0 + $(DefineConstants);NO_CHECKNULLS $(DefineConstants);FABLE_COMPILER $(DefineConstants);COMPILER $(DefineConstants);FX_NO_WEAKTABLE @@ -19,7 +20,9 @@ - + + + @@ -27,8 +30,11 @@ + + + @@ -41,8 +47,6 @@ - - @@ -61,6 +65,9 @@ + + + @@ -81,6 +88,8 @@ + + @@ -93,6 +102,8 @@ + + @@ -149,6 +160,8 @@ + + @@ -175,6 +188,7 @@ + @@ -182,6 +196,7 @@ + @@ -226,12 +241,15 @@ - - + + + - - + + + + @@ -342,6 +360,10 @@ + + + + @@ -360,8 +382,16 @@ + + + + + + + + @@ -371,6 +401,8 @@ + + @@ -381,7 +413,7 @@ - + diff --git a/fcs/fcs-fable/service_slim.fs b/fcs/fcs-fable/service_slim.fs index 33643df0f48..57e106e09f8 100644 --- a/fcs/fcs-fable/service_slim.fs +++ b/fcs/fcs-fable/service_slim.fs @@ -154,7 +154,7 @@ module internal ParseAndCheck = topAttrsOpt: TopAttribs option, tcImplFilesOpt: CheckedImplFile list option, compilerState) = let assemblyRef = mkSimpleAssemblyRef "stdin" let access = tcState.TcEnvFromImpls.AccessRights - let symbolUses = Choice2Of2 TcSymbolUses.Empty + let symbolUses = Choice2Of2 (async { return seq { } }) let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat let getAssemblyData () = None let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, diff --git a/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj index a7ab44e1acd..9dadb98e53c 100644 --- a/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj +++ b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj @@ -2,7 +2,7 @@ Exe - net8.0 + net9.0 $(DefineConstants);DOTNET_FILE_SYSTEM @@ -19,9 +19,9 @@ - + - + diff --git a/fcs/fcs-fable/test/fcs-fable-test.fsproj b/fcs/fcs-fable/test/fcs-fable-test.fsproj index ccaf13c1aaa..d566a0aa63f 100644 --- a/fcs/fcs-fable/test/fcs-fable-test.fsproj +++ b/fcs/fcs-fable/test/fcs-fable-test.fsproj @@ -2,7 +2,7 @@ Exe - net8.0 + net9.0 $(DefineConstants);DOTNET_FILE_SYSTEM @@ -18,9 +18,9 @@ - + - + diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 49c404fb83e..dc1d95e3407 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -1200,8 +1200,8 @@ type CustomAttributeRow = val mutable typeIndex: TaggedIndex val mutable valueIndex: int -let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader) = - let mutable row = ref Unchecked.defaultof +let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader<_, _, _>) = + let mutable row = ref Unchecked.defaultof<_> let mutable startRid = -1 let mutable endRid = -1 @@ -1291,7 +1291,7 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead startRid, endRid -let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader) = +let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader<_, _, _>) = let startRid, endRid = seekReadIndexedRowsRange numRows binaryChop reader if startRid <= 0 || endRid < startRid then @@ -1299,7 +1299,7 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR else Array.init (endRid - startRid + 1) (fun i -> - let mutable row = ref Unchecked.defaultof + let mutable row = ref Unchecked.defaultof<_> reader.GetRow(startRid + i, row) reader.ConvertRow(row)) @@ -2145,10 +2145,10 @@ and typeDefReader ctxtH : ILTypeDefStored = else let extendsName = if extendsTag = tdor_TypeDef then - let mutable addr = ctxt.rowAddr TableNames.TypeDef extendsIdx - let _ = seekReadInt32Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let namespaceIdx = seekReadStringIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.TypeDef extendsIdx + let _ = seekReadInt32Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let namespaceIdx = seekReadStringIdx ctxt mdv addr readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) elif extendsTag = tdor_TypeRef then let _, nameIdx, namespaceIdx = seekReadTypeRefRow ctxt mdv extendsIdx @@ -2172,8 +2172,8 @@ and typeDefReader ctxtH : ILTypeDefStored = let attributesSearcher = { new ISeekReadIndexedRowReader with - member _.GetRow(i, rowIndex) = rowIndex <- i - member _.GetKey(rowIndex) = rowIndex + member _.GetRow(i, rowIndex) = rowIndex.Value <- i + member _.GetKey(rowIndex) = rowIndex.Value member _.CompareKey(rowIndex) = let mutable addr = rowAddr ctxt TableNames.CustomAttribute rowIndex @@ -2181,7 +2181,7 @@ and typeDefReader ctxtH : ILTypeDefStored = let key = seekReadHasCustomAttributeIdx ctxt mdv addr hcaCompare searchedKey key - member _.ConvertRow(i) = i + member _.ConvertRow(i) = i.Value } let attrsStartIdx, attrsEndIdx = @@ -3337,8 +3337,8 @@ and customAttrsReader ctxtH tag : ILAttributesStored = let reader = { new ISeekReadIndexedRowReader with - member _.GetRow(i, rowIndex) = rowIndex <- i - member _.GetKey(rowIndex) = rowIndex + member _.GetRow(i, rowIndex) = rowIndex.Value <- i + member _.GetKey(rowIndex) = rowIndex.Value member _.CompareKey(rowIndex) = let mutable addr = rowAddr ctxt TableNames.CustomAttribute rowIndex @@ -3348,7 +3348,7 @@ and customAttrsReader ctxtH tag : ILAttributesStored = member _.ConvertRow(rowIndex) = let mutable attrRow = ref Unchecked.defaultof<_> - seekReadCustomAttributeRow ctxt mdv rowIndex attrRow + seekReadCustomAttributeRow ctxt mdv rowIndex.Value attrRow seekReadCustomAttr ctxt (attrRow.Value.typeIndex, attrRow.Value.valueIndex) } diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index e67df927f99..7f3492ff940 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -154,6 +154,16 @@ let (|HasFormatSpecifier|_|) (s: string) = Regex.IsMatch( s, // Regex pattern for something like: %[flags][width][.precision][type] +#if FABLE_COMPILER + @"(^|[^%])" + // Start with beginning of string or any char other than '%' + @"(%%)*%" + // followed by an odd number of '%' chars + @"[+-0 ]{0,3}" + // optionally followed by flags + @"(\d+)?" + // optionally followed by width + @"(\.\d+)?" + // optionally followed by .precision + @"[bscdiuxXoBeEfFgGMOAat]" // and then a char that determines specifier's type + , + RegexOptions.Compiled) +#else """ (^|[^%]) # Start with beginning of string or any char other than '%' (%%)*% # followed by an odd number of '%' chars @@ -163,6 +173,7 @@ let (|HasFormatSpecifier|_|) (s: string) = [bscdiuxXoBeEfFgGMOAat] # and then a char that determines specifier's type """, RegexOptions.Compiled ||| RegexOptions.IgnorePatternWhitespace) +#endif then ValueSome HasFormatSpecifier else @@ -171,7 +182,11 @@ let (|HasFormatSpecifier|_|) (s: string) = // Removes trailing "%s" unless it was escaped by another '%' (checks for odd sequence of '%' before final "%s") let (|WithTrailingStringSpecifierRemoved|) (s: string) = if s.EndsWith "%s" then +#if FABLE_COMPILER + let i = s[..(s.Length - 3)].TrimEnd('%').Length - 1 +#else let i = s.AsSpan(0, s.Length - 2).LastIndexOfAnyExcept '%' +#endif let diff = s.Length - 2 - i if diff &&& 1 <> 0 then s[..s.Length - 3] diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs index 7fc4a4dcb19..2ff713c0602 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -1125,7 +1125,9 @@ let CompilePatternBasic // The main recursive loop of the pattern match compiler. let rec InvestigateFrontiers refuted frontiers = +#if !FABLE_COMPILER Cancellable.CheckAndThrow() +#endif match frontiers with | [] -> failwith "CompilePattern: compile - empty clauses: at least the final clause should always succeed" diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 6da9afecf65..9f6fbce03f4 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -693,10 +693,10 @@ type Exception with let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 - os.Append(ConstraintSolverNullnessWarningEquivWithTypesE().Format t1) |> ignore + os.AppendString(ConstraintSolverNullnessWarningEquivWithTypesE().Format t1) |> ignore if m.StartLine <> m2.StartLine then - os.Append(SeeAlsoE().Format(stringOfRange m)) |> ignore + os.AppendString(SeeAlsoE().Format(stringOfRange m)) |> ignore | ConstraintSolverNullnessWarningWithTypes(denv, ty1, ty2, _nullness1, _nullness2, m, m2) -> @@ -708,10 +708,10 @@ type Exception with let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 - os.Append(ConstraintSolverNullnessWarningWithTypesE().Format t1 t2) |> ignore + os.AppendString(ConstraintSolverNullnessWarningWithTypesE().Format t1 t2) |> ignore if m.StartLine <> m2.StartLine then - os.Append(SeeAlsoE().Format(stringOfRange m)) |> ignore + os.AppendString(SeeAlsoE().Format(stringOfRange m)) |> ignore | ConstraintSolverNullnessWarningWithType(denv, ty, _, m, m2) -> @@ -722,13 +722,13 @@ type Exception with } let t = NicePrint.minimalStringOfType denv ty - os.Append(ConstraintSolverNullnessWarningWithTypeE().Format(t)) |> ignore + os.AppendString(ConstraintSolverNullnessWarningWithTypeE().Format(t)) |> ignore if m.StartLine <> m2.StartLine then - os.Append(SeeAlsoE().Format(stringOfRange m)) |> ignore + os.AppendString(SeeAlsoE().Format(stringOfRange m)) |> ignore | ConstraintSolverNullnessWarning(msg, m, m2) -> - os.Append(ConstraintSolverNullnessWarningE().Format(msg)) |> ignore + os.AppendString(ConstraintSolverNullnessWarningE().Format(msg)) |> ignore if m.StartLine <> m2.StartLine then os.AppendString(SeeAlsoE().Format(stringOfRange m2)) diff --git a/src/Compiler/Driver/CompilerImports.fsi b/src/Compiler/Driver/CompilerImports.fsi index cb5d7449111..f7589a2d811 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/src/Compiler/Driver/CompilerImports.fsi @@ -54,6 +54,9 @@ val IsReflectedDefinitionsResource: ILResource -> bool val GetResourceNameAndSignatureDataFuncs: ILResource list -> (string * ((unit -> ReadOnlyByteMemory) * (unit -> ReadOnlyByteMemory) option)) list +val GetResourceNameAndOptimizationDataFuncs: + ILResource list -> (string * ((unit -> ReadOnlyByteMemory) * (unit -> ReadOnlyByteMemory) option)) list + #if !FABLE_COMPILER /// Encode the F# interface data into a set of IL attributes and resources diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 1ecf477f040..c319512aecd 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -180,6 +180,7 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> |> Seq.sortBy fst |> Seq.toArray +#if !FABLE_COMPILER let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> (graph: Graph<'Item>) (work: ('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> Async<'Result>) @@ -312,3 +313,4 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> |> Seq.sortBy fst |> Seq.toArray } +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fsi b/src/Compiler/Driver/GraphChecking/GraphProcessing.fsi index 7a8c9f9885e..de5b2e9d3b3 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fsi +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fsi @@ -38,7 +38,9 @@ val processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> : parentCt: CancellationToken -> ('Item * 'Result)[] +#if !FABLE_COMPILER val processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> : graph: Graph<'Item> -> work: (('Item -> ProcessedNode<'Item, 'Result>) -> NodeInfo<'Item> -> Async<'Result>) -> Async<('Item * 'Result)[]> +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index f701e8cd991..72a63371c74 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -43,6 +43,7 @@ open FSharp.Compiler.UnicodeLexing /// /// In order to deal correctly with the `ArtificialImplFile` logic, we need to transform the resolved graph to contain the additional pair nodes. /// After we have type-checked the graph, we exclude the ArtificialImplFile nodes as they are not actual physical files in our project. +#if !FABLE_COMPILER [] type NodeToTypeCheck = /// A real physical file in the current project. @@ -52,6 +53,7 @@ type NodeToTypeCheck = /// Dependents on this type of node will perceive that a file is known in both TcEnvFromSignatures and TcEnvFromImpls. /// Even though the actual implementation file was not type-checked. | ArtificialImplFile of signatureFileIndex: FileIndex +#endif //!FABLE_COMPILER val IsScript: string -> bool @@ -195,6 +197,7 @@ val CheckOneInput: input: ParsedInput -> Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> +#if !FABLE_COMPILER val CheckOneInputWithCallback: node: NodeToTypeCheck -> checkForErrors: (unit -> bool) * @@ -207,6 +210,7 @@ val CheckOneInputWithCallback: input: ParsedInput * _skipImplIfSigExists: bool -> Cancellable> +#endif //!FABLE_COMPILER val AddCheckResultsToTcState: tcGlobals: TcGlobals * @@ -220,6 +224,7 @@ val AddCheckResultsToTcState: tcState: TcState -> ModuleOrNamespaceType * TcState +#if !FABLE_COMPILER val AddSignatureResultToTcImplEnv: tcImports: TcImports * tcGlobals: TcGlobals * @@ -230,6 +235,7 @@ val AddSignatureResultToTcImplEnv: (TcState -> PartialResult * TcState) val TransformDependencyGraph: graph: Graph * filePairs: FilePairMap -> Graph +#endif //!FABLE_COMPILER /// Finish the checking of multiple inputs val CheckMultipleInputsFinish: diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index a92734b0a3b..afa84bb4c5f 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -943,6 +943,7 @@ type StackGuard(maxDepth: int, name: string) = static member GetDepthOption(name: string) = GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth +#if !FABLE_COMPILER // UseMultipleDiagnosticLoggers in ParseAndCheckProject.fs provides similar functionality. // We should probably adapt and reuse that code. module MultipleDiagnosticsLoggers = @@ -1008,3 +1009,4 @@ module MultipleDiagnosticsLoggers = return results.ToArray() } +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index e5a4c8e7f8a..08e7ed5a6fc 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -481,6 +481,7 @@ type CompilationGlobalsScope = member BuildPhase: BuildPhase +#if !FABLE_COMPILER module MultipleDiagnosticsLoggers = /// Run computations using Async.Parallel. @@ -490,3 +491,4 @@ module MultipleDiagnosticsLoggers = /// Run computations sequentially starting immediately on the current thread. val Sequential: computations: Async<'T> seq -> Async<'T array> +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/prim-lexing.fs b/src/Compiler/Facilities/prim-lexing.fs index 36e0196c3c2..f3c8ab92fc6 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -10,7 +10,9 @@ open System.Collections.Immutable open Internal.Utilities.Library open Internal.Utilities.Collections +#if !FABLE_COMPILER open Internal.Utilities.Hashing +#endif type ISourceText = @@ -168,7 +170,11 @@ type StringText(str: string) = member _.GetChecksum() = str +#if FABLE_COMPILER + |> fun s -> BitConverter.GetBytes(hash s) +#else |> Md5Hasher.hashString +#endif |> fun byteArray -> ImmutableArray.Create(byteArray, 0, byteArray.Length) module SourceText = @@ -205,7 +211,11 @@ module SourceTextNew = member _.GetChecksum() = // TODO: something better... !! sourceText.ToString() +#if FABLE_COMPILER + |> fun s -> BitConverter.GetBytes(hash s) +#else |> Md5Hasher.hashString +#endif |> fun byteArray -> ImmutableArray.Create(byteArray, 0, byteArray.Length) } diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 867e93fb275..3b4105f1fc1 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -57,7 +57,9 @@ open Internal.Utilities.Collections open FSharp.Compiler.AbstractIL.ILBinaryReader open System.Threading.Tasks open System.Runtime.CompilerServices +#if !FABLE_COMPILER open Internal.Utilities.Hashing +#endif type FSharpUnresolvedReferencesSet = FSharpUnresolvedReferencesSet of UnresolvedAssemblyReference list @@ -3844,7 +3846,7 @@ type FSharpCheckProjectResults | Choice1Of2 builder -> #if FABLE_COMPILER ignore builder - [||] + seq {} #else builder.SourceFiles |> Array.ofList @@ -3893,7 +3895,7 @@ type FSharpCheckProjectResults | Choice1Of2 builder -> #if FABLE_COMPILER ignore builder - [||] + seq {} #else builder.SourceFiles |> Array.ofList diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index f35c860cb65..758c63a7d35 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -26,6 +26,16 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.BuildGraph open Internal.Utilities.Collections +#if FABLE_COMPILER +// stub +[] +type internal IncrementalBuilder = + member IncrementUsageCount : unit -> IDisposable + member IsAlive : bool + static member KeepBuilderAlive : IncrementalBuilder option -> IDisposable + +#else //!FABLE_COMPILER + type internal FrameworkImportsCacheKey = | FrameworkImportsCacheKey of resolvedpath: string list * @@ -37,16 +47,6 @@ type internal FrameworkImportsCacheKey = interface ICacheKey -#if FABLE_COMPILER -// stub -[] -type internal IncrementalBuilder = - member IncrementUsageCount : unit -> IDisposable - member IsAlive : bool - static member KeepBuilderAlive : IncrementalBuilder option -> IDisposable - -#else //!FABLE_COMPILER - /// Lookup the global static cache for building the FrameworkTcImports type internal FrameworkImportsCache = new: size: int -> FrameworkImportsCache diff --git a/src/Compiler/Service/SynExpr.fs b/src/Compiler/Service/SynExpr.fs index e9605582514..d3bac8650c5 100644 --- a/src/Compiler/Service/SynExpr.fs +++ b/src/Compiler/Service/SynExpr.fs @@ -251,8 +251,12 @@ module SynExpr = // Trim any leading dots or question marks from the given symbolic operator. // Leading dots or question marks have no effect on operator precedence or associativity // with the exception of &, &&, and ||. +#if FABLE_COMPILER + let trimmed = originalNotation.TrimStart([|'.'; '?'|]) +#else let ignoredLeadingChars = ".?".AsSpan() let trimmed = originalNotation.AsSpan().TrimStart ignoredLeadingChars +#endif assert (trimmed.Length > 0) match trimmed[0], originalNotation with @@ -525,7 +529,13 @@ module SynExpr = match offsides with | ValueNone -> +#if FABLE_COMPILER + let slice = line[startCol..] + let mutable i = -1 + let i = if slice |> String.forall (fun c -> i <- i + 1; c = ' ' || c = ')') then -1 else i +#else let i = line.AsSpan(startCol).IndexOfAnyExcept(' ', ')') +#endif if i >= 0 then let newOffsides = i + startCol @@ -536,11 +546,20 @@ module SynExpr = loop offsides (lineNo + 1) 0 | ValueSome offsidesCol -> +#if FABLE_COMPILER + let mutable i = -1 + let i = if line |> String.forall (fun c -> i <- i + 1; i < offsidesCol && (c = ' ' || c = ')')) then -1 else i + if i >= 0 && i < offsidesCol then + let slice = line[i .. (min (offsidesCol - i) (line.Length - i)) - 1] + let mutable j = -1 + let j = if slice |> String.forall (fun c -> j <- j + 1; "*/%-+:^@><=!|0$.?".Contains(string c)) then -1 else j +#else let i = line.AsSpan(0, min offsidesCol line.Length).IndexOfAnyExcept(' ', ')') if i >= 0 && i < offsidesCol then let slice = line.AsSpan(i, min (offsidesCol - i) (line.Length - i)) let j = slice.IndexOfAnyExcept("*/%-+:^@><=!|0$.?".AsSpan()) +#endif let lo = i + (if j >= 0 && slice[j] = ' ' then j else 0) @@ -608,9 +627,13 @@ module SynExpr = /// 1l, 1d, 0b1, 0x1, 0o1, 1e10… let (|TextContainsLetter|_|) (m: range) = let line = getSourceLineStr m.StartLine +#if FABLE_COMPILER + let span = line[m.StartColumn .. (m.EndColumn - m.StartColumn - 1)] + if span |> String.exists (fun c -> c >= 'A' && c <= 'z') then +#else let span = line.AsSpan(m.StartColumn, m.EndColumn - m.StartColumn) - if span.LastIndexOfAnyInRange('A', 'z') >= 0 then +#endif Some TextContainsLetter else None @@ -618,9 +641,13 @@ module SynExpr = // 1.0… let (|TextEndsWithNumber|_|) (m: range) = let line = getSourceLineStr m.StartLine +#if FABLE_COMPILER + if Char.IsDigit line[m.EndColumn - 1] then +#else let span = line.AsSpan(m.StartColumn, m.EndColumn - m.StartColumn) if Char.IsDigit span[span.Length - 1] then +#endif Some TextEndsWithNumber else None diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 1145e896698..83a58b9ba89 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -19,7 +19,9 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.ILDynamicAssemblyWriter #endif open FSharp.Compiler.CodeAnalysis +#if !FABLE_COMPILER open FSharp.Compiler.CodeAnalysis.TransparentCompiler +#endif open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index d06f95a2065..6315a38da45 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -10,7 +10,9 @@ open System.Threading open System.Threading.Tasks open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CodeAnalysis +#if !FABLE_COMPILER open FSharp.Compiler.CodeAnalysis.TransparentCompiler +#endif open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index 20af46524b0..e6d90a4b04c 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -514,6 +514,20 @@ type TokenTupPool() = // Utilities for the tokenizer that are needed in other places //--------------------------------------------------------------------------*) +#if FABLE_COMPILER + +[] +let (|Equals|_|) (s: string) (span: string) = + if span.Equals(s) then ValueSome Equals + else ValueNone + +[] +let (|StartsWith|_|) (s: string) (span: string) = + if span.StartsWith(s) then ValueSome StartsWith + else ValueNone + +#else + [] let (|Equals|_|) (s: string) (span: ReadOnlySpan) = if span.SequenceEqual(s.AsSpan()) then ValueSome Equals @@ -524,6 +538,8 @@ let (|StartsWith|_|) (s: string) (span: ReadOnlySpan) = if span.StartsWith(s.AsSpan()) then ValueSome StartsWith else ValueNone +#endif + // Strip a bunch of leading '>' of a token, at the end of a typar application // Note: this is used in the 'service.fs' to do limited postprocessing [] @@ -531,10 +547,18 @@ let (|TyparsCloseOp|_|) (txt: string) = if not (txt.StartsWith ">") then ValueNone else +#if FABLE_COMPILER + let afterAngles = txt.TrimStart('>') + let angles = txt.Length - afterAngles.Length + if afterAngles.Length = 0 then + ValueSome(struct (Array.init txt.Length (fun _ -> GREATER), ValueNone)) + else +#else match txt.AsSpan().IndexOfAnyExcept '>' with | -1 -> ValueSome(struct (Array.init txt.Length (fun _ -> GREATER), ValueNone)) | angles -> let afterAngles = txt.AsSpan angles +#endif let afterOp = match afterAngles with diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 7a51c6d7160..69cf8b0e02f 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -452,8 +452,8 @@ type TcGlobals( let v_string_ty = mkNonGenericTy v_string_tcr let v_string_ty_ambivalent = mkNonGenericTyWithNullness v_string_tcr KnownAmbivalentToNull let v_decimal_ty = mkSysNonGenericTy sys "Decimal" - let v_unit_ty = mkNonGenericTy v_unit_tcr_nice - let v_system_Type_ty = mkSysNonGenericTy sys "Type" + let v_unit_ty = mkNonGenericTy v_unit_tcr_nice + let v_system_Type_ty = mkSysNonGenericTy sys "Type" let v_Array_tcref = findSysTyconRef sys "Array" let v_system_Reflection_MethodInfo_ty = mkSysNonGenericTy ["System";"Reflection"] "MethodInfo" @@ -635,16 +635,16 @@ type TcGlobals( fslib_MFPrintfModule_nleref fslib_MFSeqModule_nleref fslib_MFListModule_nleref - fslib_MFArrayModule_nleref - fslib_MFArray2DModule_nleref - fslib_MFArray3DModule_nleref - fslib_MFArray4DModule_nleref - fslib_MFSetModule_nleref - fslib_MFMapModule_nleref - fslib_MFStringModule_nleref - fslib_MFNativePtrModule_nleref - fslib_MFOptionModule_nleref - fslib_MFStateMachineHelpers_nleref + fslib_MFArrayModule_nleref + fslib_MFArray2DModule_nleref + fslib_MFArray3DModule_nleref + fslib_MFArray4DModule_nleref + fslib_MFSetModule_nleref + fslib_MFMapModule_nleref + fslib_MFStringModule_nleref + fslib_MFNativePtrModule_nleref + fslib_MFOptionModule_nleref + fslib_MFStateMachineHelpers_nleref fslib_MFRuntimeHelpers_nleref ] do yield nleref.LastItemMangledName, ERefNonLocal nleref ] @@ -671,7 +671,7 @@ type TcGlobals( | Some ty -> ty | None -> TType_app(tcref, tinst, nullness) - let decodeTupleTy tupInfo tinst = + let decodeTupleTy tupInfo tinst = decodeTupleTyAndNullness tupInfo tinst v_knownWithoutNull let mk_MFCore_attrib nm : BuiltinAttribInfo = @@ -1025,7 +1025,7 @@ type TcGlobals( let t = Dictionary.newWithSize entries.Length for _, tcref, builder in entries do if tcref.CanDeref then - t.Add(tcref.Stamp, builder) + t.Add(tcref.Stamp, (fun (x, y) -> builder x y)) decompileTypeDict <- t t | _ -> decompileTypeDict @@ -1039,11 +1039,11 @@ type TcGlobals( let entries = betterEntries let t = Dictionary.newWithSize entries.Length for nm, tcref, builder in entries do - t.Add(nm, - (fun tcref2 tinst2 nullness -> - if tyconRefEq tcref tcref2 then - builder tinst2 nullness - else + t.Add(nm, + (fun (tcref2, tinst2, nullness) -> + if tyconRefEq tcref tcref2 then + builder tinst2 nullness + else TType_app (tcref2, tinst2, nullness))) betterTypeDict1 <- t t @@ -1058,7 +1058,7 @@ type TcGlobals( let t = Dictionary.newWithSize entries.Length for _, tcref, builder in entries do if tcref.CanDeref then - t.Add(tcref.Stamp, builder) + t.Add(tcref.Stamp, (fun (x, y) -> builder x y)) betterTypeDict2 <- t t | _ -> betterTypeDict2 @@ -1073,7 +1073,7 @@ type TcGlobals( else let dict = getDecompileTypeDict() match dict.TryGetValue tcref.Stamp with - | true, builder -> builder tinst nullness + | true, builder -> builder (tinst, nullness) | _ -> TType_app (tcref, tinst, nullness) /// For cosmetic purposes "improve" some .NET types, e.g. Int32 --> int32. @@ -1083,12 +1083,12 @@ type TcGlobals( if compilingFSharpCore then let dict = getBetterTypeDict1() match dict.TryGetValue tcref.LogicalName with - | true, builder -> builder tcref tinst nullness + | true, builder -> builder (tcref, tinst, nullness) | _ -> TType_app (tcref, tinst, nullness) else let dict = getBetterTypeDict2() match dict.TryGetValue tcref.Stamp with - | true, builder -> builder tinst nullness + | true, builder -> builder (tinst, nullness) | _ -> TType_app (tcref, tinst, nullness) // Adding an unnecessary "let" instead of inlining into a multi-line pipelined compute-once "member val" that is too complex for @dsyme @@ -1408,8 +1408,8 @@ type TcGlobals( member val system_ExceptionDispatchInfo_ty = tryMkSysNonGenericTy ["System"; "Runtime"; "ExceptionServices"] "ExceptionDispatchInfo" - member _.mk_IAsyncStateMachine_ty = mkSysNonGenericTy sysCompilerServices "IAsyncStateMachine" - + member _.mk_IAsyncStateMachine_ty = mkSysNonGenericTy sysCompilerServices "IAsyncStateMachine" + member val system_Object_tcref = findSysTyconRef sys "Object" member val system_Value_tcref = findSysTyconRef sys "ValueType" member val system_Void_tcref = findSysTyconRef sys "Void" @@ -1464,7 +1464,7 @@ type TcGlobals( member val iltyp_RuntimeMethodHandle = findSysILTypeRef tname_RuntimeMethodHandle |> mkILNonGenericValueTy member val iltyp_RuntimeTypeHandle = findSysILTypeRef tname_RuntimeTypeHandle |> mkILNonGenericValueTy member val iltyp_ReferenceAssemblyAttributeOpt = tryFindSysILTypeRef tname_ReferenceAssemblyAttribute |> Option.map mkILNonGenericBoxedTy - member val iltyp_UnmanagedType = findSysILTypeRef tname_UnmanagedType |> mkILNonGenericValueTy + member val iltyp_UnmanagedType = findSysILTypeRef tname_UnmanagedType |> mkILNonGenericValueTy member val attrib_AttributeUsageAttribute = findSysAttrib "System.AttributeUsageAttribute" member val attrib_ParamArrayAttribute = findSysAttrib "System.ParamArrayAttribute" member val attrib_IDispatchConstantAttribute = tryFindSysAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute" @@ -1912,7 +1912,7 @@ type TcGlobals( member _.HasTailCallAttrib (attribs: Attribs) = attribs |> List.exists (fun a -> a.TyconRef.CompiledRepresentationForNamedType.FullName = "Microsoft.FSharp.Core.TailCallAttribute") - + member _.MakeInternalsVisibleToAttribute(simpleAssemName) = mkILCustomAttribute (tref_InternalsVisibleToAttribute, [ilg.typ_String], [ILAttribElem.String (Some simpleAssemName)], []) diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 0e3c3550de0..7c04926c23e 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -799,7 +799,11 @@ let pickleObjWithDanglingCcus inMem file g scope p x = st2 // The B stream should be empty in the second phase +#if FABLE_COMPILER + let phase2bytesB = st2.osB.Close() +#else let phase2bytesB = st2.osB.AsMemory() +#endif if phase2bytesB.Length <> 0 then failwith "expected phase2bytesB.Length = 0" (st2.osB :> System.IDisposable).Dispose() st2.os diff --git a/src/Compiler/Utilities/HashMultiMap.fs b/src/Compiler/Utilities/HashMultiMap.fs index f0eea8fa895..6497059df17 100644 --- a/src/Compiler/Utilities/HashMultiMap.fs +++ b/src/Compiler/Utilities/HashMultiMap.fs @@ -31,9 +31,11 @@ type internal HashMultiMap<'Key, 'Value new(comparer: IEqualityComparer<'Key>, ?useConcurrentDictionary: bool) = HashMultiMap<'Key, 'Value>(11, comparer, defaultArg useConcurrentDictionary false) +#if !FABLE_COMPILER new(entries: seq<'Key * 'Value>, comparer: IEqualityComparer<'Key>, ?useConcurrentDictionary: bool) as this = HashMultiMap<'Key, 'Value>(11, comparer, defaultArg useConcurrentDictionary false) then entries |> Seq.iter (fun (k, v) -> this.Add(k, v)) +#endif member _.GetRest(k) = match rest.TryGetValue k with diff --git a/src/Compiler/Utilities/HashMultiMap.fsi b/src/Compiler/Utilities/HashMultiMap.fsi index 3ffbeff9993..23b600bb19c 100644 --- a/src/Compiler/Utilities/HashMultiMap.fsi +++ b/src/Compiler/Utilities/HashMultiMap.fsi @@ -22,6 +22,7 @@ type internal HashMultiMap<'Key, 'Value #if !FABLE_COMPILER /// Build a map that contains the bindings of the given IEnumerable. new: entries: seq<'Key * 'Value> * comparer: IEqualityComparer<'Key> * ?useConcurrentDictionary: bool -> HashMultiMap<'Key, 'Value> +#endif /// Make a shallow copy of the collection. member Copy: unit -> HashMultiMap<'Key, 'Value> diff --git a/src/Compiler/Utilities/TypeHashing.fs b/src/Compiler/Utilities/TypeHashing.fs index bcdface38be..1eb684a6891 100644 --- a/src/Compiler/Utilities/TypeHashing.fs +++ b/src/Compiler/Utilities/TypeHashing.fs @@ -128,8 +128,13 @@ module rec HashTypes = let stampEquals g ty1 ty2 = match (stripTyEqns g ty1), (stripTyEqns g ty2) with +#if FABLE_COMPILER + | TType_app(tcref1, _, _), TType_app(tcref2, _, _) -> tcref1.Stamp = tcref2.Stamp + | TType_var(r1, _), TType_var(r2, _) -> r1.Stamp = r2.Stamp +#else | TType_app(tcref1, _, _), TType_app(tcref2, _, _) -> tcref1.Stamp.Equals(tcref2.Stamp) | TType_var(r1, _), TType_var(r2, _) -> r1.Stamp.Equals(r2.Stamp) +#endif | _ -> false /// Get has for Stamp for TType_app tyconref and TType_var typar From 27b205edb092bd895b6485cae90a2b36c050c45d Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Thu, 16 Jan 2025 07:41:09 -0800 Subject: [PATCH 7/8] Expose missing constraints --- src/Compiler/Symbols/Symbols.fs | 5 +++++ src/Compiler/Symbols/Symbols.fsi | 6 ++++++ ...arp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl | 4 ++++ ...p.Compiler.Service.SurfaceArea.netstandard20.release.bsl | 4 ++++ 4 files changed, 19 insertions(+) diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 4e15bd4a0b7..67873834a5b 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -1600,6 +1600,11 @@ type FSharpGenericParameterConstraint(cenv, cx: TyparConstraint) = | TyparConstraint.IsDelegate(ty1, ty2, _) -> FSharpGenericParameterDelegateConstraint(cenv, ty1, ty2) | _ -> invalidOp "not a delegate constraint" + member _.IsAllowsRefStructConstraint = + match cx with + | TyparConstraint.AllowsRefStruct _ -> true + | _ -> false + override x.ToString() = "" type FSharpInlineAnnotation = diff --git a/src/Compiler/Symbols/Symbols.fsi b/src/Compiler/Symbols/Symbols.fsi index 5c26d2d42ea..49742673d58 100644 --- a/src/Compiler/Symbols/Symbols.fsi +++ b/src/Compiler/Symbols/Symbols.fsi @@ -708,6 +708,9 @@ type FSharpGenericParameterConstraint = /// Indicates a constraint that a type has a 'null' value member IsSupportsNullConstraint: bool + /// Indicates a constraint that a type doesn't support nullness + member IsNotSupportsNullConstraint: bool + /// Indicates a constraint that a type supports F# generic comparison member IsComparisonConstraint: bool @@ -750,6 +753,9 @@ type FSharpGenericParameterConstraint = /// Gets further information about a delegate constraint member DelegateConstraintData: FSharpGenericParameterDelegateConstraint + /// An anti-constraint indicating that ref structs (e.g. Span<>) are allowed here + member IsAllowsRefStructConstraint: bool + [] type FSharpInlineAnnotation = diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index 6004f3fb62d..13180c3b649 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -5398,6 +5398,8 @@ FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsRequiresDefa FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsSimpleChoiceConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsSupportsNullConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsUnmanagedConstraint +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsNotSupportsNullConstraint +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsAllowsRefStructConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsCoercesToConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsComparisonConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsDefaultsToConstraint() @@ -5411,6 +5413,8 @@ FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsRequires FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsSimpleChoiceConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsSupportsNullConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsUnmanagedConstraint() +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsNotSupportsNullConstraint() +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsAllowsRefStructConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDefaultsToConstraint DefaultsToConstraintData FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDefaultsToConstraint get_DefaultsToConstraintData() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDelegateConstraint DelegateConstraintData diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index 6004f3fb62d..13180c3b649 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -5398,6 +5398,8 @@ FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsRequiresDefa FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsSimpleChoiceConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsSupportsNullConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsUnmanagedConstraint +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsNotSupportsNullConstraint +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean IsAllowsRefStructConstraint FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsCoercesToConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsComparisonConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsDefaultsToConstraint() @@ -5411,6 +5413,8 @@ FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsRequires FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsSimpleChoiceConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsSupportsNullConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsUnmanagedConstraint() +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsNotSupportsNullConstraint() +FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: Boolean get_IsAllowsRefStructConstraint() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDefaultsToConstraint DefaultsToConstraintData FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDefaultsToConstraint get_DefaultsToConstraintData() FSharp.Compiler.Symbols.FSharpGenericParameterConstraint: FSharp.Compiler.Symbols.FSharpGenericParameterDelegateConstraint DelegateConstraintData From be1048d6269c4f6642b3f8c74405f8a06a381754 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Thu, 20 Feb 2025 10:23:20 -0800 Subject: [PATCH 8/8] Remove Async.RunSynchronously --- src/Compiler/Service/FSharpCheckerResults.fs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 3b4105f1fc1..75d613d5aab 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -3860,6 +3860,9 @@ type FSharpCheckProjectResults |> Array.toSeq #endif //!FABLE_COMPILER | Choice2Of2 task -> +#if FABLE_COMPILER + seq {} +#else Async.RunSynchronously( async { let! tcSymbolUses = task @@ -3872,6 +3875,7 @@ type FSharpCheckProjectResults }, ?cancellationToken = cancellationToken ) +#endif //!FABLE_COMPILER results |> Seq.filter (fun symbolUse -> symbolUse.ItemOccurrence <> ItemOccurrence.RelatedText) @@ -3890,7 +3894,7 @@ type FSharpCheckProjectResults let cenv = SymbolEnv(tcGlobals, thisCcu, Some ccuSig, tcImports) - let tcSymbolUses = + let tcSymbolUses : TcSymbolUses seq = match builderOrSymbolUses with | Choice1Of2 builder -> #if FABLE_COMPILER @@ -3908,7 +3912,12 @@ type FSharpCheckProjectResults | _ -> TcSymbolUses.Empty) |> Array.toSeq #endif //!FABLE_COMPILER - | Choice2Of2 tcSymbolUses -> Async.RunSynchronously(tcSymbolUses, ?cancellationToken = cancellationToken) + | Choice2Of2 tcSymbolUses -> +#if FABLE_COMPILER + seq {} +#else + Async.RunSynchronously(tcSymbolUses, ?cancellationToken = cancellationToken) +#endif //!FABLE_COMPILER [| for r in tcSymbolUses do