diff --git a/.vscode/launch.json b/.vscode/launch.json index 53b93d07fcb..ccb75083bbf 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -75,6 +75,16 @@ }, "justMyCode": true, "enableStepFiltering": false, + }, + { + "name": "FCS-Fable Test", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-fable-test/Debug/net6.0/fcs-fable-test.dll", + "args": [], + "cwd": "${workspaceFolder}/fcs/fcs-fable/test", + "console": "internalConsole", + "stopAtEntry": false } ] } diff --git a/buildtools/AssemblyCheck/AssemblyCheck.fsproj b/buildtools/AssemblyCheck/AssemblyCheck.fsproj index d82763ddc2e..d396c055fec 100644 --- a/buildtools/AssemblyCheck/AssemblyCheck.fsproj +++ b/buildtools/AssemblyCheck/AssemblyCheck.fsproj @@ -2,7 +2,7 @@ Exe - net7.0 + net6.0 true false diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index 86346fc2a15..8332b53a237 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net6.0\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net6.0\fsyacc.dll diff --git a/buildtools/fslex/fslex.fsproj b/buildtools/fslex/fslex.fsproj index 8577bf4e3af..fe737d00331 100644 --- a/buildtools/fslex/fslex.fsproj +++ b/buildtools/fslex/fslex.fsproj @@ -2,7 +2,7 @@ Exe - net7.0 + net6.0 INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants) true false diff --git a/buildtools/fsyacc/fsyacc.fsproj b/buildtools/fsyacc/fsyacc.fsproj index e3a4b88a3a0..839c919617d 100644 --- a/buildtools/fsyacc/fsyacc.fsproj +++ b/buildtools/fsyacc/fsyacc.fsproj @@ -2,7 +2,7 @@ Exe - net7.0 + net6.0 INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants) true false diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 00000000000..f8eca34a882 --- /dev/null +++ b/fcs/build.sh @@ -0,0 +1,40 @@ +#!/usr/bin/env bash + +# cd to root +cd $(dirname $0)/.. + +# build fslex/fsyacc tools +dotnet build -c Release buildtools +# build FSharp.Compiler.Service (to make sure it's not broken) +dotnet build -c Release src/Compiler + +# build FCS-Fable codegen +cd fcs/fcs-fable/codegen +dotnet build -c Release +dotnet run -c Release -- ../../../src/Compiler/FSComp.txt FSComp.fs +dotnet run -c Release -- ../../../src/Compiler/Interactive/FSIstrings.txt FSIstrings.fs + +# cleanup comments +files="FSComp.fs FSIstrings.fs" +for file in $files; do + echo "Delete comments in $file" + sed -i '1s/^\xEF\xBB\xBF//' $file # remove BOM + sed -i '/^ *\/\//d' $file # delete all comment lines +done + +# replace all #line directives with comments +files="lex.fs pplex.fs illex.fs ilpars.fs pars.fs pppars.fs" +for file in $files; do + echo "Replace #line directives with comments in $file" + sed -i 's/^# [0-9]/\/\/\0/' $file # comment all #line directives + sed -i 's/^\(\/\/# [0-9]\{1,\} "\).*\/codegen\/\(\.\.\/\)*/\1/' $file # cleanup #line paths +done + +# build FCS-Fable +cd .. +dotnet build -c Release + +# run some tests +cd test +npm test +# npm run bench diff --git a/fcs/fcs-fable/.gitignore b/fcs/fcs-fable/.gitignore new file mode 100644 index 00000000000..db7b2bd5665 --- /dev/null +++ b/fcs/fcs-fable/.gitignore @@ -0,0 +1,3 @@ +# Codegen +codegen/*.fs +codegen/*.fsi diff --git a/fcs/fcs-fable/FSStrings.fs b/fcs/fcs-fable/FSStrings.fs new file mode 100644 index 00000000000..d53f0601514 --- /dev/null +++ b/fcs/fcs-fable/FSStrings.fs @@ -0,0 +1,998 @@ +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 in augmentations are now deprecated. Interface implementations should be given on the initial declaration of a type." + ); + ( "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" + ); + ] \ No newline at end of file diff --git a/fcs/fcs-fable/SR.fs b/fcs/fcs-fable/SR.fs new file mode 100644 index 00000000000..39ca804f113 --- /dev/null +++ b/fcs/fcs-fable/SR.fs @@ -0,0 +1,28 @@ +//------------------------------------------------------------------------ +// From SR.fs +//------------------------------------------------------------------------ + +namespace FSharp.Compiler + +module SR = + let GetString(name: string) = + match SR.Resources.resources.TryGetValue(name) with + | true, value -> value + | _ -> "Missing FSStrings error message for: " + name + +module DiagnosticMessage = + type ResourceString<'T>(sfmt: string, fmt: string) = + member x.Format = + let a = fmt.Split('%') + |> Array.filter (fun s -> String.length s > 0) + |> Array.map (fun s -> box("%" + s)) + let tmp = System.String.Format(sfmt, a) + let fmt = Printf.StringFormat<'T>(tmp) + sprintf fmt + + let postProcessString (s: string) = + s.Replace("\\n","\n").Replace("\\t","\t") + + let DeclareResourceString (messageID: string, fmt: string) = + let messageString = SR.GetString(messageID) |> postProcessString + ResourceString<'T>(messageString, fmt) diff --git a/fcs/fcs-fable/System.Collections.fs b/fcs/fcs-fable/System.Collections.fs new file mode 100644 index 00000000000..105aa5fc8ac --- /dev/null +++ b/fcs/fcs-fable/System.Collections.fs @@ -0,0 +1,97 @@ +//------------------------------------------------------------------------ +// 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 actually immutable, just a ResizeArray + type ImmutableArray<'T> = + static member CreateBuilder() = ResizeArray<'T>() + + // not actually immutable, just a Dictionary + 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 actually thread safe, just a Dictionary + [] + 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, valueFactory: 'Key -> 'Value): 'Value = + match x.TryGetValue(key) with + | true, v -> v + | _ -> let v = valueFactory(key) in x.Add(key, v); v + + // 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<'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: 'Key * 'Value -> 'Value): 'Value = + // match x.TryGetValue(key) with + // | true, v -> let v = updateFactory(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 00000000000..3b3cc17b134 --- /dev/null +++ b/fcs/fcs-fable/System.IO.fs @@ -0,0 +1,56 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System.IO + +module Path = + let Combine (path1: string, path2: string) = //TODO: proper xplat implementation + let path1 = + if (String.length path1) = 0 then path1 + else (path1.TrimEnd [|'\\';'/'|]) + "/" + path1 + (path2.TrimStart [|'\\';'/'|]) + + let ChangeExtension (path: string, ext: string) = + let i = path.LastIndexOf(".") + if i < 0 then path + else path.Substring(0, i) + ext + + let HasExtension (path: string) = + let i = path.LastIndexOf(".") + i >= 0 + + let GetExtension (path: string) = + let i = path.LastIndexOf(".") + if i < 0 then "" + else path.Substring(i) + + let GetInvalidPathChars () = //TODO: proper xplat implementation + Seq.toArray "<>\"|?*\b\t" + + let GetInvalidFileNameChars () = //TODO: proper xplat implementation + Seq.toArray "<>:\"|\\/?*\b\t" + + let GetFileName (path: string) = + let normPath = path.Replace("\\", "/").TrimEnd('/') + let i = normPath.LastIndexOf("/") + normPath.Substring(i + 1) + + let GetFileNameWithoutExtension (path: string) = + let filename = GetFileName path + let i = filename.LastIndexOf(".") + if i < 0 then filename + else filename.Substring(0, i) + + let GetDirectoryName (path: string) = //TODO: proper xplat implementation + let normPath = path.Replace("\\", "/") + let i = normPath.LastIndexOf("/") + if i <= 0 then "" + else normPath.Substring(0, i) + + let DirectorySeparatorChar = '/' + let AltDirectorySeparatorChar = '/' + +module Directory = + let GetCurrentDirectory() = //TODO: proper xplat implementation + "." diff --git a/fcs/fcs-fable/System.fs b/fcs/fcs-fable/System.fs new file mode 100644 index 00000000000..366111b1520 --- /dev/null +++ b/fcs/fcs-fable/System.fs @@ -0,0 +1,40 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System + +type Environment() = + static member ProcessorCount = 1 + static member Exit(_exitcode) = () + +module Diagnostics = + type Trace() = + static member TraceInformation(_s) = () //TODO: proper implementation + +module Reflection = + type AssemblyName(assemblyName: string) = + member x.Name = assemblyName //TODO: proper implementation + +type WeakReference<'T>(v: 'T) = + member x.TryGetTarget () = (true, v) + +type StringComparer(comp: System.StringComparison) = + static member Ordinal = StringComparer(System.StringComparison.Ordinal) + static member OrdinalIgnoreCase = StringComparer(System.StringComparison.OrdinalIgnoreCase) + interface System.Collections.Generic.IEqualityComparer with + member x.Equals(a,b) = System.String.Compare(a, b, comp) = 0 + member x.GetHashCode(a) = + match comp with + | System.StringComparison.Ordinal -> hash a + | System.StringComparison.OrdinalIgnoreCase -> hash (a.ToLowerInvariant()) + | _ -> failwithf "Unsupported StringComparison: %A" comp + interface System.Collections.Generic.IComparer with + member x.Compare(a,b) = System.String.Compare(a, b, comp) + +type ArraySegment<'T>(arr: 'T[]) = + member _.Array = arr + member _.Count = arr.Length + member _.Offset = 0 + new (arr: 'T[], offset: int, count: int) = + ArraySegment<'T>(Array.sub arr offset count) diff --git a/fcs/fcs-fable/TcImports_shim.fs b/fcs/fcs-fable/TcImports_shim.fs new file mode 100644 index 00000000000..b1d322fd7a2 --- /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 00000000000..cc89d332c8b --- /dev/null +++ b/fcs/fcs-fable/ast_print.fs @@ -0,0 +1,101 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +module AstPrint + +open FSharp.Compiler.Symbols + +//------------------------------------------------------------------------- +// AstPrint +//------------------------------------------------------------------------- + +let attribsOfSymbol (s: FSharpSymbol) = + [ match s with + | :? FSharpField as v -> + yield "field" + if v.IsCompilerGenerated then yield "compgen" + if v.IsDefaultValue then yield "default" + if v.IsMutable then yield "mutable" + if v.IsVolatile then yield "volatile" + if v.IsStatic then yield "static" + if v.IsLiteral then yield sprintf "%A" v.LiteralValue.Value + + | :? FSharpEntity as v -> + v.TryFullName |> ignore // check there is no failure here + match v.BaseType with + | Some t when t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome -> + yield sprintf "inherits %s" t.TypeDefinition.FullName + | _ -> () + if v.IsNamespace then yield "namespace" + if v.IsFSharpModule then yield "module" + if v.IsByRef then yield "byref" + if v.IsClass then yield "class" + if v.IsDelegate then yield "delegate" + if v.IsEnum then yield "enum" + if v.IsFSharpAbbreviation then yield "abbrev" + if v.IsFSharpExceptionDeclaration then yield "exception" + if v.IsFSharpRecord then yield "record" + if v.IsFSharpUnion then yield "union" + if v.IsInterface then yield "interface" + if v.IsMeasure then yield "measure" +#if !NO_TYPEPROVIDERS + if v.IsProvided then yield "provided" + if v.IsStaticInstantiation then yield "static_inst" + if v.IsProvidedAndErased then yield "erased" + if v.IsProvidedAndGenerated then yield "generated" +#endif + if v.IsUnresolved then yield "unresolved" + if v.IsValueType then yield "valuetype" + + | :? FSharpMemberOrFunctionOrValue as v -> + yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "" + if v.IsActivePattern then yield "active_pattern" + if v.IsDispatchSlot then yield "dispatch_slot" + if v.IsModuleValueOrMember && not v.IsMember then yield "val" + if v.IsMember then yield "member" + if v.IsProperty then yield "property" + if v.IsExtensionMember then yield "extension_member" + if v.IsPropertyGetterMethod then yield "property_getter" + if v.IsPropertySetterMethod then yield "property_setter" + if v.IsEvent then yield "event" + if v.EventForFSharpProperty.IsSome then yield "property_event" + if v.IsEventAddMethod then yield "event_add" + if v.IsEventRemoveMethod then yield "event_remove" + if v.IsTypeFunction then yield "type_func" + if v.IsCompilerGenerated then yield "compiler_gen" + if v.IsImplicitConstructor then yield "implicit_ctor" + if v.IsMutable then yield "mutable" + if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl" + if not v.IsInstanceMember then yield "static" + if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky" + if v.IsExplicitInterfaceImplementation then yield "interface_impl" + yield sprintf "%A" v.InlineAnnotation + // if v.IsConstructorThisValue then yield "ctorthis" + // if v.IsMemberThisValue then yield "this" + // if v.LiteralValue.IsSome then yield "literal" + | _ -> () ] + +let rec printFSharpDecls prefix decls = seq { + let mutable i = 0 + for decl in decls do + i <- i + 1 + match decl with + | FSharpImplementationFileDeclaration.Entity (e, sub) -> + yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e) + if not (Seq.isEmpty e.Attributes) then + yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes) + if not (Seq.isEmpty e.DeclaredInterfaces) then + yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces) + yield "" + yield! printFSharpDecls (prefix + "\t") sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) -> + yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth) + yield sprintf "%stype: %A" prefix meth.FullType + yield sprintf "%sargs: %A" prefix args + // if not meth.IsCompilerGenerated then + yield sprintf "%sbody: %A" prefix body + yield "" + | FSharpImplementationFileDeclaration.InitAction (expr) -> + yield sprintf "%s%i) ACTION" prefix i + yield sprintf "%s%A" prefix expr + yield "" +} diff --git a/fcs/fcs-fable/codegen/codegen.fsproj b/fcs/fcs-fable/codegen/codegen.fsproj new file mode 100644 index 00000000000..670e1085cde --- /dev/null +++ b/fcs/fcs-fable/codegen/codegen.fsproj @@ -0,0 +1,52 @@ + + + artifacts + $(MSBuildProjectDirectory)/../../../src/Compiler + + + + + Exe + net6.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 00000000000..529a0a1d543 --- /dev/null +++ b/fcs/fcs-fable/codegen/fssrgen.fsx @@ -0,0 +1,495 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +module FsSrGen +open System +open System.IO + +let PrintErr(filename, line, msg) = + printfn "%s(%d): error : %s" filename line msg + +let Err(filename, line, msg) = + PrintErr(filename, line, msg) + printfn "Note that the syntax of each line is one of these three alternatives:" + printfn "# comment" + printfn "ident,\"string\"" + printfn "errNum,ident,\"string\"" + failwith (sprintf "there were errors in the file '%s'" filename) + +let xmlBoilerPlateString = @" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + +" + + +type HoleType = string + + +// The kinds of 'holes' we can do +let ComputeHoles filename lineNum (txt:string) : ResizeArray * string = + // takes in a %d%s kind of string, returns array of HoleType and {0}{1} kind of string + let mutable i = 0 + let mutable holeNumber = 0 + let mutable holes = ResizeArray() // order + let sb = new System.Text.StringBuilder() + let AddHole holeType = + sb.Append(sprintf "{%d}" holeNumber) |> ignore + holeNumber <- holeNumber + 1 + holes.Add(holeType) + while i < txt.Length do + if txt.[i] = '%' then + if i+1 = txt.Length then + Err(filename, lineNum, "(at end of string) % must be followed by d, f, s, or %") + else + match txt.[i+1] with + | 'd' -> AddHole "System.Int32" + | 'f' -> AddHole "System.Double" + | 's' -> AddHole "System.String" + | '%' -> sb.Append('%') |> ignore + | c -> Err(filename, lineNum, sprintf "'%%%c' is not a valid sequence, only %%d %%f %%s or %%%%" c) + i <- i + 2 + else + match txt.[i] with + | '{' -> sb.Append "{{" |> ignore + | '}' -> sb.Append "}}" |> ignore + | c -> sb.Append c |> ignore + i <- i + 1 + //printfn "holes.Length = %d, lineNum = %d" holes.Length //lineNum txt + (holes, sb.ToString()) + +let Unquote (s : string) = + if s.StartsWith "\"" && s.EndsWith "\"" then s.Substring(1, s.Length - 2) + else failwith "error message string should be quoted" + +let ParseLine filename lineNum (txt:string) = + let mutable errNum = None + let identB = new System.Text.StringBuilder() + let mutable i = 0 + // parse optional error number + if i < txt.Length && System.Char.IsDigit txt.[i] then + let numB = new System.Text.StringBuilder() + while i < txt.Length && System.Char.IsDigit txt.[i] do + numB.Append txt.[i] |> ignore + i <- i + 1 + errNum <- Some(int (numB.ToString())) + if i = txt.Length || not(txt.[i] = ',') then + Err(filename, lineNum, sprintf "After the error number '%d' there should be a comma" errNum.Value) + // Skip the comma + i <- i + 1 + // parse short identifier + if i < txt.Length && not(System.Char.IsLetter(txt.[i])) then + Err(filename, lineNum, sprintf "The first character in the short identifier should be a letter, but found '%c'" txt.[i]) + while i < txt.Length && System.Char.IsLetterOrDigit txt.[i] do + identB.Append txt.[i] |> ignore + i <- i + 1 + let ident = identB.ToString() + if ident.Length = 0 then + Err(filename, lineNum, "Did not find the short identifier") + else + if i = txt.Length || not(txt.[i] = ',') then + Err(filename, lineNum, sprintf "After the identifier '%s' there should be a comma" ident) + else + // Skip the comma + i <- i + 1 + if i = txt.Length then + Err(filename, lineNum, sprintf "After the identifier '%s' and comma, there should be the quoted string resource" ident) + else + let str = + try + System.String.Format(Unquote(txt.Substring i)) // Format turns e.g '\n' into that char, but also requires that we 'escape' curlies in the original .txt file, e.g. "{{" + with + e -> Err(filename, lineNum, sprintf "Error calling System.String.Format (note that curly braces must be escaped, and there cannot be trailing space on the line): >>>%s<<< -- %s" (txt.Substring i) e.Message) + let holes, netFormatString = ComputeHoles filename lineNum str + (lineNum, (errNum,ident), str, holes.ToArray(), netFormatString) + +let stringBoilerPlatePrefix = @" +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Reflection +open System.Reflection +// (namespaces below for specific case of using the tool to compile FSharp.Core itself) +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Text +open Microsoft.FSharp.Collections +open Printf +" +let StringBoilerPlate filename = + + @" + // BEGIN BOILERPLATE + + static let getCurrentAssembly () = + #if FX_RESHAPED_REFLECTION + typeof.GetTypeInfo().Assembly + #else + System.Reflection.Assembly.GetExecutingAssembly() + #endif + + static let getTypeInfo (t: System.Type) = + #if FX_RESHAPED_REFLECTION + t.GetTypeInfo() + #else + t + #endif + + static let resources = lazy (new System.Resources.ResourceManager(""" + filename + @""", getCurrentAssembly())) + + static let GetString(name:string) = + let s = resources.Value.GetString(name, System.Globalization.CultureInfo.CurrentUICulture) + #if DEBUG + if null = s then + System.Diagnostics.Debug.Assert(false, sprintf ""**RESOURCE ERROR**: Resource token %s does not exist!"" name) + #endif + s + + static let mkFunctionValue (tys: System.Type[]) (impl:obj->obj) = + FSharpValue.MakeFunction(FSharpType.MakeFunctionType(tys.[0],tys.[1]), impl) + + static let funTyC = typeof<(obj -> obj)>.GetGenericTypeDefinition() + + static let isNamedType(ty:System.Type) = not (ty.IsArray || ty.IsByRef || ty.IsPointer) + static let isFunctionType (ty1:System.Type) = + isNamedType(ty1) && getTypeInfo(ty1).IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(funTyC) + + static let rec destFunTy (ty:System.Type) = + if isFunctionType ty then + ty, ty.GetGenericArguments() + else + match getTypeInfo(ty).BaseType with + | null -> failwith ""destFunTy: not a function type"" + | b -> destFunTy b + + static let buildFunctionForOneArgPat (ty: System.Type) impl = + let _,tys = destFunTy ty + let rty = tys.[1] + // PERF: this technique is a bit slow (e.g. in simple cases, like 'sprintf ""%x""') + mkFunctionValue tys (fun inp -> impl rty inp) + + static let capture1 (fmt:string) i args ty (go : obj list -> System.Type -> int -> obj) : obj = + match fmt.[i] with + | '%' -> go args ty (i+1) + | 'd' + | 'f' + | 's' -> buildFunctionForOneArgPat ty (fun rty n -> go (n::args) rty (i+1)) + | _ -> failwith ""bad format specifier"" + + // newlines and tabs get converted to strings when read from a resource file + // this will preserve their original intention + static let postProcessString (s : string) = + s.Replace(""\\n"",""\n"").Replace(""\\t"",""\t"").Replace(""\\r"",""\r"").Replace(""\\\"""", ""\"""") + + static let createMessageString (messageString : string) (fmt : Printf.StringFormat<'T>) : 'T = + let fmt = fmt.Value // here, we use the actual error string, as opposed to the one stored as fmt + let len = fmt.Length + + /// Function to capture the arguments and then run. + let rec capture args ty i = + if i >= len || (fmt.[i] = '%' && i+1 >= len) then + let b = new System.Text.StringBuilder() + b.AppendFormat(messageString, [| for x in List.rev args -> x |]) |> ignore + box(b.ToString()) + // REVIEW: For these purposes, this should be a nop, but I'm leaving it + // in incase we ever decide to support labels for the error format string + // E.g., ""%s%d"" + elif System.Char.IsSurrogatePair(fmt,i) then + capture args ty (i+2) + else + match fmt.[i] with + | '%' -> + let i = i+1 + capture1 fmt i args ty capture + | _ -> + capture args ty (i+1) + + (unbox (capture [] (typeof<'T>) 0) : 'T) + + static let mutable swallowResourceText = false + + static let GetStringFunc((messageID : string),(fmt : Printf.StringFormat<'T>)) : 'T = + if swallowResourceText then + sprintf fmt + else + let mutable messageString = GetString(messageID) + messageString <- postProcessString messageString + createMessageString messageString fmt + + /// If set to true, then all error messages will just return the filled 'holes' delimited by ',,,'s - this is for language-neutral testing (e.g. localization-invariant baselines). + static member SwallowResourceText with get () = swallowResourceText + and set (b) = swallowResourceText <- b + // END BOILERPLATE +" + +let RunMain(filename:string, outFilename, outXmlFilenameOpt, projectNameOpt) = + try + let justfilename = System.IO.Path.GetFileNameWithoutExtension(filename) + if justfilename |> Seq.exists (fun c -> not(System.Char.IsLetterOrDigit(c))) then + Err(filename, 0, sprintf "The filename '%s' is not allowed; only letters and digits can be used, as the filename also becomes the namespace for the SR class" justfilename) + + printfn "fssrgen.fsx: Reading %s" filename + let lines = System.IO.File.ReadAllLines(filename) + |> Array.mapi (fun i s -> i,s) // keep line numbers + |> Array.filter (fun (i,s) -> not(s.StartsWith "#")) // filter out comments + + printfn "fssrgen.fsx: Parsing %s" filename + let stringInfos = lines |> Array.map (fun (i,s) -> ParseLine filename i s) + // now we have array of (lineNum, ident, str, holes, netFormatString) // str has %d, netFormatString has {0} + + printfn "fssrgen.fsx: Validating %s" filename + // validate that all the idents are unique + let allIdents = new System.Collections.Generic.Dictionary() + for (line,(_,ident),_,_,_) in stringInfos do + if allIdents.ContainsKey(ident) then + Err(filename,line,sprintf "Identifier '%s' is already used previously on line %d - each identifier must be unique" ident allIdents.[ident]) + allIdents.Add(ident,line) + + printfn "fssrgen.fsx: Validating uniqueness of %s" filename + // validate that all the strings themselves are unique + let allStrs = new System.Collections.Generic.Dictionary() + for (line,(_,ident),str,_,_) in stringInfos do + if allStrs.ContainsKey(str) then + let prevLine,prevIdent = allStrs.[str] + Err(filename,line,sprintf "String '%s' already appears on line %d with identifier '%s' - each string must be unique" str prevLine prevIdent) + allStrs.Add(str,(line,ident)) + + printfn "fssrgen.fsx: Generating %s" outFilename + + use out = new System.IO.StringWriter() + fprintfn out "// This is a generated file; the original input is '%s'" filename + fprintfn out "namespace %s" justfilename + if Option.isNone outXmlFilenameOpt then + fprintfn out "type internal SR private() =" + else + fprintfn out "%s" stringBoilerPlatePrefix + fprintfn out "type internal SR private() =" + let theResourceName = match projectNameOpt with Some p -> sprintf "%s.%s" p justfilename | None -> justfilename + fprintfn out "%s" (StringBoilerPlate theResourceName) + + printfn "fssrgen.fsx: Generating resource methods for %s" outFilename + // gen each resource method + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + let formalArgs = System.Text.StringBuilder() + let actualArgs = System.Text.StringBuilder() + let firstTime = ref true + let n = ref 0 + formalArgs.Append "(" |> ignore + for hole in holes do + if !firstTime then + firstTime := false + else + formalArgs.Append ", " |> ignore + actualArgs.Append " " |> ignore + formalArgs.Append(sprintf "a%d : %s" !n hole) |> ignore + actualArgs.Append(sprintf "a%d" !n) |> ignore + n := !n + 1 + formalArgs.Append ")" |> ignore + fprintfn out " /// %s" str + fprintfn out " /// (Originally from %s:%d)" filename (lineNum+1) + let justPercentsFromFormatString = + (holes |> Array.fold (fun acc holeType -> + acc + match holeType with + | "System.Int32" -> ",,,%d" + | "System.Double" -> ",,,%f" + | "System.String" -> ",,,%s" + | _ -> failwith "unreachable") "") + ",,," + let errPrefix = match optErrNum with + | None -> "" + | Some n -> sprintf "%d, " n + if Option.isNone outXmlFilenameOpt then + fprintfn out " static member %s%s = (%ssprintf \"%s\" %s)" ident (formalArgs.ToString()) errPrefix str (actualArgs.ToString()) + else + fprintfn out " static member %s%s = (%sGetStringFunc(\"%s\",\"%s\") %s)" ident (formalArgs.ToString()) errPrefix ident justPercentsFromFormatString (actualArgs.ToString()) + ) + + if Option.isSome outXmlFilenameOpt then + printfn "fssrgen.fsx: Generating .resx for %s" outFilename + fprintfn out "" + // gen validation method + fprintfn out " /// Call this method once to validate that all known resources are valid; throws if not" + fprintfn out " static member RunStartupValidation() =" + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + fprintfn out " ignore(GetString(\"%s\"))" ident + ) + fprintfn out " ()" // in case there are 0 strings, we need the generated code to parse + + let outFileNewText = out.ToString() + let nothingChanged = try File.Exists(outFilename) && File.ReadAllText(outFilename) = outFileNewText with _ -> false + if not nothingChanged then + File.WriteAllText(outFilename, outFileNewText, System.Text.Encoding.UTF8) + + if Option.isSome outXmlFilenameOpt then + // gen resx + let xd = new System.Xml.XmlDocument() + xd.LoadXml(xmlBoilerPlateString) + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + let xn = xd.CreateElement("data") + xn.SetAttribute("name",ident) |> ignore + xn.SetAttribute("xml:space","preserve") |> ignore + let xnc = xd.CreateElement "value" + xn.AppendChild xnc |> ignore + xnc.AppendChild(xd.CreateTextNode netFormatString) |> ignore + xd.LastChild.AppendChild xn |> ignore + ) + let outXmlFileNewText = + use outXmlStream = new System.IO.StringWriter() + xd.Save outXmlStream + outXmlStream.ToString() + let outXmlFile = outXmlFilenameOpt.Value + let nothingChanged = try File.Exists(outXmlFile) && File.ReadAllText(outXmlFile) = outXmlFileNewText with _ -> false + if not nothingChanged then + File.WriteAllText(outXmlFile, outXmlFileNewText, System.Text.Encoding.Unicode) + + + printfn "fssrgen.fsx: Done %s" outFilename + 0 + with e -> + PrintErr(filename, 0, sprintf "An exception occurred when processing '%s'\n%s" filename (e.ToString())) + 1 + +#if COMPILED +[] +#endif +let Main args = + + match args |> List.ofArray with + | [ inputFile; outFile; ] -> + let filename = System.IO.Path.GetFullPath(inputFile) + let outFilename = System.IO.Path.GetFullPath(outFile) + + RunMain(filename, outFilename, None, None) + + | [ inputFile; outFile; outXml ] -> + let filename = System.IO.Path.GetFullPath inputFile + let outFilename = System.IO.Path.GetFullPath outFile + let outXmlFilename = System.IO.Path.GetFullPath outXml + + RunMain(filename, outFilename, Some outXmlFilename, None) + + | [ inputFile; outFile; outXml; projectName ] -> + let filename = System.IO.Path.GetFullPath inputFile + let outFilename = System.IO.Path.GetFullPath outFile + let outXmlFilename = System.IO.Path.GetFullPath outXml + + RunMain(filename, outFilename, Some outXmlFilename, Some projectName) + + | _ -> + printfn "Error: invalid arguments." + printfn "Usage: " + 1 +#if !COMPILED +printfn "fssrgen: args = %A" fsi.CommandLineArgs +Main (fsi.CommandLineArgs |> Seq.skip 1 |> Seq.toArray) +#endif diff --git a/fcs/fcs-fable/codegen/fssrgen.targets b/fcs/fcs-fable/codegen/fssrgen.targets new file mode 100644 index 00000000000..c28706b5d6a --- /dev/null +++ b/fcs/fcs-fable/codegen/fssrgen.targets @@ -0,0 +1,35 @@ + + + + + ProcessFsSrGen;$(PrepareForBuildDependsOn) + + + + + + + + + + + + false + + + diff --git a/fcs/fcs-fable/fcs-fable.fsproj b/fcs/fcs-fable/fcs-fable.fsproj new file mode 100644 index 00000000000..0838086cda8 --- /dev/null +++ b/fcs/fcs-fable/fcs-fable.fsproj @@ -0,0 +1,353 @@ + + + $(MSBuildProjectDirectory)/../../src/Compiler + $(MSBuildProjectDirectory)/codegen + + + + netstandard2.0 + $(DefineConstants);FABLE_COMPILER + + + + $(DefineConstants);FX_NO_WEAKTABLE + $(DefineConstants);NO_TYPEPROVIDERS + $(DefineConstants);NO_INLINE_IL_PARSER + $(DefineConstants);USE_SHIPPED_FSCORE + $(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 00000000000..09a30702cdc --- /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 niceNameGen = NiceNameGenerator() + let assemblyName = projectOptions.ProjectFileName |> Path.GetFileNameWithoutExtension + let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, 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 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) + 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, GetScopedPragmasForInput(input), 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 00000000000..66d36d51d64 --- /dev/null +++ b/fcs/fcs-fable/test/.gitignore @@ -0,0 +1,7 @@ +# Output +out*/ + +# Node +node_modules/ +package-lock.json +yarn.lock \ No newline at end of file diff --git a/fcs/fcs-fable/test/Metadata.fs b/fcs/fcs-fable/test/Metadata.fs new file mode 100644 index 00000000000..0ad926feaed --- /dev/null +++ b/fcs/fcs-fable/test/Metadata.fs @@ -0,0 +1,216 @@ +module Metadata + +let references_core = [| + "Fable.Core" + "FSharp.Core" + "mscorlib" + "netstandard" + "System.Collections" + "System.Collections.Concurrent" + "System.ComponentModel" + "System.ComponentModel.Primitives" + "System.ComponentModel.TypeConverter" + "System.Console" + "System.Core" + "System.Diagnostics.Debug" + "System.Diagnostics.Tools" + "System.Diagnostics.Tracing" + "System.Globalization" + "System" + "System.IO" + "System.Net.Requests" + "System.Net.WebClient" + "System.Numerics" + "System.Reflection" + "System.Reflection.Extensions" + "System.Reflection.Metadata" + "System.Reflection.Primitives" + "System.Reflection.TypeExtensions" + "System.Runtime" + "System.Runtime.Extensions" + "System.Runtime.Numerics" + "System.Text.Encoding" + "System.Text.Encoding.Extensions" + "System.Text.RegularExpressions" + "System.Threading" + "System.Threading.Tasks" + "System.Threading.Thread" + "System.ValueTuple" + |] + +let references_net45 = [| + "Fable.Core" + "Fable.Import.Browser" + "FSharp.Core" + "mscorlib" + "System" + "System.Core" + "System.Data" + "System.IO" + "System.Xml" + "System.Numerics" + |] + +let references_full = [| + "Fable.Core" + "FSharp.Core" + "mscorlib" + "netstandard" + "Microsoft.CSharp" + "Microsoft.VisualBasic.Core" + "Microsoft.VisualBasic" + "Microsoft.Win32.Primitives" + "Microsoft.Win32.Registry" + "System.AppContext" + "System.Buffers" + "System.Collections.Concurrent" + "System.Collections.Immutable" + "System.Collections.NonGeneric" + "System.Collections.Specialized" + "System.Collections" + "System.ComponentModel.Annotations" + "System.ComponentModel.DataAnnotations" + "System.ComponentModel.EventBasedAsync" + "System.ComponentModel.Primitives" + "System.ComponentModel.TypeConverter" + "System.ComponentModel" + "System.Configuration" + "System.Console" + "System.Core" + "System.Data.Common" + "System.Data.DataSetExtensions" + "System.Data" + "System.Diagnostics.Contracts" + "System.Diagnostics.Debug" + "System.Diagnostics.DiagnosticSource" + "System.Diagnostics.FileVersionInfo" + "System.Diagnostics.Process" + "System.Diagnostics.StackTrace" + "System.Diagnostics.TextWriterTraceListener" + "System.Diagnostics.Tools" + "System.Diagnostics.TraceSource" + "System.Diagnostics.Tracing" + "System.Drawing.Primitives" + "System.Drawing" + "System.Dynamic.Runtime" + "System.Formats.Asn1" + "System.Globalization.Calendars" + "System.Globalization.Extensions" + "System.Globalization" + "System.IO.Compression.Brotli" + "System.IO.Compression.FileSystem" + "System.IO.Compression.ZipFile" + "System.IO.Compression" + "System.IO.FileSystem.AccessControl" + "System.IO.FileSystem.DriveInfo" + "System.IO.FileSystem.Primitives" + "System.IO.FileSystem.Watcher" + "System.IO.FileSystem" + "System.IO.IsolatedStorage" + "System.IO.MemoryMappedFiles" + "System.IO.Pipes.AccessControl" + "System.IO.Pipes" + "System.IO.UnmanagedMemoryStream" + "System.IO" + "System.Linq.Expressions" + "System.Linq.Parallel" + "System.Linq.Queryable" + "System.Linq" + "System.Memory" + "System.Net.Http.Json" + "System.Net.Http" + "System.Net.HttpListener" + "System.Net.Mail" + "System.Net.NameResolution" + "System.Net.NetworkInformation" + "System.Net.Ping" + "System.Net.Primitives" + "System.Net.Requests" + "System.Net.Security" + "System.Net.ServicePoint" + "System.Net.Sockets" + "System.Net.WebClient" + "System.Net.WebHeaderCollection" + "System.Net.WebProxy" + "System.Net.WebSockets.Client" + "System.Net.WebSockets" + "System.Net" + "System.Numerics.Vectors" + "System.Numerics" + "System.ObjectModel" + "System.Reflection.DispatchProxy" + "System.Reflection.Emit.ILGeneration" + "System.Reflection.Emit.Lightweight" + "System.Reflection.Emit" + "System.Reflection.Extensions" + "System.Reflection.Metadata" + "System.Reflection.Primitives" + "System.Reflection.TypeExtensions" + "System.Reflection" + "System.Resources.Reader" + "System.Resources.ResourceManager" + "System.Resources.Writer" + "System.Runtime.CompilerServices.Unsafe" + "System.Runtime.CompilerServices.VisualC" + "System.Runtime.Extensions" + "System.Runtime.Handles" + "System.Runtime.InteropServices.RuntimeInformation" + "System.Runtime.InteropServices" + "System.Runtime.Intrinsics" + "System.Runtime.Loader" + "System.Runtime.Numerics" + "System.Runtime.Serialization.Formatters" + "System.Runtime.Serialization.Json" + "System.Runtime.Serialization.Primitives" + "System.Runtime.Serialization.Xml" + "System.Runtime.Serialization" + "System.Runtime" + "System.Security.AccessControl" + "System.Security.Claims" + "System.Security.Cryptography.Algorithms" + "System.Security.Cryptography.Cng" + "System.Security.Cryptography.Csp" + "System.Security.Cryptography.Encoding" + "System.Security.Cryptography.OpenSsl" + "System.Security.Cryptography.Primitives" + "System.Security.Cryptography.X509Certificates" + "System.Security.Principal.Windows" + "System.Security.Principal" + "System.Security.SecureString" + "System.Security" + "System.ServiceModel.Web" + "System.ServiceProcess" + "System.Text.Encoding.CodePages" + "System.Text.Encoding.Extensions" + "System.Text.Encoding" + "System.Text.Encodings.Web" + "System.Text.Json" + "System.Text.RegularExpressions" + "System.Threading.Channels" + "System.Threading.Overlapped" + "System.Threading.Tasks.Dataflow" + "System.Threading.Tasks.Extensions" + "System.Threading.Tasks.Parallel" + "System.Threading.Tasks" + "System.Threading.Thread" + "System.Threading.ThreadPool" + "System.Threading.Timer" + "System.Threading" + "System.Transactions.Local" + "System.Transactions" + "System.ValueTuple" + "System.Web.HttpUtility" + "System.Web" + "System.Windows" + "System.Xml.Linq" + "System.Xml.ReaderWriter" + "System.Xml.Serialization" + "System.Xml.XDocument" + "System.Xml.XPath.XDocument" + "System.Xml.XPath" + "System.Xml.XmlDocument" + "System.Xml.XmlSerializer" + "System.Xml" + "System" + "WindowsBase" + |] diff --git a/fcs/fcs-fable/test/Platform.fs b/fcs/fcs-fable/test/Platform.fs new file mode 100644 index 00000000000..b4efa099d69 --- /dev/null +++ b/fcs/fcs-fable/test/Platform.fs @@ -0,0 +1,105 @@ +module Fable.Compiler.Platform + +#if DOTNET_FILE_SYSTEM && !FABLE_COMPILER + +open System.IO + +let readAllBytes (filePath: string) = File.ReadAllBytes(filePath) +let readAllText (filePath: string) = File.ReadAllText(filePath, System.Text.Encoding.UTF8) +let writeAllText (filePath: string) (text: string) = File.WriteAllText(filePath, text) + +let measureTime (f: 'a -> 'b) x = + let sw = System.Diagnostics.Stopwatch.StartNew() + let res = f x + sw.Stop() + sw.ElapsedMilliseconds, res + +let normalizeFullPath (path: string) = + let path = if System.String.IsNullOrWhiteSpace path then "." else path + Path.GetFullPath(path).Replace('\\', '/') + +let getRelativePath (path: string) (pathTo: string) = + let path = if System.String.IsNullOrWhiteSpace path then "." else path + Path.GetRelativePath(path, pathTo).Replace('\\', '/') + +let getHomePath () = + System.Environment.GetFolderPath(System.Environment.SpecialFolder.UserProfile) + +#else + +open Fable.Core.JsInterop + +module JS = + type IFileSystem = + abstract readFileSync: string -> byte[] + abstract readFileSync: string * string -> string + abstract writeFileSync: string * string -> unit + + type IProcess = + abstract hrtime: unit -> float [] + abstract hrtime: float[] -> float[] + + type IPath = + abstract resolve: string -> string + abstract relative: string * string -> string + + type IOperSystem = + abstract homedir: unit -> string + abstract tmpdir: unit -> string + abstract platform: unit -> string + abstract arch: unit -> string + + let fs: IFileSystem = importAll "fs" + let os: IOperSystem = importAll "os" + let proc: IProcess = importAll "process" + let path: IPath = importAll "path" + +let readAllBytes (filePath: string) = JS.fs.readFileSync(filePath) +let readAllText (filePath: string) = JS.fs.readFileSync(filePath, "utf8").TrimStart('\uFEFF') +let writeAllText (filePath: string) (text: string) = JS.fs.writeFileSync(filePath, text) + +let measureTime (f: 'a -> 'b) x = + let startTime = JS.proc.hrtime() + let res = f x + let elapsed = JS.proc.hrtime(startTime) + int64 (elapsed.[0] * 1e3 + elapsed.[1] / 1e6), res + +let normalizeFullPath (path: string) = + JS.path.resolve(path).Replace('\\', '/') + +let getRelativePath (path: string) (pathTo: string) = + JS.path.relative(path, pathTo).Replace('\\', '/') + +let getHomePath () = + JS.os.homedir() + +#endif + +module Path = + + let Combine (path1: string, path2: string) = + let path1 = + if path1.Length = 0 then path1 + else (path1.TrimEnd [|'\\';'/'|]) + "/" + path1 + (path2.TrimStart [|'\\';'/'|]) + + let ChangeExtension (path: string, ext: string) = + let i = path.LastIndexOf(".") + if i < 0 then path + else path.Substring(0, i) + ext + + let GetFileName (path: string) = + let normPath = path.Replace("\\", "/").TrimEnd('/') + let i = normPath.LastIndexOf("/") + normPath.Substring(i + 1) + + let GetFileNameWithoutExtension (path: string) = + let path = GetFileName path + let i = path.LastIndexOf(".") + path.Substring(0, i) + + let GetDirectoryName (path: string) = + let normPath = path.Replace("\\", "/") + let i = normPath.LastIndexOf("/") + if i < 0 then "" + else normPath.Substring(0, i) diff --git a/fcs/fcs-fable/test/ProjectParser.fs b/fcs/fcs-fable/test/ProjectParser.fs new file mode 100644 index 00000000000..991e68c5af5 --- /dev/null +++ b/fcs/fcs-fable/test/ProjectParser.fs @@ -0,0 +1,255 @@ +module Fable.Compiler.ProjectParser + +open Fable.Compiler.Platform +open System.Collections.Generic +open System.Text.RegularExpressions + +type ReferenceType = + | ProjectReference of string + | PackageReference of string * string + +let (|Regex|_|) (pattern: string) (input: string) = + let m = Regex.Match(input, pattern) + if m.Success then Some [for x in m.Groups -> x.Value] + else None + +let getXmlWithoutComments xml = + Regex.Replace(xml, @"", "") + +let getXmlTagContents tag xml = + let pattern = sprintf @"<%s[^>]*>([^<]*)<\/%s[^>]*>" tag tag + Regex.Matches(xml, pattern) + |> Seq.map (fun m -> m.Groups.[1].Value.Trim()) + +let getXmlTagContentsFirstOrDefault tag defaultValue xml = + defaultArg (getXmlTagContents tag xml |> Seq.tryHead) defaultValue + +let getXmlTagAttributes1 tag attr1 xml = + let pattern = sprintf """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)""" tag attr1 + Regex.Matches(xml, pattern) + |> Seq.map (fun m -> m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim()) + +let getXmlTagAttributes2 tag attr1 attr2 xml = + let pattern = sprintf """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)[^>]*%s\s*=\s*("[^"]*|'[^']*)""" tag attr1 attr2 + Regex.Matches(xml, pattern) + |> Seq.map (fun m -> + m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim(), + m.Groups.[2].Value.TrimStart('"').TrimStart(''').Trim()) + +let isSystemPackage (pkgName: string) = + pkgName.StartsWith("System.") + || pkgName.StartsWith("Microsoft.") + || pkgName.StartsWith("runtime.") + || pkgName = "NETStandard.Library" + || pkgName = "FSharp.Core" + || pkgName = "Fable.Core" + +let parsePackageSpec nuspecPath = + // get package spec xml + let packageXml = readAllText nuspecPath + // get package dependencies + let references = + packageXml + |> getXmlWithoutComments + |> getXmlTagAttributes2 "dependency" "id" "version" + |> Seq.map PackageReference + |> Seq.toArray + references + +// let resolvePackage (pkgName, pkgVersion) = +// if not (isSystemPackage pkgName) then +// let homePath = getHomePath().Replace('\\', '/') +// let nugetPath = sprintf ".nuget/packages/%s/%s" pkgName pkgVersion +// let pkgPath = Path.Combine(homePath, nugetPath.ToLowerInvariant()) +// let libPath = Path.Combine(pkgPath, "lib") +// let fablePath = Path.Combine(pkgPath, "fable") +// let binaryPaths = getDirFiles libPath ".dll" +// let nuspecPaths = getDirFiles pkgPath ".nuspec" +// let fsprojPaths = getDirFiles fablePath ".fsproj" +// if Array.isEmpty nuspecPaths then +// printfn "ERROR: Cannot find package %s" pkgPath +// let binaryOpt = binaryPaths |> Array.tryLast +// let dependOpt = nuspecPaths |> Array.tryLast |> Option.map parsePackageSpec +// let fsprojOpt = fsprojPaths |> Array.tryLast |> Option.map ProjectReference +// let pkgRefs, dllPaths = +// match binaryOpt, dependOpt, fsprojOpt with +// | _, _, Some projRef -> +// [| projRef |], [||] +// | Some dllRef, Some dependencies, _ -> +// dependencies, [| dllRef |] +// | _, _, _ -> [||], [||] +// pkgRefs, dllPaths +// else [||], [||] + +let parseCompilerOptions projectXml = + // get project settings, + let target = projectXml |> getXmlTagContentsFirstOrDefault "OutputType" "" + let langVersion = projectXml |> getXmlTagContentsFirstOrDefault "LangVersion" "" + let warnLevel = projectXml |> getXmlTagContentsFirstOrDefault "WarningLevel" "" + let treatWarningsAsErrors = projectXml |> getXmlTagContentsFirstOrDefault "TreatWarningsAsErrors" "" + + // get conditional defines + let defines = + projectXml + |> getXmlTagContents "DefineConstants" + |> Seq.collect (fun s -> s.Split(';')) + |> Seq.append ["FABLE_COMPILER"; "FABLE_COMPILER_JS"] + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(DefineConstants)"; ""] + |> Seq.toArray + + // get disabled warnings + let nowarns = + projectXml + |> getXmlTagContents "NoWarn" + |> Seq.collect (fun s -> s.Split(';')) + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(NoWarn)"; ""] + |> Seq.toArray + + // get warnings as errors + let warnAsErrors = + projectXml + |> getXmlTagContents "WarningsAsErrors" + |> Seq.collect (fun s -> s.Split(';')) + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(WarningsAsErrors)"; ""] + |> Seq.toArray + + // get other flags + let otherFlags = + projectXml + |> getXmlTagContents "OtherFlags" + |> Seq.collect (fun s -> s.Split(' ')) + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(OtherFlags)"; ""] + |> Seq.toArray + + let otherOptions = [| + if target.Length > 0 then + yield "--target:" + target + if langVersion.Length > 0 then + yield "--langversion:" + langVersion + if warnLevel.Length > 0 then + yield "--warn:" + warnLevel + if treatWarningsAsErrors = "true" then + yield "--warnaserror+" + for d in defines do yield "-d:" + d + for n in nowarns do yield "--nowarn:" + n + for e in warnAsErrors do yield "--warnaserror:" + e + for o in otherFlags do yield o + |] + otherOptions + +let makeFullPath projectFileDir (path: string) = + let path = path.Replace('\\', '/') + let isAbsolutePath (path: string) = + path.StartsWith('/') || path.IndexOf(':') = 1 + if isAbsolutePath path then path + else Path.Combine(projectFileDir, path) + |> normalizeFullPath + +let parseProjectScript projectFilePath = + let projectXml = readAllText projectFilePath + let projectDir = Path.GetDirectoryName projectFilePath + let dllRefs, srcFiles = + (([||], [||]), projectXml.Split('\n')) + ||> Array.fold (fun (dllRefs, srcFiles) line -> + match line.Trim() with + | Regex @"^#r\s+""(.*?)""$" [_;path] + when not(path.EndsWith("Fable.Core.dll")) -> + Array.append [| Path.Combine(projectDir, path) |] dllRefs, srcFiles + | Regex @"^#load\s+""(.*?)""$" [_;path] -> + dllRefs, Array.append [| Path.Combine(projectDir, path) |] srcFiles + | _ -> dllRefs, srcFiles) + let projectRefs = [||] + let sourceFiles = Array.append srcFiles [| Path.GetFileName projectFilePath |] + let otherOptions = [| "--define:FABLE_COMPILER"; "--define:FABLE_COMPILER_JS" |] + (projectRefs, dllRefs, sourceFiles, otherOptions) + +let parseProjectFile projectFilePath = + // get project xml without any comments + let projectXml = readAllText projectFilePath |> getXmlWithoutComments + let projectDir = Path.GetDirectoryName projectFilePath + + // get package references + let packageRefs = + projectXml + |> getXmlTagAttributes2 "PackageReference" "Include" "Version" + |> Seq.map PackageReference + |> Seq.toArray + + // get project references + let projectRefs = + projectXml + |> getXmlTagAttributes1 "ProjectReference" "Include" + |> Seq.map (makeFullPath projectDir >> ProjectReference) + |> Seq.toArray + + // replace some variables + let projectXml = projectXml.Replace("$(MSBuildProjectDirectory)", ".") + let sourceRoot = projectXml |> getXmlTagContentsFirstOrDefault "FSharpSourcesRoot" "" + let projectXml = projectXml.Replace("$(FSharpSourcesRoot)", sourceRoot.Replace('\\', '/')) + let yaccOutput = projectXml |> getXmlTagContentsFirstOrDefault "FsYaccOutputFolder" "" + let projectXml = projectXml.Replace("$(FsYaccOutputFolder)", yaccOutput.Replace('\\', '/')) + + // get source files + let sourceFiles = + projectXml + |> getXmlTagAttributes1 "Compile" "Include" + |> Seq.map (makeFullPath projectDir) + // |> Seq.collect getGlobFiles + |> Seq.toArray + + let dllRefs = [||] + let projectRefs = Array.append projectRefs packageRefs + let otherOptions = parseCompilerOptions projectXml + (projectRefs, dllRefs, sourceFiles, otherOptions) + +let makeHashSetIgnoreCase () = + let equalityComparerIgnoreCase = + { new IEqualityComparer with + member __.Equals(x, y) = x.ToLowerInvariant() = y.ToLowerInvariant() + member __.GetHashCode(x) = hash (x.ToLowerInvariant()) } + HashSet(equalityComparerIgnoreCase) + +let dedupReferences (refSet: HashSet) references = + let refName = function + | ProjectReference path -> path + | PackageReference (pkgName, pkgVersion) -> pkgName + "," + pkgVersion + let newRefs = references |> Array.filter (refName >> refSet.Contains >> not) + refSet.UnionWith(newRefs |> Array.map refName) + newRefs + +let parseProject projectFilePath = + + let rec parseProject (refSet: HashSet) (projectRef: ReferenceType) = + let projectRefs, dllPaths, sourcePaths, otherOptions = + match projectRef with + | ProjectReference path -> + if path.EndsWith(".fsx") + then parseProjectScript path + else parseProjectFile path + | PackageReference (pkgName, pkgVersion) -> + // let pkgRefs, dllPaths = resolvePackage (pkgName, pkgVersion) + // pkgRefs, dllPaths, [||], [||] + [||], [||], [||], [||] + + // parse and combine all referenced projects into one big project + let parseResult = projectRefs |> dedupReferences refSet |> Array.map (parseProject refSet) + let dllPaths = dllPaths |> Array.append (parseResult |> Array.collect (fun (x,_,_) -> x)) + let sourcePaths = sourcePaths |> Array.append (parseResult |> Array.collect (fun (_,x,_) -> x)) + let otherOptions = otherOptions |> Array.append (parseResult |> Array.collect (fun (_,_,x) -> x)) + + (dllPaths, sourcePaths, otherOptions) + + let refSet = makeHashSetIgnoreCase () + let projectRef = ProjectReference projectFilePath + let dllPaths, sourcePaths, otherOptions = parseProject refSet projectRef + (dllPaths |> Array.distinct, + sourcePaths |> Array.distinct, + otherOptions |> Array.distinct) diff --git a/fcs/fcs-fable/test/bench/bench.fs b/fcs/fcs-fable/test/bench/bench.fs new file mode 100644 index 00000000000..3c21093f434 --- /dev/null +++ b/fcs/fcs-fable/test/bench/bench.fs @@ -0,0 +1,108 @@ +module Fable.Compiler.App + +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.SourceCodeServices +open Fable.Compiler.Platform +open Fable.Compiler.ProjectParser + +let references = Metadata.references_core +let metadataPath = __SOURCE_DIRECTORY__ + "/../../../../../Fable/src/fable-metadata/lib/" // .NET BCL binaries + +let printErrors showWarnings (errors: FSharpDiagnostic[]) = + let isWarning (e: FSharpDiagnostic) = + e.Severity = FSharpDiagnosticSeverity.Warning + let printError (e: FSharpDiagnostic) = + let errorType = (if isWarning e then "Warning" else "Error") + printfn "%s (%d,%d): %s: %s" e.FileName e.StartLine e.StartColumn errorType e.Message + let warnings, errors = errors |> Array.partition isWarning + let hasErrors = not (Array.isEmpty errors) + if showWarnings then + warnings |> Array.iter printError + if hasErrors then + errors |> Array.iter printError + failwith "Too many errors." + +let parseFiles projectFileName outDir optimize = + // parse project + let (dllRefs, fileNames, otherOptions) = parseProject projectFileName + let sources = fileNames |> Array.map readAllText + + // create checker + let readAllBytes dllName = readAllBytes (metadataPath + dllName) + let optimizeFlag = "--optimize" + (if optimize then "+" else "-") + let otherOptions = otherOptions |> Array.append [| optimizeFlag |] + let createChecker () = InteractiveChecker.Create(references, readAllBytes, otherOptions) + let ms0, checker = measureTime createChecker () + printfn "--------------------------------------------" + printfn "InteractiveChecker created in %d ms" ms0 + + // parse F# files to AST + let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + let ms1, projectResults = measureTime parseFSharpProject () + printfn "Project: %s, FCS time: %d ms" projectFileName ms1 + printfn "--------------------------------------------" + let showWarnings = false // supress warnings for clarity + projectResults.Diagnostics |> printErrors showWarnings + + // // modify last file + // sources.[sources.Length - 1] <- sources.[sources.Length - 1] + "\n" + // let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + // let ms1, projectResults = measureTime parseFSharpProject () + // printfn "Project: %s, FCS time: %d ms (modified last file)" projectFileName ms1 + + // // modify middle file + // sources.[sources.Length / 2] <- sources.[sources.Length / 2] + "\n" + // let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + // let ms1, projectResults = measureTime parseFSharpProject () + // printfn "Project: %s, FCS time: %d ms (modified middle file)" projectFileName ms1 + + // // modify first file + // sources.[0] <- sources.[0] + "\n" + // let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + // let ms1, projectResults = measureTime parseFSharpProject () + // printfn "Project: %s, FCS time: %d ms (modified first file)" projectFileName ms1 + + // // clear cache + // checker.ClearCache() + + // // after clear cache + // sources.[0] <- sources.[0] + "\n" + // let parseFSharpProject () = checker.ParseAndCheckProject(projectFileName, fileNames, sources) + // let ms1, projectResults = measureTime parseFSharpProject () + // printfn "Project: %s, FCS time: %d ms (after clear cache)" projectFileName ms1 + + // exclude signature files + let fileNames = fileNames |> Array.filter (fun x -> not (x.EndsWith(".fsi"))) + + // this is memory intensive, only do it once + let implFiles = if optimize + then projectResults.GetOptimizedAssemblyContents().ImplementationFiles + else projectResults.AssemblyContents.ImplementationFiles + + let fileCount = Seq.length implFiles + printfn "Typechecked %d files" fileCount + // // for each file + // for implFile in implFiles do + // printfn "%s" implFile.FileName + + // // printfn "--------------------------------------------" + // // let fsAst = implFile.Declarations |> AstPrint.printFSharpDecls "" |> String.concat "\n" + // // printfn "%s" fsAst + +let parseArguments (argv: string[]) = + let usage = "Usage: bench [--options]" + let opts, args = argv |> Array.partition (fun s -> s.StartsWith("--")) + match args with + | [| projectFileName |] -> + let outDir = "./out-test" + let optimize = opts |> Array.contains "--optimize" + parseFiles projectFileName outDir optimize + | _ -> printfn "%s" usage + +[] +let main argv = + try + parseArguments argv + with ex -> + printfn "Error: %A" ex.Message + 0 diff --git a/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj new file mode 100644 index 00000000000..cc0b691e21a --- /dev/null +++ b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj @@ -0,0 +1,27 @@ + + + + Exe + net6.0 + $(DefineConstants);DOTNET_FILE_SYSTEM + + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/test/fcs-fable-test.fsproj b/fcs/fcs-fable/test/fcs-fable-test.fsproj new file mode 100644 index 00000000000..b2d6d836fbc --- /dev/null +++ b/fcs/fcs-fable/test/fcs-fable-test.fsproj @@ -0,0 +1,26 @@ + + + + Exe + net6.0 + $(DefineConstants);DOTNET_FILE_SYSTEM + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/test/package.json b/fcs/fcs-fable/test/package.json new file mode 100644 index 00000000000..ab5e66d407d --- /dev/null +++ b/fcs/fcs-fable/test/package.json @@ -0,0 +1,15 @@ +{ + "private": true, + "type": "module", + "scripts": { + "build-test": "dotnet build -c Release", + "build-bench": "dotnet build -c Release bench", + "build-node": "fable fcs-fable-test.fsproj out-test", + "test": "dotnet run -c Release", + "test-node": "node out-test/test", + "bench": "dotnet run -c Release --project bench ../fcs-fable.fsproj" + }, + "devDependencies": { + "fable-compiler-js": "^3.0.0" + } +} diff --git a/fcs/fcs-fable/test/test.fs b/fcs/fcs-fable/test/test.fs new file mode 100644 index 00000000000..d2405c6958b --- /dev/null +++ b/fcs/fcs-fable/test/test.fs @@ -0,0 +1,61 @@ +module Fable.Compiler.App + +open FSharp.Compiler +open FSharp.Compiler.EditorServices +open FSharp.Compiler.SourceCodeServices +open Fable.Compiler.Platform + +// let references = Metadata.references_full +// let metadataPath = "../../../../temp/metadata/" // .NET BCL binaries +let references = Metadata.references_core +let metadataPath = __SOURCE_DIRECTORY__ + "/../../../../Fable/src/fable-metadata/lib/" // .NET BCL binaries + +[] +let main _argv = + printfn "Parsing begins..." + + let defines = [||] + let optimize = false + let readAllBytes dllName = readAllBytes (metadataPath + dllName) + let checker = InteractiveChecker.Create(references, readAllBytes, defines, optimize) + + let projectFileName = "project" + let fileName = __SOURCE_DIRECTORY__ + "/test_script.fsx" + let source = readAllText fileName + + let parseResults, typeCheckResults, projectResults = + checker.ParseAndCheckFileInProject(fileName, projectFileName, [|fileName|], [|source|]) + + // print errors + projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + + printfn "Typed AST (optimize=%A):" optimize + // let implFiles = typeCheckResults.ImplementationFile |> Option.toArray + let implFiles = + let assemblyContents = + if not optimize then projectResults.AssemblyContents + else projectResults.GetOptimizedAssemblyContents() + assemblyContents.ImplementationFiles + let decls = implFiles + |> Seq.collect (fun file -> AstPrint.printFSharpDecls "" file.Declarations) + |> String.concat "\n" + decls |> printfn "%s" + // writeAllText (fileName + ".ast.txt") decls + + let inputLines = source.Split('\n') + + // Get tool tip at the specified location + let tip = typeCheckResults.GetToolTip(4, 7, inputLines.[3], ["foo"], Tokenization.FSharpTokenTag.IDENT) + (sprintf "%A" tip).Replace("\n","") |> printfn "\n---> ToolTip Text = %A" // should be "FSharpToolTipText [...]" + + // Get declarations (autocomplete) for msg + let partialName = { QualifyingIdents = []; PartialIdent = "msg"; EndColumn = 17; LastDotPos = None } + let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 6, inputLines.[5], partialName, (fun _ -> [])) + [ for item in decls.Items -> item.NameInList ] |> printfn "\n---> msg AutoComplete = %A" // should be string methods + + // Get declarations (autocomplete) for canvas + let partialName = { QualifyingIdents = []; PartialIdent = "canvas"; EndColumn = 10; LastDotPos = None } + let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 8, inputLines.[7], partialName, (fun _ -> [])) + [ for item in decls.Items -> item.NameInList ] |> printfn "\n---> canvas AutoComplete = %A" + + 0 diff --git a/fcs/fcs-fable/test/test_script.fsx b/fcs/fcs-fable/test/test_script.fsx new file mode 100644 index 00000000000..6474447f926 --- /dev/null +++ b/fcs/fcs-fable/test/test_script.fsx @@ -0,0 +1,9 @@ +open System +//open Fable.Import + +let foo() = + let msg = String.Concat("Hello"," ","world") + let len = msg.Length + // let canvas = Browser.document.createElement_canvas () + // canvas.width <- 1000. + () \ No newline at end of file diff --git a/global.json b/global.json index 8c6f61284da..7a6e25f1be4 100644 --- a/global.json +++ b/global.json @@ -1,11 +1,11 @@ { "sdk": { - "version": "7.0.100-rc.2.22477.23", + "version": "7.0.100", "allowPrerelease": true, "rollForward": "latestPatch" }, "tools": { - "dotnet": "7.0.100-rc.2.22477.23", + "dotnet": "7.0.100", "vs": { "version": "17.2", "components": [ diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index e0a5bb576aa..5fb7ee16c74 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 @@ -496,6 +498,7 @@ type ILAssemblyRef(data) = assemRefLocale = locale } +#if !FABLE_COMPILER static member FromAssemblyName(aname: AssemblyName) = let locale = None @@ -518,6 +521,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) @@ -2795,7 +2799,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() |] @@ -2841,8 +2849,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 = @@ -2902,7 +2915,11 @@ type ILResourceAccess = [] type ILResourceLocation = +#if FABLE_COMPILER + | Local of ByteMemory +#else | Local of ByteStorage +#endif | File of ILModuleRef * int32 | Assembly of ILAssemblyRef @@ -2918,7 +2935,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 @@ -3149,7 +3170,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 @@ -4662,6 +4687,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 @@ -4672,6 +4702,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 @@ -4988,7 +5019,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 @@ -5160,7 +5195,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) @@ -5531,11 +5570,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 3ea66ef5bf2..3cce5dcdcfb 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 @@ -1623,7 +1625,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 aad77eb806f..50cb2ef72fd 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 06c50483a2e..af30435da35 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) @@ -148,6 +159,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. @@ -185,6 +198,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[]) = @@ -195,6 +210,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. @@ -260,6 +277,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 @@ -1215,13 +1234,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 + +[] +type CustomAttributeRow = + val mutable parentIndex: TaggedIndex + val mutable typeIndex: TaggedIndex + val mutable valueIndex: int -let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = - let mutable row = Unchecked.defaultof<'RowT> +let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowReader) = + let mutable row = ref Unchecked.defaultof let mutable startRid = -1 let mutable endRid = -1 @@ -1237,8 +1262,8 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead fin <- true else let mid = (low + high) / 2 - reader.GetRow(mid, &row) - let c = reader.CompareKey(reader.GetKey(&row)) + reader.GetRow(mid, row) + let c = reader.CompareKey(reader.GetKey(row)) if c > 0 then low <- mid elif c < 0 then high <- mid @@ -1258,9 +1283,9 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead if curr = 0 then fin <- true else - reader.GetRow(curr, &row) + reader.GetRow(curr, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then + if reader.CompareKey(reader.GetKey(row)) = 0 then startRid <- curr else fin <- true @@ -1275,9 +1300,9 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead if curr > numRows then fin <- true else - reader.GetRow(curr, &row) + reader.GetRow(curr, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then + if reader.CompareKey(reader.GetKey(row)) = 0 then endRid <- curr else fin <- true @@ -1288,9 +1313,9 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead let mutable rid = 1 while rid <= numRows && startRid = -1 do - reader.GetRow(rid, &row) + reader.GetRow(rid, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then + if reader.CompareKey(reader.GetKey(row)) = 0 then startRid <- rid endRid <- rid @@ -1299,9 +1324,9 @@ let seekReadIndexedRowsRange numRows binaryChop (reader: ISeekReadIndexedRowRead let mutable fin = false while rid <= numRows && not fin do - reader.GetRow(rid, &row) + reader.GetRow(rid, row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then + if reader.CompareKey(reader.GetKey(row)) = 0 then endRid <- rid else fin <- true @@ -1314,114 +1339,110 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR if startRid <= 0 || endRid < startRid then [||] else - Array.init (endRid - startRid + 1) (fun i -> let mutable row = Unchecked.defaultof<'RowT> - reader.GetRow(startRid + i, &row) - reader.ConvertRow(&row)) + reader.GetRow(startRid + i, row) + reader.ConvertRow(row)) -[] -type CustomAttributeRow = - val mutable parentIndex: TaggedIndex - val mutable typeIndex: TaggedIndex - val mutable valueIndex: int +let inline rowAddr (ctxt: ILMetadataReader) (tn: TableName) (idx: int) = + ref (ctxt.rowAddr tn idx) -let seekReadUInt16Adv mdv (addr: byref) = - let res = seekReadUInt16 mdv addr - addr <- addr + 2 +let seekReadUInt16Adv mdv (addr: ref) = + let res = seekReadUInt16 mdv addr.Value + addr.Value <- addr.Value + 2 res -let seekReadInt32Adv mdv (addr: byref) = - let res = seekReadInt32 mdv addr - addr <- addr + 4 +let seekReadInt32Adv mdv (addr: ref) = + let res = seekReadInt32 mdv addr.Value + addr.Value <- addr.Value + 4 res -let seekReadUInt16AsInt32Adv mdv (addr: byref) = - let res = seekReadUInt16AsInt32 mdv addr - addr <- addr + 2 +let seekReadUInt16AsInt32Adv mdv (addr: ref) = + let res = seekReadUInt16AsInt32 mdv addr.Value + addr.Value <- addr.Value + 2 res -let inline seekReadTaggedIdx f nbits big mdv (addr: byref) = +let inline seekReadTaggedIdx f nbits big mdv (addr: ref) = let tok = if big then - seekReadInt32Adv mdv &addr + seekReadInt32Adv mdv addr else - seekReadUInt16AsInt32Adv mdv &addr + seekReadUInt16AsInt32Adv mdv addr tokToTaggedIdx f nbits tok -let seekReadIdx big mdv (addr: byref) = +let seekReadIdx big mdv (addr: ref) = if big then - seekReadInt32Adv mdv &addr + seekReadInt32Adv mdv addr else - seekReadUInt16AsInt32Adv mdv &addr + seekReadUInt16AsInt32Adv mdv addr -let seekReadUntaggedIdx (tab: TableName) (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadIdx ctxt.tableBigness[tab.Index] mdv &addr +let seekReadUntaggedIdx (tab: TableName) (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadIdx ctxt.tableBigness[tab.Index] mdv addr -let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv &addr +let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv addr -let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv &addr +let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv addr -let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv &addr +let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv addr -let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv &addr +let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv addr -let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv &addr +let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv addr -let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv &addr +let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv addr -let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv &addr +let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv addr -let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv &addr +let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv addr -let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv &addr +let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv addr -let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv &addr +let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv addr -let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv &addr +let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv addr -let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv &addr +let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv addr -let seekReadCustomAttributeTypeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadTaggedIdx mkILCustomAttributeTypeTag 3 ctxt.catBigness mdv &addr +let seekReadCustomAttributeTypeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadTaggedIdx mkILCustomAttributeTypeTag 3 ctxt.catBigness mdv addr -let seekReadStringIdx (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadIdx ctxt.stringsBigness mdv &addr +let seekReadStringIdx (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadIdx ctxt.stringsBigness mdv addr -let seekReadGuidIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadIdx ctxt.guidsBigness mdv &addr -let seekReadBlobIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadIdx ctxt.blobsBigness mdv &addr +let seekReadGuidIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadIdx ctxt.guidsBigness mdv addr +let seekReadBlobIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadIdx ctxt.blobsBigness mdv addr let seekReadModuleRow (ctxt: ILMetadataReader) mdv idx = if idx = 0 then failwith "cannot read Module table row 0" - let mutable addr = ctxt.rowAddr TableNames.Module idx - let generation = seekReadUInt16Adv mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let mvidIdx = seekReadGuidIdx ctxt mdv &addr - let encidIdx = seekReadGuidIdx ctxt mdv &addr - let encbaseidIdx = seekReadGuidIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.Module idx + let generation = seekReadUInt16Adv mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let mvidIdx = seekReadGuidIdx ctxt mdv addr + let encidIdx = seekReadGuidIdx ctxt mdv addr + let encbaseidIdx = seekReadGuidIdx ctxt mdv addr (generation, nameIdx, mvidIdx, encidIdx, encbaseidIdx) /// Read Table ILTypeRef. let seekReadTypeRefRow (ctxt: ILMetadataReader) mdv idx = - let mutable addr = ctxt.rowAddr TableNames.TypeRef idx - let scopeIdx = seekReadResolutionScopeIdx ctxt mdv &addr - let nameIdx = seekReadStringIdx ctxt mdv &addr - let namespaceIdx = seekReadStringIdx ctxt mdv &addr + let mutable addr = rowAddr ctxt TableNames.TypeRef idx + let scopeIdx = seekReadResolutionScopeIdx ctxt mdv addr + let nameIdx = seekReadStringIdx ctxt mdv addr + let namespaceIdx = seekReadStringIdx ctxt mdv addr (scopeIdx, nameIdx, namespaceIdx) /// Read Table ILTypeDef. @@ -1430,55 +1451,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. @@ -1487,83 +1508,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. @@ -1572,101 +1595,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. @@ -1675,32 +1698,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 = @@ -1797,6 +1820,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 = @@ -1806,7 +1830,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 = @@ -2971,15 +2996,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 @@ -2996,8 +3021,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))) @@ -3212,14 +3237,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) @@ -3991,7 +4016,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) @@ -4908,6 +4938,8 @@ type ILModuleReaderImpl(ilModule: ILModuleDef, ilAssemblyRefs: Lazy BinaryFile +#endif //!FABLE_COMPILER + let OpenILModuleReaderFromBytes fileName assemblyContents options = let pefile = ByteFile(fileName, assemblyContents) :> BinaryFile @@ -4981,6 +5015,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) @@ -5142,3 +5178,5 @@ module Shim = OpenILModuleReader fileName readerOptions let mutable AssemblyReader = DefaultAssemblyReader() :> IAssemblyReader + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/AbstractIL/ilread.fsi b/src/Compiler/AbstractIL/ilread.fsi index f2b86266063..6332e6af451 100644 --- a/src/Compiler/AbstractIL/ilread.fsi +++ b/src/Compiler/AbstractIL/ilread.fsi @@ -68,7 +68,7 @@ type public ILModuleReader = // ILModuleReader objects only need to be explicitly disposed if memory mapping is used, i.e. reduceMemoryUsage = false inherit System.IDisposable - +#if !FABLE_COMPILER /// Open a binary reader, except first copy the entire contents of the binary into /// memory, close the file and ensure any subsequent reads happen from the in-memory store. /// PDB files may not be read with this option. @@ -76,15 +76,18 @@ type public ILModuleReader = val internal OpenILModuleReader: string -> ILReaderOptions -> ILModuleReader val internal ClearAllILModuleReaderCache : unit -> unit +#endif //!FABLE_COMPILER /// Open a binary reader based on the given bytes. /// This binary reader is not internally cached. val internal OpenILModuleReaderFromBytes: fileName:string -> assemblyContents: byte[] -> options: ILReaderOptions -> ILModuleReader +#if !FABLE_COMPILER /// Open a binary reader based on the given stream. /// This binary reader is not internally cached. /// The binary reader will own the given stream and the stream will be disposed when there are no references to the binary reader. val internal OpenILModuleReaderFromStream: fileName:string -> peStream: Stream -> options: ILReaderOptions -> ILModuleReader +#endif //!FABLE_COMPILER type internal Statistics = { mutable rawMemoryFileCount : int @@ -95,6 +98,8 @@ type internal Statistics = val internal GetStatistics : unit -> Statistics +#if !FABLE_COMPILER + /// The public API hook for changing the IL assembly reader, used by Resharper [] module public Shim = @@ -103,3 +108,5 @@ module public Shim = abstract GetILModuleReader: fileName: string * readerOptions: ILReaderOptions -> ILModuleReader val mutable AssemblyReader: IAssemblyReader + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index de1aadfc803..41cc5372e6c 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 751e71bff5c..28cd13def3f 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 1536277c506..e11d4be6ca7 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 a70827d8fec..803a51b36f5 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 6f2bcb62f80..0fe38c80dad --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -2121,8 +2121,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 80c7e52e7bf..b7e74e08d2b 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 = condition "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 a5dad6c8907..72af44c18a8 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -211,9 +211,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) @@ -1262,6 +1266,7 @@ let AddSignatureRemapInfo _msg (rpi, mhi) eenv = sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: eenv.sigToImplRemapInfo } +#if !FABLE_COMPILER let OutputStorage (pps: TextWriter) s = match s with | StaticPropertyWithField _ -> pps.Write "(top)" @@ -1271,6 +1276,7 @@ let OutputStorage (pps: TextWriter) s = | Arg _ -> pps.Write "(arg)" | Env _ -> pps.Write "(env)" | Null -> pps.Write "(null)" +#endif //-------------------------------------------------------------------------- // Augment eenv with values @@ -1321,7 +1327,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 = @@ -1350,9 +1360,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 @@ -1859,7 +1873,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 = @@ -2681,7 +2699,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 @@ -11730,6 +11752,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 = @@ -11838,6 +11862,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) = @@ -11914,6 +11940,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 @@ -11924,3 +11951,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 d68463e9ca7..30cdab9d26e 100644 --- a/src/Compiler/CodeGen/IlxGen.fsi +++ b/src/Compiler/CodeGen/IlxGen.fsi @@ -104,6 +104,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 @@ -112,6 +113,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 91a2e9fde3d..a1274bea0df 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -7,14 +7,18 @@ open System open System.Collections.Concurrent 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 @@ -55,6 +59,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 () = @@ -85,6 +97,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 ... @@ -156,6 +170,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 -> @@ -173,6 +191,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. @@ -224,9 +243,11 @@ type TimeStampCache(defaultTimeStamp: DateTime) = v else let v = +#if !FABLE_COMPILER try FileSystem.GetLastWriteTimeShim fileName with :? FileNotFoundException -> +#endif defaultTimeStamp files[fileName] <- v @@ -737,7 +758,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 showLoadedAssemblies = false @@ -782,6 +807,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 = @@ -796,6 +824,7 @@ type TcConfigBuilder = tcConfigB.fxResolver <- Some fxResolver fxResolver +#endif //!FABLE_COMPILER | Some fxResolver -> fxResolver member tcConfigB.SetPrimaryAssembly primaryAssembly = @@ -806,6 +835,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 @@ -869,6 +900,8 @@ type TcConfigBuilder = tcConfigB.outputFile <- Some outfile outfile, pdbfile, assemblyName +#endif //!FABLE_COMPILER + member tcConfigB.TurnWarningOff(m, s: string) = use _ = UseBuildPhase BuildPhase.Parameter @@ -900,6 +933,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 = @@ -920,8 +957,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 @@ -940,6 +982,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 @@ -971,6 +1014,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 @@ -1001,6 +1045,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 <- @@ -1041,6 +1086,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 @@ -1331,11 +1382,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 @@ -1348,6 +1401,8 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = else (tcConfig.indentationAwareSyntax = Some true) +#if !FABLE_COMPILER + member tcConfig.GetAvailableLoadedSources() = use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter @@ -1439,4 +1494,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 70abf7beb63..2c099c207e3 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 = @@ -504,7 +512,9 @@ type TcConfigBuilder = rangeForErrors: range -> TcConfigBuilder +#if !FABLE_COMPILER member DecideNames: string list -> string * string option * string +#endif member TurnWarningOff: range * string -> unit @@ -529,8 +539,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 @@ -780,6 +792,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 @@ -793,6 +807,8 @@ type TcConfig = /// File system query based on TcConfig settings member MakePathAbsolute: string -> string +#endif //!FABLE_COMPILER + member resolutionEnvironment: LegacyResolutionEnvironment member copyFSharpCore: CopyFSharpCoreFlag @@ -830,6 +846,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 @@ -872,6 +890,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 4b78aa9b9f9..d1d23765e73 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 8e0890d4418..44d303b0c46 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -93,6 +93,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 +127,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 22162611f0c..2a425d79206 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 MakeILResource rName bytes = { Name = rName @@ -225,12 +239,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 = { @@ -253,6 +271,8 @@ let OpenILBinary (fileName, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, AssemblyReader.GetILModuleReader(location, opts) +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = | Speculative @@ -286,6 +306,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 @@ -315,6 +337,8 @@ type AssemblyResolution = this.ilAssemblyRef <- Some assemblyRef assemblyRef +#endif //!FABLE_COMPILER + type ImportedBinary = { FileName: string @@ -352,6 +376,8 @@ type CcuLoadFailureAction = type TcImportsLockToken() = interface LockToken +#if !FABLE_COMPILER + type TcImportsLock = Lock let RequireTcImportsLock (_tcitok: TcImportsLockToken, _thingProtected: 'T) = () @@ -978,10 +1004,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 ( @@ -2594,3 +2667,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 30bb4333f77..1598a6dcbb0 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 82a5df7242b..33666fcfc6a 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 @@ -1113,6 +1124,10 @@ let mlCompatibilityFlag (tcConfigB: TcConfigBuilder) = Some(FSComp.SR.optsMlcompatibility ()) ) +#if FABLE_COMPILER +let exit _code = () +#endif + let GetLanguageVersions () = seq { FSComp.SR.optsSupportedLangVersions () @@ -1183,10 +1198,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, @@ -1381,7 +1398,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 @@ -2303,6 +2322,8 @@ let ApplyCommandLineArgs (tcConfigB: TcConfigBuilder, sourceFiles: string list, errorRecovery e range0 sourceFiles +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // PrintWholeAssemblyImplementation //---------------------------------------------------------------------------- @@ -2457,3 +2478,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 0915d999032..9db513990cd 100644 --- a/src/Compiler/Driver/CompilerOptions.fsi +++ b/src/Compiler/Driver/CompilerOptions.fsi @@ -76,6 +76,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 @@ -94,3 +96,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 0696758780b..0bbb7d21ab1 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 //---------------------------------------------------------------------------- @@ -276,6 +290,8 @@ let NormalizeAssemblyRefs (ctok, ilGlobals: ILGlobals, tcImports: TcImports) sco | ILScopeRef.PrimaryAssembly -> normalizeAssemblyRefByName ilGlobals.primaryAssemblyName | ILScopeRef.Assembly aref -> normalizeAssemblyRefByName aref.Name +#endif //!FABLE_COMPILER + let GetGeneratedILModuleName (t: CompilerTarget) (s: string) = // return the name of the file as a module name let ext = diff --git a/src/Compiler/Driver/OptimizeInputs.fsi b/src/Compiler/Driver/OptimizeInputs.fsi index d5c731ba05d..4d90a7212c1 100644 --- a/src/Compiler/Driver/OptimizeInputs.fsi +++ b/src/Compiler/Driver/OptimizeInputs.fsi @@ -32,6 +32,8 @@ val ApplyAllOptimizations: implFiles: CheckedImplFile list -> CheckedAssemblyAfterOptimization * LazyModuleInfo * IncrementalOptimizationEnv +#if !FABLE_COMPILER + val CreateIlxAssemblyGenerator: TcConfig * TcImports * TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxAssemblyGenerator @@ -49,3 +51,5 @@ val GenerateIlxCode: val NormalizeAssemblyRefs: CompilationThreadToken * ILGlobals * TcImports -> (ILScopeRef -> ILScopeRef) val GetGeneratedILModuleName: CompilerTarget -> string -> string + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index b63976cb7d5..2e2bdf178f3 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -464,7 +464,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 () @@ -478,7 +478,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 @@ -628,6 +628,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 @@ -953,6 +955,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 @@ -981,6 +985,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 @@ -1005,6 +1011,8 @@ let CheckSimulateException (tcConfig: TcConfig) = | Some ("tc-fail") -> failwith "simulated" | _ -> () +#endif //!FABLE_COMPILER + //---------------------------------------------------------------------------- // Type-check sets of files //-------------------------------------------------------------------------- @@ -1175,7 +1183,9 @@ let CheckOneInputAux cancellable { try +#if !FABLE_COMPILER CheckSimulateException tcConfig +#endif let m = inp.Range let amap = tcImports.GetImportMap() diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 166191d363e..ef47ea08878 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 @@ -42,6 +44,8 @@ val ParseInput: isLastCompiland: (bool * 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) -> @@ -94,8 +98,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 * @@ -105,6 +113,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 74a4c083a7d..cbaa200485d 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 @@ -777,3 +781,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 c5deec56b64..1af54ba6339 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 6170d726d75..1bf6db40b08 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 @@ -420,3 +422,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 76001d940da..66f20de6932 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -16,6 +16,8 @@ open Internal.Utilities.Library [] type NodeCode<'T> +#if !FABLE_COMPILER + type Async<'T> with /// Asynchronously await code in the build graph @@ -113,3 +115,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 27ff2059914..aaa7f546c3f 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 af937a28151..dd828163ed2 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -153,11 +153,14 @@ 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) | _ -> exn @@ -167,10 +170,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 +391,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 +417,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 +436,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 +471,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 +856,11 @@ type StackGuard(maxDepth: int, name: string) = [] member _.Guard(f) = +#if FABLE_COMPILER + ignore depth + ignore maxDepth + f () +#else //!FABLE_COMPILER depth <- depth + 1 try @@ -856,6 +879,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/Logger.fs b/src/Compiler/Facilities/Logger.fs index dc425c506fe..b6b886cad1f 100644 --- a/src/Compiler/Facilities/Logger.fs +++ b/src/Compiler/Facilities/Logger.fs @@ -5,6 +5,13 @@ namespace FSharp.Compiler.Diagnostics open System.Diagnostics.Tracing open System +#if FABLE_COMPILER +type EventSource() = + member this.IsEnabled() = false + member this.WriteEvent(_eventId:int, _arg1:int) = () + member this.WriteEvent(_eventId:int, _arg1:string, _arg2:int) = () +#endif + type LogCompilerFunctionId = | Service_ParseAndCheckFileInProject = 1 | Service_CheckOneFile = 2 diff --git a/src/Compiler/Facilities/ReferenceResolver.fs b/src/Compiler/Facilities/ReferenceResolver.fs index d4eeb29871d..618dd1ab970 100644 --- a/src/Compiler/Facilities/ReferenceResolver.fs +++ b/src/Compiler/Facilities/ReferenceResolver.fs @@ -59,3 +59,24 @@ type internal 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 619c21d423c..52fd9f9da43 100644 --- a/src/Compiler/Facilities/ReferenceResolver.fsi +++ b/src/Compiler/Facilities/ReferenceResolver.fsi @@ -57,7 +57,21 @@ type internal 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 = internal 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 e9b7cd8637a..38c9a439b83 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 88dc9921e72..e6977691f6e 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 dee03bb5f7e..82e0c005c8b 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 e662c1edf37..6d94d522aae 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 91b00ba592f..01b5e33deff 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 4177d66e9a9..4284b3f4564 100644 --- a/src/Compiler/Facilities/prim-parsing.fsi +++ b/src/Compiler/Facilities/prim-parsing.fsi @@ -34,7 +34,7 @@ type internal IParseState = member RaiseError<'b> : unit -> 'b /// Return the LexBuffer for this parser instance. - member LexBuffer : LexBuffer + member LexBuffer : LexBuffer /// The context provided when a parse error occurs. @@ -115,7 +115,7 @@ type internal Tables<'Token> = /// Interpret the parser table taking input from the given lexer, using the given lex buffer, and the given start state. /// Returns an object indicating the final synthesized value for the parse. - member Interpret : lexer:(LexBuffer -> 'Token) * lexbuf:LexBuffer * initialState:int -> obj + member Interpret : lexer:(LexBuffer -> 'Token) * lexbuf:LexBuffer * initialState:int -> obj /// Indicates an accept action has occurred. exception internal Accept of obj diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 5660f844d71..5a227c6b066 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -2597,7 +2597,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 b4af719fa39..0e9b1c1b768 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 54665570cc5..dabeb0fb4ad 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -36,7 +36,7 @@ open System.Collections.ObjectModel let OptimizerStackGuardDepth = GetEnvInteger "FSHARP_Optimizer" 50 -#if DEBUG +#if DEBUG && !FABLE_COMPILER let verboseOptimizationInfo = try not (System.String.IsNullOrEmpty (System.Environment.GetEnvironmentVariable "FSHARP_verboseOptimizationInfo")) with _ -> false let verboseOptimizations = @@ -165,7 +165,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 @@ -660,6 +664,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 @@ -1721,6 +1730,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)) -> @@ -3092,7 +3104,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 b6d64e22ec0..f3c8975e06b 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) = @@ -2382,6 +2392,8 @@ module internal ParseAndCheckFile = errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors +#if !FABLE_COMPILER + let ApplyLoadClosure ( tcConfig, @@ -2483,6 +2495,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 ( @@ -2514,9 +2528,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 @@ -2526,8 +2542,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) @@ -2929,6 +2947,8 @@ type FSharpCheckFileResults FSharpCheckFileResults(mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) +#if !FABLE_COMPILER + static member CheckOneFile ( parseResults: FSharpParseFileResults, @@ -2978,6 +2998,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 @@ -3083,6 +3105,10 @@ type FSharpCheckProjectResults let results = match builderOrSymbolUses with | Choice1Of2 builder -> +#if FABLE_COMPILER + ignore builder + [||] +#else builder.SourceFiles |> Array.ofList |> Array.collect (fun x -> @@ -3092,6 +3118,7 @@ type FSharpCheckProjectResults | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses.GetUsesOfSymbol symbol.Item | _ -> [||] | _ -> [||]) +#endif //!FABLE_COMPILER | Choice2Of2 tcSymbolUses -> tcSymbolUses.GetUsesOfSymbol symbol.Item results @@ -3113,6 +3140,10 @@ type FSharpCheckProjectResults let tcSymbolUses = match builderOrSymbolUses with | Choice1Of2 builder -> +#if FABLE_COMPILER + ignore builder + [||] +#else builder.SourceFiles |> Array.ofList |> Array.map (fun x -> @@ -3122,6 +3153,7 @@ type FSharpCheckProjectResults | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses | _ -> TcSymbolUses.Empty | _ -> TcSymbolUses.Empty) +#endif //!FABLE_COMPILER | Choice2Of2 tcSymbolUses -> [| tcSymbolUses |] [| @@ -3157,6 +3189,8 @@ type FSharpCheckProjectResults override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" +#if !FABLE_COMPILER + type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, tcState) = let keepAssemblyContents = false @@ -3262,6 +3296,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 bbf14830f39..6b377347f64 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 = @@ -541,6 +587,26 @@ module internal ParseAndCheckFile = suggestNamesForErrors: bool -> (range * range)[] +// #if FABLE_COMPILER +// val CheckOneFile: +// parseResults: FSharpParseFileResults * +// sourceText: ISourceText * +// mainInputFileName: string * +// projectOptions: FSharpProjectOptions * +// projectFileName: string * +// tcConfig: TcConfig * +// tcGlobals: TcGlobals * +// tcImports: TcImports * +// tcState: TcState * +// moduleNamesDict: ModuleNamesDict * +// loadClosure: LoadClosure option * +// backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[] * +// suggestNamesForErrors: bool +// -> Cancellable +// #endif + +#if !FABLE_COMPILER + // An object to typecheck source in a given typechecking environment. // Used internally to provide intellisense over F# Interactive. type internal FsiInteractiveChecker = @@ -552,5 +618,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 383a61be85a..4635256cfbc 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() @@ -73,6 +81,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 @@ -83,3 +92,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 5692bd7a6b0..e2cc5cc2b22 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,12 +30,17 @@ 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: filePath: string * getTimeStamp: (unit -> DateTime) * getSourceText: (unit -> ISourceText) -> FSharpSource + + /// Creates a FSharpSource. + static member Create : filePath: string * getTimeStamp: (unit -> DateTime) * getSourceText: (unit -> ISourceText) -> FSharpSource \ No newline at end of file diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index f3655c4cab3..42026a11458 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 = @@ -1684,4 +1701,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 481ed50689e..829e0d27297 100755 --- 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 @@ -273,3 +285,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 e40d660bb2f..dba79e70f90 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 f1fdc92c0bb..df8e7612d3f 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 0a89eb646d2..1086bba0f40 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 09756eee2e5..5346fc3eab2 100644 --- a/src/Compiler/Service/ServiceAssemblyContent.fsi +++ b/src/Compiler/Service/ServiceAssemblyContent.fsi @@ -88,6 +88,8 @@ type public EntityCache = /// Performs an operation on the cache in thread safe manner. member Locking: (IAssemblyContentCache -> 'T) -> 'T +#if !FABLE_COMPILER + /// Provides assembly content. module public AssemblyContent = @@ -101,3 +103,6 @@ module public AssemblyContent = fileName: string option -> assemblies: FSharpAssembly list -> AssemblySymbol list + +#endif //!FABLE_COMPILER + diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 06cf656b078..66474f0f782 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 a772cd707aa..d2c011ece65 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -834,7 +834,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 39b2febf315..b1976cf70aa 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 d41426a5e70..29e850c32e0 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -996,9 +996,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 = @@ -1221,6 +1235,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 @@ -1244,9 +1278,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 9328b513aa5..3181ea8b6f7 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 // @@ -1585,3 +1593,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 31801bfbf46..9953348560e 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 + /// Used to parse and check F# source code. [] type public FSharpChecker = @@ -446,3 +448,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 eabc11f3410..d95b0daf0b9 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 e05c7b31560..a6983666173 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 a3232c3db39..2edf2c8346a 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 /// Cut long filenames to make them visually appealing let cutFileName s = if String.length s > 40 then String.sub s 0 10 + "..."+String.sub s (String.length s - 27) 27 else s diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 499654b029a..0b64c495ac8 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 @@ -2250,7 +2254,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 = @@ -2660,7 +2666,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 de98566ffe0..ff84f6a268b 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 ee6b39a5a93..027d341e1c4 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 fee75795e33..24c6c27b2d4 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 4ab6f181358..8841069e80d 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 66192a60310..212b3355e28 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 41bbc768ff5..2fb3f7ba74c 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 72c657d2911..7d695dfc5a0 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) = @@ -365,6 +384,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 f736088be52..1c6a9d7ef5f 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 b7eea4fb718..a980d66f364 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -92,12 +92,20 @@ type internal CompilerGlobalState () = type Unique = int64 //++GLOBAL MUTABLE STATE (concurrency-safe) +#if FABLE_COMPILER +let newUnique = let i = ref 0L in fun () -> i.Value <- i.Value + 1L; i.Value +#else let newUnique = let i = ref 0L fun () -> System.Threading.Interlocked.Increment i +#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 in fun () -> i.Value <- i.Value + 1L; i.Value +#else let newStamp = let i = ref 0L fun () -> System.Threading.Interlocked.Increment i +#endif diff --git a/src/Compiler/TypedTree/QuotationPickler.fs b/src/Compiler/TypedTree/QuotationPickler.fs index 4c613f007d2..addd6bac6ea 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 dfdc9640a0c..dbe0675a270 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2370,7 +2370,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 @@ -2385,6 +2389,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 b63942d2c8c..d68d6e1354e 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 @@ -1629,7 +1631,11 @@ type TyparConstraint = override ToString: unit -> string +#if FABLE_COMPILER +[] +#else [] +#endif type TraitWitnessInfo = | TraitWitnessInfo of tys: TTypes * @@ -1640,6 +1646,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 511a4cc44f2..a7a61f13527 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 6fa70a5903e..73896f7c80e 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10102,6 +10102,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 @@ -10111,6 +10128,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 ae58019683a..41a40949b5b 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2548,7 +2548,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 90fd15fa1e2..3ebab3d6d72 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 @@ -808,7 +810,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) @@ -840,7 +846,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/FileSystem.fs b/src/Compiler/Utilities/FileSystem.fs index 722978e8513..e5f39e18129 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 @@ -59,11 +61,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 [] [] @@ -126,9 +132,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 @@ -142,6 +150,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 @@ -321,6 +331,8 @@ type RawByteMemory(addr: nativeptr, length: int, holder: obj) = else new MemoryStream([||], 0, 0, false) :> Stream +#endif //!FABLE_COMPILER + [] type ReadOnlyByteMemory(bytes: ByteMemory) = @@ -342,16 +354,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 = @@ -397,6 +415,8 @@ module MemoryMappedFileExtensions = bytes.Span.CopyTo(span) stream.Position <- stream.Position + length) +#endif //!FABLE_COMPILER + [] module internal FileSystemUtils = let checkPathForIllegalChars = @@ -448,6 +468,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 = @@ -850,18 +914,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 @@ -941,19 +1009,26 @@ 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 buf.useArrayPool then - ArrayPool.Shared.Return old +#if !FABLE_COMPILER + if buf.useArrayPool then ArrayPool.Shared.Return old +#endif +#if FABLE_COMPILER + member buf.Close () = Bytes.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() @@ -1001,6 +1076,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 @@ -1016,6 +1092,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() @@ -1048,11 +1125,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 } @@ -1062,8 +1143,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) = @@ -1112,3 +1197,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 9b23e58a3f6..a090c29a9be 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 b88af5d77eb..92eaa750cdb 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 a4dd51a5bba..7565b102e67 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 f11edef6a82..8d2a9a87b10 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 c36cf0afb4f..759ec0a8ddb 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 e5f3b069bbb..bb71f31e129 100644 --- a/src/Compiler/Utilities/ildiag.fs +++ b/src/Compiler/Utilities/ildiag.fs @@ -4,6 +4,14 @@ module internal FSharp.Compiler.AbstractIL.Diagnostics +#if FABLE_COMPILER + +let dprintf fmt = printf fmt +let dprintfn fmt = printfn fmt +let dprintn s = printfn "%s" s + +#else + let mutable diagnosticsLog = Some stdout let setDiagnosticsChannel s = diagnosticsLog <- s @@ -43,3 +51,5 @@ let dprintfn (fmt: Format<_, _, _, _>) = | None -> System.IO.TextWriter.Null | Some d -> d) fmt + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/Utilities/ildiag.fsi b/src/Compiler/Utilities/ildiag.fsi index 6f5fb86849a..6aec4952319 100644 --- a/src/Compiler/Utilities/ildiag.fsi +++ b/src/Compiler/Utilities/ildiag.fsi @@ -11,7 +11,9 @@ module internal FSharp.Compiler.AbstractIL.Diagnostics open System.IO open Microsoft.FSharp.Core.Printf +#if !FABLE_COMPILER val public setDiagnosticsChannel: TextWriter option -> unit +#endif val public dprintfn: TextWriterFormat<'a> -> 'a val public dprintf: TextWriterFormat<'a> -> 'a diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index fcb2a84c35b..3527b0c5e7d 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -90,7 +90,11 @@ module internal PervasiveAutoOpens = fun showTimes descr -> if showTimes then +#if FABLE_COMPILER + let t = 0.0 +#else let t = Process.GetCurrentProcess().UserProcessorTime.TotalSeconds +#endif let prev = match tPrev with @@ -111,6 +115,7 @@ module internal PervasiveAutoOpens = let notFound () = raise (KeyNotFoundException()) +#if !FABLE_COMPILER type Async with static member RunImmediate(computation: Async<'T>, ?cancellationToken) = @@ -127,8 +132,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) = @@ -147,6 +158,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 @@ -407,7 +419,9 @@ module List = | _ -> true let mapq (f: 'T -> 'T) inp = +#if !FABLE_COMPILER assert not typeof<'T>.IsValueType +#endif match inp with | [] -> inp @@ -619,7 +633,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 @@ -720,12 +738,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) [| @@ -740,6 +761,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) = @@ -818,12 +840,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 @@ -1057,7 +1081,11 @@ type UniqueStampGenerator<'T when 'T: equality>() = member _.Encode str = encode str +#if FABLE_COMPILER + member _.Table = encodeTab.Keys :> ICollection<'T> +#else member _.Table = encodeTab.Keys +#endif /// memoize tables (all entries cached, never collected) type MemoizationTable<'T, 'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) = @@ -1139,6 +1167,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 @@ -1146,6 +1177,7 @@ type LazyWithContext<'T, 'Ctxt> = x.UnsynchronizedForce ctxt finally Monitor.Exit x +#endif member x.UnsynchronizedForce ctxt = match x.funcOrException with @@ -1396,7 +1428,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 40f8c8f8162..1b581989908 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 = @@ -592,7 +602,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 95a20226a2d..36b7fab4751 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 condition (s: string) = ignore s; false +let GetEnvInteger (e: string) (dflt: int) = ignore e; dflt +#else let condition 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() @@ -320,11 +325,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 @@ -421,6 +428,8 @@ type Dumper(x:obj) = member self.Dump = sprintf "%A" x #endif +#if !FABLE_COMPILER + //--------------------------------------------------------------------------- // AsyncUtil //--------------------------------------------------------------------------- @@ -549,6 +558,8 @@ module UnmanagedProcessExecutionOptions = "HeapSetInformation() returned FALSE; LastError = 0x" + GetLastError().ToString("X").PadLeft(8, '0') + ".")) +#endif //!FABLE_COMPILER + [] type MaybeLazy<'T> = | Strict of 'T @@ -569,10 +580,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 @@ -589,6 +608,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 -> @@ -597,6 +619,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 bab85ccd414..f11b0e3f0e9 100644 --- a/src/Compiler/Utilities/lib.fsi +++ b/src/Compiler/Utilities/lib.fsi @@ -229,8 +229,10 @@ val equalOn: f: ('a -> 'b) -> x: 'a -> y: 'a -> bool when 'b: equality /// 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 @@ -267,6 +269,8 @@ val inline cacheOptRef: cache: 'a option ref -> f: (unit -> 'a) -> 'a val inline tryGetCacheValue: cache: cache<'a> -> NonNullSlot<'a> voption +#if !FABLE_COMPILER + module AsyncUtil = /// Represents the reified result of an asynchronous computation. @@ -289,6 +293,8 @@ module AsyncUtil = 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 bbd6a9f0673..39140bb9c33 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 303e2f968b5..9c5c58b85f7 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: @@ -149,7 +149,7 @@ module TaggedText = let space = tagSpace " " let equals = tagOperator "=" -#if COMPILER +#if COMPILER || FABLE_COMPILER let tagAlias t = mkTag TextTag.Alias t let keywordFunctions = @@ -280,7 +280,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) @@ -399,6 +399,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 = @@ -1647,3 +1649,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 72afa8361d3..9f731d9e5c3 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. @@ -408,3 +410,5 @@ module internal Display = #if COMPILER val fsi_any_to_layout: options: FormatOptions -> value: 'T * typValue: Type -> Layout #endif + +#endif //!FABLE_COMPILER diff --git a/src/Compiler/lex.fsl b/src/Compiler/lex.fsl index ab11625c7d5..e465802f55d 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