From 81895c0c5641ad88d8680dc913dd87c80e27d0ab 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] Fable support --- .vscode/launch.json | 10 + buildtools/buildtools.targets | 4 +- fcs/build.sh | 40 + fcs/fcs-fable/.gitignore | 3 + fcs/fcs-fable/FSStrings.fs | 1001 +++++++++++++++++ fcs/fcs-fable/SR.fs | 28 + fcs/fcs-fable/System.Collections.fs | 109 ++ fcs/fcs-fable/System.IO.fs | 56 + fcs/fcs-fable/System.fs | 49 + fcs/fcs-fable/TcImports_shim.fs | 274 +++++ 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 | 352 ++++++ fcs/fcs-fable/service_slim.fs | 353 ++++++ 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 | 47 + src/Compiler/AbstractIL/il.fsi | 6 + src/Compiler/AbstractIL/illex.fsl | 19 +- src/Compiler/AbstractIL/ilread.fs | 489 ++++---- src/Compiler/AbstractIL/ilread.fsi | 9 +- src/Compiler/Checking/AttributeChecking.fs | 6 +- src/Compiler/Checking/ConstraintSolver.fs | 4 +- src/Compiler/Checking/MethodCalls.fs | 2 +- src/Compiler/Checking/MethodCalls.fsi | 2 +- src/Compiler/Checking/NicePrint.fs | 2 + src/Compiler/Checking/QuotationTranslator.fs | 8 + src/Compiler/CodeGen/IlxGen.fs | 26 + src/Compiler/CodeGen/IlxGen.fsi | 2 + src/Compiler/Driver/CompilerConfig.fs | 65 ++ src/Compiler/Driver/CompilerConfig.fsi | 23 + src/Compiler/Driver/CompilerDiagnostics.fs | 21 + src/Compiler/Driver/CompilerDiagnostics.fsi | 6 + src/Compiler/Driver/CompilerImports.fs | 75 ++ src/Compiler/Driver/CompilerImports.fsi | 25 + src/Compiler/Driver/CompilerOptions.fs | 23 + src/Compiler/Driver/CompilerOptions.fsi | 4 + src/Compiler/Driver/OptimizeInputs.fs | 18 +- src/Compiler/Driver/OptimizeInputs.fsi | 4 + src/Compiler/Driver/ParseAndCheckInputs.fs | 25 +- 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 | 61 +- src/Compiler/Facilities/prim-lexing.fsi | 22 +- src/Compiler/Facilities/prim-parsing.fs | 9 +- src/Compiler/Facilities/prim-parsing.fsi | 4 +- src/Compiler/Interactive/fsi.fs | 4 + .../Legacy/LegacyHostedCompilerForTesting.fs | 15 + src/Compiler/Optimize/Optimizer.fs | 17 + src/Compiler/Service/FSharpCheckerResults.fs | 40 + src/Compiler/Service/FSharpCheckerResults.fsi | 50 + src/Compiler/Service/FSharpSource.fs | 10 + src/Compiler/Service/FSharpSource.fsi | 4 + src/Compiler/Service/IncrementalBuild.fs | 21 +- src/Compiler/Service/IncrementalBuild.fsi | 14 + src/Compiler/Service/QuickParse.fs | 10 + .../Service/SemanticClassification.fs | 4 + .../Service/ServiceAssemblyContent.fs | 5 +- .../Service/ServiceAssemblyContent.fsi | 5 + .../Service/ServiceDeclarationLists.fs | 3 + src/Compiler/Service/ServiceLexing.fs | 4 + src/Compiler/Service/ServiceLexing.fsi | 3 +- src/Compiler/Service/ServiceParsedInputOps.fs | 39 + src/Compiler/Service/service.fs | 10 + src/Compiler/Service/service.fsi | 4 + src/Compiler/Symbols/Exprs.fs | 8 + src/Compiler/Symbols/Exprs.fsi | 3 + src/Compiler/Symbols/SymbolHelpers.fs | 7 + src/Compiler/Symbols/Symbols.fs | 10 + src/Compiler/SyntaxTree/LexFilter.fsi | 6 +- src/Compiler/SyntaxTree/LexHelpers.fs | 22 + src/Compiler/SyntaxTree/ParseHelpers.fs | 11 +- src/Compiler/SyntaxTree/PrettyNaming.fs | 4 + src/Compiler/SyntaxTree/UnicodeLexing.fs | 14 +- 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/TypedTree.fs | 11 + src/Compiler/TypedTree/TypedTree.fsi | 12 + src/Compiler/TypedTree/TypedTreeBasics.fs | 3 +- src/Compiler/TypedTree/TypedTreeOps.fs | 22 + src/Compiler/TypedTree/TypedTreeOps.fsi | 4 + src/Compiler/TypedTree/TypedTreePickle.fs | 10 + src/Compiler/Utilities/Activity.fs | 14 + src/Compiler/Utilities/Activity.fsi | 2 + src/Compiler/Utilities/FileSystem.fs | 88 ++ src/Compiler/Utilities/FileSystem.fsi | 75 ++ src/Compiler/Utilities/HashMultiMap.fs | 24 + src/Compiler/Utilities/HashMultiMap.fsi | 6 + 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 | 50 +- src/Compiler/Utilities/illib.fsi | 12 +- src/Compiler/Utilities/lib.fs | 24 + src/Compiler/Utilities/lib.fsi | 6 + src/Compiler/Utilities/range.fs | 19 + src/Compiler/Utilities/sformat.fs | 10 +- src/Compiler/Utilities/sformat.fsi | 12 +- src/Compiler/lex.fsl | 58 +- 123 files changed, 5522 insertions(+), 288 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 813f774b07f7..3f6c878d47c2 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -84,6 +84,16 @@ }, "justMyCode": true, "enableStepFiltering": false, + }, + { + "name": "FCS-Fable Test", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-fable-test/Debug/net7.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 86346fc2a156..3b2fa489c66e 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net7.0\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net7.0\fsyacc.dll diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 000000000000..f8eca34a882c --- /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 000000000000..db7b2bd5665b --- /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 000000000000..b4d6e985d656 --- /dev/null +++ b/fcs/fcs-fable/FSStrings.fs @@ -0,0 +1,1001 @@ +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." + ); + ( "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" + ); + ] \ 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 000000000000..39ca804f1134 --- /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 000000000000..19602f414f1e --- /dev/null +++ b/fcs/fcs-fable/System.Collections.fs @@ -0,0 +1,109 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System.Collections + +module Generic = + + type Queue<'T> = + inherit ResizeArray<'T> + + new () = Queue<'T>() + + member x.Enqueue (item: 'T) = + x.Add(item) + + member x.Dequeue () = + let item = x.Item(0) + x.RemoveAt(0) + item + +module Immutable = + open System.Collections.Generic + + // not immutable, just a ResizeArray // TODO: immutable implementation + type ImmutableArray<'T> = + static member CreateBuilder() = ResizeArray<'T>() + + // not immutable, just a Dictionary // TODO: immutable implementation + type ImmutableDictionary<'Key, 'Value>(comparer: IEqualityComparer<'Key>) = + inherit Dictionary<'Key, 'Value>(comparer) + static member Create(comparer) = ImmutableDictionary<'Key, 'Value>(comparer) + static member Empty = ImmutableDictionary<'Key, 'Value>(EqualityComparer.Default) + member x.Add (key: 'Key, value: 'Value) = x[key] <- value; x + member x.SetItem (key: 'Key, value: 'Value) = x[key] <- value; x + +module Concurrent = + open System.Collections.Generic + + // not thread safe, just a ResizeArray // TODO: threaded implementation + type ConcurrentStack<'T> = + inherit ResizeArray<'T> + + new () = ConcurrentStack<'T>() + + member x.Push (item: 'T) = + x.Add(item) + + member x.PushRange (items: 'T[]) = + x.AddRange(items) + + // 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 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 diff --git a/fcs/fcs-fable/System.IO.fs b/fcs/fcs-fable/System.IO.fs new file mode 100644 index 000000000000..3b3cc17b134a --- /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 000000000000..6678445b20a1 --- /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 000000000000..b1d322fd7a24 --- /dev/null +++ b/fcs/fcs-fable/TcImports_shim.fs @@ -0,0 +1,274 @@ +// 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) = + let findEntity (entityOpt: Entity option) n = + match entityOpt with + | None -> None + | Some entity -> entity.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind n + let entityOpt = (Some ccu.Contents, nsname) ||> List.fold findEntity + match entityOpt with + | Some ns -> + match Map.tryFind tname ns.ModuleOrNamespaceType.TypesByMangledName with + | Some _ -> true + | None -> false + | None -> false + + // Search for a type + let tryFindSysTypeCcu nsname typeName = + let search = sysCcuInfos |> List.tryFind (fun ccuInfo -> ccuHasType ccuInfo.FSharpViewOfMetadata nsname typeName) + match search with + | Some x -> Some x.FSharpViewOfMetadata + | None -> +#if DEBUG + printfn "Cannot find type %s.%s" (String.concat "." nsname) 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 000000000000..cc89d332c8b6 --- /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 000000000000..aec6498a3362 --- /dev/null +++ b/fcs/fcs-fable/codegen/codegen.fsproj @@ -0,0 +1,52 @@ + + + artifacts + $(MSBuildProjectDirectory)/../../../src/Compiler + + + + + Exe + net7.0 + + + + + + --unicode --lexlib Internal.Utilities.Text.Lexing + AbstractIL/illex.fsl + + + --module FSharp.Compiler.AbstractIL.AsciiParser --open FSharp.Compiler.AbstractIL --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + AbstractIL/ilpars.fsy + + + --unicode --lexlib Internal.Utilities.Text.Lexing + SyntaxTree/pplex.fsl + + + --module FSharp.Compiler.PPParser --open FSharp.Compiler --open FSharp.Compiler.Syntax --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + SyntaxTree/pppars.fsy + + + --unicode --lexlib Internal.Utilities.Text.Lexing + SyntaxTree/lex.fsl + + + --module FSharp.Compiler.Parser --open FSharp.Compiler --open FSharp.Compiler.Syntax --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + 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 000000000000..529a0a1d543b --- /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 000000000000..c28706b5d6ad --- /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 000000000000..85c6842a7a8f --- /dev/null +++ b/fcs/fcs-fable/fcs-fable.fsproj @@ -0,0 +1,352 @@ + + + $(MSBuildProjectDirectory)/../../src/Compiler + $(MSBuildProjectDirectory)/codegen + + + + netstandard2.0 + $(DefineConstants);FABLE_COMPILER + $(DefineConstants);FX_NO_WEAKTABLE + $(DefineConstants);NO_TYPEPROVIDERS + $(DefineConstants);NO_INLINE_IL_PARSER + $(DefineConstants);FSHARPCORE_USE_PACKAGE + $(OtherFlags) --warnon:1182 --nowarn:57 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/service_slim.fs b/fcs/fcs-fable/service_slim.fs new file mode 100644 index 000000000000..e2eab58598ce --- /dev/null +++ b/fcs/fcs-fable/service_slim.fs @@ -0,0 +1,353 @@ +// 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) = + let parseCacheKey = fileName, hash source + compilerState.parseCache.GetOrAdd(parseCacheKey, fun _ -> + ClearStaleCache(fileName, parsingOptions, compilerState) + let sourceText = SourceText.ofString source + let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors, captureIdentifiersWhenParsing) + 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, false) + |> Cancellable.runWithoutCancellation + + let fileName = parseResults.FileName + let tcErrors = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, (capturingLogger.GetDiagnostics()), suggestNamesForErrors) + (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 compilerState = compilerStateCache.Get() + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile (fileName, source) = ParseFile (fileName, source, parsingOptions, compilerState) + 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 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) + 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 000000000000..66d36d51d648 --- /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 000000000000..0ad926feaed6 --- /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 000000000000..b4efa099d696 --- /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 000000000000..991e68c5af55 --- /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 000000000000..3c21093f4346 --- /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 000000000000..f9df9bdebaef --- /dev/null +++ b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj @@ -0,0 +1,27 @@ + + + + Exe + net7.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 000000000000..db8d3b2b7170 --- /dev/null +++ b/fcs/fcs-fable/test/fcs-fable-test.fsproj @@ -0,0 +1,26 @@ + + + + Exe + net7.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 000000000000..6ce97590acdd --- /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 000000000000..ab5e66d407d9 --- /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 000000000000..d2405c6958ba --- /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 000000000000..6474447f926e --- /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 2470c7ae2151..f5a2241698a5 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -14,7 +14,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 @@ -485,6 +487,7 @@ type ILAssemblyRef(data) = assemRefLocale = locale } +#if !FABLE_COMPILER static member FromAssemblyName(aname: AssemblyName) = let locale = None @@ -507,6 +510,7 @@ type ILAssemblyRef(data) = let retargetable = aname.Flags = AssemblyNameFlags.Retargetable ILAssemblyRef.Create(aname.Name, None, publicKey, retargetable, version, locale) +#endif //!FABLE_COMPILER member aref.QualifiedName = let b = StringBuilder(100) @@ -2787,7 +2791,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 array.Value -> pre.GetTypeDef() |] @@ -2833,8 +2841,13 @@ and [] ILPreTypeDefImpl(nameSpace: string list, name: string, metadataIn | ILTypeDefStored.Given td -> store <- td td +#if FABLE_COMPILER + | ILTypeDefStored.Computed f -> store <- f(); store + | ILTypeDefStored.Reader f -> store <- f metadataIndex; store +#else | ILTypeDefStored.Computed f -> LazyInitializer.EnsureInitialized(&store, Func<_>(fun () -> f ())) | ILTypeDefStored.Reader f -> LazyInitializer.EnsureInitialized(&store, Func<_>(fun () -> f metadataIndex)) +#endif | _ -> store and ILTypeDefStored = @@ -2894,7 +2907,11 @@ type ILResourceAccess = [] type ILResourceLocation = +#if FABLE_COMPILER + | Local of ByteMemory +#else | Local of ByteStorage +#endif | File of ILModuleRef * int32 | Assembly of ILAssemblyRef @@ -2910,7 +2927,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 @@ -3141,7 +3162,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 @@ -4608,6 +4633,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 @@ -4618,6 +4648,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 @@ -4934,7 +4965,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 @@ -5106,7 +5141,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) @@ -5477,11 +5516,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 cf4400582cb8..78387501f11e 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -87,7 +87,9 @@ type ILAssemblyRef = locale: string option -> ILAssemblyRef +#if !FABLE_COMPILER static member FromAssemblyName: AssemblyName -> ILAssemblyRef +#endif member Name: string @@ -1624,7 +1626,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 aad77eb806fd..50cb2ef72fdc 100644 --- a/src/Compiler/AbstractIL/illex.fsl +++ b/src/Compiler/AbstractIL/illex.fsl @@ -14,9 +14,25 @@ open FSharp.Compiler.AbstractIL.AsciiParser 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 ;; @@ -113,8 +129,7 @@ rule token = parse (* The problem is telling an integer-followed-by-ellipses from a floating-point-nubmer-followed-by-dots *) | ((['0'-'9']) | (['0'-'9']['0'-'9']['0'-'9']+)) "..." - { let b = lexbuf.LexemeView in - VAL_INT32_ELIPSES(int32(b.Slice(0, (b.Length - 3)).ToString())) } + { VAL_INT32_ELIPSES(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 7c7f26a699be..440dd3b303e3 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -21,13 +21,17 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.BinaryConstants open Internal.Utilities.Library +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.Support +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open System.Reflection +#if !FABLE_COMPILER open System.Reflection.PortableExecutable open FSharp.NativeInterop +#endif #nowarn "9" @@ -38,6 +42,12 @@ let _ = if checking then dprintn "warning: ILBinaryReader.checking is on" +#if FABLE_COMPILER +let noStableFileHeuristic = false +let alwaysMemoryMapFSC = false +let stronglyHeldReaderCacheSizeDefault = 30 +let stronglyHeldReaderCacheSize = stronglyHeldReaderCacheSizeDefault +#else //!FABLE_COMPILER let noStableFileHeuristic = try (Environment.GetEnvironmentVariable("FSharp_NoStableFileHeuristic") <> null) @@ -60,6 +70,7 @@ let stronglyHeldReaderCacheSize = | s -> int32 s) with _ -> stronglyHeldReaderCacheSizeDefault +#endif //!FABLE_COMPILER let singleOfBits (x: int32) = BitConverter.ToSingle(BitConverter.GetBytes x, 0) @@ -146,6 +157,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. @@ -183,6 +196,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[]) = @@ -193,6 +208,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. @@ -258,6 +275,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 @@ -1194,13 +1213,19 @@ 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 -let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = - let mutable row = Unchecked.defaultof<'RowT> +[] +type CustomAttributeRow = + val mutable parentIndex: TaggedIndex + val mutable typeIndex: TaggedIndex + val mutable valueIndex: int + +let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader) = + let mutable row = ref Unchecked.defaultof if binaryChop then let mutable low = 0 @@ -1213,8 +1238,8 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR 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 @@ -1234,10 +1259,10 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR if curr = 0 then fin <- true else - reader.GetRow(curr, &row) + reader.GetRow(curr, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + if reader.CompareKey(reader.GetKey(row)) = 0 then + res.Add(reader.ConvertRow(row)) else fin <- true @@ -1253,10 +1278,10 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR if curr > numRows then fin <- true else - reader.GetRow(curr, &row) + reader.GetRow(curr, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + if reader.CompareKey(reader.GetKey(row)) = 0 then + res.Add(reader.ConvertRow(row)) else fin <- true @@ -1267,115 +1292,112 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR let res = ImmutableArray.CreateBuilder() for i = 1 to numRows do - reader.GetRow(i, &row) + reader.GetRow(i, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + if reader.CompareKey(reader.GetKey(row)) = 0 then + res.Add(reader.ConvertRow(row)) res.ToArray() -[] -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. @@ -1384,55 +1406,55 @@ 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 seekReadInterfaceImplRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx - let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr - let intfIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.InterfaceImpl idx + let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv addr + let intfIdx = seekReadTypeDefOrRefOrSpecIdx ctxt mdv addr (tidx, intfIdx) /// 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. @@ -1441,83 +1463,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. @@ -1526,101 +1550,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 forwrdedIdx = 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 forwrdedIdx = seekReadMemberForwardedIdx ctxt mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let scopeIdx = seekReadUntaggedIdx TableNames.ModuleRef ctxt mdv addr (flags, forwrdedIdx, 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. @@ -1629,32 +1653,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 seekReadGenericParamConstraintRow (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 (pidx, 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 = @@ -1751,6 +1775,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 = @@ -1760,7 +1785,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 = @@ -2925,15 +2951,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 @@ -2950,8 +2976,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))) @@ -3166,14 +3192,14 @@ and customAttrsReader ctxtH tag : ILAttributesStored = let reader = { new ISeekReadIndexedRowReader, ILAttribute> with member _.GetRow(i, row) = - seekReadCustomAttributeRow ctxt mdv i &row + seekReadCustomAttributeRow ctxt mdv i row - member _.GetKey(attrRow) = attrRow.parentIndex + member _.GetKey(attrRow) = attrRow.Value.parentIndex member _.CompareKey(key) = hcaCompare (TaggedIndex(tag, idx)) key member _.ConvertRow(attrRow) = - seekReadCustomAttr ctxt (attrRow.typeIndex, attrRow.valueIndex) + seekReadCustomAttr ctxt (attrRow.Value.typeIndex, attrRow.Value.valueIndex) } seekReadIndexedRowsByInterface (ctxt.getNumRows TableNames.CustomAttribute) (isSorted ctxt TableNames.CustomAttribute) reader) @@ -3945,7 +3971,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) @@ -4862,6 +4893,8 @@ type ILModuleReaderImpl(ilModule: ILModuleDef, ilAssemblyRefs: Lazy BinaryFile +#endif //!FABLE_COMPILER + let OpenILModuleReaderFromBytes fileName assemblyContents options = let pefile = ByteFile(fileName, assemblyContents) :> BinaryFile @@ -4935,6 +4970,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) @@ -5096,3 +5133,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 f2b86266063b..6332e6af4516 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 087ebc1e0b13..9f06637c6131 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -271,7 +271,11 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = if g.compilingFSharpCore then true else +#if FABLE_COMPILER + g.langVersion.IsPreviewEnabled && (s.ToLowerInvariant().IndexOf(langVersionPrefix) >= 0) +#else g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0) +#endif if isNil attribs then CompleteD else @@ -434,7 +438,7 @@ let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = CompleteD) 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 6b0ef85d5e84..2ffda750db6e 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2621,7 +2621,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 ) @@ -2653,7 +2653,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 870443d32b97..879c1c353458 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 60a5ace7201e..e5f377cadb3a 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 6f02548b0841..5939b4822396 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -2113,8 +2113,10 @@ module TastDefinitionPrinting = | _ when isNil allDecls -> lhsL +#if !NO_TYPEPROVIDERS | TProvidedNamespaceRepr _ | TProvidedTypeRepr _ +#endif | TNoRepr -> allDecls |> applyMaxMembers denv.maxMembers diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index 063609d02329..3dbe65ca8c37 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 = @@ -713,9 +717,13 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let witnessArgInfo = if g.generateWitnesses && inWitnessPassingScope then let witnessInfo = traitInfo.GetWitnessInfo() +#if FABLE_COMPILER + env.witnessesInScope.TryFind witnessInfo +#else match env.witnessesInScope.TryGetValue witnessInfo with | true, storage -> Some storage | _ -> None +#endif else None diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 584c627b206a..243ef814307a 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -216,9 +216,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) @@ -1316,7 +1320,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 = @@ -1345,9 +1353,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 @@ -1848,7 +1860,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 = @@ -2677,7 +2693,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 @@ -11745,6 +11765,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 = @@ -11853,6 +11875,8 @@ let ClearGeneratedValue (ctxt: ExecutionContext) eenv (v: Val) = #endif () +#endif //!FABLE_COMPILER + /// The published API from the ILX code generator type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: ConstraintSolver.TcValF, ccu: CcuThunk) = @@ -11928,6 +11952,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai GenerateCode(cenv, anonTypeTable, ilxGenEnv, typedAssembly, assemAttribs, moduleAttribs) +#if !FABLE_COMPILER /// Invert the compilation of the given value and clear the storage of the value member _.ClearGeneratedValue(ctxt, v) = ClearGeneratedValue ctxt ilxGenEnv v @@ -11938,3 +11963,4 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai /// 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 4658dd0693bc..fc15b94a68a3 100644 --- a/src/Compiler/CodeGen/IlxGen.fsi +++ b/src/Compiler/CodeGen/IlxGen.fsi @@ -107,6 +107,7 @@ type public IlxAssemblyGenerator = /// Generate ILX code for an assembly fragment member GenerateCode: IlxGenOptions * CheckedAssemblyAfterOptimization * Attribs * Attribs -> IlxGenResults +#if !FABLE_COMPILER /// Invert the compilation of the given value and clear the storage of the value member ClearGeneratedValue: ExecutionContext * Val -> unit @@ -115,6 +116,7 @@ type public IlxAssemblyGenerator = /// Invert the compilation of the given value and return its current dynamic value and its compiled System.Type member LookupGeneratedValue: ExecutionContext * Val -> (obj * Type) option +#endif //!FABLE_COMPILER val ReportStatistics: TextWriter -> unit diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index aee2d46e095a..b7ebb3d7ae82 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -8,14 +8,18 @@ open System.Collections.Concurrent open System.Runtime.InteropServices open System.IO 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 + let GetWarningNumber (m, warningNumber: string) = try // Okay so ... @@ -161,6 +175,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 -> @@ -178,6 +196,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 the compiler service. @@ -228,7 +247,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 @@ -742,7 +765,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 @@ -789,6 +816,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 = @@ -803,6 +833,7 @@ type TcConfigBuilder = tcConfigB.fxResolver <- Some fxResolver fxResolver +#endif //!FABLE_COMPILER | Some fxResolver -> fxResolver member tcConfigB.SetPrimaryAssembly primaryAssembly = @@ -813,6 +844,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 @@ -876,6 +909,8 @@ type TcConfigBuilder = tcConfigB.outputFile <- Some outfile outfile, pdbfile, assemblyName +#endif //!FABLE_COMPILER + member tcConfigB.TurnWarningOff(m, s: string) = use _ = UseBuildPhase BuildPhase.Parameter @@ -907,6 +942,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 = @@ -927,8 +966,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 @@ -947,6 +991,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 @@ -978,6 +1023,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 @@ -1008,6 +1054,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 <- @@ -1048,6 +1095,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 @@ -1179,6 +1232,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 @@ -1334,11 +1389,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 @@ -1351,6 +1408,8 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = else (tcConfig.indentationAwareSyntax = Some true) +#if !FABLE_COMPILER + member tcConfig.GetAvailableLoadedSources() = use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter @@ -1442,4 +1501,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 89f2cf815378..6383ee3eacd6 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 = @@ -510,7 +518,9 @@ type TcConfigBuilder = rangeForErrors: range -> TcConfigBuilder +#if !FABLE_COMPILER member DecideNames: string list -> string * string option * string +#endif member TurnWarningOff: range * string -> unit @@ -535,8 +545,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 @@ -790,6 +802,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 @@ -803,6 +817,8 @@ type TcConfig = /// File system query based on TcConfig settings member MakePathAbsolute: string -> string +#endif //!FABLE_COMPILER + member resolutionEnvironment: LegacyResolutionEnvironment member copyFSharpCore: CopyFSharpCoreFlag @@ -840,6 +856,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 @@ -859,6 +877,7 @@ type TcConfig = /// Check if the primary assembly is mscorlib member assumeDotNetFramework: bool +#endif //!FABLE_COMPILER member exiter: Exiter @@ -866,6 +885,8 @@ type TcConfig = member captureIdentifiersWhenParsing: bool +#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. [] @@ -884,6 +905,8 @@ val TryResolveFileUsingPaths: paths: string seq * m: range * fileName: string -> val ResolveFileUsingPaths: paths: string seq * m: range * fileName: string -> string +#endif //!FABLE_COMPILER + val GetWarningNumber: m: range * warningNumber: string -> int option /// Get the name used for FSharp.Core diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 4b78aa9b9f91..d1d23765e732 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 @@ -201,8 +203,10 @@ type Exception with | AssemblyNotResolved (_, m) | HashLoadedSourceHasIssues (_, _, _, m) | HashLoadedScriptConsideredSource m -> Some m +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e -> e.InnerException.DiagnosticRange +#endif #if !NO_TYPEPROVIDERS | :? TypeProviderError as e -> e.Range |> Some #endif @@ -325,8 +329,10 @@ type Exception with #endif | PatternMatchCompilation.EnumMatchIncomplete _ -> 104 +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? TargetInvocationException as e -> e.InnerException.DiagnosticNumber +#endif | WrappedError (e, _) -> e.DiagnosticNumber | DiagnosticWithText (n, _, _) -> n | DiagnosticWithSuggestions (n, _, _, _, _) -> n @@ -430,7 +436,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") @@ -601,6 +609,13 @@ let (|InvalidArgument|_|) (exn: exn) = | :? ArgumentException as e -> Some e.Message | _ -> None +#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 @@ -1856,6 +1871,7 @@ type Exception with | MSBuildReferenceResolutionError (code, message, _) -> os.AppendString(MSBuildReferenceResolutionErrorE().Format message code) +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? TargetInvocationException as exn -> exn.InnerException.Output(os, suggestNames) @@ -1870,6 +1886,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 | exn -> os.AppendString(TargetInvocationExceptionWrapperE().Format exn.Message) @@ -1931,6 +1948,8 @@ let SanitizeFileName fileName implicitIncludeDir = with _ -> fileName +#if !FABLE_COMPILER + [] type FormattedDiagnosticLocation = { @@ -2136,6 +2155,8 @@ type PhasedDiagnostic with diagnostic.OutputContext(buf, prefix, fileLineFunction) diagnostic.Output(buf, tcConfig, severity)) +#endif //!FABLE_COMPILER + //---------------------------------------------------------------------------- // Scoped #nowarn pragmas diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 8e0890d44180..64077fcf06d4 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -70,6 +70,7 @@ type PhasedDiagnostic with /// Indicates if a diagnostic should be reported as an error member ReportAsError: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool +#if !FABLE_COMPILER /// Output all of a diagnostic to a buffer, including range member Output: buf: StringBuilder * tcConfig: TcConfig * severity: FSharpDiagnosticSeverity -> unit @@ -81,6 +82,7 @@ type PhasedDiagnostic with tcConfig: TcConfig * severity: FSharpDiagnosticSeverity -> unit +#endif //!FABLE_COMPILER /// Get a diagnostics logger that filters the reporting of warnings based on scoped pragma information val GetDiagnosticsLoggerFilteringByScopedPragmas: @@ -93,6 +95,8 @@ val GetDiagnosticsLoggerFilteringByScopedPragmas: /// Remove 'implicitIncludeDir' from a file name before output val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string +#if !FABLE_COMPILER + /// Used internally and in LegacyHostedCompilerForTesting [] type FormattedDiagnosticLocation = @@ -125,3 +129,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 4def1237b114..877a29155006 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -6,15 +6,21 @@ module internal FSharp.Compiler.CompilerImports open System open System.Collections.Generic +#if !FABLE_COMPILER open System.Collections.Immutable +#endif open System.Diagnostics open System.IO +#if !FABLE_COMPILER open System.IO.Compression +#endif open System.Reflection open Internal.Utilities open Internal.Utilities.Collections +#if !FABLE_COMPILER open Internal.Utilities.FSharpEnvironment +#endif open Internal.Utilities.Library open Internal.Utilities.Library.Extras @@ -25,7 +31,9 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.IO @@ -64,12 +72,16 @@ let IsOptimizationDataResource (r: ILResource) = || r.Name.StartsWithOrdinal FSharpOptimizationDataResourceName2 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 GetResourceNameAndSignatureDataFunc (r: ILResource) = let resourceType, ccuName = @@ -106,6 +118,8 @@ let GetResourceNameAndOptimizationDataFunc (r: ILResource) = let IsReflectedDefinitionsResource (r: ILResource) = r.Name.StartsWithOrdinal(QuotationPickler.SerializedReflectedDefinitionsResourceNameBase) +#if !FABLE_COMPILER + let PickleToResource inMem file (g: TcGlobals) compress scope rName p x = let file = PathMap.apply g.pathMap file @@ -216,12 +230,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 = { @@ -244,6 +262,8 @@ let OpenILBinary (fileName, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, AssemblyReader.GetILModuleReader(location, opts) +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = | Speculative @@ -277,6 +297,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 @@ -306,6 +328,8 @@ type AssemblyResolution = this.ilAssemblyRef <- Some assemblyRef assemblyRef +#endif //!FABLE_COMPILER + type ImportedBinary = { FileName: string @@ -343,6 +367,8 @@ type CcuLoadFailureAction = type TcImportsLockToken() = interface LockToken +#if !FABLE_COMPILER + type TcImportsLock = Lock let RequireTcImportsLock (_tcitok: TcImportsLockToken, _thingProtected: 'T) = () @@ -969,10 +995,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 ( @@ -2585,3 +2658,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 f9fa17487ae8..0e64f4a192a9 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 @@ -44,6 +46,9 @@ val IsOptimizationDataResource: ILResource -> bool val IsReflectedDefinitionsResource: ILResource -> bool val GetResourceNameAndSignatureDataFunc: ILResource -> string * (unit -> ReadOnlyByteMemory) +val GetResourceNameAndOptimizationDataFunc: ILResource -> string * (unit -> ReadOnlyByteMemory) + +#if !FABLE_COMPILER /// Encode the F# interface data into a set of IL attributes and resources val EncodeSignatureData: @@ -64,6 +69,8 @@ val EncodeOptimizationData: isIncrementalBuild: bool -> ILResource list +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = | Speculative @@ -118,6 +125,22 @@ type ImportedAssembly = #endif FSharpOptimizationData: Lazy } +#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 = @@ -217,3 +240,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 0c48513b6c51..be3273b03bcb 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -10,7 +10,9 @@ open System.IO 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 @@ -124,9 +126,11 @@ let getCompilerOption (CompilerOption (_s, _tag, _spec, _, help) as compilerOpti let lineWidth = match width with | None -> +#if !FABLE_COMPILER try Console.BufferWidth with _ -> +#endif defaultLineWidth | Some w -> w @@ -233,6 +237,7 @@ module ResponseFile = | CompilerOptionSpec of string | Comment of string +#if !FABLE_COMPILER let parseFile path : Choice = let parseLine (l: string) = match l with @@ -255,6 +260,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 @@ -332,6 +338,10 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler match args with | [] -> () | rsp: string :: t when rsp.StartsWithOrdinal("@") -> +#if FABLE_COMPILER + ignore t + () +#else let responseFileOptions = let fullpath = try @@ -360,6 +370,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 @@ -1092,6 +1103,10 @@ let mlCompatibilityFlag (tcConfigB: TcConfigBuilder) = Some(FSComp.SR.optsMlcompatibility ()) ) +#if FABLE_COMPILER +let exit _code = () +#endif + let GetLanguageVersions () = seq { FSComp.SR.optsSupportedLangVersions () @@ -1162,10 +1177,12 @@ let codePageFlag (tcConfigB: TcConfigBuilder) = "codepage", tagInt, OptionInt(fun n -> +#if !FABLE_COMPILER try System.Text.Encoding.GetEncoding n |> ignore with :? ArgumentException as err -> error (Error(FSComp.SR.optsProblemWithCodepage (n, err.Message), rangeCmdArgs)) +#endif tcConfigB.inputCodePage <- Some n), None, @@ -1366,7 +1383,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 @@ -2315,6 +2334,8 @@ let ApplyCommandLineArgs (tcConfigB: TcConfigBuilder, sourceFiles: string list, errorRecovery e range0 sourceFiles +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // ReportTime //---------------------------------------------------------------------------- @@ -2413,3 +2434,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 bb2034b93d55..20b9d2a1ffed 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 @@ -96,3 +98,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/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index 4c4dac6ac36c..6dea76123040 100644 --- a/src/Compiler/Driver/OptimizeInputs.fs +++ b/src/Compiler/Driver/OptimizeInputs.fs @@ -18,6 +18,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 @@ -65,6 +69,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 @@ -73,9 +80,12 @@ 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 let optEnv0 = optEnv +#if !FABLE_COMPILER ReportTime tcConfig "Optimizations" +#endif // Only do abstract_big_targets on the first pass! Only do it when TLR is on! let optSettings = tcConfig.optSettings @@ -119,7 +129,7 @@ let ApplyAllOptimizations abstractBigTargets = false reportingPhase = false } -#if DEBUG +#if DEBUG && !FABLE_COMPILER if tcConfig.showOptimizationData then dprintf "Optimization implFileOptData:\n%s\n" @@ -203,10 +213,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 //---------------------------------------------------------------------------- @@ -277,6 +291,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 d5c731ba05d0..4d90a7212c1e 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 45fb1ab34f7c..1350241c2daf 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -496,7 +496,7 @@ let ParseInput type Tokenizer = unit -> Parser.token // Show all tokens in the stream, for testing purposes -let ShowAllTokensAndExit (shortFilename, tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: Exiter) = +let ShowAllTokensAndExit (shortFilename, tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: Exiter) = while true do printf "tokenize - getting one token from %s\n" shortFilename let t = tokenizer () @@ -510,7 +510,7 @@ let ShowAllTokensAndExit (shortFilename, tokenizer: Tokenizer, lexbuf: LexBuffer printf "!!! at end of stream\n" // Test one of the parser entry points, just for testing purposes -let TestInteractionParserAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: Exiter) = +let TestInteractionParserAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer, exiter: Exiter) = while true do match (Parser.interaction (fun _ -> tokenizer ()) lexbuf) with | ParsedScriptInteraction.Definitions (l, m) -> printfn "Parsed OK, got %d defs @ %a" l.Length outputRange m @@ -663,6 +663,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 @@ -988,6 +990,8 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig: TcConfig, inp: ParsedInput, ProcessMetaCommandsFromInput (getWarningNumber, addReferenceDirective, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) TcConfig.Create(tcConfigB, validate = false) +#endif //!FABLE_COMPILER + /// Build the initial type checking environment let GetInitialTcEnv (assemblyName: string, initm: range, tcConfig: TcConfig, tcImports: TcImports, tcGlobals) = let initm = initm.StartRange @@ -1016,6 +1020,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 @@ -1040,6 +1046,8 @@ let CheckSimulateException (tcConfig: TcConfig) = | Some ("tc-fail") -> failwith "simulated" | _ -> () +#endif //!FABLE_COMPILER + //---------------------------------------------------------------------------- // Type-check sets of files //-------------------------------------------------------------------------- @@ -1213,7 +1221,9 @@ let CheckOneInputAux use _ = Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, inp.FileName |] +#if !FABLE_COMPILER CheckSimulateException tcConfig +#endif let m = inp.Range let amap = tcImports.GetImportMap() @@ -1427,6 +1437,8 @@ let CheckMultipleInputsSequential (ctok, checkForErrors, tcConfig, tcImports, tc (tcState, inputs) ||> List.mapFold (CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, false)) +#if !FABLE_COMPILER + /// Use parallel checking of implementation files that have signature files let CheckMultipleInputsInParallel ( @@ -1540,12 +1552,19 @@ let CheckMultipleInputsInParallel results, 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 = +#if !FABLE_COMPILER if tcConfig.parallelCheckingWithSignatureFiles then CheckMultipleInputsInParallel(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) else +#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 13ed6801ad22..beb5d7f2c751 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -11,7 +11,9 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals @@ -43,6 +45,8 @@ val ParseInput: identCapture: bool -> ParsedInput +#if !FABLE_COMPILER + /// A general routine to process hash directives val ProcessMetaCommandsFromInput: ('T -> range * string -> 'T) * ('T -> range * string * Directive -> 'T) * ('T -> range * string -> unit) -> @@ -95,8 +99,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 * @@ -106,6 +114,8 @@ val ParseInputFiles: retryLocked: bool -> (ParsedInput * string) list +#endif //!FABLE_COMPILER + /// Get the initial type checking environment including the loading of mscorlib/System.Core, FSharp.Core /// applying the InternalsVisibleTo in referenced assemblies and opening 'Checked' if requested. val GetInitialTcEnv: assemblyName: string * range * TcConfig * TcImports * TcGlobals -> TcEnv * OpenDeclaration list diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index 00d38e1f2343..77246c3fc191 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -14,7 +14,9 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO @@ -79,6 +81,8 @@ type CodeContext = | Compilation // in fsc.exe | Editing // in VS +#if !FABLE_COMPILER + module ScriptPreprocessClosure = /// Represents an input to the closure finding process @@ -787,3 +791,5 @@ type LoadClosure with use _ = UseBuildPhase BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptFiles(tcConfig, files, implicitDefines, lexResourceManager, dependencyProvider) + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/ScriptClosure.fsi b/src/Compiler/Driver/ScriptClosure.fsi index c5deec56b644..1af54ba63396 100644 --- a/src/Compiler/Driver/ScriptClosure.fsi +++ b/src/Compiler/Driver/ScriptClosure.fsi @@ -7,7 +7,9 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis @@ -70,6 +72,8 @@ type LoadClosure = LoadClosureRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list } +#if !FABLE_COMPILER + /// Analyze a script text and find the closure of its references. /// Used from FCS, when editing a script file. // @@ -102,3 +106,5 @@ type LoadClosure = lexResourceManager: Lexhelp.LexResourceManager * dependencyProvider: DependencyProvider -> LoadClosure + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index b8ee50564c19..e1a6cb43001d 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -13,6 +13,8 @@ open Internal.Utilities.Library [] type NodeCode<'T> = Node of Async<'T> +#if !FABLE_COMPILER + let wrapThreadStaticInfo computation = async { let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger @@ -430,3 +432,5 @@ type GraphNode<'T>(retryCompute: bool, computation: NodeCode<'T>) = member _.IsComputing = requestCount > 0 new(computation) = GraphNode(retryCompute = true, computation = computation) + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index b94c6e30b269..cabeaaff7d3b 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -17,6 +17,8 @@ open Internal.Utilities.Library [] type NodeCode<'T> +#if !FABLE_COMPILER + type Async<'T> with /// Asynchronously await code in the build graph @@ -116,3 +118,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 27ff2059914b..aaa7f546c3f0 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 af937a281516..b5acc96a30b9 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -153,12 +153,16 @@ let rec AttachRange m (exn: exn) = exn else match exn with +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException -> AttachRange m exn.InnerException +#endif | UnresolvedReferenceNoRange a -> UnresolvedReferenceError(a, m) | UnresolvedPathReferenceNoRange (a, p) -> UnresolvedPathReference(a, p, m) | Failure msg -> InternalError(msg + " (Failure)", m) +#if !FABLE_COMPILER | :? ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) +#endif | _ -> exn type Exiter = @@ -167,10 +171,12 @@ type Exiter = let QuitProcessExiter = { new Exiter with member _.Exit n = +#if !FABLE_COMPILER try Environment.Exit n with _ -> () +#endif failwith (FSComp.SR.elSysEnvExitDidntExit ()) } @@ -386,14 +392,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 = @@ -404,6 +418,7 @@ module DiagnosticsLoggerExtensions = // This is probably only the mono case. Debug.Assert(false, "Could not preserve stack trace for watson exception.") () +#endif /// Reraise an exception if it is one we want to report to Watson. let ReraiseIfWatsonable (exn: exn) = @@ -422,10 +437,12 @@ module DiagnosticsLoggerExtensions = type DiagnosticsLogger with member x.EmitDiagnostic(exn, severity) = +#if !FABLE_COMPILER match exn with | InternalError (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 @@ -455,9 +472,11 @@ module DiagnosticsLoggerExtensions = // Never throws ReportedError. // Throws StopProcessing and exceptions raised by the DiagnosticSink(exn) handler. match exn with +#if !FABLE_COMPILER // Don't send ThreadAbortException down the error channel | :? System.Threading.ThreadAbortException | WrappedError (:? System.Threading.ThreadAbortException, _) -> () +#endif | ReportedError _ | WrappedError (ReportedError _, _) -> () | StopProcessing @@ -838,6 +857,12 @@ type StackGuard(maxDepth: int, name: string) = [] member _.Guard(f) = +#if FABLE_COMPILER + ignore depth + ignore maxDepth + ignore name + f () +#else //!FABLE_COMPILER depth <- depth + 1 try @@ -856,6 +881,7 @@ type StackGuard(maxDepth: int, name: string) = f () finally depth <- depth - 1 +#endif //!FABLE_COMPILER static member val DefaultDepth = #if DEBUG diff --git a/src/Compiler/Facilities/ReferenceResolver.fs b/src/Compiler/Facilities/ReferenceResolver.fs index 7e8257419425..4f5c5b41bd57 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 8371775f9563..6201f136b1ac 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 e9b7cd8637a3..38c9a439b833 100644 --- a/src/Compiler/Facilities/TextLayoutRender.fs +++ b/src/Compiler/Facilities/TextLayoutRender.fs @@ -156,6 +156,7 @@ module LayoutRender = member _.Finish rstrs = NoResult } +#if !FABLE_COMPILER /// channel LayoutRenderer let channelR (chan: TextWriter) = { new LayoutRenderer with @@ -173,6 +174,7 @@ module LayoutRender = member r.AddTag z (tag, attrs, start) = z member r.Finish z = NoResult } +#endif //!FABLE_COMPILER /// buffer render let bufferR os = @@ -194,8 +196,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 88dc9921e72e..e6977691f6e4 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 dee03bb5f7e7..82e0c005c8b2 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -32,6 +32,9 @@ type ISourceText = 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) [| @@ -46,6 +49,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. @@ -96,7 +100,12 @@ 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.IndexOf(target, startIndex, target.Length) <> -1 +#endif member _.Length = str.Length @@ -106,7 +115,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 module SourceText = @@ -158,6 +171,12 @@ type internal Position = static member FirstLine fileIdx = Position(fileIdx, 1, 0, 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>(filler: LexBufferFiller<'Char>, reportLibraryOnlyFeatures: bool, langVersion: LanguageVersion) = @@ -201,8 +220,10 @@ and [] internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>, reportL 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] @@ -237,8 +258,13 @@ and [] internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>, reportL 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 @@ -293,6 +319,10 @@ and [] internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>, reportL LexBuffer.FromArrayNoCopy(reportLibraryOnlyFeatures, langVersion, arr) static member FromSourceText(reportLibraryOnlyFeatures, langVersion, sourceText: ISourceText) = +#if FABLE_COMPILER + let arr = Array.init sourceText.Length (fun i -> uint16 (sourceText.Item i)) + LexBuffer.FromArrayNoCopy (reportLibraryOnlyFeatures, langVersion, arr) +#else let mutable currentSourceIndex = 0 LexBuffer.FromFunction @@ -311,16 +341,25 @@ and [] internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>, reportL sourceText.CopyTo(currentSourceIndex, chars, start, lengthToCopy) currentSourceIndex <- currentSourceIndex + lengthToCopy lengthToCopy) +#endif //!FABLE_COMPILER + + static member FromString (reportLibraryOnlyFeatures, langVersion, s: string) = +#if FABLE_COMPILER + let arr = Array.init s.Length (fun i -> uint16 s.[i]) + LexBuffer.FromArrayNoCopy (reportLibraryOnlyFeatures, langVersion, arr) +#else + LexBuffer.FromArrayNoCopy (reportLibraryOnlyFeatures, langVersion, 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 @@ -337,7 +376,7 @@ module GenericImplFragments = else scanUntilSentinel lexBuffer state - let onAccept (lexBuffer: LexBuffer, a) = + let onAccept (lexBuffer: LexBuffer, a) = lexBuffer.LexemeLength <- lexBuffer.BufferScanLength lexBuffer.BufferAcceptAction <- a @@ -352,7 +391,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 @@ -367,15 +406,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) @@ -414,7 +457,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 e662c1edf372..6d94d522aaed 100644 --- a/src/Compiler/Facilities/prim-lexing.fsi +++ b/src/Compiler/Facilities/prim-lexing.fsi @@ -95,6 +95,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). @@ -106,8 +112,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 @@ -115,8 +123,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 @@ -140,6 +153,9 @@ type internal LexBuffer<'Char> = /// Important: does take ownership of the array. static member FromChars: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * char[] -> LexBuffer + /// Create a lex buffer suitable for Unicode lexing that reads characters from the given string. + static member FromString: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * string -> LexBuffer + /// Create a lex buffer that reads character or byte inputs by using the given function. static member FromFunction: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * ('Char[] * int * int -> int) -> @@ -147,7 +163,7 @@ type internal LexBuffer<'Char> = /// Create a lex buffer backed by source text. static member FromSourceText: - reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * ISourceText -> LexBuffer + reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * ISourceText -> LexBuffer /// The type of tables for an unicode lexer generated by fslex.exe. [] @@ -157,4 +173,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 91b00ba592f9..01b5e33deff5 100644 --- a/src/Compiler/Facilities/prim-parsing.fs +++ b/src/Compiler/Facilities/prim-parsing.fs @@ -7,7 +7,9 @@ namespace Internal.Utilities.Text.Parsing open Internal.Utilities.Text.Lexing open System +#if !FABLE_COMPILER open System.Buffers +#endif exception RecoverableParseError exception Accept of obj @@ -19,7 +21,7 @@ type internal IParseState ruleEndPoss: Position[], lhsPos: Position[], ruleValues: obj[], - lexbuf: LexBuffer + lexbuf: LexBuffer ) = member _.LexBuffer = lexbuf @@ -281,6 +283,10 @@ module internal Implementation = let cacheSize = 7919 // the 1000'th prime // Use a simpler hash table with faster lookup, but only one // hash bucket per key. +#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) // Clear the arrays since ArrayPool does not @@ -293,6 +299,7 @@ module internal Implementation = ArrayPool.Shared.Return actionTableCache ArrayPool.Shared.Return gotoTableCache } +#endif //!FABLE_COMPILER let actionTable = AssocTable(tables.actionTableElements, tables.actionTableRowOffsets, actionTableCache, cacheSize) diff --git a/src/Compiler/Facilities/prim-parsing.fsi b/src/Compiler/Facilities/prim-parsing.fsi index 4177d66e9a9d..4284b3f45645 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/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 30a55989edf7..7bdd61f42e8e 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -2599,7 +2599,11 @@ type FsiStdinLexerProvider let numTrimmed = min len input.Length for i = 0 to numTrimmed-1 do +#if FABLE_COMPILER + buf[i+start] <- uint16 input.[i] +#else buf[i+start] <- input[i] +#endif numTrimmed )) diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index b4af719fa398..0e9b1c1b7686 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -160,18 +160,33 @@ 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 -> 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 -> 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 -> 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 343d911aa4d4..13c1d9c613ad 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -155,7 +155,11 @@ type ValInfos(entries) = if dict.ContainsKey vkey then failwithf "dictionary already contains key %A" vkey dict.Add(vkey, p) +#if FABLE_COMPILER + dict), id) +#else ReadOnlyDictionary dict), id) +#endif member x.Entries = valInfoTable.Force().Values @@ -650,6 +654,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.MustInline then match TryGetInfoForNonLocalEntityRef env vref.nlr.EnclosingEntity.nlr with @@ -1709,6 +1718,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)) -> @@ -3080,7 +3092,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.MustInline && not (v.ToString().StartsWith("Microsoft.FSharp.")) then +#else if v.MustInline then +#endif error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) if v.InlineIfLambda then warning(Error(FSComp.SR.optFailedToInlineSuggestedValue(v.DisplayName), m)) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index c66bb3e51426..e18343d610ea 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -49,8 +49,10 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.AbstractIL +#if !FABLE_COMPILER open System.Reflection.PortableExecutable open FSharp.Compiler.CreateILModule +#endif open FSharp.Compiler.IlxGen open FSharp.Compiler.BuildGraph @@ -77,6 +79,9 @@ type internal DelayedILModuleReader = } member this.TryGetILModuleReader() = +#if FABLE_COMPILER + cancellable.Return(None) +#else // fast path match box this.result with | null -> @@ -112,6 +117,7 @@ type internal DelayedILModuleReader = | _ -> Some this.result) } | _ -> cancellable.Return(Some this.result) +#endif //!FABLE_COMPILER [] type FSharpReferencedProject = @@ -210,12 +216,16 @@ 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( Some(Path.GetDirectoryName(typeof.Assembly.Location)) ) .Value +#endif [] type FSharpSymbolUse(denv: DisplayEnv, symbol: FSharpSymbol, inst: TyparInstantiation, itemOcc, range: range) = @@ -2392,6 +2402,8 @@ module internal ParseAndCheckFile = errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors +#if !FABLE_COMPILER + let ApplyLoadClosure ( tcConfig, @@ -2493,6 +2505,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 ( @@ -2530,9 +2544,11 @@ module internal ParseAndCheckFile = use _unwindBP = UseBuildPhase BuildPhase.TypeCheck +#if !FABLE_COMPILER // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) let tcConfig = ApplyNoWarnsToTcConfig(tcConfig, parsedMainInput, Path.GetDirectoryName mainInputFileName) +#endif // update the error handler with the modified tcConfig errHandler.DiagnosticOptions <- tcConfig.diagnosticsOptions @@ -2542,8 +2558,10 @@ module internal ParseAndCheckFile = for err, severity in backgroundDiagnostics do diagnosticSink (err, severity) +#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) @@ -2843,7 +2861,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) @@ -2945,6 +2967,8 @@ type FSharpCheckFileResults FSharpCheckFileResults(mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) +#if !FABLE_COMPILER + static member CheckOneFile ( parseResults: FSharpParseFileResults, @@ -2994,6 +3018,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 @@ -3099,6 +3125,10 @@ type FSharpCheckProjectResults let results = match builderOrSymbolUses with | Choice1Of2 builder -> +#if FABLE_COMPILER + ignore builder + [||] +#else builder.SourceFiles |> Array.ofList |> Array.collect (fun x -> @@ -3108,6 +3138,7 @@ type FSharpCheckProjectResults | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses.GetUsesOfSymbol symbol.Item | _ -> [||] | _ -> [||]) +#endif //!FABLE_COMPILER | Choice2Of2 tcSymbolUses -> tcSymbolUses.GetUsesOfSymbol symbol.Item results @@ -3129,6 +3160,10 @@ type FSharpCheckProjectResults let tcSymbolUses = match builderOrSymbolUses with | Choice1Of2 builder -> +#if FABLE_COMPILER + ignore builder + [||] +#else builder.SourceFiles |> Array.ofList |> Array.map (fun x -> @@ -3138,6 +3173,7 @@ type FSharpCheckProjectResults | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses | _ -> TcSymbolUses.Empty | _ -> TcSymbolUses.Empty) +#endif //!FABLE_COMPILER | Choice2Of2 tcSymbolUses -> [| tcSymbolUses |] [| @@ -3173,6 +3209,8 @@ type FSharpCheckProjectResults override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" +#if !FABLE_COMPILER + type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, tcState) = let keepAssemblyContents = false @@ -3285,6 +3323,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 444807b01178..9056b424de8f 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -236,9 +236,51 @@ type public FSharpParsingOptions = static member internal FromTcConfigBuilder: tcConfigB: TcConfigBuilder * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions +#if FABLE_COMPILER + +[] +type internal TypeCheckInfo = + internal new : + _sTcConfig: TcConfig * + g: TcGlobals * + ccuSigForFile: ModuleOrNamespaceType * + thisCcu: CcuThunk * + tcImports: TcImports * + tcAccessRights: AccessorDomain * + projectFileName: string * + mainInputFileName: string * + projectOptions: FSharpProjectOptions * + sResolutions: TcResolutions * + sSymbolUses: TcSymbolUses * + sFallback: NameResolutionEnv * + loadClosure: LoadClosure option * + implFileOpt: CheckedImplFile option * + openDeclarations: OpenDeclaration[] + -> TypeCheckInfo + member ScopeResolutions: TcResolutions + member ScopeSymbolUses: TcSymbolUses + member TcGlobals: TcGlobals + member TcImports: TcImports + member CcuSigForFile: ModuleOrNamespaceType + member ThisCcu: CcuThunk + member ImplementationFile: CheckedImplFile option + +#endif //FABLE_COMPILER + /// A handle to the results of CheckFileInProject. [] type public FSharpCheckFileResults = +#if FABLE_COMPILER + internal new : + fileName: string * + errors: FSharpDiagnostic[] * + scopeOptX: TypeCheckInfo option * + dependencyFiles: string[] * + builderX: IncrementalBuilder option * + keepAssemblyContents: bool + -> FSharpCheckFileResults +#endif //FABLE_COMPILER + /// The errors returned by parsing a source file. member Diagnostics: FSharpDiagnostic[] @@ -252,8 +294,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 @@ -450,6 +494,7 @@ type public FSharpCheckFileResults = openDeclarations: OpenDeclaration[] -> FSharpCheckFileResults +#if !FABLE_COMPILER /// Internal constructor - check a file and collect errors static member internal CheckOneFile: parseResults: FSharpParseFileResults * @@ -472,6 +517,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 = @@ -542,6 +588,8 @@ module internal ParseAndCheckFile = suggestNamesForErrors: bool -> (range * range)[] +#if !FABLE_COMPILER + // An object to typecheck source in a given typechecking environment. // Used internally to provide intellisense over F# Interactive. type internal FsiInteractiveChecker = @@ -553,5 +601,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 f2483115b262..9c29b18849cd 100644 --- a/src/Compiler/Service/FSharpSource.fs +++ b/src/Compiler/Service/FSharpSource.fs @@ -11,14 +11,18 @@ open FSharp.Compiler.Text [] type TextContainer = | OnDisk +#if !FABLE_COMPILER | Stream of Stream +#endif | SourceText of ISourceText interface IDisposable with member this.Dispose() = match this with +#if !FABLE_COMPILER | Stream stream -> stream.Dispose() +#endif | _ -> () [] @@ -30,6 +34,8 @@ type FSharpSource internal () = abstract GetTextContainer: unit -> TextContainer +#if !FABLE_COMPILER + type private FSharpSourceMemoryMappedFile(filePath: string, timeStamp: DateTime, openStream: unit -> Stream) = inherit FSharpSource() @@ -58,6 +64,8 @@ type private FSharpSourceFromFile(filePath: string) = override _.GetTextContainer() = TextContainer.OnDisk +#endif //!FABLE_COMPILER + type private FSharpSourceCustom(filePath: string, getTimeStamp, getSourceText) = inherit FSharpSource() @@ -75,6 +83,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 @@ -85,3 +94,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 366886312540..2ab2fb12401e 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 internal GetTextContainer: unit -> TextContainer +#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 152d5119fb0e..185e6df1825b 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -7,7 +7,9 @@ open System.Collections.Generic open System.Collections.Immutable open System.Diagnostics open System.IO +#if !FABLE_COMPILER open System.IO.Compression +#endif open System.Threading open Internal.Utilities.Library open Internal.Utilities.Collections @@ -21,8 +23,10 @@ open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerGlobalState 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 @@ -42,6 +46,19 @@ 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 = @@ -1722,4 +1739,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc FSharpDiagnostic.CreateFromException(diagnostic, severity, range.Zero, suggestNamesForErrors)) return builderOpt, diagnostics - } \ No newline at end of file + } + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index c527ca8a70b4..d302f6bbf472 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -10,7 +10,9 @@ open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.DiagnosticsLogger @@ -23,6 +25,16 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.BuildGraph +#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 @@ -278,3 +290,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 e40d660bb2ff..dba79e70f901 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 GetCompleteIdentifierIslandImpl (lineStr: string) (index: int) : (string * int * bool) option = diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index f1fdc92c0bb7..df8e7612d3f4 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -203,7 +203,11 @@ module TcResolutionsExtensions = let duplicates = HashSet(comparer) +#if FABLE_COMPILER + let results = ResizeArray<_>() +#else let results = ImmutableArray.CreateBuilder() +#endif let inline add m (typ: SemanticClassificationType) = if duplicates.Add m then diff --git a/src/Compiler/Service/ServiceAssemblyContent.fs b/src/Compiler/Service/ServiceAssemblyContent.fs index 0a89eb646d23..1086bba0f40b 100644 --- a/src/Compiler/Service/ServiceAssemblyContent.fs +++ b/src/Compiler/Service/ServiceAssemblyContent.fs @@ -106,6 +106,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) = @@ -290,6 +292,8 @@ module AssemblyContent = | Full -> true | Public -> entity.Symbol.Accessibility.IsPublic) +#endif //!FABLE_COMPILER + type EntityCache() = let dic = Dictionary() interface IAssemblyContentCache with @@ -301,4 +305,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 09756eee2e52..5346fc3eab2a 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/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 06cf656b0782..66474f0f782e 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -952,6 +952,9 @@ module internal DescriptionListsImpl = /// Select the items that participate in a MethodGroup. let SelectMethodGroupItems g m item = +#if FABLE_COMPILER + ignore m +#endif match item with | Item.CtorGroup(nm, cinfos) -> List.map (fun minfo -> Item.CtorGroup(nm, [minfo])) cinfos | Item.Trait traitInfo -> diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index ac28ec245aaf..4b3297d873f7 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -833,7 +833,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 39b2febf3150..b1976cf70aae 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" @@ -331,7 +332,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 a8344a59e970..594d2137e4ff 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -1002,9 +1002,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 = @@ -1227,6 +1241,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 @@ -1250,9 +1284,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 ad84d6e4b69f..010d8ae76833 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -15,15 +15,21 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILDynamicAssemblyWriter +#endif open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions +#if !FABLE_COMPILER open FSharp.Compiler.DependencyManager +#endif open FSharp.Compiler.Diagnostics +#if !FABLE_COMPILER open FSharp.Compiler.Driver +#endif open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.ParseAndCheckInputs @@ -45,6 +51,8 @@ module EnvMisc = let projectCacheSizeDefault = GetEnvInteger "FCS_ProjectCacheSizeDefault" 3 let frameworkTcImportsCacheStrongSize = GetEnvInteger "FCS_frameworkTcImportsCacheStrongSizeDefault" 8 +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // BackgroundCompiler // @@ -1798,3 +1806,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 40b6b978690b..6c6b20be7a79 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -16,6 +16,8 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Tokenization +#if !FABLE_COMPILER + [] [] type DocumentSource = @@ -463,3 +465,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 eabc11f3410c..d95b0daf0b9f 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -515,6 +515,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 -> @@ -1247,8 +1250,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 e05c7b31560e..a6983666173b 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/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index 5f028e020b65..27d0eda5d48f 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -219,6 +219,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 -> @@ -228,6 +234,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 56d19effb2ab..17b8f3448e65 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -81,7 +81,11 @@ module Impl = f let makeReadOnlyCollection (arr: seq<'T>) = +#if FABLE_COMPILER + System.Collections.Generic.List<_>(Seq.toArray arr) :> IList<_> +#else System.Collections.ObjectModel.ReadOnlyCollection<_>(Seq.toArray arr) :> IList<_> +#endif let makeXmlDoc (doc: XmlDoc) = FSharpXmlDoc.FromXmlText doc @@ -2258,7 +2262,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 = @@ -2668,7 +2674,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 de98566ffe09..ff84f6a268bb 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fsi +++ b/src/Compiler/SyntaxTree/LexFilter.fsi @@ -20,12 +20,12 @@ type LexFilter = new: indentationSyntaxStatus: IndentationAwareSyntaxStatus * compilingFSharpCore: bool * - lexer: (LexBuffer -> token) * - lexbuf: LexBuffer -> + lexer: (LexBuffer -> token) * + lexbuf: LexBuffer -> 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 f5c83752477d..2178544d4a01 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -127,7 +127,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" @@ -135,8 +139,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 @@ -148,8 +157,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 = @@ -216,12 +230,20 @@ let addByteChar buf (c: char) = addIntChar buf (int32 c % 256) /// Sanity check that high bytes are zeros. Further check each low byte <= 127 let stringBufferIsBytes (buf: ByteBuffer) = +#if FABLE_COMPILER + let bytes = buf.Close() +#else let bytes = buf.AsMemory() +#endif let mutable ok = true for i = 0 to bytes.Length / 2 - 1 do +#if FABLE_COMPILER + if bytes[i * 2 + 1] <> 0uy then ok <- false +#else if bytes.Span[i * 2 + 1] <> 0uy then ok <- false +#endif ok diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index e181801324d7..3b7db6ac3659 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -365,10 +365,11 @@ and LexCont = LexerContinuation // Parse IL assembly code //------------------------------------------------------------------------ -let ParseAssemblyCodeInstructions s reportLibraryOnlyFeatures langVersion m : IL.ILInstr[] = +let ParseAssemblyCodeInstructions (s: string) (reportLibraryOnlyFeatures: bool) (langVersion: LanguageVersion) 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)) [||] @@ -380,10 +381,14 @@ let ParseAssemblyCodeInstructions s reportLibraryOnlyFeatures langVersion m : IL [||] #endif -let ParseAssemblyCodeType s reportLibraryOnlyFeatures langVersion m = +let ParseAssemblyCodeType (s: string) (reportLibraryOnlyFeatures: bool) (langVersion: LanguageVersion) 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 dd428deb8c3a..656f0991483a 100755 --- a/src/Compiler/SyntaxTree/PrettyNaming.fs +++ b/src/Compiler/SyntaxTree/PrettyNaming.fs @@ -808,7 +808,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 66192a603109..212b3355e282 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fs +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fs @@ -6,16 +6,22 @@ module internal FSharp.Compiler.UnicodeLexing open System.IO open Internal.Utilities.Text.Lexing -type Lexbuf = LexBuffer +type Lexbuf = LexBuffer let StringAsLexbuf (reportLibraryOnlyFeatures, langVersion, s: string) = +#if FABLE_COMPILER + LexBuffer.FromString (reportLibraryOnlyFeatures, langVersion, s) +#else LexBuffer.FromChars (reportLibraryOnlyFeatures, langVersion, s.ToCharArray()) +#endif let FunctionAsLexbuf (reportLibraryOnlyFeatures, langVersion, bufferFiller) = - LexBuffer.FromFunction (reportLibraryOnlyFeatures, langVersion, bufferFiller) + LexBuffer.FromFunction (reportLibraryOnlyFeatures, langVersion, bufferFiller) let SourceTextAsLexbuf (reportLibraryOnlyFeatures, langVersion, sourceText) = - LexBuffer.FromSourceText (reportLibraryOnlyFeatures, langVersion, sourceText) + LexBuffer.FromSourceText (reportLibraryOnlyFeatures, langVersion, sourceText) + +#if !FABLE_COMPILER let StreamReaderAsLexbuf (reportLibraryOnlyFeatures, langVersion, reader: StreamReader) = let mutable isFinished = false @@ -35,3 +41,5 @@ let StreamReaderAsLexbuf (reportLibraryOnlyFeatures, langVersion, reader: Stream else nBytesRead ) + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fsi b/src/Compiler/SyntaxTree/UnicodeLexing.fsi index 41bbc768ff56..2fb3f7ba74c1 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fsi +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fsi @@ -7,16 +7,20 @@ open FSharp.Compiler.Features open FSharp.Compiler.Text open Internal.Utilities.Text.Lexing -type Lexbuf = LexBuffer +type Lexbuf = LexBuffer val StringAsLexbuf: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * string -> Lexbuf val FunctionAsLexbuf: - reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * bufferFiller: (char[] * int * int -> int) -> Lexbuf + reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * bufferFiller: (LexBufferChar[] * int * int -> int) -> Lexbuf val SourceTextAsLexbuf: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * sourceText: ISourceText -> Lexbuf +#if !FABLE_COMPILER + /// Will not dispose of the stream reader. val StreamReaderAsLexbuf: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * reader: StreamReader -> Lexbuf + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/SyntaxTree/XmlDoc.fs b/src/Compiler/SyntaxTree/XmlDoc.fs index ccab935a365e..2879d2cacfb4 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 @@ -115,6 +118,7 @@ type XmlDoc(unprocessedLines: string[], range: range) = with e -> warning (Error(FSComp.SR.xmlDocBadlyFormed (e.Message), doc.Range)) +#endif //!FABLE_COMPILER #if CREF_ELABORATION member doc.Elaborate(crefResolver) = @@ -263,8 +267,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 @@ -300,6 +306,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) = @@ -375,6 +394,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 f736088be524..1c6a9d7ef5f3 100644 --- a/src/Compiler/SyntaxTree/XmlDoc.fsi +++ b/src/Compiler/SyntaxTree/XmlDoc.fsi @@ -14,8 +14,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 7047fc3cf35a..0565c8b2be77 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -23,7 +23,7 @@ type NiceNameGenerator() = member _.FreshCompilerGeneratedName (name, m: range) = let basicName = GetBasicNameOfPossibleCompilerGeneratedName name - let countCell = basicNameCounts.GetOrAdd(basicName,fun k -> ref 0) + let countCell = basicNameCounts.GetOrAdd(basicName, fun _k -> ref 0) let count = Interlocked.Increment(countCell) CompilerGeneratedNameSuffix basicName (string m.StartLine + (match (count-1) with 0 -> "" | n -> "-" + string n)) @@ -64,10 +64,22 @@ type internal CompilerGlobalState () = type Unique = int64 //++GLOBAL MUTABLE STATE (concurrency-safe) +#if FABLE_COMPILER +let newUnique = + let i = ref 0L + fun () -> i.Value <- i.Value + 1L; i.Value +#else let mutable private uniqueCount = 0L let newUnique() = System.Threading.Interlocked.Increment &uniqueCount +#endif /// Unique name generator for stamps attached to to val_specs, tycon_specs etc. //++GLOBAL MUTABLE STATE (concurrency-safe) +#if FABLE_COMPILER +let newStamp = + let i = ref 0L + fun () -> i.Value <- i.Value + 1L; i.Value +#else let mutable private stampCount = 0L let newStamp() = System.Threading.Interlocked.Increment &stampCount +#endif diff --git a/src/Compiler/TypedTree/QuotationPickler.fs b/src/Compiler/TypedTree/QuotationPickler.fs index 4c613f007d2a..addd6bac6ea8 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/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 0adaac1f63ee..2a0c74d4989a 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2372,7 +2372,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 @@ -2387,6 +2391,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 621a9da12bd5..7cb0163d4957 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 @@ -1632,7 +1634,11 @@ type TyparConstraint = override ToString: unit -> string +#if FABLE_COMPILER +[] +#else [] +#endif type TraitWitnessInfo = | TraitWitnessInfo of tys: TTypes * @@ -1643,6 +1649,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 511a4cc44f25..a7a61f13527a 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) @@ -474,4 +474,3 @@ let combineAccess (TAccess a1) (TAccess a2) = TAccess(a1@a2) 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 b87db718b3a7..c92bca63a994 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -9719,7 +9719,11 @@ let rec EvalAttribArgExpr (g: TcGlobals) x = let v1, v2 = EvalAttribArgExpr g arg1, EvalAttribArgExpr g arg2 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.(-)) v1 v2 | SpecificBinopExpr g g.unchecked_multiply_vref (arg1, arg2) when arithmeticInLiteralsEnabled -> @@ -10159,6 +10163,23 @@ let CombineCcuContentFragments l = /// An immutable mappping 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 @@ -10168,6 +10189,7 @@ let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = member _.Equals(a, b) = traitKeysAEquiv g TypeEquivEnv.Empty a b member _.GetHashCode(a) = hash a.MemberName }) +#endif //!FABLE_COMPILER let (|WhileExpr|_|) expr = match expr with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 60bc899d6621..22f8142715d6 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2550,7 +2550,11 @@ val GetTraitWitnessInfosOfTypars: TcGlobals -> numParentTypars: int -> typars: T /// An immutable mappping 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/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index f19ca1caaa15..4003d38857ef 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -213,10 +213,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 @@ -715,7 +717,11 @@ let pickleObjWithDanglingCcus inMem file g scope p x = st1.otypars.Size, st1.ovals.Size, st1.oanoninfos.Size +#if FABLE_COMPILER + st1.occus, sizes, st1.ostrings, st1.opubpaths, st1.onlerefs, st1.osimpletys, st1.os.Close() +#else st1.occus, sizes, st1.ostrings, st1.opubpaths, st1.onlerefs, st1.osimpletys, st1.os.AsMemory() +#endif let st2 = { os = ByteBuffer.Create(PickleBufferCapacity, useArrayPool = true) @@ -747,7 +753,11 @@ let pickleObjWithDanglingCcus inMem file g scope p x = (p_array p_encoded_pubpath) (p_array p_encoded_nleref) (p_array p_encoded_simpletyp) +#if FABLE_COMPILER + p_bytes +#else p_memory +#endif (stringTab.AsArray, pubpathTab.AsArray, nlerefTab.AsArray, simpleTyTab.AsArray, phase1bytes) st2 st2.os diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index a5f8000cfa0a..57ecca940787 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -43,6 +43,18 @@ module internal Activity = let private activitySourceName = "fsc" let private profiledSourceName = "fsc_with_env_stats" +#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 + +#else //!FABLE_COMPILER + type System.Diagnostics.Activity with member this.RootId = @@ -239,3 +251,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 746422455bf2..5f6904564077 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -21,9 +21,11 @@ module internal Activity = val start: name: string -> tags: (string * string) seq -> IDisposable +#if !FABLE_COMPILER module Profiling = val startAndMeasureEnvironmentStats: name: string -> IDisposable val addConsoleListener: unit -> IDisposable module CsvExport = val addCsvFileListener: pathToFile: string -> IDisposable +#endif diff --git a/src/Compiler/Utilities/FileSystem.fs b/src/Compiler/Utilities/FileSystem.fs index 1614400bb48d..1196ba91d7f7 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 = @@ -848,18 +912,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 @@ -939,19 +1007,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() @@ -999,6 +1075,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 @@ -1014,6 +1091,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() @@ -1046,11 +1124,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 } @@ -1060,8 +1142,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) = @@ -1110,3 +1196,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 9b23e58a3f62..a090c29a9be6 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 @@ -308,6 +351,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 @@ -315,12 +360,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 @@ -341,6 +388,32 @@ type internal ByteStream = member Skip: int -> unit #endif +#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. [] @@ -408,3 +481,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 b88af5d77eb2..92eaa750cdbe 100644 --- a/src/Compiler/Utilities/HashMultiMap.fs +++ b/src/Compiler/Utilities/HashMultiMap.fs @@ -13,11 +13,13 @@ type internal HashMultiMap<'Key, 'Value>(size: int, comparer: IEqualityComparer< let rest = Dictionary<_, _>(3, comparer) +#if !FABLE_COMPILER new(comparer: IEqualityComparer<'Key>) = HashMultiMap<'Key, 'Value>(11, comparer) new(entries: seq<'Key * 'Value>, comparer: IEqualityComparer<'Key>) as x = new HashMultiMap<'Key, 'Value>(11, comparer) then entries |> Seq.iter (fun (k, v) -> x.Add(k, v)) +#endif member x.GetRest(k) = match rest.TryGetValue k with @@ -40,7 +42,11 @@ type internal HashMultiMap<'Key, 'Value>(size: int, comparer: IEqualityComparer< member x.Rest = rest member x.Copy() = +#if FABLE_COMPILER + let res = HashMultiMap<'Key,'Value>(firstEntries.Count, comparer) +#else let res = HashMultiMap<'Key, 'Value>(firstEntries.Count, firstEntries.Comparer) +#endif for kvp in firstEntries do res.FirstEntries.Add(kvp.Key, kvp.Value) @@ -117,6 +123,22 @@ type internal HashMultiMap<'Key, 'Value>(size: int, comparer: IEqualityComparer< member x.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() = @@ -161,6 +183,8 @@ type internal HashMultiMap<'Key, 'Value>(size: int, comparer: IEqualityComparer< 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 a4dd51a5bbaa..7565b102e677 100644 --- a/src/Compiler/Utilities/HashMultiMap.fsi +++ b/src/Compiler/Utilities/HashMultiMap.fsi @@ -8,15 +8,19 @@ open System.Collections.Generic /// The table may map a single key to multiple bindings. [] type internal HashMultiMap<'Key, 'Value> = +#if !FABLE_COMPILER /// Create a new empty mutable HashMultiMap with the given key hash/equality functions. new: comparer: IEqualityComparer<'Key> -> HashMultiMap<'Key, 'Value> +#endif /// Create a new empty mutable HashMultiMap with an internal bucket array of the given approximate size /// and with the given key hash/equality functions. new: size: int * comparer: IEqualityComparer<'Key> -> 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> -> HashMultiMap<'Key, 'Value> +#endif /// Make a shallow copy of the collection. member Copy: unit -> HashMultiMap<'Key, 'Value> @@ -56,7 +60,9 @@ type internal HashMultiMap<'Key, 'Value> = /// Apply the given function to each binding in the hash table. member Iterate: ('Key -> 'Value -> unit) -> unit +#if !FABLE_COMPILER interface IDictionary<'Key, 'Value> +#endif interface ICollection> interface IEnumerable> interface System.Collections.IEnumerable diff --git a/src/Compiler/Utilities/PathMap.fs b/src/Compiler/Utilities/PathMap.fs index f11edef6a820..8d2a9a87b106 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.EndsWith dirSepStr then diff --git a/src/Compiler/Utilities/TaggedCollections.fs b/src/Compiler/Utilities/TaggedCollections.fs index c36cf0afb4f9..759ec0a8ddb1 100644 --- a/src/Compiler/Utilities/TaggedCollections.fs +++ b/src/Compiler/Utilities/TaggedCollections.fs @@ -658,10 +658,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. @@ -820,7 +824,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 (m: MapTree<'Key, 'Value>) = @@ -1232,10 +1245,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: obj) = diff --git a/src/Compiler/Utilities/ildiag.fs b/src/Compiler/Utilities/ildiag.fs index e5f3b069bbba..bb71f31e1293 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 6f5fb86849aa..6aec4952319d 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 0161ac651673..2a23382a8e70 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -84,7 +84,7 @@ module internal PervasiveAutoOpens = | None -> failwith "getHole" | Some x -> x - let reportTime = + let reportTime: (string -> unit) = let mutable tPrev: IDisposable = null fun descr -> @@ -93,7 +93,11 @@ module internal PervasiveAutoOpens = tPrev <- if descr <> "Finish" then +#if FABLE_COMPILER + null +#else FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr +#endif else null @@ -101,6 +105,7 @@ module internal PervasiveAutoOpens = let notFound () = raise (KeyNotFoundException()) +#if !FABLE_COMPILER type Async with static member RunImmediate(computation: Async<'T>, ?cancellationToken) = @@ -117,8 +122,14 @@ module internal PervasiveAutoOpens = ) task.Result +#endif //!FABLE_COMPILER /// An efficient lazy for inline storage in a class type. Results in fewer thunks. +#if FABLE_COMPILER +type InlineDelayInit<'T when 'T : not struct>(f: unit -> 'T) = + let store = lazy(f()) + member x.Value = store.Force() +#else [] type InlineDelayInit<'T when 'T: not struct> = new(f: unit -> 'T) = @@ -137,6 +148,7 @@ type InlineDelayInit<'T when 'T: not struct> = let res = LazyInitializer.EnsureInitialized(&x.store, x.func) x.func <- Unchecked.defaultof<_> res +#endif //!FABLE_COMPILER //------------------------------------------------------------------------- // Library: projections @@ -397,7 +409,9 @@ module List = | _ -> true let mapq (f: 'T -> 'T) inp = +#if !FABLE_COMPILER assert not typeof<'T>.IsValueType +#endif match inp with | [] -> inp @@ -609,7 +623,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 @@ -710,12 +728,15 @@ module String = elif value.StartsWithOrdinal pattern then Some() else None - let (|Contains|_|) pattern value = + let (|Contains|_|) (pattern: string) (value: string) = if String.IsNullOrWhiteSpace value then None elif 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) [| @@ -730,6 +751,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) = @@ -808,12 +830,14 @@ module internal LockAutoOpens = let AssumeLockWithoutEvidence<'LockTokenType when 'LockTokenType :> LockToken> () = Unchecked.defaultof<'LockTokenType> +#if !FABLE_COMPILER /// Encapsulates a lock associated with a particular token-type representing the acquisition of that lock. type Lock<'LockTokenType when 'LockTokenType :> LockToken>() = let lockObj = obj () member _.AcquireLock f = lock lockObj (fun () -> f (AssumeLockWithoutEvidence<'LockTokenType>())) +#endif //--------------------------------------------------- // Misc @@ -966,7 +990,7 @@ type CancellableBuilder() = | Choice2Of2 err -> Cancellable.run ct (handler err) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) - member inline _.Using(resource, [] comp) = + member inline _.Using(resource: #IDisposable, [] comp) = Cancellable(fun ct -> #if !FSHARPCORE_USE_PACKAGE __debugPoint "" @@ -983,7 +1007,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 @@ -1035,7 +1065,11 @@ type UniqueStampGenerator<'T when 'T: equality>() = member _.Encode str = encodeTable.GetOrAdd(str, computeFunc).Value +#if FABLE_COMPILER + member _.Table = encodeTable.Keys :> ICollection<'T> +#else member _.Table = encodeTable.Keys +#endif /// memoize tables (all entries cached, never collected) type MemoizationTable<'T, 'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) = @@ -1069,7 +1103,11 @@ type internal StampedDictionary<'T, 'U>(keyComparer: IEqualityComparer<'T>) = match valueReplaceFunc oldVal with | None -> () +#if FABLE_COMPILER + | Some newVal -> table[key] <- lazy (stamp, newVal) +#else | Some newVal -> table.TryUpdate(key, lazy (stamp, newVal), v) |> ignore +#endif | _ -> () member _.GetAll() = @@ -1131,6 +1169,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 @@ -1138,6 +1179,7 @@ type LazyWithContext<'T, 'Ctxt> = x.UnsynchronizedForce ctxt finally Monitor.Exit x +#endif member x.UnsynchronizedForce ctxt = match x.funcOrException with @@ -1388,7 +1430,7 @@ module MapAutoOpens = static member Empty: Map<'Key, 'Value> = Map.empty -#if FSHARPCORE_USE_PACKAGE +#if FSHARPCORE_USE_PACKAGE || FABLE_COMPILER member x.Values = [ for KeyValue (_, v) in x -> v ] #endif diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index 26c8fb21db47..b0bbc90bdeb6 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -61,15 +61,22 @@ module internal PervasiveAutoOpens = member inline EndsWithOrdinalIgnoreCase: value: string -> bool +#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 val notFound: unit -> 'a +#if FABLE_COMPILER +type internal InlineDelayInit<'T when 'T: not struct> = + new: f:(unit -> 'T) -> InlineDelayInit<'T> + member Value: 'T +#else [] type internal InlineDelayInit<'T when 'T: not struct> = @@ -77,6 +84,7 @@ type internal InlineDelayInit<'T when 'T: not struct> = val mutable store: 'T val mutable func: Func<'T> member Value: 'T +#endif module internal Order = @@ -319,11 +327,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 = @@ -603,7 +613,7 @@ module internal MapAutoOpens = static member Empty: Map<'Key, 'Value> when 'Key: comparison -#if FSHARPCORE_USE_PACKAGE +#if FSHARPCORE_USE_PACKAGE || FABLE_COMPILER member Values: 'Value list #endif diff --git a/src/Compiler/Utilities/lib.fs b/src/Compiler/Utilities/lib.fs index bc03a8de2ab7..3a938f425b65 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -21,10 +21,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 (Environment.GetEnvironmentVariable(s) <> null) with _ -> false let GetEnvInteger e dflt = match Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt +#endif let dispose (x:IDisposable) = match x with null -> () | x -> x.Dispose() @@ -285,11 +290,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 @@ -385,6 +392,9 @@ type Dumper(x:obj) = [] member self.Dump = sprintf "%A" x #endif + +#if !FABLE_COMPILER + //--------------------------------------------------------------------------- // EnableHeapTerminationOnCorruption() //--------------------------------------------------------------------------- @@ -428,6 +438,8 @@ module UnmanagedProcessExecutionOptions = "HeapSetInformation() returned FALSE; LastError = 0x" + GetLastError().ToString("X").PadLeft(8, '0') + ".")) +#endif //!FABLE_COMPILER + [] type MaybeLazy<'T> = | Strict of 'T @@ -448,10 +460,18 @@ let inline vsnd ((_, y): struct('T * 'T)) = y /// Track a set of resources to cleanup type DisposablesTracker() = +#if FABLE_COMPILER + let items = List() +#else let items = Stack() +#endif /// Register some items to dispose +#if FABLE_COMPILER + member _.Register i = items.Add i +#else member _.Register i = items.Push i +#endif interface IDisposable with @@ -468,6 +488,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 -> @@ -476,6 +499,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 2e6b0318f7a4..9422724954c8 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 @@ -247,9 +249,13 @@ val inline cacheOptRef: cache: 'a option ref -> f: (unit -> 'a) -> 'a val inline tryGetCacheValue: cache: cache<'a> -> NonNullSlot<'a> voption +#if !FABLE_COMPILER + module UnmanagedProcessExecutionOptions = val EnableHeapTerminationOnCorruption: unit -> unit +#endif //!FABLE_COMPILER + [] type MaybeLazy<'T> = | Strict of 'T diff --git a/src/Compiler/Utilities/range.fs b/src/Compiler/Utilities/range.fs index bbd6a9f06739..39140bb9c335 100755 --- a/src/Compiler/Utilities/range.fs +++ b/src/Compiler/Utilities/range.fs @@ -198,23 +198,36 @@ type FileIndexTable() = | _ -> // 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 -> // Record the non-normalized entry if necessary if filePath <> normalizedFilePath then +#if FABLE_COMPILER + fileToIndexTable[filePath] <- idx +#else lock fileToIndexTable (fun () -> fileToIndexTable[filePath] <- idx) +#endif // Return the index idx | _ -> +#if FABLE_COMPILER + ( +#else lock fileToIndexTable (fun () -> +#endif // Get the new index let idx = indexToFileTable.Count @@ -341,6 +354,9 @@ type Range(code1: int64, code2: int64) = member _.Code2 = code2 member m.DebugCode = +#if FABLE_COMPILER + "" +#else let name = m.FileName if @@ -367,6 +383,7 @@ type Range(code1: int64, code2: int64) = |> fun s -> s.Substring(startCol + 1, s.LastIndexOf("\n", StringComparison.Ordinal) + 1 - startCol + endCol) with e -> e.ToString() +#endif //!FABLE_COMPILER member m.ToShortString() = sprintf "(%d,%d--%d,%d)" m.StartLine m.StartColumn m.EndLine m.EndColumn @@ -535,6 +552,7 @@ module Range = } let mkFirstLineOfFile (file: string) = +#if !FABLE_COMPILER try let lines = FileSystem.OpenFileForReadShim(file).ReadLines() |> Seq.indexed @@ -551,4 +569,5 @@ module Range = | Some (i, s) -> mkRange file (mkPos (i + 1) 0) (mkPos (i + 1) s.Length) | None -> mkRange file (mkPos 1 0) (mkPos 1 80) with _ -> +#endif //!FABLE_COMPILER mkRange file (mkPos 1 0) (mkPos 1 80) diff --git a/src/Compiler/Utilities/sformat.fs b/src/Compiler/Utilities/sformat.fs index 5d42dae0b45c..64ef14cf650b 100644 --- a/src/Compiler/Utilities/sformat.fs +++ b/src/Compiler/Utilities/sformat.fs @@ -10,7 +10,7 @@ #nowarn "52" // The value has been copied to ensure the original is not mutated by this operation -#if COMPILER +#if COMPILER || FABLE_COMPILER namespace FSharp.Compiler.Text #else // FSharp.Core.dll: @@ -145,7 +145,7 @@ module TaggedText = let rightBrace = tagPunctuation "}" let equals = tagOperator "=" -#if COMPILER +#if COMPILER || FABLE_COMPILER let tagAlias t = mkTag TextTag.Alias t let keywordFunctions = @@ -278,7 +278,7 @@ module Layout = | Leaf (true, s, true) -> s.Text = "" | _ -> false -#if COMPILER +#if COMPILER || FABLE_COMPILER let rec endsWithL (text: string) layout = match layout with | Leaf (_, s, _) -> s.Text.EndsWith(text) @@ -397,6 +397,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 = @@ -1629,3 +1631,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 2707838552e7..26990a8ab8ae 100644 --- a/src/Compiler/Utilities/sformat.fsi +++ b/src/Compiler/Utilities/sformat.fsi @@ -12,7 +12,7 @@ // // Note no layout objects are ever transferred between the above implementations. -#if COMPILER +#if COMPILER || FABLE_COMPILER namespace FSharp.Compiler.Text #else namespace Microsoft.FSharp.Text.StructuredPrintfImpl @@ -23,7 +23,7 @@ open System.IO open Microsoft.FSharp.Core open Microsoft.FSharp.Collections -#if COMPILER +#if COMPILER || FABLE_COMPILER /// Data representing joints in structured layouts of terms. The representation /// of this data type is only for the consumption of formatting engines. @@ -124,7 +124,7 @@ module internal TaggedText = val comma: TaggedText -#if COMPILER +#if COMPILER || FABLE_COMPILER val tagNamespace: string -> TaggedText val tagParameter: string -> TaggedText val tagSpace: string -> TaggedText @@ -239,7 +239,7 @@ module internal Layout = /// Is it the empty layout? val isEmptyL: layout: Layout -> bool -#if COMPILER +#if COMPILER || FABLE_COMPILER /// Check if the last character in the layout is the given character val endsWithL: text: string -> layout: Layout -> bool #endif @@ -343,6 +343,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. @@ -404,3 +406,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 ab11625c7d5f..e465802f55d8 100644 --- a/src/Compiler/lex.fsl +++ b/src/Compiler/lex.fsl @@ -49,8 +49,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 @@ -72,10 +76,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 @@ -84,10 +95,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 formatError() = raise (new System.FormatException(SR.GetString("bad format string"))) @@ -103,6 +121,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 @@ -111,6 +139,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) @@ -120,10 +149,17 @@ 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 unexpectedChar lexbuf = LEX_FAILURE (FSComp.SR.lexUnexpectedChar(lexeme lexbuf)) @@ -188,7 +224,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) -> @@ -211,7 +251,11 @@ let shouldStartFile args lexbuf (m:range) err tok = else tok let evalIfDefExpression startPos reportLibraryOnlyFeatures langVersion args (lookup:string->bool) (lexed:string) = +#if FABLE_COMPILER + let lexbuf = LexBuffer<_>.FromString (reportLibraryOnlyFeatures, langVersion, lexed) +#else let lexbuf = LexBuffer.FromChars (reportLibraryOnlyFeatures, langVersion, lexed.ToCharArray ()) +#endif lexbuf.StartPos <- startPos lexbuf.EndPos <- startPos let tokenStream = FSharp.Compiler.PPLexer.tokenstream args @@ -501,16 +545,26 @@ rule token args skip = 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.lexOusideThirtyTwoBitFloat()) (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