From 03003c699c2282a0ffe42e523ad01647a8955f08 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 01/10] 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 | 2 +- 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 | 73 ++ 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 | 42 + 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 | 2 +- src/Compiler/Service/ServiceParsedInputOps.fs | 39 + src/Compiler/Service/service.fs | 6 + 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 | 18 +- 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 | 12 + 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 | 11 + 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, 5681 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 5d7848f246e..238ff72b592 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 @@ -494,6 +496,7 @@ type ILAssemblyRef(data) = assemRefLocale = locale } +#if !FABLE_COMPILER static member FromAssemblyName(aname: AssemblyName) = let locale = None @@ -521,6 +524,7 @@ type ILAssemblyRef(data) = | name -> name ILAssemblyRef.Create(name, None, publicKey, retargetable, version, locale) +#endif //!FABLE_COMPILER member aref.QualifiedName = let b = StringBuilder(100) @@ -2932,7 +2936,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() |] @@ -3038,7 +3046,11 @@ type ILResourceAccess = [] type ILResourceLocation = +#if FABLE_COMPILER + | Local of ByteMemory +#else | Local of ByteStorage +#endif | File of ILModuleRef * int32 | Assembly of ILAssemblyRef @@ -3054,7 +3066,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 @@ -3291,7 +3307,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 @@ -4860,6 +4880,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 @@ -4870,6 +4895,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 @@ -5186,7 +5212,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 @@ -5358,7 +5388,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) @@ -5729,11 +5763,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 3d6f88bb6ca..31b2a01e180 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 9aa2a2672ef..f7fc49cae5b 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -20,13 +20,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" @@ -37,6 +41,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")) @@ -58,6 +68,7 @@ let stronglyHeldReaderCacheSize = | s -> int32 s) with _ -> stronglyHeldReaderCacheSizeDefault +#endif //!FABLE_COMPILER let singleOfBits (x: int32) = BitConverter.ToSingle(BitConverter.GetBytes x, 0) @@ -144,6 +155,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. @@ -181,6 +194,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[]) = @@ -191,6 +206,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. @@ -256,6 +273,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 @@ -1169,13 +1188,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 @@ -1191,8 +1221,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 @@ -1213,9 +1243,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 @@ -1230,9 +1260,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 @@ -1243,9 +1273,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 @@ -1277,108 +1307,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. @@ -1387,54 +1414,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. @@ -1443,83 +1470,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. @@ -1528,101 +1557,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. @@ -1631,32 +1660,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 = @@ -1753,6 +1782,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 = @@ -1762,7 +1792,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 = @@ -2149,9 +2180,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 @@ -2169,10 +2200,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 = @@ -2182,8 +2213,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 "" @@ -2260,8 +2291,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 -> @@ -2325,8 +2356,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 -> @@ -2354,8 +2385,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) @@ -3059,15 +3090,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 @@ -3084,8 +3115,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))) @@ -3128,8 +3159,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 @@ -3208,8 +3239,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) @@ -3278,8 +3309,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) @@ -3314,15 +3345,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) @@ -4094,7 +4125,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) @@ -5004,6 +5040,8 @@ type ILModuleReaderImpl(ilModule: ILModuleDef, ilAssemblyRefs: Lazy BinaryFile +#endif //!FABLE_COMPILER + let OpenILModuleReaderFromBytes fileName assemblyContents options = let pefile = ByteFile(fileName, assemblyContents) :> BinaryFile @@ -5077,6 +5117,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) @@ -5238,3 +5280,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 3ec71958851..ee19bd08c14 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -564,7 +564,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 8b633577c5a..28c1ce5790f 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -3091,7 +3091,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 ) @@ -3123,7 +3123,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 0a7f7f353bb..8024103e61c 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 1a62bbe01bd..2e0d9fdadd6 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 12b7566db6e..89795d937c0 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -334,9 +334,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 @@ -980,7 +984,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 0532182fb88..17f73f7cd45 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -22,7 +22,9 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeRelations +#if !FABLE_COMPILER open type System.MemoryExtensions +#endif exception MatchIncomplete of bool * (string * bool) option * range exception RuleNeverMatched of range @@ -768,7 +770,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 ed37c3ba46f..eae503a4302 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 = @@ -717,9 +721,13 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : Exp 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 553e6ac9aa1..816a42a1a98 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -197,9 +197,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) @@ -1348,7 +1352,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 = @@ -1383,9 +1391,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 @@ -1868,7 +1880,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 = @@ -2747,7 +2763,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 @@ -12148,6 +12168,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 = @@ -12325,3 +12347,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 cd9dd0f2ffb..8e98655e3bc 100644 --- a/src/Compiler/CodeGen/IlxGen.fsi +++ b/src/Compiler/CodeGen/IlxGen.fsi @@ -90,6 +90,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 @@ -114,6 +115,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 -> (objnull * Type) option +#endif //!FABLE_COMPILER val ReportStatistics: TextWriter -> unit diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 5bd5c5266ce..423b9390253 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 @@ -60,6 +64,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 () = @@ -90,6 +102,8 @@ let ResolveFileUsingPaths (paths, m, fileName) = let searchMessage = String.concat "\n " paths raise (FileNameNotResolved(fileName, searchMessage, m)) +#endif //!FABLE_COMPILER + [] type WarningNumberSource = | CommandLineOption @@ -201,6 +215,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 -> @@ -218,6 +236,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. @@ -271,7 +290,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 @@ -811,7 +834,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 @@ -867,6 +894,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 = @@ -881,6 +911,7 @@ type TcConfigBuilder = tcConfigB.fxResolver <- Some fxResolver fxResolver +#endif //!FABLE_COMPILER | Some fxResolver -> fxResolver member tcConfigB.SetPrimaryAssembly primaryAssembly = @@ -891,6 +922,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 @@ -954,6 +987,8 @@ type TcConfigBuilder = tcConfigB.outputFile <- Some outfile outfile, pdbfile, assemblyName +#endif //!FABLE_COMPILER + member tcConfigB.TurnWarningOff(m, s: string) = use _ = UseBuildPhase BuildPhase.Parameter @@ -985,6 +1020,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 = @@ -1005,8 +1044,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 @@ -1025,6 +1069,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 @@ -1056,6 +1101,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 @@ -1092,6 +1138,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 <- @@ -1132,6 +1179,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 @@ -1263,6 +1316,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 @@ -1423,11 +1478,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 @@ -1440,6 +1497,8 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = else (tcConfig.indentationAwareSyntax = Some true) +#if !FABLE_COMPILER + member tcConfig.GetAvailableLoadedSources() = use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter @@ -1531,4 +1590,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 646b4477be3..162693abb34 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 @@ -24,6 +26,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 = @@ -542,7 +550,9 @@ type TcConfigBuilder = rangeForErrors: range -> TcConfigBuilder +#if !FABLE_COMPILER member DecideNames: string list -> string * string option * string +#endif member TurnWarningOff: range * string -> unit @@ -567,8 +577,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 @@ -824,6 +836,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 @@ -837,6 +851,8 @@ type TcConfig = /// File system query based on TcConfig settings member MakePathAbsolute: string -> string +#endif //!FABLE_COMPILER + member resolutionEnvironment: LegacyResolutionEnvironment member copyFSharpCore: CopyFSharpCoreFlag @@ -874,6 +890,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 @@ -894,6 +912,8 @@ type TcConfig = /// Check if the primary assembly is mscorlib member assumeDotNetFramework: bool +#endif //!FABLE_COMPILER + member exiter: Exiter member parallelReferenceResolution: ParallelReferenceResolution @@ -908,6 +928,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. [] @@ -926,6 +948,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 71b0ba0eb2c..62b827ff9b4 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 @@ -200,8 +202,10 @@ type Exception with | HashLoadedScriptConsideredSource m | NoConstructorsAvailableForType(_, _, m) -> Some m +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).DiagnosticRange +#endif #if !NO_TYPEPROVIDERS | :? TypeProviderError as e -> e.Range |> Some #endif @@ -331,8 +335,10 @@ type Exception with | NoConstructorsAvailableForType _ -> 1133 | 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 @@ -435,7 +441,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") @@ -621,6 +629,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 @@ -1952,6 +1967,7 @@ type Exception with | NoConstructorsAvailableForType(t, denv, _) -> os.AppendString(NoConstructorsAvailableForTypeE().Format(NicePrint.minimalStringOfType denv t)) +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).Output(os, suggestNames) @@ -1966,6 +1982,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 @@ -2029,6 +2046,8 @@ let SanitizeFileName fileName implicitIncludeDir = with _ -> fileName +#if !FABLE_COMPILER + [] type FormattedDiagnosticLocation = { @@ -2307,6 +2326,8 @@ type PhasedDiagnostic with diagnostic.OutputContext(buf, prefix, fileLineFunction) diagnostic.Output(buf, tcConfig, severity)) +#endif //!FABLE_COMPILER + /// Build an DiagnosticsLogger that delegates to another DiagnosticsLogger but filters warnings type DiagnosticsLoggerFilteringByScopedNowarn(diagnosticOptions: FSharpDiagnosticOptions, diagnosticsLogger: DiagnosticsLogger) = inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedNowarn") diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index dc9bccc3362..575a910ffc8 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -63,6 +63,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 @@ -74,6 +75,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 GetDiagnosticsLoggerFilteringByScopedNowarn: @@ -82,6 +84,8 @@ val GetDiagnosticsLoggerFilteringByScopedNowarn: /// 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 = @@ -116,3 +120,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 cb60295b4fe..cbda112d165 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -8,12 +8,16 @@ open System open System.Collections.Generic 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 @@ -24,7 +28,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 @@ -69,12 +75,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 @@ -143,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()) @@ -339,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 = { @@ -367,6 +383,8 @@ let OpenILBinary (fileName, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, AssemblyReader.GetILModuleReader(location, opts) +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = | Speculative @@ -400,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 @@ -429,6 +449,8 @@ type AssemblyResolution = this.ilAssemblyRef <- Some assemblyRef assemblyRef +#endif //!FABLE_COMPILER + type ImportedBinary = { FileName: string @@ -466,6 +488,8 @@ type CcuLoadFailureAction = type TcImportsLockToken() = interface LockToken +#if !FABLE_COMPILER + type TcImportsLock = Lock let RequireTcImportsLock (_tcitok: TcImportsLockToken, _thingProtected: 'T) = () @@ -1091,10 +1115,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 (tciLock: TcImportsLock, disposeActions: ResizeArray unit>, disposeTypeProviderActions: ResizeArray unit>) = @@ -2707,3 +2778,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 9da0ef71b1d..d899bdcc2ad 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 @@ -51,6 +53,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 * @@ -70,6 +74,8 @@ val EncodeOptimizationData: isIncrementalBuild: bool -> ILResource list +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = | Speculative @@ -124,6 +130,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 = @@ -223,3 +245,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 a62dad75eac..ce6d26434f7 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -10,7 +10,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 @@ -123,9 +125,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 @@ -232,6 +236,7 @@ module ResponseFile = | CompilerOptionSpec of string | Comment of string +#if !FABLE_COMPILER let parseFile path : Choice = let parseLine (l: string) = match l with @@ -254,6 +259,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 @@ -331,6 +337,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 @@ -359,6 +369,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 @@ -1140,6 +1151,10 @@ let mlCompatibilityFlag (tcConfigB: TcConfigBuilder) = Some(FSComp.SR.optsMlcompatibility ()) ) +#if FABLE_COMPILER +let exit _code = () +#endif + let GetLanguageVersions () = seq { FSComp.SR.optsSupportedLangVersions () @@ -1220,10 +1235,12 @@ let codePageFlag (tcConfigB: TcConfigBuilder) = "codepage", tagInt, OptionInt(fun n -> +#if !FABLE_COMPILER try Encoding.GetEncoding n |> ignore with :? ArgumentException as err -> error (Error(FSComp.SR.optsProblemWithCodepage (n, err.Message), rangeCmdArgs)) +#endif tcConfigB.inputCodePage <- Some n), None, @@ -1430,7 +1447,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 @@ -2412,6 +2431,8 @@ let ApplyCommandLineArgs (tcConfigB: TcConfigBuilder, sourceFiles: string list, errorRecovery e range0 sourceFiles +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // ReportTime //---------------------------------------------------------------------------- @@ -2510,3 +2531,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 1854368285e..0f6a753e56e 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 c79af5b33bc..13d6ee5f0a1 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 = @@ -37,6 +39,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 @@ -130,6 +134,7 @@ module private ParallelOptimization = finalFileResults, lastFileFirstLoopEnv +#if !FABLE_COMPILER let optimizeFilesInParallel (env0: IncrementalOptimizationEnv) (phases: PhaseInfo[]) @@ -247,6 +252,7 @@ module private ParallelOptimization = raise ex.InnerExceptions[0] collectFinalResults lastPhaseResults +#endif //!FABLE_COMPILER let optimizeFilesSequentially optEnv (phases: PhaseInfo[]) implFiles = let results, (optEnvFirstLoop, _, _, _) = @@ -311,6 +317,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 @@ -319,8 +328,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 @@ -511,12 +523,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 @@ -526,7 +540,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 @@ -534,10 +552,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 //---------------------------------------------------------------------------- @@ -600,6 +622,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 3425c5368fd..359d8e44f45 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -488,7 +488,7 @@ let ParseInput type Tokenizer = unit -> 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 @@ -515,10 +515,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 (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 @@ -651,6 +655,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 @@ -969,6 +975,8 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig: TcConfig, inp: ParsedInput, ProcessMetaCommandsFromInput (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 @@ -997,6 +1005,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 @@ -1021,6 +1031,8 @@ let CheckSimulateException (tcConfig: TcConfig) = | Some("tc-fail") -> failwith "simulated" | _ -> () +#endif //!FABLE_COMPILER + //---------------------------------------------------------------------------- // Type-check sets of files //-------------------------------------------------------------------------- @@ -1177,7 +1189,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 -> @@ -1231,7 +1247,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() @@ -1394,6 +1412,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 @@ -1877,10 +1897,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 @@ -1897,6 +1923,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 3e47c3c17c6..41341a4c07e 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -10,7 +10,9 @@ open FSharp.Compiler.CheckDeclarations 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 @@ -75,6 +77,8 @@ val ParseInput: userOpName: string option -> ParsedInput +#if !FABLE_COMPILER + /// A general routine to process hash directives val ProcessMetaCommandsFromInput: ('T -> range * string * Directive -> 'T) * ('T -> range * string -> unit) -> @@ -124,8 +128,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 * @@ -138,6 +146,8 @@ val ParseInputFiles: /// Process collected directives val FinishPreprocessing: Lexbuf -> FSharpDiagnosticOptions -> bool -> range list -> unit +#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 2f3778bb1db..99b060d07ad 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 @@ -765,3 +769,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 b54b9b2f0d0..fb86918530f 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. // @@ -103,3 +107,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 97068cfea2d..9cca9333158 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 58d24ddaaa7..3d680aaaf3e 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -183,12 +183,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 = @@ -197,10 +201,12 @@ type Exiter = let QuitProcessExiter = { new Exiter with member _.Exit n = +#if !FABLE_COMPILER try Environment.Exit n with _ -> () +#endif failwith (FSComp.SR.elSysEnvExitDidntExit ()) } @@ -423,14 +429,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 = @@ -441,16 +455,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 @@ -480,9 +497,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 | :? ThreadAbortException | WrappedError(:? ThreadAbortException, _) -> () +#endif | ReportedError _ | WrappedError(ReportedError _, _) -> () | StopProcessing @@ -961,6 +980,12 @@ type StackGuard(name: string) = [] path: string, [] line: int ) = +#if FABLE_COMPILER + ignore depth + ignore maxDepth + ignore name + f () +#else //!FABLE_COMPILER depth.Value <- depth.Value + 1 @@ -981,6 +1006,7 @@ type StackGuard(name: string) = |> Async.RunImmediate finally depth.Value <- depth.Value - 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 cfde35d5a77..c5afa4d51dd 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -42,6 +42,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) [| @@ -56,6 +59,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. @@ -106,7 +110,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 @@ -116,7 +124,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 @@ -240,6 +252,12 @@ type internal Position = static member FirstLine fileIdx = Position(fileIdx, 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> @@ -285,8 +303,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] @@ -321,8 +341,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 @@ -382,6 +407,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 @@ -403,16 +432,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 @@ -429,7 +467,7 @@ module GenericImplFragments = else scanUntilSentinel lexBuffer state - let onAccept (lexBuffer: LexBuffer, a) = + let onAccept (lexBuffer: LexBuffer, a) = lexBuffer.LexemeLength <- lexBuffer.BufferScanLength lexBuffer.BufferAcceptAction <- a @@ -444,7 +482,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 @@ -459,15 +497,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) @@ -508,7 +550,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 c95a97a8d42..6304b137571 100644 --- a/src/Compiler/Facilities/prim-lexing.fsi +++ b/src/Compiler/Facilities/prim-lexing.fsi @@ -103,6 +103,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). @@ -114,8 +120,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 @@ -123,8 +131,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 @@ -152,6 +165,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 * @@ -163,7 +179,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. [] @@ -173,4 +189,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 fc6eb237c2d..399d50a183b 100644 --- a/src/Compiler/Facilities/prim-parsing.fs +++ b/src/Compiler/Facilities/prim-parsing.fs @@ -8,14 +8,20 @@ open Internal.Utilities.Text.Lexing open Internal.Utilities.Library 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 = @@ -277,6 +283,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) @@ -286,6 +296,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 0eba72d17ff..401d0255c15 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -151,7 +151,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 @@ -659,6 +663,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 @@ -1738,6 +1747,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)) -> @@ -3134,7 +3146,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 584591c059c..aa47eaf0f99 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -80,6 +80,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 -> @@ -115,6 +118,7 @@ type DelayedILModuleReader = | _ -> Some this.result) } | _ -> cancellable.Return(Some this.result) +#endif //!FABLE_COMPILER [] type FSharpReferencedProject = @@ -198,6 +202,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( @@ -205,6 +212,7 @@ module internal FSharpCheckerResultsSettings = |> Option.ofObj ) .Value +#endif [] type FSharpSymbolUse(denv: DisplayEnv, symbol: FSharpSymbol, inst: TyparInstantiation, itemOcc, range: range) = @@ -2876,7 +2884,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 @@ -2987,7 +2997,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()) @@ -3158,6 +3172,8 @@ module internal ParseAndCheckFile = errHandler.CollectedDiagnostics(None), parseResult, errHandler.AnyErrors +#if !FABLE_COMPILER + let ApplyLoadClosure ( tcConfig: TcConfig, @@ -3259,6 +3275,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 ( @@ -3296,8 +3314,10 @@ module internal ParseAndCheckFile = use _unwindBP = UseBuildPhase BuildPhase.TypeCheck +#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) @@ -3626,7 +3646,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) @@ -3733,6 +3757,8 @@ type FSharpCheckFileResults FSharpCheckFileResults(mainInputFileName, errors, Some tcFileInfo, dependencyFiles, builder, keepAssemblyContents) +#if !FABLE_COMPILER + static member CheckOneFile ( parseResults: FSharpParseFileResults, @@ -3782,6 +3808,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 @@ -3901,6 +3929,10 @@ type FSharpCheckProjectResults let results = match builderOrSymbolUses with | Choice1Of2 builder -> +#if FABLE_COMPILER + ignore builder + [||] +#else builder.SourceFiles |> Array.ofList |> Array.collect (fun x -> @@ -3911,6 +3943,7 @@ type FSharpCheckProjectResults | _ -> [||] | _ -> [||]) |> Array.toSeq +#endif //!FABLE_COMPILER | Choice2Of2 task -> Async.RunSynchronously( async { @@ -3945,6 +3978,10 @@ type FSharpCheckProjectResults let tcSymbolUses = match builderOrSymbolUses with | Choice1Of2 builder -> +#if FABLE_COMPILER + ignore builder + [||] +#else builder.SourceFiles |> Array.ofList |> Array.map (fun x -> @@ -3955,6 +3992,7 @@ type FSharpCheckProjectResults | _ -> TcSymbolUses.Empty | _ -> TcSymbolUses.Empty) |> Array.toSeq +#endif //!FABLE_COMPILER | Choice2Of2 tcSymbolUses -> Async.RunSynchronously(tcSymbolUses, ?cancellationToken = cancellationToken) [| @@ -3990,6 +4028,8 @@ type FSharpCheckProjectResults override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" +#if !FABLE_COMPILER + type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, tcState) = let keepAssemblyContents = false @@ -4107,6 +4147,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 28deec6804a..534ea736dad 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -249,9 +249,51 @@ type public FSharpCodeCompletionOptions = static member Default: FSharpCodeCompletionOptions +#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[] @@ -265,8 +307,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 @@ -487,6 +531,7 @@ type public FSharpCheckFileResults = openDeclarations: OpenDeclaration[] -> FSharpCheckFileResults +#if !FABLE_COMPILER /// Internal constructor - check a file and collect errors static member internal CheckOneFile: parseResults: FSharpParseFileResults * @@ -509,6 +554,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 = @@ -616,6 +662,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 = @@ -627,5 +675,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 bfdab00d690..c247edf5166 100644 --- a/src/Compiler/Service/FSharpSource.fs +++ b/src/Compiler/Service/FSharpSource.fs @@ -10,14 +10,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 | _ -> () [] @@ -29,6 +33,8 @@ type FSharpSource internal () = abstract GetTextContainer: unit -> Async +#if !FABLE_COMPILER + type private FSharpSourceMemoryMappedFile(filePath: string, timeStamp: DateTime, openStream: unit -> Stream) = inherit FSharpSource() @@ -59,6 +65,8 @@ type private FSharpSourceFromFile(filePath: string) = override _.GetTextContainer() = TextContainer.OnDisk |> async.Return +#endif //!FABLE_COMPILER + type private FSharpSourceCustom(filePath: string, getTimeStamp, getSourceText) = inherit FSharpSource() @@ -81,6 +89,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 @@ -91,3 +100,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 6db19653f9a..c2854fd9b69 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 @@ -39,6 +41,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 = @@ -1670,3 +1686,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 915f21196a7..a7e77e50e1a 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -9,7 +9,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 @@ -33,6 +35,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 @@ -302,3 +314,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 6a3e9a2b8b3..791e15a74fe 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 f384cabebdc..c40db43082d 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -388,7 +388,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 af87f73f0d4..613d1c0e638 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 006f6670208..bd5e7df0ee3 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -877,7 +877,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 7f2cc207ec0..49a115eddd1 100755 --- a/src/Compiler/Service/ServiceLexing.fsi +++ b/src/Compiler/Service/ServiceLexing.fsi @@ -336,7 +336,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 3065bc7f179..920b52d1d94 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -1005,9 +1005,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 = @@ -1239,6 +1253,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 @@ -1262,9 +1296,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 75d6c137087..7d17ca40ec7 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -12,13 +12,17 @@ open FSharp.Compiler.CodeAnalysis.TransparentCompiler open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerOptions open FSharp.Compiler.Diagnostics +#if !FABLE_COMPILER open FSharp.Compiler.Driver +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Symbols open FSharp.Compiler.Tokenization open FSharp.Compiler.Text open FSharp.Compiler.Text.Range +#if !FABLE_COMPILER + /// Callback that indicates whether a requested result has become obsolete. [] type IsResultObsolete = IsResultObsolete of (unit -> bool) @@ -723,3 +727,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 2120cab1eef..62ea74abb4f 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -14,6 +14,8 @@ open FSharp.Compiler.Symbols open FSharp.Compiler.Text open FSharp.Compiler.Tokenization +#if !FABLE_COMPILER + /// Used to parse and check F# source code. [] type public FSharpChecker = @@ -546,3 +548,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 33c87edb597..2466119433e 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 7ef704e62c8..f6676e643f4 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 24ea614cc16..8670263b491 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -225,9 +225,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 let m = match diagnostic.Range with Some m -> m.ApplyLineDirectives() | None -> range0 diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index fed644eeb61..0a51d307100 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 37f0d206fd3..3ec19a75c5f 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 @@ -2330,7 +2334,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 = @@ -2838,7 +2844,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 360e683d2b7..76bce6c3608 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -118,7 +118,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" @@ -126,8 +130,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 @@ -139,8 +148,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 = @@ -214,7 +228,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? @@ -226,10 +244,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 47c33e57bcd..f705b6240c9 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 815c5d65903..c15b2087ce5 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 4ea41cbcf84..57c256b9300 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fs +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fs @@ -6,7 +6,7 @@ module internal FSharp.Compiler.UnicodeLexing open System.IO open Internal.Utilities.Text.Lexing -type Lexbuf = LexBuffer +type Lexbuf = LexBuffer type LexBuffer<'char> with @@ -24,13 +24,27 @@ type LexBuffer<'char> with | _ -> None 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.FromFunction(reportLibraryOnlyFeatures, langVersion, strictIndentation, bufferFiller) +#else LexBuffer.FromFunction(reportLibraryOnlyFeatures, langVersion, strictIndentation, bufferFiller) +#endif let SourceTextAsLexbuf (reportLibraryOnlyFeatures, langVersion, strictIndentation, sourceText) = +#if FABLE_COMPILER + LexBuffer.FromSourceText(reportLibraryOnlyFeatures, langVersion, strictIndentation, sourceText) +#else LexBuffer.FromSourceText(reportLibraryOnlyFeatures, langVersion, strictIndentation, sourceText) +#endif + +#if !FABLE_COMPILER let StreamReaderAsLexbuf (reportLibraryOnlyFeatures, langVersion, strictIndentation, reader: StreamReader) = let mutable isFinished = false @@ -51,3 +65,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 ee722ee08c3..2f63f9458d3 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 type LexBuffer<'char> with member GetLocalData<'T when 'T: not null> : key: string * initializer: (unit -> 'T) -> 'T @@ -20,7 +20,7 @@ val FunctionAsLexbuf: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * strictIndentation: bool option * - bufferFiller: (char[] * int * int -> int) -> + bufferFiller: (LexBufferChar[] * int * int -> int) -> Lexbuf val SourceTextAsLexbuf: @@ -30,6 +30,8 @@ val SourceTextAsLexbuf: sourceText: ISourceText -> Lexbuf +#if !FABLE_COMPILER + /// Will not dispose of the stream reader. val StreamReaderAsLexbuf: reportLibraryOnlyFeatures: bool * @@ -37,3 +39,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 017298fa3a0..6f0df4d0ca2 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() = @@ -226,8 +230,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 @@ -263,6 +269,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) = @@ -338,6 +357,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 ac83f077ae7..e216e5fe4db 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() = 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 = 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 de18b73e5c0..2bb14ebff7b 100644 --- a/src/Compiler/TypedTree/QuotationPickler.fs +++ b/src/Compiler/TypedTree/QuotationPickler.fs @@ -313,10 +313,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 @@ -375,7 +377,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) @@ -383,6 +389,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() @@ -390,6 +401,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 d00e6009231..33e89344fa4 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 @@ -1115,7 +1117,11 @@ type TcGlobals( member _.tryFindSysTypeCcuHelper: string list -> string -> bool -> 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 e7be325ce33..775606e60d9 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2560,7 +2560,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 @@ -2575,6 +2579,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 20014a13a64..1f50512d68e 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 @@ -1714,7 +1716,11 @@ type TyparConstraint = override ToString: unit -> string +#if FABLE_COMPILER +[] +#else [] +#endif type TraitWitnessInfo = | TraitWitnessInfo of tys: TTypes * @@ -1725,6 +1731,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 76f58275fb6..dd9a288f5f6 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 b50c5153886..bb352ba8b47 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10230,7 +10230,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) -> @@ -11440,6 +11444,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 @@ -11449,6 +11470,7 @@ let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = member _.Equals(a, b) = nullSafeEquality a b (fun a b -> traitKeysAEquiv g TypeEquivEnv.EmptyIgnoreNulls a b) member _.GetHashCode(a) = hash a.MemberName }) +#endif //!FABLE_COMPILER [] let (|WhileExpr|_|) expr = @@ -11865,6 +11887,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 { @@ -11931,6 +11955,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 72601a04aad..778b17d1be2 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2743,7 +2743,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> @@ -2930,6 +2934,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 @@ -2937,6 +2943,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 8a61809ab06..a94b4f44189 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -276,10 +276,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 @@ -961,7 +963,11 @@ let pickleObjWithDanglingCcus inMem file g scope p x = let sizes = st1.oentities.Size, 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 = { @@ -1006,15 +1012,21 @@ 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 +#if !FABLE_COMPILER // The B stream should be empty in the second phase let phase2bytesB = st2.osB.AsMemory() if phase2bytesB.Length <> 0 then failwith "expected phase2bytesB.Length = 0" +#endif (st2.osB :> System.IDisposable).Dispose() st2.os diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 6ceaaa51eab..9e6b7d97c0e 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -117,6 +117,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 = @@ -329,3 +346,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 8ff0a4c3494..13da61cdf61 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -53,9 +53,11 @@ module internal Activity = val addEventWithTags: name: string -> tags: (string * objnull) seq -> unit +#if !FABLE_COMPILER module Profiling = val startAndMeasureEnvironmentStats: name: string -> System.IDisposable | null 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 bae9c6f8299..c79bcefa4b4 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -184,7 +184,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 a19df26aad1..fa5b96c851f 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 = @@ -860,18 +924,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 @@ -943,19 +1011,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() @@ -1003,6 +1079,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 @@ -1018,6 +1095,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() @@ -1050,11 +1128,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 } @@ -1064,8 +1146,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) = @@ -1114,3 +1200,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 2688869136e..a7ff049bae0 100644 --- a/src/Compiler/Utilities/HashMultiMap.fs +++ b/src/Compiler/Utilities/HashMultiMap.fs @@ -129,6 +129,22 @@ type internal HashMultiMap<'Key, 'Value when 'Key: not null>(size: int, comparer 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() = @@ -173,6 +189,8 @@ type internal HashMultiMap<'Key, 'Value when 'Key: not null>(size: int, comparer 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 475f9db558d..23807af5267 100644 --- a/src/Compiler/Utilities/HashMultiMap.fsi +++ b/src/Compiler/Utilities/HashMultiMap.fsi @@ -15,6 +15,7 @@ type internal HashMultiMap<'Key, 'Value when 'Key: not null> = /// 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 -> @@ -58,7 +59,9 @@ type internal HashMultiMap<'Key, 'Value when 'Key: not null> = /// 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 cf158a412b0..659954c31f7 100644 --- a/src/Compiler/Utilities/PathMap.fs +++ b/src/Compiler/Utilities/PathMap.fs @@ -19,7 +19,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 d16f33aebc9..3ea26d694c1 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>) = @@ -1240,10 +1253,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 ee33e444803..a6e7c3016cd 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -129,12 +129,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) = @@ -150,6 +155,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[]) = @@ -463,7 +469,9 @@ module List = | _ -> true let mapq (f: 'T -> 'T) inp = +#if !FABLE_COMPILER assert not typeof<'T>.IsValueType +#endif match inp with | [] -> inp @@ -699,7 +707,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 @@ -707,6 +719,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 @@ -717,6 +730,7 @@ module Span = i <- i + 1 state +#endif module String = let make (n: int) (c: char) : string = String(c, n) @@ -806,6 +820,9 @@ module String = | value -> if value.Contains pattern then Some() 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) [| @@ -820,6 +837,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) = @@ -896,12 +914,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 @@ -949,7 +969,11 @@ type UniqueStampGenerator<'T when 'T: equality and 'T: not null>() = 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 when 'T: not null>(name, compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) = @@ -1046,6 +1070,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 @@ -1053,6 +1080,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 654a7259d82..4598bfcfce9 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 @@ -239,8 +241,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 String = @@ -330,11 +334,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 a05bf5d20bc..c173d2eacbf 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -20,10 +20,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 @@ -423,6 +430,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 -> @@ -431,6 +441,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 c2147208ef9..f35866b74f1 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 3a22199c32f..25de09eb52f 100755 --- a/src/Compiler/Utilities/range.fs +++ b/src/Compiler/Utilities/range.fs @@ -198,11 +198,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 -> @@ -214,7 +219,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 @@ -383,6 +392,9 @@ type Range(code1: int64, code2: int64) = member _.Code2 = code2 member m.DebugCode = +#if FABLE_COMPILER + "" +#else let getRangeSubstring (m: range) (stream: Stream) = let endCol = m.EndColumn - 1 let startCol = m.StartColumn - 1 @@ -419,6 +431,7 @@ type Range(code1: int64, code2: int64) = getRangeSubstring m stream with e -> e.ToString() +#endif //!FABLE_COMPILER member _.Equals(m2: range) = let code2 = code2 &&& ~~~(debugPointKindMask ||| isSyntheticMask) @@ -610,6 +623,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) @@ -629,6 +643,7 @@ 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) let internal setTestSource path (source: string) = diff --git a/src/Compiler/Utilities/sformat.fs b/src/Compiler/Utilities/sformat.fs index 6ba5b68c462..9c57e41d17e 100644 --- a/src/Compiler/Utilities/sformat.fs +++ b/src/Compiler/Utilities/sformat.fs @@ -409,6 +409,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 = @@ -1643,3 +1645,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 64f8d917a13..d8a16a7d9fe 100644 --- a/src/Compiler/Utilities/sformat.fsi +++ b/src/Compiler/Utilities/sformat.fsi @@ -347,6 +347,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. @@ -408,3 +410,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 1f905bc049a..8e303087943 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 172bd9683e3..f6bdca58f41 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 63c9d43631674f3330e2b856dad40b5aa16c81d9 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 02/10] 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 ecf96c58932..09286cd7038 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -464,7 +464,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 527a09cf1d0..ef0d2489f9e 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -4212,7 +4212,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 @@ -9842,6 +9842,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 = @@ -9895,7 +9896,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 @@ -10140,7 +10141,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 8024103e61c..080095c22b8 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -498,7 +498,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 89795d937c0..abc2db69378 100755 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1656,7 +1656,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 @@ -1708,6 +1708,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) -> @@ -1718,6 +1719,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 b9a3b4df351..0294b020db3 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2390,7 +2390,7 @@ 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)) @@ -2416,7 +2416,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = | ValueNone -> errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, desiredTyName, NicePrint.minimalStringOfType cenv.denv ty), m)) minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst) - |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, nameOpt, _, ty)) -> + |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, nameOpt, _, ty), _) -> ignore isInArg let m = diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 58f973e928a..3eca9de5967 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -334,7 +334,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 @@ -1290,7 +1290,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 @@ -1312,7 +1312,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. @@ -1423,9 +1423,9 @@ 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)) member x.HasGenericRetTy() = match x with @@ -1443,7 +1443,7 @@ type MethInfo = /// 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 e091834e271..c204c64c27e 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 aa47eaf0f99..83e7beacd77 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -676,7 +676,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 9e55016aea5..c9ace0dd165 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -800,7 +800,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 3ec19a75c5f..15aa0d54ef1 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -2149,10 +2149,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 9dc4718065d16e9e48e07abde8329981be14065f 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 03/10] 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 f7fc49cae5b..6780a122a71 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -1193,19 +1193,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 @@ -1284,9 +1279,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 @@ -1295,7 +1290,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 @@ -1303,9 +1298,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 eae503a4302..76a45e29c1f 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -721,13 +721,9 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : Exp 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 816a42a1a98..295fcb69185 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1391,13 +1391,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 bb352ba8b47..f1000fe5e12 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -11444,23 +11444,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 @@ -11470,7 +11453,6 @@ let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = member _.Equals(a, b) = nullSafeEquality a b (fun a b -> traitKeysAEquiv g TypeEquivEnv.EmptyIgnoreNulls 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 778b17d1be2..08068631b05 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2743,11 +2743,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 c79bcefa4b4..66ad36e370d 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -73,11 +73,15 @@ module Cancellable = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled(OperationCanceledException ct) else +#if FABLE_COMPILER + oper ct +#else try oper ct with | :? OperationCanceledException as e when ct.IsCancellationRequested -> ValueOrCancelled.Cancelled e | :? OperationCanceledException as e -> InvalidOperationException("Wrong cancellation token", e) |> raise +#endif let fold f acc seq = Cancellable(fun ct -> @@ -167,7 +171,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: _ MaybeNull, [] comp) = +#endif Cancellable(fun ct -> __debugPoint "" From 03dc4cc25a8857e5bdbeacd3f265faa065531e46 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 04/10] 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 59172563e850cd1a0a14d1a25b12485142a33113 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 05/10] 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 2466119433e..a38257e6910 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 31ceea19de04a53cdf9c2462c12d39fe4756501b 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 06/10] 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 | 4 +- 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 | 6 +- src/Compiler/Utilities/HashMultiMap.fs | 2 + src/Compiler/Utilities/HashMultiMap.fsi | 1 + 36 files changed, 585 insertions(+), 308 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 6780a122a71..593cf59177a 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -1199,8 +1199,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 @@ -1290,7 +1290,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 @@ -1298,7 +1298,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)) @@ -2144,10 +2144,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 @@ -2171,8 +2171,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 @@ -2180,7 +2180,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 = @@ -3336,8 +3336,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 @@ -3347,7 +3347,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 ef0d2489f9e..c9de912a550 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -156,6 +156,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 @@ -165,6 +175,7 @@ let (|HasFormatSpecifier|_|) (s: string) = [bscdiuxXoBeEfFgGMOAat] # and then a char that determines specifier's type """, RegexOptions.Compiled ||| RegexOptions.IgnorePatternWhitespace) +#endif then ValueSome HasFormatSpecifier else @@ -173,7 +184,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 17f73f7cd45..db4ce04df6e 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 62b827ff9b4..c1162f8553f 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -702,10 +702,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) -> @@ -717,10 +717,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) -> @@ -731,13 +731,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 d899bdcc2ad..39553d95dc1 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/src/Compiler/Driver/CompilerImports.fsi @@ -53,6 +53,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 0f6a753e56e..85816193a35 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 41341a4c07e..bfa00bd863f 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -42,6 +42,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. @@ -51,6 +52,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 @@ -194,6 +196,7 @@ val CheckOneInput: input: ParsedInput -> Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> +#if !FABLE_COMPILER val CheckOneInputWithCallback: node: NodeToTypeCheck -> checkForErrors: (unit -> bool) * @@ -206,6 +209,7 @@ val CheckOneInputWithCallback: input: ParsedInput * _skipImplIfSigExists: bool -> Cancellable> +#endif //!FABLE_COMPILER val AddCheckResultsToTcState: tcGlobals: TcGlobals * @@ -219,6 +223,7 @@ val AddCheckResultsToTcState: tcState: TcState -> ModuleOrNamespaceType * TcState +#if !FABLE_COMPILER val AddSignatureResultToTcImplEnv: tcImports: TcImports * tcGlobals: TcGlobals * @@ -229,6 +234,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 3d680aaaf3e..8b4a900ef3b 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -1012,6 +1012,7 @@ type StackGuard(name: string) = member x.GuardCancellable(original: Cancellable<'T>) = Cancellable(fun ct -> x.Guard(fun () -> Cancellable.run ct original)) +#if !FABLE_COMPILER // UseMultipleDiagnosticLoggers in ParseAndCheckProject.fs provides similar functionality. // We should probably adapt and reuse that code. module MultipleDiagnosticsLoggers = @@ -1077,3 +1078,4 @@ module MultipleDiagnosticsLoggers = return results.ToArray() } +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 7a083efae7e..cd5a1b96579 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -492,6 +492,7 @@ type CompilationGlobalsScope = member BuildPhase: BuildPhase +#if !FABLE_COMPILER module MultipleDiagnosticsLoggers = /// Run computations using Async.Parallel. @@ -501,3 +502,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 c5afa4d51dd..bfe61878a6d 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -9,7 +9,9 @@ open System.IO open System.Collections.Immutable open Internal.Utilities.Library +#if !FABLE_COMPILER open Internal.Utilities.Hashing +#endif type ISourceText = @@ -167,7 +169,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 = @@ -204,7 +210,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 83e7beacd77..87f55230780 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -3931,7 +3931,7 @@ type FSharpCheckProjectResults | Choice1Of2 builder -> #if FABLE_COMPILER ignore builder - [||] + seq {} #else builder.SourceFiles |> Array.ofList @@ -3980,7 +3980,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 a7e77e50e1a..f49280dae12 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -24,6 +24,16 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree 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 * @@ -35,16 +45,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 9fd1b3a888a..09cfb7e5f43 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 @@ -526,7 +530,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 @@ -537,11 +547,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("*/%-+:^@><=!|$.?".AsSpan()) +#endif let lo = i + (if j >= 0 && slice[j] = ' ' then j else 0) @@ -609,9 +628,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 @@ -619,9 +642,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 7d17ca40ec7..74f79407432 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -8,7 +8,9 @@ open Internal.Utilities.Library open FSharp.Compiler 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.CompilerOptions open FSharp.Compiler.Diagnostics diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index 62ea74abb4f..013492854da 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -7,7 +7,9 @@ namespace FSharp.Compiler.CodeAnalysis open System open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CodeAnalysis +#if !FABLE_COMPILER open FSharp.Compiler.CodeAnalysis.TransparentCompiler +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.Symbols diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index ac068f3acd0..2a2ca27d000 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 33e89344fa4..c29871b7c4f 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 = @@ -1028,7 +1028,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 @@ -1042,11 +1042,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 @@ -1061,7 +1061,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 @@ -1076,7 +1076,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. @@ -1086,12 +1086,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 @@ -1414,8 +1414,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" @@ -1470,7 +1470,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" @@ -1920,7 +1920,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 a94b4f44189..ea2b31c105a 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -1020,13 +1020,15 @@ let pickleObjWithDanglingCcus inMem file g scope p x = (stringTab.AsArray, pubpathTab.AsArray, nlerefTab.AsArray, simpleTyTab.AsArray, phase1bytes) st2 -#if !FABLE_COMPILER // 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" -#endif (st2.osB :> System.IDisposable).Dispose() st2.os diff --git a/src/Compiler/Utilities/HashMultiMap.fs b/src/Compiler/Utilities/HashMultiMap.fs index a7ff049bae0..16ca0f778cf 100644 --- a/src/Compiler/Utilities/HashMultiMap.fs +++ b/src/Compiler/Utilities/HashMultiMap.fs @@ -27,9 +27,11 @@ type internal HashMultiMap<'Key, 'Value when 'Key: not null>(size: int, comparer 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 23807af5267..aa5c4a4d746 100644 --- a/src/Compiler/Utilities/HashMultiMap.fsi +++ b/src/Compiler/Utilities/HashMultiMap.fsi @@ -20,6 +20,7 @@ type internal HashMultiMap<'Key, 'Value when 'Key: not null> = 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> From d3569558f6186ab65270ff42ec9718b57543cfb4 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 07/10] Expose missing constraints --- .../FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index e2aaca46ac3..5ab48f837f9 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -5464,6 +5464,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 4b41d577ac4b8c39afa10b81bdf365b0caf9051e 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 08/10] 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 87f55230780..d7be5f3b1d9 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -3945,6 +3945,9 @@ type FSharpCheckProjectResults |> Array.toSeq #endif //!FABLE_COMPILER | Choice2Of2 task -> +#if FABLE_COMPILER + seq {} +#else Async.RunSynchronously( async { let! tcSymbolUses = task @@ -3957,6 +3960,7 @@ type FSharpCheckProjectResults }, ?cancellationToken = cancellationToken ) +#endif //!FABLE_COMPILER results |> Seq.filter (fun symbolUse -> symbolUse.ItemOccurrence <> ItemOccurrence.RelatedText) @@ -3975,7 +3979,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 @@ -3993,7 +3997,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 From 1dcef236daac20f976c8e9051d6cb947f8fb9787 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Sun, 3 Aug 2025 17:07:09 -0700 Subject: [PATCH 09/10] Updated System.Collections --- fcs/fcs-fable/Fable.Core.fs | 17 +++ .../System.Collections.Concurrent.fs | 143 ++++++++++++++---- fcs/fcs-fable/fcs-fable.fsproj | 4 + src/Compiler/AbstractIL/il.fs | 2 +- .../Facilities/DiagnosticResolutionHints.fs | 2 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 2 +- src/Compiler/Utilities/Activity.fs | 8 +- src/Compiler/Utilities/FileSystem.fs | 4 +- src/Compiler/Utilities/illib.fs | 8 +- 9 files changed, 147 insertions(+), 43 deletions(-) create mode 100644 fcs/fcs-fable/Fable.Core.fs diff --git a/fcs/fcs-fable/Fable.Core.fs b/fcs/fcs-fable/Fable.Core.fs new file mode 100644 index 00000000000..e787823c708 --- /dev/null +++ b/fcs/fcs-fable/Fable.Core.fs @@ -0,0 +1,17 @@ +namespace Fable.Core + +module JS = + + type Map<'K, 'V> = + abstract size: int + abstract clear: unit -> unit + abstract delete: key: 'K -> bool + abstract entries: unit -> seq<'K * 'V> + + abstract forEach: callbackfn: ('V -> 'K -> Map<'K, 'V> -> unit) * ?thisArg: obj -> unit + + abstract get: key: 'K -> 'V + abstract has: key: 'K -> bool + abstract keys: unit -> seq<'K> + abstract set: key: 'K * value: 'V -> Map<'K, 'V> + abstract values: unit -> seq<'V> diff --git a/fcs/fcs-fable/System.Collections.Concurrent.fs b/fcs/fcs-fable/System.Collections.Concurrent.fs index 778ba19afa4..363fd1f20b1 100644 --- a/fcs/fcs-fable/System.Collections.Concurrent.fs +++ b/fcs/fcs-fable/System.Collections.Concurrent.fs @@ -24,9 +24,8 @@ type ConcurrentStack<'T>() = (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) + let xs = Dictionary<'K, 'V>(comparer) new () = ConcurrentDictionary<'K, 'V>(EqualityComparer.Default) @@ -37,47 +36,127 @@ type ConcurrentDictionary<'K, 'V>(comparer: IEqualityComparer<'K>) = new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'K>) = ConcurrentDictionary<'K, 'V>(comparer) - member x.TryAdd (key: 'K, value: 'V): bool = - if x.ContainsKey(key) + 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 x.Add(key, value); true + else xs.Add(key, value); true - member x.TryRemove (key: 'K): bool * 'V = - match x.TryGetValue(key) with - | true, v -> (x.Remove(key), v) + member _.TryRemove (key: 'K): bool * 'V = + match xs.TryGetValue(key) with + | true, v -> (xs.Remove(key), v) | _ as res -> res - member x.GetOrAdd (key: 'K, value: 'V): 'V = - match x.TryGetValue(key) with + member _.GetOrAdd (key: 'K, value: 'V): 'V = + 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: 'K, valueFactory: System.Func<'K, 'V>): 'V = - match x.TryGetValue(key) with + member _.GetOrAdd (key: 'K, valueFactory: System.Func<'K, 'V>): 'V = + 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: 'K, valueFactory: 'K * 'Arg -> 'V, arg: 'Arg): 'V = - // match x.TryGetValue(key) with + // 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 x.Add(key, v); v + // | _ -> let v = valueFactory(key, arg) in xs.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 + 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 - 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 _.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 System.Collections.IEnumerable with + member _.GetEnumerator(): System.Collections.IEnumerator = + (xs.GetEnumerator() :> System.Collections.IEnumerator) + + interface IEnumerable> with + member _.GetEnumerator(): IEnumerator> = + xs.GetEnumerator() + + interface ICollection> with + member _.Add(item: KeyValuePair<'K, 'V>) : unit = + xs.Add(item.Key, item.Value) + + member _.Clear() : unit = xs.Clear() + + member _.Contains(item: KeyValuePair<'K, 'V>) : bool = + match xs.TryGetValue(item.Key) with + | true, value when Unchecked.equals value item.Value -> true + | _ -> false + + member _.CopyTo(array: KeyValuePair<'K, 'V>[], arrayIndex: int) : unit = + xs |> Seq.iteri (fun i e -> array[arrayIndex + i] <- e) + + member _.Count: int = xs.Count + member _.IsReadOnly: bool = false + + member _.Remove(item: KeyValuePair<'K, 'V>) : bool = + match xs.TryGetValue(item.Key) with + | true, value when Unchecked.equals value item.Value -> xs.Remove(item.Key) + | _ -> false + + interface IDictionary<'K, 'V> with + member _.Add(key: 'K, value: 'V) : unit = xs.Add(key, value) + member _.ContainsKey(key: 'K) : bool = xs.ContainsKey(key) + + member _.Item + with get (key: 'K): 'V = xs[key] + and set (key: 'K) (v: 'V): unit = xs[key] <- v + + member _.Keys: ICollection<'K> = xs.Keys + + member _.Remove(key: 'K) : bool = xs.Remove(key) + + member _.TryGetValue(key: 'K, value: byref<'V>) : bool = xs.TryGetValue(key, &value) + member _.Values: ICollection<'V> = xs.Values + + interface Fable.Core.JS.Map<'K, 'V> with + member _.size = xs.Count + member _.clear() = xs.Clear() + member _.delete(k) = xs.Remove(k) + + member _.entries() = + xs |> Seq.map (fun p -> p.Key, p.Value) + + member _.get(k) = xs[k] + member _.has(k) = xs.ContainsKey(k) + member _.keys() = xs.Keys + member _.values() = xs.Values - // 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 this.set(k, v) = + xs[k] <- v + this - // 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 + member this.forEach(f, ?thisArg) = + this |> Seq.iter (fun p -> f p.Value p.Key this) diff --git a/fcs/fcs-fable/fcs-fable.fsproj b/fcs/fcs-fable/fcs-fable.fsproj index 6db4eddb218..a649510096d 100644 --- a/fcs/fcs-fable/fcs-fable.fsproj +++ b/fcs/fcs-fable/fcs-fable.fsproj @@ -14,10 +14,14 @@ $(DefineConstants);NO_INLINE_IL_PARSER $(DefineConstants);FSHARPCORE_USE_PACKAGE $(OtherFlags) --nowarn:57 + + + + diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 238ff72b592..bee53be3861 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1581,7 +1581,7 @@ type ILFieldInit = | ILFieldInit.UInt64 u64 -> box u64 | ILFieldInit.Single ieee32 -> box ieee32 | ILFieldInit.Double ieee64 -> box ieee64 - | ILFieldInit.Null -> (null :> objnull) + | ILFieldInit.Null -> (null: objnull) // -------------------------------------------------------------------- // Native Types, for marshalling to the native C interface. diff --git a/src/Compiler/Facilities/DiagnosticResolutionHints.fs b/src/Compiler/Facilities/DiagnosticResolutionHints.fs index 9cca9333158..06b9788d3ee 100644 --- a/src/Compiler/Facilities/DiagnosticResolutionHints.fs +++ b/src/Compiler/Facilities/DiagnosticResolutionHints.fs @@ -119,6 +119,6 @@ type SuggestionBuffer(idText: string) = interface IEnumerable with member this.GetEnumerator() = if this.IsEmpty then - Seq.empty.GetEnumerator() :> IEnumerator + Seq.empty.GetEnumerator() :> IEnumerator else new SuggestionBufferEnumerator(tail, data) :> IEnumerator diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 8b4a900ef3b..41e5ba216e7 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -218,7 +218,7 @@ type StopProcessingExiter() = interface Exiter with member exiter.Exit n = exiter.ExitCode <- n - raise StopProcessing + raise StopProcessing /// Closed enumeration of build phases. [] diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 9e6b7d97c0e..de733d62049 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -122,11 +122,15 @@ module internal Activity = let start (name: string) (tags: (string * string) seq) : IDisposable = ignore name ignore tags - null + { new IDisposable with + member _.Dispose() = () + } let startNoTags (name: string) : IDisposable = ignore name - null + { new IDisposable with + member _.Dispose() = () + } let addEvent (name: string) = ignore name diff --git a/src/Compiler/Utilities/FileSystem.fs b/src/Compiler/Utilities/FileSystem.fs index fa5b96c851f..1fb05204950 100644 --- a/src/Compiler/Utilities/FileSystem.fs +++ b/src/Compiler/Utilities/FileSystem.fs @@ -496,8 +496,8 @@ type FileSystem = 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 + let isInvalidDirectory(p: string) = + String.IsNullOrEmpty p || p.IndexOfAny(Path.GetInvalidPathChars()) <> -1 isInvalidPath path || let directory = Path.GetDirectoryName path let filename = Path.GetFileName path diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index a6e7c3016cd..7827580bde8 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -42,7 +42,7 @@ type InterruptibleLazy<'T> private (value, valueFactory: unit -> 'T) = | _ -> value <- (valueFactory |> unbox 'T>) () - valueFactory <- Unchecked.defaultof<_> + valueFactory <- Unchecked.defaultof<'T> finally Monitor.Exit(syncObj) @@ -1051,7 +1051,7 @@ type LazyWithContext<'T, 'Ctxt> = static member NotLazy(x: 'T) : LazyWithContext<'T, 'Ctxt> = { value = x - funcOrException = null + funcOrException = (null: objnull) findOriginalException = id } @@ -1094,7 +1094,7 @@ type LazyWithContext<'T, 'Ctxt> = try let res = f ctxt x.value <- res - x.funcOrException <- null + x.funcOrException <- (null: objnull) res with RecoverableException exn -> x.funcOrException <- box (LazyWithContextFailure(exn)) @@ -1153,7 +1153,7 @@ module IPartialEqualityComparer = if dict.ContainsKey key then false else - (dict[key] <- null + (dict[key] <- (null: objnull) true) else true) From a8baa1397ac582a53eac62cd43fbf95a6b32b3f4 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Tue, 11 Nov 2025 11:48:32 -0800 Subject: [PATCH 10/10] Fix merge issues --- buildtools/buildtools.targets | 4 +-- fcs/fcs-fable/FSStrings.fs | 25 +++++++++++++++++-- fcs/fcs-fable/System.Collections.Immutable.fs | 3 +++ fcs/fcs-fable/TcImports_shim.fs | 8 +++--- fcs/fcs-fable/codegen/codegen.fsproj | 3 ++- fcs/fcs-fable/fcs-fable.fsproj | 5 ++++ fcs/fcs-fable/service_slim.fs | 6 ++--- fcs/fcs-fable/test/Metadata.fs | 1 + .../test/bench/fcs-fable-bench.fsproj | 3 ++- fcs/fcs-fable/test/fcs-fable-test.fsproj | 4 +-- src/Compiler/AbstractIL/ilread.fs | 9 ++----- src/Compiler/Checking/TypeRelations.fs | 5 ++++ src/Compiler/Facilities/DiagnosticsLogger.fs | 3 ++- src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 ++ src/Compiler/Facilities/prim-lexing.fs | 6 ++--- src/Compiler/Service/FSharpCheckerResults.fsi | 2 +- src/Compiler/Service/ServiceLexing.fsi | 1 + src/Compiler/SyntaxTree/UnicodeLexing.fs | 2 +- src/Compiler/SyntaxTree/UnicodeLexing.fsi | 2 +- src/Compiler/SyntaxTree/WarnScopes.fs | 21 ++++++++++++++++ src/Compiler/TypedTree/TypedTree.fs | 6 +++++ src/Compiler/Utilities/Activity.fs | 9 +++++++ src/Compiler/Utilities/Activity.fsi | 4 +++ src/Compiler/Utilities/Cancellable.fs | 16 +++++++++++- src/Compiler/Utilities/Cancellable.fsi | 7 ++++++ src/Compiler/Utilities/illib.fs | 16 +++++++----- src/Compiler/Utilities/illib.fsi | 10 ++++---- 27 files changed, 142 insertions(+), 41 deletions(-) diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index ed0259f01c7..8fb40e444e2 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fslex\Release\net9.0\linux-x64\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net10.0\linux-x64\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fsyacc\Release\net9.0\linux-x64\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net10.0\linux-x64\fsyacc.dll diff --git a/fcs/fcs-fable/FSStrings.fs b/fcs/fcs-fable/FSStrings.fs index e827a1b585a..f58710a7905 100644 --- a/fcs/fcs-fable/FSStrings.fs +++ b/fcs/fcs-fable/FSStrings.fs @@ -242,6 +242,12 @@ let resources = ( "Parser.TOKEN.EQUALS", "symbol '='" ); + ( "Parser.TOKEN.GREATER.BAR.RBRACE", + "symbol '>|}'" + ); + ( "Parser.TOKEN.RQUOTE.BAR.RBRACE", + "symbol '@>|}' or '@@>|}'" + ); ( "Parser.TOKEN.GREATER.BAR.RBRACK", "symbol '>|]'" ); @@ -914,8 +920,14 @@ let resources = ( "Obsolete2", ". {0}" ); - ( "Experimental", - "{0}. This warning can be disabled using '--nowarn:57' or '#nowarn \"57\"'." + ( "Experimental1", + "This construct is experimental" + ); + ( "Experimental2", + ". {0}" + ); + ( "Experimental3", + ". 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\"'." @@ -1019,4 +1031,13 @@ let resources = ( "Parser.TOKEN.WHILE.BANG", "keyword 'while!'" ); + ( "InvalidAttributeTargetForLanguageElement1", + "This attribute cannot be applied to {0}. Valid targets are: {1}" + ); + ( "InvalidAttributeTargetForLanguageElement2", + "This attribute is not valid for use on this language element" + ); + ( "NoConstructorsAvailableForType", + "No constructors are available for the type '{0}'" + ); ] \ No newline at end of file diff --git a/fcs/fcs-fable/System.Collections.Immutable.fs b/fcs/fcs-fable/System.Collections.Immutable.fs index 5d7a89275df..40c59c726b7 100644 --- a/fcs/fcs-fable/System.Collections.Immutable.fs +++ b/fcs/fcs-fable/System.Collections.Immutable.fs @@ -11,9 +11,12 @@ 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)] + let ofSeq<'T>(items: seq<'T>) = Array.ofSeq items + [] type ImmutableHashSet<'T when 'T: equality>(values: 'T seq) = let xs = HashSet<'T>(values) diff --git a/fcs/fcs-fable/TcImports_shim.fs b/fcs/fcs-fable/TcImports_shim.fs index cddf4c5c62c..7fa14e8cff8 100644 --- a/fcs/fcs-fable/TcImports_shim.fs +++ b/fcs/fcs-fable/TcImports_shim.fs @@ -89,7 +89,7 @@ module TcImports = unpickleObjWithDanglingCcus file ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo memA memB - let memoize_mod = new MemoizationTable<_,_> (LoadMod, keyComparer=HashIdentity.Structural) + let memoize_mod = MemoizationTable<_,_> ("mod", LoadMod, keyComparer=HashIdentity.Structural) let LoadSigData ccuName = let ilModule = memoize_mod.Apply ccuName @@ -109,8 +109,8 @@ module TcImports = | [] -> None | (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) + let memoize_sig = MemoizationTable<_,_> ("sig", LoadSigData, keyComparer=HashIdentity.Structural) + let memoize_opt = MemoizationTable<_,_> ("opt", LoadOptData, keyComparer=HashIdentity.Structural) let GetCustomAttributesOfILModule (ilModule: ILModuleDef) = (match ilModule.Manifest with Some m -> m.CustomAttrs | None -> ilModule.CustomAttrs).AsList() @@ -218,7 +218,7 @@ module TcImports = refCcusUnfixed |> List.choose snd |> List.iter fixup refCcus - let m = range.Zero + let m = Range.range0 let fsharpCoreAssemblyName = "FSharp.Core" let primaryAssemblyName = PrimaryAssembly.Mscorlib.Name let refCcusUnfixed = List.ofArray references |> List.map (GetCcu m) diff --git a/fcs/fcs-fable/codegen/codegen.fsproj b/fcs/fcs-fable/codegen/codegen.fsproj index 3a0aac2a097..6fa28dc4330 100644 --- a/fcs/fcs-fable/codegen/codegen.fsproj +++ b/fcs/fcs-fable/codegen/codegen.fsproj @@ -2,12 +2,13 @@ artifacts $(MSBuildProjectDirectory)/../../../src/Compiler + true Exe - net9.0 + net10.0 diff --git a/fcs/fcs-fable/fcs-fable.fsproj b/fcs/fcs-fable/fcs-fable.fsproj index a649510096d..16e7cf27cfc 100644 --- a/fcs/fcs-fable/fcs-fable.fsproj +++ b/fcs/fcs-fable/fcs-fable.fsproj @@ -18,6 +18,7 @@ + true @@ -37,6 +38,8 @@ + + @@ -164,6 +167,8 @@ + + diff --git a/fcs/fcs-fable/service_slim.fs b/fcs/fcs-fable/service_slim.fs index 57e106e09f8..8ca3e63db23 100644 --- a/fcs/fcs-fable/service_slim.fs +++ b/fcs/fcs-fable/service_slim.fs @@ -158,7 +158,7 @@ module internal ParseAndCheck = 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) + getAssemblyData, assemblyRef, access, tcImplFilesOpt, dependencyFiles, Some compilerState.projectOptions) let keepAssemblyContents = true FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) @@ -192,7 +192,7 @@ module internal ParseAndCheck = let input = parseResults.ParseTree let diagnosticsOptions = compilerState.tcConfig.diagnosticsOptions let capturingLogger = CompilationDiagnosticLogger("TypeCheckFile", diagnosticsOptions) - let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, diagnosticsOptions, capturingLogger) + let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedNowarn(diagnosticsOptions, capturingLogger) use _scope = new CompilationGlobalsScope (diagnosticsLogger, BuildPhase.TypeCheck) let checkForErrors () = parseResults.ParseHadErrors || diagnosticsLogger.ErrorCount > 0 @@ -224,7 +224,7 @@ module internal ParseAndCheck = 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, + projectFileName, fileName, Some compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, loadClosure, implFile, sink.GetOpenDeclarations()) FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) diff --git a/fcs/fcs-fable/test/Metadata.fs b/fcs/fcs-fable/test/Metadata.fs index 0ad926feaed..27065c97449 100644 --- a/fcs/fcs-fable/test/Metadata.fs +++ b/fcs/fcs-fable/test/Metadata.fs @@ -28,6 +28,7 @@ let references_core = [| "System.Reflection.TypeExtensions" "System.Runtime" "System.Runtime.Extensions" + "System.Runtime.InteropServices" "System.Runtime.Numerics" "System.Text.Encoding" "System.Text.Encoding.Extensions" diff --git a/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj index 9dadb98e53c..035b2de773d 100644 --- a/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj +++ b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj @@ -2,9 +2,10 @@ Exe - net9.0 + net10.0 $(DefineConstants);DOTNET_FILE_SYSTEM + true diff --git a/fcs/fcs-fable/test/fcs-fable-test.fsproj b/fcs/fcs-fable/test/fcs-fable-test.fsproj index d566a0aa63f..1740b838d9d 100644 --- a/fcs/fcs-fable/test/fcs-fable-test.fsproj +++ b/fcs/fcs-fable/test/fcs-fable-test.fsproj @@ -2,7 +2,7 @@ Exe - net9.0 + net10.0 $(DefineConstants);DOTNET_FILE_SYSTEM @@ -20,7 +20,7 @@ - + diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 593cf59177a..fcfc42515fb 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -41,12 +41,6 @@ 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")) @@ -62,13 +56,14 @@ let alwaysMemoryMapFSC = let stronglyHeldReaderCacheSizeDefault = 30 let stronglyHeldReaderCacheSize = +#if !FABLE_COMPILER try (match Environment.GetEnvironmentVariable("FSharp_StronglyHeldBinaryReaderCacheSize") with | null -> stronglyHeldReaderCacheSizeDefault | s -> int32 s) with _ -> +#endif stronglyHeldReaderCacheSizeDefault -#endif //!FABLE_COMPILER let singleOfBits (x: int32) = BitConverter.ToSingle(BitConverter.GetBytes x, 0) diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs index 021370f2067..120d65adab1 100644 --- a/src/Compiler/Checking/TypeRelations.fs +++ b/src/Compiler/Checking/TypeRelations.fs @@ -39,12 +39,17 @@ type TTypeCacheKey = ||> ValueOption.map2(fun t1 t2 -> TTypeCacheKey(t1, t2, canCoerce)) let getTypeSubsumptionCache = +#if FABLE_COMPILER + let factory (_g: TcGlobals) = + new System.Collections.Concurrent.ConcurrentDictionary() +#else let factory (g: TcGlobals) = let options = match g.compilationMode with | CompilationMode.OneOff -> Caches.CacheOptions.getDefault HashIdentity.Structural |> Caches.CacheOptions.withNoEviction | _ -> { Caches.CacheOptions.getDefault HashIdentity.Structural with TotalCapacity = 65536; HeadroomPercentage = 75 } new Caches.Cache(options, "typeSubsumptionCache") +#endif Extras.WeakMap.getOrCreate factory /// Implements a :> b without coercion based on finalized (no type variable) types diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 41e5ba216e7..bd2ecfdc3e1 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -886,6 +886,7 @@ let internal languageFeatureNotSupportedInLibraryError (langFeature: LanguageFea let suggestedVersionStr = LanguageVersion.GetFeatureVersionString langFeature error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary (featureStr, suggestedVersionStr), m)) +#if !FABLE_COMPILER module StackGuardMetrics = let meter = FSharp.Compiler.Diagnostics.Metrics.Meter @@ -952,6 +953,7 @@ module StackGuardMetrics = listener.Dispose() StatsToString() |> printfn "%s" } +#endif /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached type StackGuard(name: string) = @@ -982,7 +984,6 @@ type StackGuard(name: string) = ) = #if FABLE_COMPILER ignore depth - ignore maxDepth ignore name f () #else //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index cd5a1b96579..04de96f5f9f 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -459,10 +459,12 @@ val tryLanguageFeatureErrorOption: val languageFeatureNotSupportedInLibraryError: langFeature: LanguageFeature -> m: range -> 'T +#if !FABLE_COMPILER module internal StackGuardMetrics = val Listen: unit -> IDisposable val StatsToString: unit -> string val CaptureStatsAndWriteToConsole: unit -> IDisposable +#endif type StackGuard = new: name: string -> StackGuard diff --git a/src/Compiler/Facilities/prim-lexing.fs b/src/Compiler/Facilities/prim-lexing.fs index bfe61878a6d..6edd0caafb7 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -263,9 +263,9 @@ type internal Position = static member FirstLine fileIdx = Position(fileIdx, 1, 0, 0) #if FABLE_COMPILER - type internal LexBufferChar = uint16 +type internal LexBufferChar = uint16 #else - type internal LexBufferChar = char +type internal LexBufferChar = char #endif type internal LexBufferFiller<'Char> = LexBuffer<'Char> -> unit @@ -385,7 +385,7 @@ and [] internal LexBuffer<'Char> FSharp.Compiler.DiagnosticsLogger.checkLanguageFeatureAndRecover langVersion featureId range static member FromFunction - (reportLibraryOnlyFeatures, langVersion, strictIndentation, f: 'Char[] * int * int -> int) + (reportLibraryOnlyFeatures: bool, langVersion: LanguageVersion, strictIndentation: bool option, f: 'Char[] * int * int -> int) : LexBuffer<'Char> = let extension = Array.zeroCreate 4096 diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 534ea736dad..a6dd8a8dd8c 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -262,7 +262,7 @@ type internal TypeCheckInfo = tcAccessRights: AccessorDomain * projectFileName: string * mainInputFileName: string * - projectOptions: FSharpProjectOptions * + projectOptions: FSharpProjectOptions option * sResolutions: TcResolutions * sSymbolUses: TcSymbolUses * sFallback: NameResolutionEnv * diff --git a/src/Compiler/Service/ServiceLexing.fsi b/src/Compiler/Service/ServiceLexing.fsi index 49a115eddd1..516ced179d3 100755 --- a/src/Compiler/Service/ServiceLexing.fsi +++ b/src/Compiler/Service/ServiceLexing.fsi @@ -6,6 +6,7 @@ open System open System.Threading open FSharp.Compiler open FSharp.Compiler.Text +open Internal.Utilities.Text.Lexing #nowarn "57" diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fs b/src/Compiler/SyntaxTree/UnicodeLexing.fs index 57c256b9300..8d21462cc59 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fs +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fs @@ -8,7 +8,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'char> with +type LexBuffer<'Char> with member lexbuf.GetLocalData<'T when 'T: not null>(key: string, initializer) = match lexbuf.BufferLocalStore.TryGetValue key with diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fsi b/src/Compiler/SyntaxTree/UnicodeLexing.fsi index 2f63f9458d3..b28300c3352 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fsi +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fsi @@ -9,7 +9,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'char> with +type LexBuffer<'Char> with member GetLocalData<'T when 'T: not null> : key: string * initializer: (unit -> 'T) -> 'T member TryGetLocalData<'T when 'T: not null> : key: string -> 'T option diff --git a/src/Compiler/SyntaxTree/WarnScopes.fs b/src/Compiler/SyntaxTree/WarnScopes.fs index da6aeb5627a..c822304be37 100644 --- a/src/Compiler/SyntaxTree/WarnScopes.fs +++ b/src/Compiler/SyntaxTree/WarnScopes.fs @@ -110,7 +110,11 @@ module internal WarnScopes = // 4. The trailing whitespace. // 5. The comment (if any). +#if FABLE_COMPILER + Regex("""( *)#(\S+)(?: +([^\/\r\n/;]+))*(?:;;)?( *)(\/\/.*)?$""") +#else Regex("""( *)#(\S+)(?: +([^ \r\n/;]+))*(?:;;)?( *)(\/\/.*)?$""", RegexOptions.CultureInvariant) +#endif let private parseDirective lexbuf = let text = Lexbuf.LexemeString lexbuf @@ -119,7 +123,18 @@ module internal WarnScopes = let mGroups = (regex.Match text).Groups let totalLength = mGroups[0].Length let dIdent = mGroups[2].Value +#if FABLE_COMPILER + // Fable's Regex does not support Captures and CaptureCollections, + // so we extract the arguments and indices from the match group[3] + let argsStr: string = mGroups[3].Value + let argsPos = text.IndexOf(argsStr, System.StringComparison.Ordinal) + let args = argsStr.Split([|' '|]) + let argCaptures, _last = + (argsPos, args) ||> Array.mapFold (fun acc arg -> (acc, arg), acc + arg.Length + 1) + let argCaptures = argCaptures |> Array.filter (fun (pos, arg) -> arg <> "") |> Array.toList +#else let argCaptures = [ for c in mGroups[3].Captures -> c ] +#endif let positions line offset length = mkPos line (startPos.Column + offset), mkPos line (startPos.Column + offset + length) @@ -133,9 +148,15 @@ module internal WarnScopes = if argCaptures.IsEmpty then errorR (Error(FSComp.SR.lexWarnDirectiveMustHaveArgs (), directiveRange)) +#if FABLE_COMPILER + let mkDirective ctor (offset: int, arg: string) = + let m = mkRange offset arg.Length + getNumber lexbuf.LanguageVersion m arg |> Option.map (fun n -> ctor (n, m)) +#else let mkDirective ctor (c: Capture) = let m = mkRange c.Index c.Length getNumber lexbuf.LanguageVersion m c.Value |> Option.map (fun n -> ctor (n, m)) +#endif let warnCmds = match dIdent with diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 775606e60d9..c15f47a9baa 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4499,7 +4499,13 @@ type TType = | TType_var (tp, _) -> match tp.Solution with | None -> tp.DisplayName +#if FABLE_COMPILER + | Some t -> + let s = if maxDepth < 0 then "True" else t.LimitedToString(maxDepth-1) + tp.DisplayName + $" (solved: {s})" +#else | Some t -> tp.DisplayName + $" (solved: {if maxDepth < 0 then Boolean.TrueString else t.LimitedToString(maxDepth-1)})" +#endif | TType_measure ms -> ms.ToString() override x.ToString() = x.LimitedToString(4) diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index de733d62049..844774a6c67 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -18,6 +18,7 @@ module ActivityNames = let AllRelevantNames = [| FscSourceName; ProfiledSourceName |] +#if !FABLE_COMPILER module Metrics = let Meter = new Metrics.Meter(ActivityNames.FscSourceName) @@ -65,6 +66,7 @@ module Metrics = formatTable headers rows with exn -> $"Error formatting table: {exn}" +#endif [] module internal Activity = @@ -91,6 +93,7 @@ module internal Activity = let callerFilePath = "callerFilePath" let callerLineNumber = "callerLineNumber" +#if !FABLE_COMPILER let AllKnownTags = [| fileName @@ -113,6 +116,7 @@ module internal Activity = callerFilePath callerLineNumber |] +#endif module Events = let cacheHit = "cacheHit" @@ -135,6 +139,11 @@ module internal Activity = let addEvent (name: string) = ignore name () + + let addEventWithTags (name: string) (tags: (string * objnull) seq) = + ignore name + ignore tags + () #else //!FABLE_COMPILER diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index 13da61cdf61..a4faee3bc45 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -2,7 +2,9 @@ namespace FSharp.Compiler.Diagnostics open System +#if !FABLE_COMPILER open System.Diagnostics.Metrics +#endif /// For activities following the dotnet distributed tracing concept /// https://learn.microsoft.com/dotnet/core/diagnostics/distributed-tracing-concepts?source=recommendations @@ -16,10 +18,12 @@ module ActivityNames = val AllRelevantNames: string[] +#if !FABLE_COMPILER module internal Metrics = val Meter: Meter val printTable: headers: string list -> rows: string list list -> string +#endif /// For activities following the dotnet distributed tracing concept /// https://learn.microsoft.com/dotnet/core/diagnostics/distributed-tracing-concepts?source=recommendations diff --git a/src/Compiler/Utilities/Cancellable.fs b/src/Compiler/Utilities/Cancellable.fs index 66ad36e370d..03b701bef9d 100644 --- a/src/Compiler/Utilities/Cancellable.fs +++ b/src/Compiler/Utilities/Cancellable.fs @@ -57,7 +57,9 @@ open System open System.Threading open FSharp.Compiler +#if !FABLE_COMPILER open FSharp.Core.CompilerServices.StateMachineHelpers +#endif [] type ValueOrCancelled<'TResult> = @@ -127,7 +129,9 @@ type CancellableBuilder() = member inline _.Bind(comp, [] k) = Cancellable(fun ct -> +#if !FABLE_COMPILER __debugPoint "" +#endif match Cancellable.run ct comp with | ValueOrCancelled.Value v1 -> Cancellable.run ct (k v1) @@ -136,7 +140,9 @@ type CancellableBuilder() = member inline _.BindReturn(comp, [] k) = Cancellable(fun ct -> +#if !FABLE_COMPILER __debugPoint "" +#endif match Cancellable.run ct comp with | ValueOrCancelled.Value v1 -> ValueOrCancelled.Value(k v1) @@ -145,7 +151,9 @@ type CancellableBuilder() = member inline _.Combine(comp1, comp2) = Cancellable(fun ct -> +#if !FABLE_COMPILER __debugPoint "" +#endif match Cancellable.run ct comp1 with | ValueOrCancelled.Value() -> Cancellable.run ct comp2 @@ -154,7 +162,9 @@ type CancellableBuilder() = member inline _.TryWith(comp, [] handler) = Cancellable(fun ct -> +#if !FABLE_COMPILER __debugPoint "" +#endif let compRes = try @@ -172,13 +182,15 @@ type CancellableBuilder() = | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) #if FABLE_COMPILER - member inline _.Using(resource: 'Resource when 'Resource :> IDisposable, [] comp) = + member inline _.Using(resource: ('R :> IDisposable), [] comp) = #else member inline _.Using(resource: _ MaybeNull, [] comp) = #endif Cancellable(fun ct -> +#if !FABLE_COMPILER __debugPoint "" +#endif let body = comp resource @@ -208,7 +220,9 @@ type CancellableBuilder() = member inline _.TryFinally(comp, [] compensation) = Cancellable(fun ct -> +#if !FABLE_COMPILER __debugPoint "" +#endif let compRes = try diff --git a/src/Compiler/Utilities/Cancellable.fsi b/src/Compiler/Utilities/Cancellable.fsi index 0d82faa68cb..c4a49f9a1c8 100644 --- a/src/Compiler/Utilities/Cancellable.fsi +++ b/src/Compiler/Utilities/Cancellable.fsi @@ -67,10 +67,17 @@ type internal CancellableBuilder = member inline TryWith: comp: Cancellable<'T> * [] handler: (exn -> Cancellable<'T>) -> Cancellable<'T> + +#if FABLE_COMPILER + member inline Using: + resource: 'R * [] comp: ('R -> Cancellable<'T>) -> Cancellable<'T> + when 'R :> IDisposable +#else member inline Using: resource: 'Resource MaybeNull * [] comp: ('Resource MaybeNull -> Cancellable<'T>) -> Cancellable<'T> when 'Resource :> IDisposable and 'Resource: not struct and 'Resource: not null +#endif member inline Zero: unit -> Cancellable diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 7827580bde8..e145cdb8aed 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -11,7 +11,9 @@ open System.Threading open System.Threading.Tasks open System.Runtime.CompilerServices +#if !FABLE_COMPILER open FSharp.Compiler.Caches +#endif [] type InterruptibleLazy<'T> private (value, valueFactory: unit -> 'T) = @@ -976,11 +978,17 @@ type UniqueStampGenerator<'T when 'T: equality and 'T: not null>() = #endif /// memoize tables (all entries cached, never collected) -type MemoizationTable<'T, 'U when 'T: not null>(name, compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) = +type MemoizationTable<'T, 'U when 'T: not null>(name: string, compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) = +#if FABLE_COMPILER + do ignore name + let table = new ConcurrentDictionary<'T, Lazy<'U>>(keyComparer) + let computeFunc = Func<_, _>(fun key -> lazy (compute key)) +#else let options = CacheOptions.getDefault keyComparer |> CacheOptions.withNoEviction let table = new Cache<'T, Lazy<'U>>(options, name) let computeFunc key = lazy compute key +#endif member t.Apply x = if @@ -1066,13 +1074,10 @@ type LazyWithContext<'T, 'Ctxt> = | null -> true | _ -> false) - member x.Force(ctxt: 'Ctxt) = + member x.Force(ctxt: 'Ctxt) : 'T = 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 @@ -1080,7 +1085,6 @@ 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 4598bfcfce9..f2b2421a750 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -421,11 +421,11 @@ type internal LazyWithContextFailure = /// Just like "Lazy" but EVERY forcer must provide an instance of "ctxt", e.g. to help track errors /// on forcing back to at least one sensible user location [] -type internal LazyWithContext<'T, 'ctxt> = - static member Create: f: ('ctxt -> 'T) * findOriginalException: (exn -> exn) -> LazyWithContext<'T, 'ctxt> - static member NotLazy: x: 'T -> LazyWithContext<'T, 'ctxt> - member Force: ctxt: 'ctxt -> 'T - member UnsynchronizedForce: ctxt: 'ctxt -> 'T +type internal LazyWithContext<'T, 'Ctxt> = + static member Create: f: ('Ctxt -> 'T) * findOriginalException: (exn -> exn) -> LazyWithContext<'T, 'Ctxt> + static member NotLazy: x: 'T -> LazyWithContext<'T, 'Ctxt> + member Force: ctxt: 'Ctxt -> 'T + member UnsynchronizedForce: ctxt: 'Ctxt -> 'T member IsDelayed: bool member IsForced: bool