diff --git a/.vscode/launch.json b/.vscode/launch.json new file mode 100644 index 000000000000..04bc0ff0446e --- /dev/null +++ b/.vscode/launch.json @@ -0,0 +1,18 @@ +{ + // Use IntelliSense to learn about possible attributes. + // Hover to view descriptions of existing attributes. + // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 + "version": "0.2.0", + "configurations": [ + { + "name": ".NET Core Launch (console)", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-fable-test/Debug/netcoreapp3.1/fcs-fable-test.dll", + "args": [], + "cwd": "${workspaceFolder}/fcs/fcs-fable/test", + "console": "internalConsole", + "stopAtEntry": false + } + ] +} \ No newline at end of file diff --git a/eng/Versions.props b/eng/Versions.props index 4d4f0b03af3d..b4fcb9799107 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -68,7 +68,7 @@ 4.5.1 - 5.0.0-preview.8.20407.11 + 1.7.1 4.3.0 4.3.0 4.0.0 @@ -81,7 +81,7 @@ 4.3.0 4.3.0 4.3.0 - 5.0.0-preview.8.20407.11 + 1.8.1 4.3.0 1.5.0 4.3.0 diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 000000000000..a6e0335bbb1a --- /dev/null +++ b/fcs/build.sh @@ -0,0 +1,30 @@ +#!/usr/bin/env bash + +# cd to root +cd $(dirname $0)/.. + +# build fslex/fsyacc tools +dotnet build -c Release src/buildtools/buildtools.proj +# dotnet build -c Release src/fsharp/FSharp.Compiler.Service + +# FCS-Fable codegen +cd fcs/fcs-fable/codegen +dotnet build -c Release +dotnet run -c Release -- ../../../src/fsharp/FSComp.txt FSComp.fs +dotnet run -c Release -- ../../../src/fsharp/fsi/FSIstrings.txt FSIstrings.fs + +# 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 #line directives + sed -i 's/^\(\/\/# [0-9]\{1,\} "\).*\/codegen\//\1/' $file # cleanup #line paths +done + +# FCS-Fable build +cd .. +dotnet build -c Release + +# # run test +# cd test +# dotnet run -c Release diff --git a/fcs/fcs-fable/.gitignore b/fcs/fcs-fable/.gitignore new file mode 100644 index 000000000000..db7b2bd5665b --- /dev/null +++ b/fcs/fcs-fable/.gitignore @@ -0,0 +1,3 @@ +# Codegen +codegen/*.fs +codegen/*.fsi diff --git a/fcs/fcs-fable/FSStrings.fs b/fcs/fcs-fable/FSStrings.fs new file mode 100644 index 000000000000..7567ed18a2c1 --- /dev/null +++ b/fcs/fcs-fable/FSStrings.fs @@ -0,0 +1,992 @@ +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" + ); + ( "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}" + ); + ] \ No newline at end of file diff --git a/fcs/fcs-fable/SR.fs b/fcs/fcs-fable/SR.fs new file mode 100644 index 000000000000..39ca804f1134 --- /dev/null +++ b/fcs/fcs-fable/SR.fs @@ -0,0 +1,28 @@ +//------------------------------------------------------------------------ +// From SR.fs +//------------------------------------------------------------------------ + +namespace FSharp.Compiler + +module SR = + let GetString(name: string) = + match SR.Resources.resources.TryGetValue(name) with + | true, value -> value + | _ -> "Missing FSStrings error message for: " + name + +module DiagnosticMessage = + type ResourceString<'T>(sfmt: string, fmt: string) = + member x.Format = + let a = fmt.Split('%') + |> Array.filter (fun s -> String.length s > 0) + |> Array.map (fun s -> box("%" + s)) + let tmp = System.String.Format(sfmt, a) + let fmt = Printf.StringFormat<'T>(tmp) + sprintf fmt + + let postProcessString (s: string) = + s.Replace("\\n","\n").Replace("\\t","\t") + + let DeclareResourceString (messageID: string, fmt: string) = + let messageString = SR.GetString(messageID) |> postProcessString + ResourceString<'T>(messageString, fmt) diff --git a/fcs/fcs-fable/System.Collections.fs b/fcs/fcs-fable/System.Collections.fs new file mode 100644 index 000000000000..6c72e7c4fef4 --- /dev/null +++ b/fcs/fcs-fable/System.Collections.fs @@ -0,0 +1,91 @@ +//------------------------------------------------------------------------ +// 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 = + + type ImmutableArray<'T> = + static member CreateBuilder() = ResizeArray<'T>() + +module Concurrent = + open System.Collections.Generic + + /// not actually thread safe, just an extension of Dictionary + type ConcurrentDictionary<'Key, 'Value when 'Key: equality>(comparer: IEqualityComparer<'Key>) = + inherit Dictionary<'Key, 'Value>(comparer) + + new () = + let comparer = { + new IEqualityComparer<'Key> with + member __.GetHashCode(x) = x.GetHashCode() + member __.Equals(x, y) = x.Equals(y) } + ConcurrentDictionary(comparer) + + new (_concurrencyLevel: int, _capacity: int) = + ConcurrentDictionary() + new (_concurrencyLevel: int, comparer: IEqualityComparer<'Key>) = + ConcurrentDictionary(comparer) + new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'Key>) = + ConcurrentDictionary(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 000000000000..3e37869f7e2f --- /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 IsPathRooted (path: string) = //TODO: proper xplat implementation + let normPath = path.Replace("\\", "/").TrimEnd('/') + normPath.StartsWith("/") + + let DirectorySeparatorChar = '/' + let AltDirectorySeparatorChar = '/' diff --git a/fcs/fcs-fable/System.fs b/fcs/fcs-fable/System.fs new file mode 100644 index 000000000000..a0bf5606eb53 --- /dev/null +++ b/fcs/fcs-fable/System.fs @@ -0,0 +1,29 @@ +//------------------------------------------------------------------------ +// shims for things not yet implemented in Fable +//------------------------------------------------------------------------ + +namespace System + +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) diff --git a/fcs/fcs-fable/TcImports_shim.fs b/fcs/fcs-fable/TcImports_shim.fs new file mode 100644 index 000000000000..44bf53679c37 --- /dev/null +++ b/fcs/fcs-fable/TcImports_shim.fs @@ -0,0 +1,260 @@ +// 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 FSharp.Compiler +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.AbstractIL.Internal +open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils +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.Driver +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Lib +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.Range +open FSharp.Compiler.ScriptClosure +open FSharp.Compiler.SyntaxTree +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypedTreePickle + +// open Microsoft.DotNet.DependencyManager + +open Internal.Utilities +open Internal.Utilities.Collections + +//------------------------------------------------------------------------- +// TcImports shim +//------------------------------------------------------------------------- + +module TcImports = + + let internal BuildTcImports (tcConfig: TcConfig, references: string[], readAllBytes: string -> byte[]) = + let tcImports = TcImports () + let ilGlobals = IL.EcmaMscorlibILGlobals + + let sigDataReaders ilModule = + [ for resource in ilModule.Resources.AsList do + if IsSignatureDataResource resource then + let _ccuName = GetSignatureDataResourceName resource + yield resource.GetBytes() ] + + let optDataReaders ilModule = + [ for resource in ilModule.Resources.AsList do + if IsOptimizationDataResource resource then + let _ccuName = GetOptimizationDataResourceName resource + yield 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 ilg ilModule = + ilModule |> GetCustomAttributesOfILModule |> List.choose (TryFindAutoOpenAttr ilg) + + let GetInternalsVisibleToAttributes ilg ilModule = + ilModule |> GetCustomAttributesOfILModule |> List.choose (TryFindInternalsVisibleToAttr ilg) + + let HasAnyFSharpSignatureDataAttribute ilModule = + let attrs = GetCustomAttributesOfILModule ilModule + List.exists IsSignatureDataVersionAttr attrs + + let mkCcuInfo ilg ilScopeRef ilModule ccu : ImportedAssembly = + { ILScopeRef = ilScopeRef + FSharpViewOfMetadata = ccu + AssemblyAutoOpenAttributes = GetAutoOpenAttributes ilg ilModule + AssemblyInternalsVisibleToAttributes = GetInternalsVisibleToAttributes ilg ilModule +#if !NO_EXTENSIONTYPING + 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, ilScopeRef, + tcConfig.implicitIncludeDir, Some fileName, ilModule, invalidateCcu.Publish) + let ccuInfo = mkCcuInfo ilGlobals 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_EXTENSIONTYPING + 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_EXTENSIONTYPING + 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) + } + + 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 ilGlobals 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 refCcusUnfixed = List.ofArray references |> List.map (GetCcu m) + let refCcus = fixupCcuInfo refCcusUnfixed + let sysCcus = refCcus |> List.filter (fun x -> x.FSharpViewOfMetadata.AssemblyName <> "FSharp.Core") + let fslibCcu = refCcus |> List.find (fun x -> x.FSharpViewOfMetadata.AssemblyName = "FSharp.Core") + + let ccuInfos = [fslibCcu] @ sysCcus + 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 = sysCcus |> 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 tcGlobals = TcGlobals ( + tcConfig.compilingFslib, ilGlobals, fslibCcu.FSharpViewOfMetadata, + tcConfig.implicitIncludeDir, tcConfig.mlCompatibility, + tcConfig.isInteractive, tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations, + tcConfig.noDebugData, 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) + tcImports, tcGlobals diff --git a/fcs/fcs-fable/ast_print.fs b/fcs/fcs-fable/ast_print.fs new file mode 100644 index 000000000000..bf936a8d48d4 --- /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. + +namespace FSharp.Compiler.SourceCodeServices + +//------------------------------------------------------------------------- +// AstPrint +//------------------------------------------------------------------------- + +module 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_EXTENSIONTYPING + if v.IsProvided then yield "provided" + if v.IsStaticInstantiation then yield "static_inst" + if v.IsProvidedAndErased then yield "erased" + if v.IsProvidedAndGenerated then yield "generated" +#endif + if v.IsUnresolved then yield "unresolved" + if v.IsValueType then yield "valuetype" + + | :? FSharpMemberOrFunctionOrValue as v -> + yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "" + if v.IsActivePattern then yield "active_pattern" + if v.IsDispatchSlot then yield "dispatch_slot" + if v.IsModuleValueOrMember && not v.IsMember then yield "val" + if v.IsMember then yield "member" + if v.IsProperty then yield "property" + if v.IsExtensionMember then yield "extension_member" + if v.IsPropertyGetterMethod then yield "property_getter" + if v.IsPropertySetterMethod then yield "property_setter" + if v.IsEvent then yield "event" + if v.EventForFSharpProperty.IsSome then yield "property_event" + if v.IsEventAddMethod then yield "event_add" + if v.IsEventRemoveMethod then yield "event_remove" + if v.IsTypeFunction then yield "type_func" + if v.IsCompilerGenerated then yield "compiler_gen" + if v.IsImplicitConstructor then yield "implicit_ctor" + if v.IsMutable then yield "mutable" + if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl" + if not v.IsInstanceMember then yield "static" + if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky" + if v.IsExplicitInterfaceImplementation then yield "interface_impl" + yield sprintf "%A" v.InlineAnnotation + // if v.IsConstructorThisValue then yield "ctorthis" + // if v.IsMemberThisValue then yield "this" + // if v.LiteralValue.IsSome then yield "literal" + | _ -> () ] + + let rec printFSharpDecls prefix decls = seq { + let mutable i = 0 + for decl in decls do + i <- i + 1 + match decl with + | FSharpImplementationFileDeclaration.Entity (e, sub) -> + yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e) + if not (Seq.isEmpty e.Attributes) then + yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes) + if not (Seq.isEmpty e.DeclaredInterfaces) then + yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces) + yield "" + yield! printFSharpDecls (prefix + "\t") sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) -> + yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth) + yield sprintf "%stype: %A" prefix meth.FullType + yield sprintf "%sargs: %A" prefix args + // if not meth.IsCompilerGenerated then + yield sprintf "%sbody: %A" prefix body + yield "" + | FSharpImplementationFileDeclaration.InitAction (expr) -> + yield sprintf "%s%i) ACTION" prefix i + yield sprintf "%s%A" prefix expr + yield "" + } diff --git a/fcs/fcs-fable/codegen/codegen.fsproj b/fcs/fcs-fable/codegen/codegen.fsproj new file mode 100644 index 000000000000..78b0b488aa33 --- /dev/null +++ b/fcs/fcs-fable/codegen/codegen.fsproj @@ -0,0 +1,54 @@ + + + artifacts + $(MSBuildProjectDirectory)/../../../src + + + + + Exe + netcoreapp3.1 + + true + + + + + --unicode --lexlib Internal.Utilities.Text.Lexing + AbsIL/illex.fsl + + + --module FSharp.Compiler.AbstractIL.Internal.AsciiParser --open FSharp.Compiler.AbstractIL --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + AbsIL/ilpars.fsy + + + --unicode --lexlib Internal.Utilities.Text.Lexing + ParserAndUntypedAST/pplex.fsl + + + --module FSharp.Compiler.PPParser --open FSharp.Compiler --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + ParserAndUntypedAST/pppars.fsy + + + --unicode --lexlib Internal.Utilities.Text.Lexing + ParserAndUntypedAST/lex.fsl + + + --module FSharp.Compiler.Parser --open FSharp.Compiler --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + ParserAndUntypedAST/pars.fsy + + + + + + + + + + + \ No newline at end of file diff --git a/fcs/fcs-fable/codegen/fssrgen.fsx b/fcs/fcs-fable/codegen/fssrgen.fsx new file mode 100644 index 000000000000..529a0a1d543b --- /dev/null +++ b/fcs/fcs-fable/codegen/fssrgen.fsx @@ -0,0 +1,495 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +module FsSrGen +open System +open System.IO + +let PrintErr(filename, line, msg) = + printfn "%s(%d): error : %s" filename line msg + +let Err(filename, line, msg) = + PrintErr(filename, line, msg) + printfn "Note that the syntax of each line is one of these three alternatives:" + printfn "# comment" + printfn "ident,\"string\"" + printfn "errNum,ident,\"string\"" + failwith (sprintf "there were errors in the file '%s'" filename) + +let xmlBoilerPlateString = @" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + +" + + +type HoleType = string + + +// The kinds of 'holes' we can do +let ComputeHoles filename lineNum (txt:string) : ResizeArray * string = + // takes in a %d%s kind of string, returns array of HoleType and {0}{1} kind of string + let mutable i = 0 + let mutable holeNumber = 0 + let mutable holes = ResizeArray() // order + let sb = new System.Text.StringBuilder() + let AddHole holeType = + sb.Append(sprintf "{%d}" holeNumber) |> ignore + holeNumber <- holeNumber + 1 + holes.Add(holeType) + while i < txt.Length do + if txt.[i] = '%' then + if i+1 = txt.Length then + Err(filename, lineNum, "(at end of string) % must be followed by d, f, s, or %") + else + match txt.[i+1] with + | 'd' -> AddHole "System.Int32" + | 'f' -> AddHole "System.Double" + | 's' -> AddHole "System.String" + | '%' -> sb.Append('%') |> ignore + | c -> Err(filename, lineNum, sprintf "'%%%c' is not a valid sequence, only %%d %%f %%s or %%%%" c) + i <- i + 2 + else + match txt.[i] with + | '{' -> sb.Append "{{" |> ignore + | '}' -> sb.Append "}}" |> ignore + | c -> sb.Append c |> ignore + i <- i + 1 + //printfn "holes.Length = %d, lineNum = %d" holes.Length //lineNum txt + (holes, sb.ToString()) + +let Unquote (s : string) = + if s.StartsWith "\"" && s.EndsWith "\"" then s.Substring(1, s.Length - 2) + else failwith "error message string should be quoted" + +let ParseLine filename lineNum (txt:string) = + let mutable errNum = None + let identB = new System.Text.StringBuilder() + let mutable i = 0 + // parse optional error number + if i < txt.Length && System.Char.IsDigit txt.[i] then + let numB = new System.Text.StringBuilder() + while i < txt.Length && System.Char.IsDigit txt.[i] do + numB.Append txt.[i] |> ignore + i <- i + 1 + errNum <- Some(int (numB.ToString())) + if i = txt.Length || not(txt.[i] = ',') then + Err(filename, lineNum, sprintf "After the error number '%d' there should be a comma" errNum.Value) + // Skip the comma + i <- i + 1 + // parse short identifier + if i < txt.Length && not(System.Char.IsLetter(txt.[i])) then + Err(filename, lineNum, sprintf "The first character in the short identifier should be a letter, but found '%c'" txt.[i]) + while i < txt.Length && System.Char.IsLetterOrDigit txt.[i] do + identB.Append txt.[i] |> ignore + i <- i + 1 + let ident = identB.ToString() + if ident.Length = 0 then + Err(filename, lineNum, "Did not find the short identifier") + else + if i = txt.Length || not(txt.[i] = ',') then + Err(filename, lineNum, sprintf "After the identifier '%s' there should be a comma" ident) + else + // Skip the comma + i <- i + 1 + if i = txt.Length then + Err(filename, lineNum, sprintf "After the identifier '%s' and comma, there should be the quoted string resource" ident) + else + let str = + try + System.String.Format(Unquote(txt.Substring i)) // Format turns e.g '\n' into that char, but also requires that we 'escape' curlies in the original .txt file, e.g. "{{" + with + e -> Err(filename, lineNum, sprintf "Error calling System.String.Format (note that curly braces must be escaped, and there cannot be trailing space on the line): >>>%s<<< -- %s" (txt.Substring i) e.Message) + let holes, netFormatString = ComputeHoles filename lineNum str + (lineNum, (errNum,ident), str, holes.ToArray(), netFormatString) + +let stringBoilerPlatePrefix = @" +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Reflection +open System.Reflection +// (namespaces below for specific case of using the tool to compile FSharp.Core itself) +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Text +open Microsoft.FSharp.Collections +open Printf +" +let StringBoilerPlate filename = + + @" + // BEGIN BOILERPLATE + + static let getCurrentAssembly () = + #if FX_RESHAPED_REFLECTION + typeof.GetTypeInfo().Assembly + #else + System.Reflection.Assembly.GetExecutingAssembly() + #endif + + static let getTypeInfo (t: System.Type) = + #if FX_RESHAPED_REFLECTION + t.GetTypeInfo() + #else + t + #endif + + static let resources = lazy (new System.Resources.ResourceManager(""" + filename + @""", getCurrentAssembly())) + + static let GetString(name:string) = + let s = resources.Value.GetString(name, System.Globalization.CultureInfo.CurrentUICulture) + #if DEBUG + if null = s then + System.Diagnostics.Debug.Assert(false, sprintf ""**RESOURCE ERROR**: Resource token %s does not exist!"" name) + #endif + s + + static let mkFunctionValue (tys: System.Type[]) (impl:obj->obj) = + FSharpValue.MakeFunction(FSharpType.MakeFunctionType(tys.[0],tys.[1]), impl) + + static let funTyC = typeof<(obj -> obj)>.GetGenericTypeDefinition() + + static let isNamedType(ty:System.Type) = not (ty.IsArray || ty.IsByRef || ty.IsPointer) + static let isFunctionType (ty1:System.Type) = + isNamedType(ty1) && getTypeInfo(ty1).IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(funTyC) + + static let rec destFunTy (ty:System.Type) = + if isFunctionType ty then + ty, ty.GetGenericArguments() + else + match getTypeInfo(ty).BaseType with + | null -> failwith ""destFunTy: not a function type"" + | b -> destFunTy b + + static let buildFunctionForOneArgPat (ty: System.Type) impl = + let _,tys = destFunTy ty + let rty = tys.[1] + // PERF: this technique is a bit slow (e.g. in simple cases, like 'sprintf ""%x""') + mkFunctionValue tys (fun inp -> impl rty inp) + + static let capture1 (fmt:string) i args ty (go : obj list -> System.Type -> int -> obj) : obj = + match fmt.[i] with + | '%' -> go args ty (i+1) + | 'd' + | 'f' + | 's' -> buildFunctionForOneArgPat ty (fun rty n -> go (n::args) rty (i+1)) + | _ -> failwith ""bad format specifier"" + + // newlines and tabs get converted to strings when read from a resource file + // this will preserve their original intention + static let postProcessString (s : string) = + s.Replace(""\\n"",""\n"").Replace(""\\t"",""\t"").Replace(""\\r"",""\r"").Replace(""\\\"""", ""\"""") + + static let createMessageString (messageString : string) (fmt : Printf.StringFormat<'T>) : 'T = + let fmt = fmt.Value // here, we use the actual error string, as opposed to the one stored as fmt + let len = fmt.Length + + /// Function to capture the arguments and then run. + let rec capture args ty i = + if i >= len || (fmt.[i] = '%' && i+1 >= len) then + let b = new System.Text.StringBuilder() + b.AppendFormat(messageString, [| for x in List.rev args -> x |]) |> ignore + box(b.ToString()) + // REVIEW: For these purposes, this should be a nop, but I'm leaving it + // in incase we ever decide to support labels for the error format string + // E.g., ""%s%d"" + elif System.Char.IsSurrogatePair(fmt,i) then + capture args ty (i+2) + else + match fmt.[i] with + | '%' -> + let i = i+1 + capture1 fmt i args ty capture + | _ -> + capture args ty (i+1) + + (unbox (capture [] (typeof<'T>) 0) : 'T) + + static let mutable swallowResourceText = false + + static let GetStringFunc((messageID : string),(fmt : Printf.StringFormat<'T>)) : 'T = + if swallowResourceText then + sprintf fmt + else + let mutable messageString = GetString(messageID) + messageString <- postProcessString messageString + createMessageString messageString fmt + + /// If set to true, then all error messages will just return the filled 'holes' delimited by ',,,'s - this is for language-neutral testing (e.g. localization-invariant baselines). + static member SwallowResourceText with get () = swallowResourceText + and set (b) = swallowResourceText <- b + // END BOILERPLATE +" + +let RunMain(filename:string, outFilename, outXmlFilenameOpt, projectNameOpt) = + try + let justfilename = System.IO.Path.GetFileNameWithoutExtension(filename) + if justfilename |> Seq.exists (fun c -> not(System.Char.IsLetterOrDigit(c))) then + Err(filename, 0, sprintf "The filename '%s' is not allowed; only letters and digits can be used, as the filename also becomes the namespace for the SR class" justfilename) + + printfn "fssrgen.fsx: Reading %s" filename + let lines = System.IO.File.ReadAllLines(filename) + |> Array.mapi (fun i s -> i,s) // keep line numbers + |> Array.filter (fun (i,s) -> not(s.StartsWith "#")) // filter out comments + + printfn "fssrgen.fsx: Parsing %s" filename + let stringInfos = lines |> Array.map (fun (i,s) -> ParseLine filename i s) + // now we have array of (lineNum, ident, str, holes, netFormatString) // str has %d, netFormatString has {0} + + printfn "fssrgen.fsx: Validating %s" filename + // validate that all the idents are unique + let allIdents = new System.Collections.Generic.Dictionary() + for (line,(_,ident),_,_,_) in stringInfos do + if allIdents.ContainsKey(ident) then + Err(filename,line,sprintf "Identifier '%s' is already used previously on line %d - each identifier must be unique" ident allIdents.[ident]) + allIdents.Add(ident,line) + + printfn "fssrgen.fsx: Validating uniqueness of %s" filename + // validate that all the strings themselves are unique + let allStrs = new System.Collections.Generic.Dictionary() + for (line,(_,ident),str,_,_) in stringInfos do + if allStrs.ContainsKey(str) then + let prevLine,prevIdent = allStrs.[str] + Err(filename,line,sprintf "String '%s' already appears on line %d with identifier '%s' - each string must be unique" str prevLine prevIdent) + allStrs.Add(str,(line,ident)) + + printfn "fssrgen.fsx: Generating %s" outFilename + + use out = new System.IO.StringWriter() + fprintfn out "// This is a generated file; the original input is '%s'" filename + fprintfn out "namespace %s" justfilename + if Option.isNone outXmlFilenameOpt then + fprintfn out "type internal SR private() =" + else + fprintfn out "%s" stringBoilerPlatePrefix + fprintfn out "type internal SR private() =" + let theResourceName = match projectNameOpt with Some p -> sprintf "%s.%s" p justfilename | None -> justfilename + fprintfn out "%s" (StringBoilerPlate theResourceName) + + printfn "fssrgen.fsx: Generating resource methods for %s" outFilename + // gen each resource method + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + let formalArgs = System.Text.StringBuilder() + let actualArgs = System.Text.StringBuilder() + let firstTime = ref true + let n = ref 0 + formalArgs.Append "(" |> ignore + for hole in holes do + if !firstTime then + firstTime := false + else + formalArgs.Append ", " |> ignore + actualArgs.Append " " |> ignore + formalArgs.Append(sprintf "a%d : %s" !n hole) |> ignore + actualArgs.Append(sprintf "a%d" !n) |> ignore + n := !n + 1 + formalArgs.Append ")" |> ignore + fprintfn out " /// %s" str + fprintfn out " /// (Originally from %s:%d)" filename (lineNum+1) + let justPercentsFromFormatString = + (holes |> Array.fold (fun acc holeType -> + acc + match holeType with + | "System.Int32" -> ",,,%d" + | "System.Double" -> ",,,%f" + | "System.String" -> ",,,%s" + | _ -> failwith "unreachable") "") + ",,," + let errPrefix = match optErrNum with + | None -> "" + | Some n -> sprintf "%d, " n + if Option.isNone outXmlFilenameOpt then + fprintfn out " static member %s%s = (%ssprintf \"%s\" %s)" ident (formalArgs.ToString()) errPrefix str (actualArgs.ToString()) + else + fprintfn out " static member %s%s = (%sGetStringFunc(\"%s\",\"%s\") %s)" ident (formalArgs.ToString()) errPrefix ident justPercentsFromFormatString (actualArgs.ToString()) + ) + + if Option.isSome outXmlFilenameOpt then + printfn "fssrgen.fsx: Generating .resx for %s" outFilename + fprintfn out "" + // gen validation method + fprintfn out " /// Call this method once to validate that all known resources are valid; throws if not" + fprintfn out " static member RunStartupValidation() =" + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + fprintfn out " ignore(GetString(\"%s\"))" ident + ) + fprintfn out " ()" // in case there are 0 strings, we need the generated code to parse + + let outFileNewText = out.ToString() + let nothingChanged = try File.Exists(outFilename) && File.ReadAllText(outFilename) = outFileNewText with _ -> false + if not nothingChanged then + File.WriteAllText(outFilename, outFileNewText, System.Text.Encoding.UTF8) + + if Option.isSome outXmlFilenameOpt then + // gen resx + let xd = new System.Xml.XmlDocument() + xd.LoadXml(xmlBoilerPlateString) + stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> + let xn = xd.CreateElement("data") + xn.SetAttribute("name",ident) |> ignore + xn.SetAttribute("xml:space","preserve") |> ignore + let xnc = xd.CreateElement "value" + xn.AppendChild xnc |> ignore + xnc.AppendChild(xd.CreateTextNode netFormatString) |> ignore + xd.LastChild.AppendChild xn |> ignore + ) + let outXmlFileNewText = + use outXmlStream = new System.IO.StringWriter() + xd.Save outXmlStream + outXmlStream.ToString() + let outXmlFile = outXmlFilenameOpt.Value + let nothingChanged = try File.Exists(outXmlFile) && File.ReadAllText(outXmlFile) = outXmlFileNewText with _ -> false + if not nothingChanged then + File.WriteAllText(outXmlFile, outXmlFileNewText, System.Text.Encoding.Unicode) + + + printfn "fssrgen.fsx: Done %s" outFilename + 0 + with e -> + PrintErr(filename, 0, sprintf "An exception occurred when processing '%s'\n%s" filename (e.ToString())) + 1 + +#if COMPILED +[] +#endif +let Main args = + + match args |> List.ofArray with + | [ inputFile; outFile; ] -> + let filename = System.IO.Path.GetFullPath(inputFile) + let outFilename = System.IO.Path.GetFullPath(outFile) + + RunMain(filename, outFilename, None, None) + + | [ inputFile; outFile; outXml ] -> + let filename = System.IO.Path.GetFullPath inputFile + let outFilename = System.IO.Path.GetFullPath outFile + let outXmlFilename = System.IO.Path.GetFullPath outXml + + RunMain(filename, outFilename, Some outXmlFilename, None) + + | [ inputFile; outFile; outXml; projectName ] -> + let filename = System.IO.Path.GetFullPath inputFile + let outFilename = System.IO.Path.GetFullPath outFile + let outXmlFilename = System.IO.Path.GetFullPath outXml + + RunMain(filename, outFilename, Some outXmlFilename, Some projectName) + + | _ -> + printfn "Error: invalid arguments." + printfn "Usage: " + 1 +#if !COMPILED +printfn "fssrgen: args = %A" fsi.CommandLineArgs +Main (fsi.CommandLineArgs |> Seq.skip 1 |> Seq.toArray) +#endif diff --git a/fcs/fcs-fable/codegen/fssrgen.targets b/fcs/fcs-fable/codegen/fssrgen.targets new file mode 100644 index 000000000000..c28706b5d6ad --- /dev/null +++ b/fcs/fcs-fable/codegen/fssrgen.targets @@ -0,0 +1,35 @@ + + + + + ProcessFsSrGen;$(PrepareForBuildDependsOn) + + + + + + + + + + + + false + + + diff --git a/fcs/fcs-fable/fcs-fable.fsproj b/fcs/fcs-fable/fcs-fable.fsproj new file mode 100644 index 000000000000..5414b0a8db0e --- /dev/null +++ b/fcs/fcs-fable/fcs-fable.fsproj @@ -0,0 +1,270 @@ + + + $(MSBuildProjectDirectory)/../../src + $(MSBuildProjectDirectory)/codegen + + + + netstandard2.0 + $(DefineConstants);FABLE_COMPILER + $(DefineConstants);FX_NO_CORHOST_SIGNER + $(DefineConstants);FX_NO_PDB_READER + $(DefineConstants);FX_NO_PDB_WRITER + $(DefineConstants);FX_NO_WEAKTABLE + $(DefineConstants);NO_EXTENSIONTYPING + $(DefineConstants);NO_INLINE_IL_PARSER + $(OtherFlags) --warnon:1182 + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/service_slim.fs b/fcs/fcs-fable/service_slim.fs new file mode 100644 index 000000000000..0efb93d2f9aa --- /dev/null +++ b/fcs/fcs-fable/service_slim.fs @@ -0,0 +1,298 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +open System.Collections.Generic +open System.Collections.Concurrent + +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.Internal.Library +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.ErrorLogger +open FSharp.Compiler.NameResolution +open FSharp.Compiler.Parser +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.Range +open FSharp.Compiler.ScriptClosure +open FSharp.Compiler.SyntaxTree +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree + +open Internal.Utilities +open Internal.Utilities.Collections + + +//------------------------------------------------------------------------- +// InteractiveChecker +//------------------------------------------------------------------------- + +type internal TcResult = TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType +type internal TcErrors = FSharpErrorInfo[] + +type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) = + let userOpName = "Unknown" + let suggestNamesForErrors = true + + 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 = [] + ExtraProjectInfo = None + Stamp = None + } + InteractiveChecker.Create(readAllBytes, projectOptions) + + static member Create(readAllBytes: string -> byte[], projectOptions: FSharpProjectOptions) = + let references = + projectOptions.OtherOptions + |> Array.filter (fun s -> s.StartsWith("-r:")) + |> Array.map (fun s -> s.Replace("-r:", "")) + + let tcConfig = + let tcConfigB = TcConfigBuilder.Initial + tcConfigB.implicitIncludeDir <- System.IO.Path.GetDirectoryName (projectOptions.ProjectFileName) + let sourceFiles = projectOptions.SourceFiles |> Array.toList + let argv = projectOptions.OtherOptions |> Array.toList + let _sourceFiles = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) + TcConfig.Create(tcConfigB, validate=false) + + let ctok = CompilationThreadToken() + let tcImports, tcGlobals = + TcImports.BuildTcImports (tcConfig, references, readAllBytes) + + let niceNameGen = NiceNameGenerator() + let assemblyName = projectOptions.ProjectFileName |> System.IO.Path.GetFileNameWithoutExtension + let tcInitialEnv = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitialEnv) + + let reactorOps = + { new IReactorOperations with + member __.EnqueueAndAwaitOpAsync (userOpName, opName, opArg, op) = + async.Return (Cancellable.runWithoutCancellation (op ctok)) + member __.EnqueueOp (userOpName, opName, opArg, op) = (op ctok) } + + // 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) + + InteractiveChecker (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) + + member private x.MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpErrorInfo[], + symbolUses: TcSymbolUses list, topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option) = + let assemblyRef = mkSimpleAssemblyRef "stdin" + let assemblyDataOpt = None + let access = tcState.TcEnvFromImpls.AccessRights + let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat + let details = (tcGlobals, tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles) + let keepAssemblyContents = true + FSharpCheckProjectResults (projectFileName, Some tcConfig, keepAssemblyContents, errors, Some details) + + member private x.ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions) = + 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 checkCache.TryGetValue(key) with + | true, value -> Some (key, value) + | false, _ -> None) + // remove all parse cache entries with the same file name + let staleParseKeys = parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray + staleParseKeys |> Array.iter (fun key -> parseCache.TryRemove(key) |> ignore) + checkCache.Clear(); // clear all typecheck cache + // restore all cached typecheck entries above file + cachedAbove |> Array.iter (fun (key, value) -> checkCache.TryAdd(key, value) |> ignore) + + member private x.ParseFile (fileName: string, source: string, parsingOptions: FSharpParsingOptions) = + let parseCacheKey = fileName, hash source + parseCache.GetOrAdd(parseCacheKey, fun _ -> + x.ClearStaleCache(fileName, parsingOptions) + 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) ) + + member private x.TypeCheckOneInput (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict) = + let input = parseResults.ParseTree.Value + let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", tcConfig.errorSeverityOptions) + let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) + use _errorScope = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) + + let checkForErrors () = parseResults.ParseHadErrors || errorLogger.ErrorCount > 0 + let prefixPathOpt = None + + let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict + let tcResult, tcState = + TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + |> Eventually.force ctok + + let fileName = parseResults.FileName + let tcErrors = ErrorHelpers.CreateErrorInfos (tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetErrors()), suggestNamesForErrors) + (tcResult, tcErrors), (tcState, moduleNamesDict) + + member private x.CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict) = + match parseResults.ParseTree with + | Some _input -> + let sink = TcResultsSinkImpl(tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + x.TypeCheckOneInput (parseResults, tcSink, tcState, moduleNamesDict) + let fileName = parseResults.FileName + checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let textSnapshotInfo = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Errors tcErrors + + let scope = TypeCheckInfo (tcConfig, tcGlobals, ccuSigForFile, tcState.Ccu, tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, reactorOps, textSnapshotInfo, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, reactorOps, keepAssemblyContents) + |> Some + | None -> + None + + member private x.TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState) = + let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = + let checkCacheKey = parseRes.FileName + let typeCheckOneInput _fileName = + x.TypeCheckOneInput (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict) + 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 = + TypeCheckMultipleInputsFinish(tcResults |> Array.toList, tcState) + let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) + tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors + + /// Errors grouped by file, sorted by line, column + member private x.ErrorsByFile (fileNames: string[], errorList: FSharpErrorInfo[] 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.StartLineAlternate, x.StartColumn)) + errors |> Array.concat + + /// Clears parse and typecheck caches. + member x.ClearCache () = + parseCache.Clear() + checkCache.Clear() + + /// Parses and checks single file only, left as is for backwards compatibility. + /// Despite the name, there is no support for #load etc. + member x.ParseAndCheckScript (projectFileName: string, fileName: string, source: string) = + let sourceText = SourceText.ofString source + let fileNames = [| fileName |] + let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false) + let parseResults = x.ParseFile (fileName, source, parsingOptions) + let moduleNamesDict = Map.empty + let loadClosure = None + let backgroundErrors = [||] + let textSnapshotInfo = None + let tcState = tcInitialState + let tcResults = ParseAndCheckFile.CheckOneFile( + parseResults, sourceText, fileName, projectFileName, tcConfig, tcGlobals, tcImports, tcState, + moduleNamesDict, loadClosure, backgroundErrors, reactorOps, textSnapshotInfo, userOpName, suggestNamesForErrors) + match tcResults with + | tcErrors, Result.Ok tcFileInfo -> + let errors = Array.append parseResults.Errors tcErrors + let tcImplFilesOpt = match tcFileInfo.ImplementationFile with Some x -> Some [x] | None -> None + let typeCheckResults = FSharpCheckFileResults (fileName, errors, Some tcFileInfo, parseResults.DependencyFiles, None, reactorOps, true) + let symbolUses = [tcFileInfo.ScopeSymbolUses] + let projectResults = x.MakeProjectResults (projectFileName, [|parseResults|], tcState, errors, symbolUses, None, tcImplFilesOpt) + parseResults, typeCheckResults, projectResults + | _ -> + failwith "unexpected aborted" + + /// 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 x.ParseAndCheckProject (projectFileName: string, fileNames: string[], sources: string[]) = + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false) + let parseFile (fileName, source) = x.ParseFile (fileName, source, parsingOptions) + let parseResults = Array.zip fileNames sources |> Array.map parseFile + + // type check files + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors = + x.TypeCheckClosedInputSet (parseResults, tcInitialState) + + // make project results + let parseErrors = parseResults |> Array.collect (fun p -> p.Errors) + let typedErrors = tcErrors |> Array.concat + let errors = x.ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) + let symbolUses = [] //TODO: + let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles) + + 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 x.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) = + // 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(tcConfig, fileNames, false) + let parseFile (fileName, source) = x.ParseFile (fileName, source, parsingOptions) + let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + x.TypeCheckClosedInputSet (parseResults, tcInitialState) + + // parse and type check file + let parseFileResults = parseFile (fileName, sources.[fileIndex]) + let checkFileResults = x.CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Errors) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = match checkFileResults with | Some res -> res.Errors | None -> [||] + let errors = x.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 symbolUses = [] //TODO: + let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles) + + parseFileResults, checkFileResults, projectResults diff --git a/fcs/fcs-fable/test/.gitignore b/fcs/fcs-fable/test/.gitignore new file mode 100644 index 000000000000..66d36d51d648 --- /dev/null +++ b/fcs/fcs-fable/test/.gitignore @@ -0,0 +1,7 @@ +# Output +out*/ + +# Node +node_modules/ +package-lock.json +yarn.lock \ No newline at end of file diff --git a/fcs/fcs-fable/test/Metadata.fs b/fcs/fcs-fable/test/Metadata.fs new file mode 100644 index 000000000000..64ea889fd8f8 --- /dev/null +++ b/fcs/fcs-fable/test/Metadata.fs @@ -0,0 +1,207 @@ +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.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" + "Microsoft.CSharp" + "Microsoft.VisualBasic.Core" + "Microsoft.VisualBasic" + "Microsoft.Win32.Primitives" + "mscorlib" + "netstandard" + "System.AppContext" + "System.Buffers" + "System.Collections.Concurrent" + "System.Collections" + "System.Collections.Immutable" + "System.Collections.NonGeneric" + "System.Collections.Specialized" + "System.ComponentModel.Annotations" + "System.ComponentModel.DataAnnotations" + "System.ComponentModel" + "System.ComponentModel.EventBasedAsync" + "System.ComponentModel.Primitives" + "System.ComponentModel.TypeConverter" + "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" + "System.Drawing" + "System.Drawing.Primitives" + "System.Dynamic.Runtime" + "System.Globalization.Calendars" + "System.Globalization" + "System.Globalization.Extensions" + "System.IO.Compression.Brotli" + "System.IO.Compression" + "System.IO.Compression.FileSystem" + "System.IO.Compression.ZipFile" + "System.IO" + "System.IO.FileSystem" + "System.IO.FileSystem.DriveInfo" + "System.IO.FileSystem.Primitives" + "System.IO.FileSystem.Watcher" + "System.IO.IsolatedStorage" + "System.IO.MemoryMappedFiles" + "System.IO.Pipes" + "System.IO.UnmanagedMemoryStream" + "System.Linq" + "System.Linq.Expressions" + "System.Linq.Parallel" + "System.Linq.Queryable" + "System.Memory" + "System.Net" + "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.Numerics" + "System.Numerics.Vectors" + "System.ObjectModel" + "System.Reflection.DispatchProxy" + "System.Reflection" + "System.Reflection.Emit" + "System.Reflection.Emit.ILGeneration" + "System.Reflection.Emit.Lightweight" + "System.Reflection.Extensions" + "System.Reflection.Metadata" + "System.Reflection.Primitives" + "System.Reflection.TypeExtensions" + "System.Resources.Reader" + "System.Resources.ResourceManager" + "System.Resources.Writer" + "System.Runtime.CompilerServices.Unsafe" + "System.Runtime.CompilerServices.VisualC" + "System.Runtime" + "System.Runtime.Extensions" + "System.Runtime.Handles" + "System.Runtime.InteropServices" + "System.Runtime.InteropServices.RuntimeInformation" + "System.Runtime.InteropServices.WindowsRuntime" + "System.Runtime.Intrinsics" + "System.Runtime.Loader" + "System.Runtime.Numerics" + "System.Runtime.Serialization" + "System.Runtime.Serialization.Formatters" + "System.Runtime.Serialization.Json" + "System.Runtime.Serialization.Primitives" + "System.Runtime.Serialization.Xml" + "System.Security.Claims" + "System.Security.Cryptography.Algorithms" + "System.Security.Cryptography.Csp" + "System.Security.Cryptography.Encoding" + "System.Security.Cryptography.Primitives" + "System.Security.Cryptography.X509Certificates" + "System.Security" + "System.Security.Principal" + "System.Security.SecureString" + "System.ServiceModel.Web" + "System.ServiceProcess" + "System.Text.Encoding.CodePages" + "System.Text.Encoding" + "System.Text.Encoding.Extensions" + "System.Text.Encodings.Web" + "System.Text.Json" + "System.Text.RegularExpressions" + "System.Threading.Channels" + "System.Threading" + "System.Threading.Overlapped" + "System.Threading.Tasks.Dataflow" + "System.Threading.Tasks" + "System.Threading.Tasks.Extensions" + "System.Threading.Tasks.Parallel" + "System.Threading.Thread" + "System.Threading.ThreadPool" + "System.Threading.Timer" + "System.Transactions" + "System.Transactions.Local" + "System.ValueTuple" + "System.Web" + "System.Web.HttpUtility" + "System.Windows" + "System.Xml" + "System.Xml.Linq" + "System.Xml.ReaderWriter" + "System.Xml.Serialization" + "System.Xml.XDocument" + "System.Xml.XmlDocument" + "System.Xml.XmlSerializer" + "System.Xml.XPath" + "System.Xml.XPath.XDocument" + "WindowsBase" + |] diff --git a/fcs/fcs-fable/test/Platform.fs b/fcs/fcs-fable/test/Platform.fs new file mode 100644 index 000000000000..a3878b1a8609 --- /dev/null +++ b/fcs/fcs-fable/test/Platform.fs @@ -0,0 +1,92 @@ +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('\\', '/') + +#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 + + let FileSystem: IFileSystem = importAll "fs" + let Process: IProcess = importAll "process" + let Path: IPath = importAll "path" + +let readAllBytes (filePath: string) = JS.FileSystem.readFileSync(filePath) +let readAllText (filePath: string) = JS.FileSystem.readFileSync(filePath, "utf8").TrimStart('\uFEFF') +let writeAllText (filePath: string) (text: string) = JS.FileSystem.writeFileSync(filePath, text) + +let measureTime (f: 'a -> 'b) x = + let startTime = JS.Process.hrtime() + let res = f x + let elapsed = JS.Process.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('\\', '/') + +#endif + +module Path = + + let Combine (path1: string, path2: string) = + let path1 = + if path1.Length = 0 then path1 + else (path1.TrimEnd [|'\\';'/'|]) + "/" + path1 + (path2.TrimStart [|'\\';'/'|]) + + let ChangeExtension (path: string, ext: string) = + let i = path.LastIndexOf(".") + if i < 0 then path + else path.Substring(0, i) + ext + + let GetFileName (path: string) = + let normPath = path.Replace("\\", "/").TrimEnd('/') + let i = normPath.LastIndexOf("/") + normPath.Substring(i + 1) + + let GetFileNameWithoutExtension (path: string) = + let path = GetFileName path + let i = path.LastIndexOf(".") + path.Substring(0, i) + + let GetDirectoryName (path: string) = + let normPath = path.Replace("\\", "/") + let i = normPath.LastIndexOf("/") + if i < 0 then "" + else normPath.Substring(0, i) diff --git a/fcs/fcs-fable/test/ProjectParser.fs b/fcs/fcs-fable/test/ProjectParser.fs new file mode 100644 index 000000000000..eac497e38b32 --- /dev/null +++ b/fcs/fcs-fable/test/ProjectParser.fs @@ -0,0 +1,176 @@ +module Fable.Compiler.ProjectParser + +open Fable.Compiler.Platform +open System.Collections.Generic +open System.Text.RegularExpressions + +let (|Regex|_|) (pattern: string) (input: string) = + let m = Regex.Match(input, pattern) + if m.Success then + let mutable groups = [] + for i = m.Groups.Count - 1 downto 0 do + groups <- m.Groups.[i].Value::groups + Some groups + else None + +let parseCompilerOptions projectText = + + // get project type + let m = Regex.Match(projectText, @"]*>([^<]*)<\/OutputType[^>]*>") + let target = if m.Success then m.Groups.[1].Value.Trim().ToLowerInvariant() else "" + + // get warning level + let m = Regex.Match(projectText, @"]*>([^<]*)<\/WarningLevel[^>]*>") + let warnLevel = if m.Success then m.Groups.[1].Value.Trim() else "" + + // get treat warnings as errors + let m = Regex.Match(projectText, @"]*>([^<]*)<\/TreatWarningsAsErrors[^>]*>") + let treatWarningsAsErrors = m.Success && m.Groups.[1].Value.Trim().ToLowerInvariant() = "true" + + // get conditional defines + let defines = + Regex.Matches(projectText, @"]*>([^<]*)<\/DefineConstants[^>]*>") + |> Seq.collect (fun m -> m.Groups.[1].Value.Split(';')) + |> Seq.append ["FABLE_COMPILER"] + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(DefineConstants)"; ""] + |> Seq.toArray + + // get disabled warnings + let nowarns = + Regex.Matches(projectText, @"]*>([^<]*)<\/NoWarn[^>]*>") + |> Seq.collect (fun m -> m.Groups.[1].Value.Split(';')) + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(NoWarn)"; ""] + |> Seq.toArray + + // get warnings as errors + let warnAsErrors = + Regex.Matches(projectText, @"]*>([^<]*)<\/WarningsAsErrors[^>]*>") + |> Seq.collect (fun m -> m.Groups.[1].Value.Split(';')) + |> Seq.map (fun s -> s.Trim()) + |> Seq.distinct + |> Seq.except ["$(WarningsAsErrors)"; ""] + |> Seq.toArray + + // get other flags + let otherFlags = + Regex.Matches(projectText, @"]*>([^<]*)<\/OtherFlags[^>]*>") + |> Seq.collect (fun m -> m.Groups.[1].Value.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 warnLevel.Length > 0 then + yield "--warn:" + warnLevel + if treatWarningsAsErrors 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 parseProjectScript projectFileName = + let projectText = readAllText projectFileName + let projectDir = Path.GetDirectoryName projectFileName + let dllRefs, srcFiles = + (([||], [||]), projectText.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 projectFileName|] + let otherOptions = [| "--define:FABLE_COMPILER" |] + (dllRefs, projectRefs, sourceFiles, otherOptions) + +let parseProjectFile projectFileName = + let projectText = readAllText projectFileName + + // remove all comments + let projectText = Regex.Replace(projectText, @"", "") + + // get project references + let projectRefs = + Regex.Matches(projectText, @"]*Include\s*=\s*(""[^""]*|'[^']*)") + |> Seq.map (fun m -> m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim().Replace("\\", "/")) + |> Seq.toArray + + // replace some variables + let projectText = projectText.Replace(@"$(MSBuildProjectDirectory)", ".") + let m = Regex.Match(projectText, @"]*>([^<]*)<\/FSharpSourcesRoot[^>]*>") + let sourcesRoot = if m.Success then m.Groups.[1].Value.Replace("\\", "/") else "" + let projectText = projectText.Replace(@"$(FSharpSourcesRoot)", sourcesRoot) + + // get source files + let sourceFilesRegex = @"]*Include\s*=\s*(""[^""]*|'[^']*)" + let sourceFiles = + Regex.Matches(projectText, sourceFilesRegex) + |> Seq.map (fun m -> m.Groups.[1].Value.TrimStart('"').TrimStart(''').Trim().Replace("\\", "/")) + |> Seq.toArray + + let dllRefs = [||] + let otherOptions = parseCompilerOptions projectText + (dllRefs, projectRefs, 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 dedupProjectRefs (projSet: HashSet) projectRefs = + let newRefs = projectRefs |> Array.filter (fun x -> projSet.Contains(x) |> not) + projSet.UnionWith(newRefs) + newRefs + +let dedupFileNames (fileSet: HashSet) fileNames = + let padName (fileName: string) = + let pos = fileName.LastIndexOf(".") + let nm = if pos < 0 then fileName else fileName.Substring(0, pos) + let ext = if pos < 0 then "" else fileName.Substring(pos) + nm + "_" + ext + let rec dedup fileName = + if fileSet.Contains(fileName) then + dedup (padName fileName) + else + fileSet.Add(fileName) |> ignore + fileName + fileNames |> Array.map dedup + +let rec parseProject (projSet: HashSet) (projectFileName: string) = + let (dllRefs, projectRefs, sourceFiles, otherOptions) = + if projectFileName.EndsWith(".fsx") + then parseProjectScript projectFileName + else parseProjectFile projectFileName + + let projectFileDir = Path.GetDirectoryName projectFileName + let isAbsolutePath (path: string) = path.StartsWith("/") || path.IndexOf(":") = 1 + let makePath path = + if isAbsolutePath path then path + else Path.Combine(projectFileDir, path) + |> normalizeFullPath + + let sourcePaths = sourceFiles |> Array.map makePath + let sourceTexts = sourcePaths |> Array.map readAllText + + // parse and combine all referenced projects into one big project + let parsedProjects = projectRefs |> Array.map makePath |> dedupProjectRefs projSet |> Array.map (parseProject projSet) + let sourcePaths = sourcePaths |> Array.append (parsedProjects |> Array.collect (fun (_,x,_,_) -> x)) + let sourceTexts = sourceTexts |> Array.append (parsedProjects |> Array.collect (fun (_,_,x,_) -> x)) + let otherOptions = otherOptions |> Array.append (parsedProjects |> Array.collect (fun (_,_,_,x) -> x)) + + (dllRefs, sourcePaths, sourceTexts, otherOptions |> Array.distinct) diff --git a/fcs/fcs-fable/test/bench/Properties/launchSettings.json b/fcs/fcs-fable/test/bench/Properties/launchSettings.json new file mode 100644 index 000000000000..787bc4e16eef --- /dev/null +++ b/fcs/fcs-fable/test/bench/Properties/launchSettings.json @@ -0,0 +1,9 @@ +{ + "profiles": { + "fcs-fable-bench": { + "commandName": "Project", + "commandLineArgs": "../../fcs-fable.fsproj", + "workingDirectory": "$(SolutionDir)" + } + } +} \ No newline at end of file diff --git a/fcs/fcs-fable/test/bench/bench.fs b/fcs/fcs-fable/test/bench/bench.fs new file mode 100644 index 000000000000..801677d27fee --- /dev/null +++ b/fcs/fcs-fable/test/bench/bench.fs @@ -0,0 +1,109 @@ +module Fable.Compiler.App + +open FSharp.Compiler.SourceCodeServices +open Fable.Compiler.Platform +open Fable.Compiler.ProjectParser + +let references = Metadata.references_core +let metadataPath = "/Projects/Fable/src/fable-metadata/lib/" // .NET BCL binaries + +let printErrors showWarnings (errors: FSharpErrorInfo[]) = + let isWarning (e: FSharpErrorInfo) = + e.Severity = FSharpErrorSeverity.Warning + let printError (e: FSharpErrorInfo) = + let errorType = (if isWarning e then "Warning" else "Error") + printfn "%s (%d,%d): %s: %s" e.FileName e.StartLineAlternate 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 projSet = makeHashSetIgnoreCase () + let (dllRefs, fileNames, sources, otherOptions) = parseProject projSet projectFileName + + // dedup file names + let fileSet = makeHashSetIgnoreCase () + let fileNames = dedupFileNames fileSet fileNames + + // 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.Errors |> 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 + + // 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-fcs" + parseFiles projectFileName outDir optimize + | _ -> printfn "%s" usage + +[] +let main argv = + try + parseArguments argv + with ex -> + printfn "Error: %A" ex.Message + 0 diff --git a/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj new file mode 100644 index 000000000000..50636c4d921b --- /dev/null +++ b/fcs/fcs-fable/test/bench/fcs-fable-bench.fsproj @@ -0,0 +1,26 @@ + + + + Exe + netcoreapp3.1 + $(DefineConstants);DOTNET_FILE_SYSTEM + true + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/test/bench/fcs-fable-bench.sln b/fcs/fcs-fable/test/bench/fcs-fable-bench.sln new file mode 100644 index 000000000000..213e74fbe718 --- /dev/null +++ b/fcs/fcs-fable/test/bench/fcs-fable-bench.sln @@ -0,0 +1,37 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 15 +VisualStudioVersion = 15.0.28307.106 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "fcs-fable-bench", "fcs-fable-bench.fsproj", "{83F34C34-6804-4436-923E-E2C539AA59F0}" +EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "fcs-fable", "../../fcs-fable.fsproj", "{7D5BC9E3-CEE5-4E1B-BF4E-67553841FD37}" +EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "fcs-fable-test", "../fcs-fable-test.fsproj", "{C270F69E-224E-4438-8EF3-5AB59FF11453}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {83F34C34-6804-4436-923E-E2C539AA59F0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {83F34C34-6804-4436-923E-E2C539AA59F0}.Debug|Any CPU.Build.0 = Debug|Any CPU + {83F34C34-6804-4436-923E-E2C539AA59F0}.Release|Any CPU.ActiveCfg = Release|Any CPU + {83F34C34-6804-4436-923E-E2C539AA59F0}.Release|Any CPU.Build.0 = Release|Any CPU + {7D5BC9E3-CEE5-4E1B-BF4E-67553841FD37}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {7D5BC9E3-CEE5-4E1B-BF4E-67553841FD37}.Debug|Any CPU.Build.0 = Debug|Any CPU + {7D5BC9E3-CEE5-4E1B-BF4E-67553841FD37}.Release|Any CPU.ActiveCfg = Release|Any CPU + {7D5BC9E3-CEE5-4E1B-BF4E-67553841FD37}.Release|Any CPU.Build.0 = Release|Any CPU + {C270F69E-224E-4438-8EF3-5AB59FF11453}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {C270F69E-224E-4438-8EF3-5AB59FF11453}.Debug|Any CPU.Build.0 = Debug|Any CPU + {C270F69E-224E-4438-8EF3-5AB59FF11453}.Release|Any CPU.ActiveCfg = Release|Any CPU + {C270F69E-224E-4438-8EF3-5AB59FF11453}.Release|Any CPU.Build.0 = Release|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {BC5C2845-7FCA-4814-93C2-F5910096D973} + EndGlobalSection +EndGlobal diff --git a/fcs/fcs-fable/test/fcs-fable-test.fsproj b/fcs/fcs-fable/test/fcs-fable-test.fsproj new file mode 100644 index 000000000000..5149afd9e3d2 --- /dev/null +++ b/fcs/fcs-fable/test/fcs-fable-test.fsproj @@ -0,0 +1,25 @@ + + + + Exe + netcoreapp3.1 + $(DefineConstants);DOTNET_FILE_SYSTEM + true + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-fable/test/package.json b/fcs/fcs-fable/test/package.json new file mode 100644 index 000000000000..12b0c43302f9 --- /dev/null +++ b/fcs/fcs-fable/test/package.json @@ -0,0 +1,15 @@ +{ + "private": true, + "type": "module", + "scripts": { + "build-test": "dotnet build -c Release fcs-fable-test.fsproj", + "build-bench": "dotnet build -c Release bench/fcs-fable-bench.fsproj", + "build-node": "fable fcs-fable-test.fsproj out-test", + "test-node": "node out-test/test", + "test-dotnet": "dotnet run -c Release -p fcs-fable-test.fsproj", + "bench-dotnet": "dotnet run -c Release -p bench/fcs-fable-bench.fsproj ../fcs-fable.fsproj" + }, + "devDependencies": { + "fable-compiler-js": "^1.3.1" + } +} diff --git a/fcs/fcs-fable/test/splitter.config.js b/fcs/fcs-fable/test/splitter.config.js new file mode 100644 index 000000000000..428407dfe0aa --- /dev/null +++ b/fcs/fcs-fable/test/splitter.config.js @@ -0,0 +1,28 @@ +const path = require("path"); + +const useCommonjs = process.argv.find(v => v === "--commonjs"); +console.log("Compiling to " + (useCommonjs ? "commonjs" : "ES2015 modules") + "...") + +const babelOptions = useCommonjs + ? { plugins: ["@babel/plugin-transform-modules-commonjs"] } + : {}; + +const fableOptions = { + define: [ + "FX_NO_CORHOST_SIGNER", + "FX_NO_PDB_READER", + "FX_NO_PDB_WRITER", + "FX_NO_WEAKTABLE", + "NO_EXTENSIONTYPING", + "NO_INLINE_IL_PARSER" + ], + // extra: { saveAst: "./ast" } +}; + +module.exports = { + entry: path.join(__dirname, "./fcs-fable-test.fsproj"), + outDir: path.join(__dirname, "./out-test"), + // port: 61225, + babel: babelOptions, + fable: fableOptions, +}; diff --git a/fcs/fcs-fable/test/test.fs b/fcs/fcs-fable/test/test.fs new file mode 100644 index 000000000000..176975a0f077 --- /dev/null +++ b/fcs/fcs-fable/test/test.fs @@ -0,0 +1,65 @@ +module Fable.Compiler.App + +open FSharp.Compiler +open FSharp.Compiler.SourceCodeServices +open Fable.Compiler.Platform + +let references = Metadata.references_core +let metadataPath = "../../../../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 = "test_script.fsx" + let source = readAllText fileName + + //let parseResults, typeCheckResults, projectResults = + // checker.ParseAndCheckScript(projectFileName, fileName, source) + let parseResults, tcResultsOpt, projectResults = + checker.ParseAndCheckFileInProject(fileName, projectFileName, [|fileName|], [|source|]) + + // print errors + projectResults.Errors |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + + match tcResultsOpt with + | Some typeCheckResults -> + + 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') + + async { + // Get tool tip at the specified location + let! tip = typeCheckResults.GetToolTipText(4, 7, inputLines.[3], ["foo"], 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 _ -> []), fun _ -> false) + [ for item in decls.Items -> item.Name ] |> 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 _ -> []), fun _ -> false) + [ for item in decls.Items -> item.Name ] |> printfn "\n---> canvas AutoComplete = %A" + } |> Async.StartImmediate + | _ -> () + 0 diff --git a/fcs/fcs-fable/test/test_script.fsx b/fcs/fcs-fable/test/test_script.fsx new file mode 100644 index 000000000000..344a81772ef5 --- /dev/null +++ b/fcs/fcs-fable/test/test_script.fsx @@ -0,0 +1,9 @@ +open System +open Fable.Import + +let foo() = + let msg = String.Concat("Hello"," ","world") + let len = msg.Length + // let canvas = Browser.document.createElement_canvas () + // canvas.width <- 1000. + () \ No newline at end of file diff --git a/src/buildtools/buildtools.targets b/src/buildtools/buildtools.targets index 86346fc2a156..25effd1d61e2 100644 --- a/src/buildtools/buildtools.targets +++ b/src/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\netcoreapp3.1\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\netcoreapp3.1\fsyacc.dll diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index f7554e44c39f..93f7c3821527 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -274,7 +274,11 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = if g.compilingFslib 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 diff --git a/src/fsharp/CompilerConfig.fs b/src/fsharp/CompilerConfig.fs index aef116cef1ac..dcf0665eb060 100644 --- a/src/fsharp/CompilerConfig.fs +++ b/src/fsharp/CompilerConfig.fs @@ -16,11 +16,15 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILPdbWriter +#endif open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Internal.Utils +#if !FABLE_COMPILER open FSharp.Compiler.DotNetFrameworkDependencies +#endif open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Lib @@ -28,7 +32,9 @@ open FSharp.Compiler.Range open FSharp.Compiler.ReferenceResolver open FSharp.Compiler.TypedTree +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif #if !NO_EXTENSIONTYPING open FSharp.Compiler.ExtensionTyping @@ -55,6 +61,8 @@ let FSharpLightSyntaxFileSuffixes: string list = [ ".fs";".fsscript";".fsx";".fs exception FileNameNotResolved of (*filename*) string * (*description of searched locations*) string * range exception LoadedSourceNotFoundIgnoring of (*filename*) string * range +#if !FABLE_COMPILER + /// Will return None if the filename is not found. let TryResolveFileUsingPaths(paths, m, name) = let () = @@ -77,6 +85,8 @@ let ResolveFileUsingPaths(paths, m, name) = let searchMessage = String.concat "\n " paths raise (FileNameNotResolved(name, searchMessage, m)) +#endif //!FABLE_COMPILER + let GetWarningNumber(m, warningNumber: string) = try // Okay so ... @@ -129,7 +139,11 @@ type VersionFlag = IL.parseILVersion vstr with _ -> errorR(Error(FSComp.SR.buildInvalidVersionString vstr, rangeStartup)); IL.parseILVersion "0.0.0.0" - member x.GetVersionString implicitIncludeDir = + member x.GetVersionString (implicitIncludeDir: string) = +#if FABLE_COMPILER + ignore implicitIncludeDir + "0.0.0.0" +#else match x with | VersionString s -> s | VersionFile s -> @@ -140,6 +154,7 @@ type VersionFlag = use is = System.IO.File.OpenText s 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 @@ -183,10 +198,12 @@ type TimeStampCache(defaultTimeStamp: DateTime) = let ok, v = files.TryGetValue fileName if ok then v else let v = +#if !FABLE_COMPILER try FileSystem.GetLastWriteTimeShim fileName with | :? FileNotFoundException -> +#endif defaultTimeStamp files.[fileName] <- v v @@ -415,7 +432,9 @@ type TcConfigBuilder = mutable maxErrors: int mutable abortOnError: bool (* intended for fsi scripts that should exit on first error *) mutable baseAddress: int32 option +#if !FABLE_COMPILER mutable checksumAlgorithm: HashAlgorithm +#endif #if DEBUG mutable showOptimizationData: bool #endif @@ -548,7 +567,9 @@ type TcConfigBuilder = maxErrors = 100 abortOnError = false baseAddress = None +#if !FABLE_COMPILER checksumAlgorithm = HashAlgorithm.Sha256 +#endif delaysign = false publicsign = false @@ -595,7 +616,11 @@ type TcConfigBuilder = deterministic = false preferredUiLang = None lcid = None +#if FABLE_COMPILER + productNameForBannerText = "Microsoft (R) F# Compiler" +#else productNameForBannerText = FSharpEnvironment.FSharpProductName +#endif showBanner = true showTimes = false showLoadedAssemblies = false @@ -664,6 +689,8 @@ type TcConfigBuilder = } tcConfigBuilder +#if !FABLE_COMPILER + member tcConfigB.ResolveSourceFile(m, nm, pathLoadedFrom) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter ResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom], m, nm) @@ -704,6 +731,8 @@ type TcConfigBuilder = tcConfigB.outputFile <- Some outfile outfile, pdbfile, assemblyName +#endif //!FABLE_COMPILER + member tcConfigB.TurnWarningOff(m, s: string) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter match GetWarningNumber(m, s) with @@ -724,7 +753,13 @@ type TcConfigBuilder = tcConfigB.errorSeverityOptions <- { tcConfigB.errorSeverityOptions with WarnOn = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOn } - member tcConfigB.AddIncludePath (m, path, pathIncludedFrom) = + member tcConfigB.AddIncludePath (m: range, path: string, pathIncludedFrom: string) = +#if FABLE_COMPILER + ignore m + ignore path + ignore pathIncludedFrom + () +#else //!FABLE_COMPILER let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path let ok = let existsOpt = @@ -737,8 +772,15 @@ type TcConfigBuilder = | None -> false if ok && not (List.contains absolutePath tcConfigB.includes) then tcConfigB.includes <- tcConfigB.includes ++ absolutePath - - member tcConfigB.AddLoadedSource(m, originalPath, pathLoadedFrom) = +#endif //!FABLE_COMPILER + + member tcConfigB.AddLoadedSource(m: range, originalPath: string, pathLoadedFrom: string) = +#if FABLE_COMPILER + ignore m + ignore originalPath + ignore pathLoadedFrom + () +#else //!FABLE_COMPILER if FileSystem.IsInvalidPathShim originalPath then warning(Error(FSComp.SR.buildInvalidFilename originalPath, m)) else @@ -750,6 +792,7 @@ type TcConfigBuilder = ComputeMakePathAbsolute pathLoadedFrom originalPath 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 (file) = tcConfigB.embedSourceList <- tcConfigB.embedSourceList ++ file @@ -770,6 +813,7 @@ type TcConfigBuilder = let projectReference = tcConfigB.projectReferences |> List.tryPick (fun pr -> if pr.FileName = path then Some pr else None) 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 @@ -798,6 +842,7 @@ type TcConfigBuilder = // #r "Assembly" | path, _ -> tcConfigB.AddReferencedAssemblyByPath (m, path) +#endif //!FABLE_COMPILER member tcConfigB.RemoveReferencedAssemblyByPath (m, path) = tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs |> List.filter (fun ar -> not (Range.equals ar.Range m) || ar.Text <> path) @@ -831,6 +876,12 @@ type TcConfigBuilder = /// This type is immutable and must be kept as such. Do not extract or mutate the underlying data except by cloning it. type TcConfig private (data: TcConfigBuilder, validate: bool) = +#if FABLE_COMPILER + let _ = validate + let clrRootValue, targetFrameworkVersionValue = "", "" + +#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 if validate then try data.version.GetVersionInfo(data.implicitIncludeDir) |> ignore with e -> errorR e @@ -890,6 +941,8 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let systemAssemblies = systemAssemblies +#endif //!FABLE_COMPILER + member x.primaryAssembly = data.primaryAssembly member x.noFeedback = data.noFeedback member x.stackReserveSize = data.stackReserveSize @@ -975,8 +1028,10 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member x.flatErrors = data.flatErrors member x.maxErrors = data.maxErrors member x.baseAddress = data.baseAddress +#if !FABLE_COMPILER member x.checksumAlgorithm = data.checksumAlgorithm - #if DEBUG +#endif +#if DEBUG member x.showOptimizationData = data.showOptimizationData #endif member x.showTerms = data.showTerms @@ -1023,6 +1078,8 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member tcConfig.CloneToBuilder() = { data with conditionalCompilationDefines=data.conditionalCompilationDefines } +#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) @@ -1105,12 +1162,16 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = with e -> errorRecovery e range0; [] +#endif //!FABLE_COMPILER + member tcConfig.ComputeLightSyntaxInitialStatus filename = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter let lower = String.lowercase filename let lightOnByDefault = List.exists (Filename.checkSuffix lower) FSharpLightSyntaxFileSuffixes if lightOnByDefault then (tcConfig.light <> Some false) else (tcConfig.light = Some true ) +#if !FABLE_COMPILER + member tcConfig.GetAvailableLoadedSources() = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter let resolveLoadedSource (m, originalPath, path) = @@ -1186,4 +1247,10 @@ type TcConfigProvider = /// TcConfigBuilder rather than delivering snapshots. 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 //!FABLE_COMPILER diff --git a/src/fsharp/CompilerConfig.fsi b/src/fsharp/CompilerConfig.fsi index 00e824b4054d..7fa66080679c 100644 --- a/src/fsharp/CompilerConfig.fsi +++ b/src/fsharp/CompilerConfig.fsi @@ -10,14 +10,18 @@ open Internal.Utilities open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILPdbWriter +#endif open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Range +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif exception FileNameNotResolved of (*filename*) string * (*description of searched locations*) string * range exception LoadedSourceNotFoundIgnoring of (*filename*) string * range @@ -228,8 +232,10 @@ type TcConfigBuilder = mutable maxErrors: int mutable abortOnError: bool mutable baseAddress: int32 option +#if !FABLE_COMPILER mutable checksumAlgorithm: HashAlgorithm - #if DEBUG +#endif +#if DEBUG mutable showOptimizationData: bool #endif mutable showTerms : bool @@ -293,7 +299,9 @@ type TcConfigBuilder = tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot -> TcConfigBuilder +#if !FABLE_COMPILER member DecideNames: string list -> outfile: string * pdbfile: string option * assemblyName: string +#endif //!FABLE_COMPILER member TurnWarningOff: range * string -> unit @@ -318,7 +326,9 @@ 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 @@ -406,7 +416,9 @@ type TcConfig = member maxErrors: int member baseAddress: int32 option +#if !FABLE_COMPILER member checksumAlgorithm: HashAlgorithm +#endif #if DEBUG member showOptimizationData: bool #endif @@ -440,6 +452,8 @@ type TcConfig = member ComputeLightSyntaxInitialStatus: 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 @@ -453,6 +467,8 @@ type TcConfig = /// File system query based on TcConfig settings member MakePathAbsolute: string -> string +#endif //!FABLE_COMPILER + member resolutionEnvironment: ReferenceResolver.ResolutionEnvironment member copyFSharpCore: CopyFSharpCoreFlag @@ -485,6 +501,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 @@ -514,6 +532,8 @@ val TryResolveFileUsingPaths: paths: string list * m: range * name: string -> st val ResolveFileUsingPaths: paths: string list * m: range * name: string -> string +#endif //!FABLE_COMPILER + val GetWarningNumber: m: range * warningNumber: string -> int option /// Get the name used for FSharp.Core diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index 80c84edf17b8..da9b4fa196a8 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -204,9 +204,11 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | HashLoadedSourceHasIssues(_, _, m) | HashLoadedScriptConsideredSource m -> Some m +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e -> RangeFromException e.InnerException +#endif #if !NO_EXTENSIONTYPING | :? TypeProviderError as e -> e.Range |> Some #endif @@ -332,9 +334,11 @@ let GetDiagnosticNumber(err: PhasedDiagnostic) = | PatternMatchCompilation.EnumMatchIncomplete _ -> 104 (* DO NOT CHANGE THE NUMBERS *) +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e -> GetFromException e.InnerException +#endif | WrappedError(e, _) -> GetFromException e @@ -400,9 +404,11 @@ let SplitRelatedDiagnostics(err: PhasedDiagnostic) : PhasedDiagnostic * PhasedDi | WrappedError (e, m) -> let e, related = SplitRelatedException e WrappedError(e.Exception, m)|>ToPhased, related +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e -> SplitRelatedException e.InnerException +#endif | e -> ToPhased e, [] SplitRelatedException err.Exception @@ -410,7 +416,9 @@ let SplitRelatedDiagnostics(err: PhasedDiagnostic) : PhasedDiagnostic * PhasedDi let DeclareMessage = FSharp.Compiler.DiagnosticMessage.DeclareResourceString +#if !FABLE_COMPILER do FSComp.SR.RunStartupValidation() +#endif let SeeAlsoE() = DeclareResourceString("SeeAlso", "%s") let ConstraintSolverTupleDiffLengthsE() = DeclareResourceString("ConstraintSolverTupleDiffLengths", "%d%d") let ConstraintSolverInfiniteTypesE() = DeclareResourceString("ConstraintSolverInfiniteTypes", "%s%s") @@ -573,6 +581,19 @@ let getErrorString key = SR.GetString key let (|InvalidArgument|_|) (exn: exn) = match exn with :? ArgumentException as e -> Some e.Message | _ -> None +#if FABLE_COMPILER +type StringBuilder() = + let buf = System.Text.StringBuilder() + member x.Append(s: string) = buf.Append(s) |> ignore; x + member x.AppendLine() = x.Append("\n") + override x.ToString() = buf.ToString() + +module Printf = + let bprintf (sb: StringBuilder) = + let f (s: string) = sb.Append(s) |> ignore + Printf.kprintf f +#endif + let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNames: bool) = let suggestNames suggestionsF idText = @@ -1154,7 +1175,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa | Some token -> match (token |> Parser.tagOfToken |> Parser.tokenTagToTokenId), token with | EndOfStructuredConstructToken, _ -> os.Append(OBlockEndSentenceE().Format) |> ignore - | Parser.TOKEN_LEX_FAILURE, Parser.LEX_FAILURE str -> Printf.bprintf os "%s" str (* Fix bug://2431 *) + | Parser.TOKEN_LEX_FAILURE, Parser.LEX_FAILURE str -> Printf.bprintf os "%s" str //(* Fix bug://2431 *) | token, _ -> os.Append(UnexpectedE().Format (token |> tokenIdToText)) |> ignore (* Search for a state producing a single recognized non-terminal in the states on the stack *) @@ -1396,7 +1417,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa os.Append(LetRecUnsound1E().Format v.DisplayName) |> ignore | LetRecUnsound (_, path, _) -> - let bos = new System.Text.StringBuilder() + let bos = new StringBuilder() (path.Tail @ [path.Head]) |> List.iter (fun (v: ValRef) -> bos.Append(LetRecUnsoundInnerE().Format v.DisplayName) |> ignore) os.Append(LetRecUnsound2E().Format (List.head path).DisplayName (bos.ToString())) |> ignore @@ -1618,6 +1639,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa | MSBuildReferenceResolutionError(code, message, _) -> os.Append(MSBuildReferenceResolutionErrorE().Format message code) |> ignore +#if !FABLE_COMPILER // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e -> OutputExceptionR os e.InnerException @@ -1633,7 +1655,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa | :? IOException as e -> Printf.bprintf os "%s" e.Message | :? System.UnauthorizedAccessException as e -> Printf.bprintf os "%s" e.Message - +#endif //!FABLE_COMPILER | e -> os.Append(TargetInvocationExceptionWrapperE().Format e.Message) |> ignore #if DEBUG @@ -1647,7 +1669,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa // remove any newlines and tabs let OutputPhasedDiagnostic (os: System.Text.StringBuilder) (err: PhasedDiagnostic) (flattenErrors: bool) (suggestNames: bool) = - let buf = new System.Text.StringBuilder() + let buf = new StringBuilder() OutputPhasedErrorR buf err suggestNames let s = if flattenErrors then ErrorLogger.NormalizeErrorString (buf.ToString()) else buf.ToString() @@ -1674,6 +1696,8 @@ let SanitizeFileName fileName implicitIncludeDir = with _ -> fileName +#if !FABLE_COMPILER + [] type DiagnosticLocation = { Range: range @@ -1771,7 +1795,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt let where = OutputWhere mainError let canonical = OutputCanonicalInformation(err.Subcategory(), GetDiagnosticNumber mainError) let message = - let os = System.Text.StringBuilder() + let os = StringBuilder() OutputPhasedDiagnostic os mainError flattenErrors suggestNames os.ToString() @@ -1786,7 +1810,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt let relWhere = OutputWhere mainError // mainError? let relCanonical = OutputCanonicalInformation(err.Subcategory(), GetDiagnosticNumber mainError) // Use main error for code let relMessage = - let os = System.Text.StringBuilder() + let os = StringBuilder() OutputPhasedDiagnostic os err flattenErrors suggestNames os.ToString() @@ -1794,7 +1818,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt errors.Add( Diagnostic.Long (isError, entry) ) | _ -> - let os = System.Text.StringBuilder() + let os = StringBuilder() OutputPhasedDiagnostic os err flattenErrors suggestNames errors.Add( Diagnostic.Short(isError, os.ToString()) ) @@ -1845,6 +1869,8 @@ let OutputDiagnosticContext prefix fileLineFunction os err = Printf.bprintf os "%s%s\n" prefix line Printf.bprintf os "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') +#endif //!FABLE_COMPILER + let ReportWarning options err = warningOn err (options.WarnLevel) (options.WarnOn) && not (List.contains (GetDiagnosticNumber err) (options.WarnOff)) diff --git a/src/fsharp/CompilerDiagnostics.fsi b/src/fsharp/CompilerDiagnostics.fsi index 531cc29076be..72d6339573f5 100644 --- a/src/fsharp/CompilerDiagnostics.fsi +++ b/src/fsharp/CompilerDiagnostics.fsi @@ -55,6 +55,8 @@ val SplitRelatedDiagnostics: PhasedDiagnostic -> PhasedDiagnostic * PhasedDiagno /// Output an error to a buffer val OutputPhasedDiagnostic: StringBuilder -> PhasedDiagnostic -> flattenErrors: bool -> suggestNames: bool -> unit +#if !FABLE_COMPILER + /// Output an error or warning to a buffer val OutputDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * isError:bool -> StringBuilder -> PhasedDiagnostic -> unit @@ -92,6 +94,8 @@ type Diagnostic = /// Part of LegacyHostedCompilerForTesting val CollectDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * isError:bool * PhasedDiagnostic * suggestNames: bool -> seq +#endif //!FABLE_COMPILER + /// Get an error logger that filters the reporting of warnings based on scoped pragma information val GetErrorLoggerFilteringByScopedPragmas: checkFile:bool * ScopedPragma list * ErrorLogger -> ErrorLogger diff --git a/src/fsharp/CompilerGlobalState.fs b/src/fsharp/CompilerGlobalState.fs index 08e977aa3b71..c734226e118f 100644 --- a/src/fsharp/CompilerGlobalState.fs +++ b/src/fsharp/CompilerGlobalState.fs @@ -97,12 +97,16 @@ type internal CompilerGlobalState () = type Unique = int64 //++GLOBAL MUTABLE STATE (concurrency-safe) -let newUnique = - let i = ref 0L - fun () -> System.Threading.Interlocked.Increment i +#if FABLE_COMPILER +let newUnique = let i = ref 0L in fun () -> i := !i + 1L; !i +#else +let newUnique = let i = ref 0L in 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) -let newStamp = - let i = ref 0L - fun () -> System.Threading.Interlocked.Increment i +#if FABLE_COMPILER +let newStamp = let i = ref 0L in fun () -> i := !i + 1L; !i +#else +let newStamp = let i = ref 0L in fun () -> System.Threading.Interlocked.Increment i +#endif diff --git a/src/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index 3db33b94f9bd..b0b87d2449dc 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -24,7 +24,9 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig +#if !FABLE_COMPILER open FSharp.Compiler.DotNetFrameworkDependencies +#endif open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Import open FSharp.Compiler.Lib @@ -39,7 +41,9 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TcGlobals open FSharp.Compiler.XmlDoc +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif #if !NO_EXTENSIONTYPING open FSharp.Compiler.ExtensionTyping @@ -77,6 +81,8 @@ let GetOptimizationDataResourceName (r: ILResource) = let IsReflectedDefinitionsResource (r: ILResource) = r.Name.StartsWithOrdinal(QuotationPickler.SerializedReflectedDefinitionsResourceNameBase) +#if !FABLE_COMPILER + let MakeILResource rName bytes = { Name = rName Location = ILResourceLocation.Local(ByteStorage.FromByteArray(bytes)) @@ -131,10 +137,14 @@ let WriteOptimizationData (tcGlobals, filename, inMem, ccu: CcuThunk, modulInfo) let rName = if ccu.AssemblyName = getFSharpCoreLibraryName then FSharpOptimizationDataResourceName2 else FSharpOptimizationDataResourceName PickleToResource inMem filename tcGlobals ccu (rName+ccu.AssemblyName) Optimizer.p_CcuOptimizationInfo modulInfo +#endif //!FABLE_COMPILER + exception AssemblyNotResolved of (*originalName*) string * range exception MSBuildReferenceResolutionWarning of (*MSBuild warning code*)string * (*Message*)string * range exception MSBuildReferenceResolutionError of (*MSBuild warning code*)string * (*Message*)string * range +#if !FABLE_COMPILER + let OpenILBinary(filename, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, tryGetMetadataSnapshot) = let opts: ILReaderOptions = { metadataOnly = MetadataOnlyFlag.Yes @@ -157,6 +167,8 @@ let OpenILBinary(filename, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, filename AssemblyReader.GetILModuleReader(location, opts) +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = Speculative | ReportErrors @@ -185,6 +197,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 @@ -227,6 +241,8 @@ type AssemblyResolution = return assemblyRef } +#endif //!FABLE_COMPILER + type ImportedBinary = { FileName: string RawMetadata: IRawFSharpAssemblyData @@ -257,6 +273,8 @@ type CcuLoadFailureAction = | RaiseError | ReturnNone +#if !FABLE_COMPILER + type TcConfig with member tcConfig.TryResolveLibWithDirectories (r: AssemblyReference) = @@ -687,10 +705,50 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR let attrs = GetCustomAttributesOfILModule ilModule List.exists (IsMatchingSignatureDataVersionAttr ilg (IL.parseILVersion Internal.Utilities.FSharpEnvironment.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 + + member x.GetImportMap() = + let loaderInterface = + { new Import.AssemblyLoader with + member x.FindCcuFromAssemblyRef (_ctok, m, ilAssemblyRef) = + FindCcuInfo(m, ilAssemblyRef.Name) + } + new Import.ImportMap (tcGlobalsOpt.Value, loaderInterface) + +#else //!FABLE_COMPILER + [] type TcImportsSafeDisposal (disposeActions: ResizeArray unit>, @@ -1844,3 +1902,5 @@ let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, referenceRa // Existing public APIs delegate to newer implementations let DefaultReferencesForScriptsAndOutOfProjectSources assumeDotNetFramework = defaultReferencesForScriptsAndOutOfProjectSources (*useFsiAuxLib*)false assumeDotNetFramework (*useSdkRefs*)false + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/CompilerImports.fsi b/src/fsharp/CompilerImports.fsi index d6eedc6d214b..12417578bc3a 100644 --- a/src/fsharp/CompilerImports.fsi +++ b/src/fsharp/CompilerImports.fsi @@ -22,7 +22,9 @@ open FSharp.Core.CompilerServices open FSharp.Compiler.ExtensionTyping #endif +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif //!FABLE_COMPILER /// This exception is an old-style way of reporting a diagnostic exception AssemblyNotResolved of (*originalName*) string * range @@ -42,6 +44,9 @@ val IsOptimizationDataResource: ILResource -> bool /// Determine if an IL resource attached to an F# assembly is an F# quotation data resource for reflected definitions val IsReflectedDefinitionsResource: ILResource -> bool val GetSignatureDataResourceName: ILResource -> string +val GetOptimizationDataResourceName: ILResource -> string + +#if !FABLE_COMPILER /// Write F# signature data as an IL resource val WriteSignatureData: TcConfig * TcGlobals * Remap * CcuThunk * filename: string * inMem: bool -> ILResource @@ -49,6 +54,8 @@ val WriteSignatureData: TcConfig * TcGlobals * Remap * CcuThunk * filename: stri /// Write F# optimization data as an IL resource val WriteOptimizationData: TcGlobals * filename: string * inMem: bool * CcuThunk * Optimizer.LazyModuleInfo -> ILResource +#endif //!FABLE_COMPILER + [] type ResolveAssemblyReferenceMode = | Speculative @@ -103,6 +110,21 @@ type ImportedAssembly = } +#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 + +#else //!FABLE_COMPILER + [] /// Tables of assembly resolutions type TcAssemblyResolutions = @@ -198,3 +220,5 @@ val RequireDLL: ctok: CompilationThreadToken * tcImports: TcImports * tcEnv: TcE /// This list is the default set of references for "non-project" files. val DefaultReferencesForScriptsAndOutOfProjectSources: bool -> string list + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/CompilerOptions.fs b/src/fsharp/CompilerOptions.fs index 90df5b020043..19411b4808b6 100644 --- a/src/fsharp/CompilerOptions.fs +++ b/src/fsharp/CompilerOptions.fs @@ -10,7 +10,9 @@ open System.IO open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILPdbWriter +#endif open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.AbstractIL.Extensions.ILX @@ -101,9 +103,14 @@ let PrintCompilerOption (CompilerOption(_s, _tag, _spec, _, help) as compilerOpt let flagWidth = 42 // fixed width for printing of flags, e.g. --debug:{full|pdbonly|portable|embedded} let defaultLineWidth = 80 // the fallback width let lineWidth = +#if FABLE_COMPILER + defaultLineWidth +#else try System.Console.BufferWidth with e -> defaultLineWidth +#endif + let lineWidth = if lineWidth=0 then defaultLineWidth else lineWidth (* Have seen BufferWidth=0 on Linux/Mono *) // Lines have this form: // flagWidth chars - for flags description or padding on continuation lines. @@ -178,6 +185,7 @@ module ResponseFile = | CompilerOptionSpec of string | Comment of string +#if !FABLE_COMPILER let parseFile path: Choice = let parseLine (l: string) = match l with @@ -195,6 +203,7 @@ module ResponseFile = Choice1Of2 data with e -> Choice2Of2 e +#endif //!FABLE_COMPILER let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: CompilerOptionBlock list, args) = @@ -254,6 +263,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 @@ -281,6 +294,7 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler rspData |> List.choose onlyOptions processArg (responseFileOptions @ t) +#endif //!FABLE_COMPILER | opt :: t -> @@ -847,7 +861,11 @@ let setLanguageVersion (specifiedVersion) = printfn "%s" (FSComp.SR.optsSupportedLangVersions()) for v in languageVersion.ValidOptions do printfn "%s" v for v in languageVersion.ValidVersions do printfn "%s" v +#if FABLE_COMPILER + () +#else exit 0 +#endif if specifiedVersion = "?" then dumpAllowedValues () if not (languageVersion.ContainsVersion specifiedVersion) then error(Error(FSComp.SR.optsUnrecognizedLanguageVersion specifiedVersion, rangeCmdArgs)) @@ -881,10 +899,12 @@ let codePageFlag (tcConfigB: TcConfigBuilder) = CompilerOption ("codepage", tagInt, OptionInt (fun n -> +#if !FABLE_COMPILER try System.Text.Encoding.GetEncoding n |> ignore with :? System.ArgumentException as err -> error(Error(FSComp.SR.optsProblemWithCodepage(n, err.Message), rangeCmdArgs)) +#endif tcConfigB.inputCodePage <- Some n), None, Some (FSComp.SR.optsCodepage())) @@ -966,6 +986,7 @@ let advancedFlagsFsc tcConfigB = OptionString (fun s -> tcConfigB.baseAddress <- Some(int32 s)), None, Some (FSComp.SR.optsBaseaddress())) +#if !FABLE_COMPILER yield CompilerOption ("checksumalgorithm", tagAlgorithm, OptionString (fun s -> @@ -975,6 +996,7 @@ let advancedFlagsFsc tcConfigB = | "SHA256" -> HashAlgorithm.Sha256 | _ -> error(Error(FSComp.SR.optsUnknownChecksumAlgorithm s, rangeCmdArgs))), None, Some (FSComp.SR.optsChecksumAlgorithm())) +#endif yield noFrameworkFlag true tcConfigB @@ -1038,7 +1060,9 @@ let testFlag tcConfigB = | "FunctionSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportFunctionSizes = true } | "TotalSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportTotalSizes = true } | "HasEffect" -> tcConfigB.optSettings <- { 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 @@ -1420,11 +1444,19 @@ let DisplayBannerText tcConfigB = let displayHelpFsc tcConfigB (blocks:CompilerOptionBlock list) = DisplayBannerText tcConfigB PrintCompilerOptionBlocks blocks +#if FABLE_COMPILER + () +#else exit 0 +#endif let displayVersion tcConfigB = printfn "%s" tcConfigB.productNameForBannerText +#if FABLE_COMPILER + () +#else exit 0 +#endif let miscFlagsBoth tcConfigB = [ CompilerOption("nologo", tagNone, OptionUnit (fun () -> tcConfigB.showBanner <- false), None, Some (FSComp.SR.optsNologo())) @@ -1607,6 +1639,8 @@ let ApplyCommandLineArgs(tcConfigB: TcConfigBuilder, sourceFiles: string list, a sourceFiles +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // PrintWholeAssemblyImplementation //---------------------------------------------------------------------------- @@ -1719,3 +1753,5 @@ let DoWithErrorColor isError f = let errorColor = ConsoleColor.Red let color = if isError then errorColor else warnColor DoWithColor color f + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/CompilerOptions.fsi b/src/fsharp/CompilerOptions.fsi index 5c83869d87cb..fca5fbb4a0d8 100644 --- a/src/fsharp/CompilerOptions.fsi +++ b/src/fsharp/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 : string Set -> string [] -> string list + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 982c42e58a13..d35b0f88e71c 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -2296,7 +2296,7 @@ and CanMemberSigsMatchUpToCheck match calledMeth.ParamArrayCallerArgs with | Some args -> for callerArg in args do - do! subsumeArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg + do! subsumeArg (GetCalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg | _ -> () | _ -> () for argSet in calledMeth.ArgSets do @@ -2318,7 +2318,7 @@ and CanMemberSigsMatchUpToCheck let calledArgTy = rfinfo.FieldType rfinfo.Name, calledArgTy - do! subsumeArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller + do! subsumeArg (GetCalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller // - Always take the return type into account for // -- op_Explicit, op_Implicit // -- methods using tupling of unfilled out args diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index 7705278dceed..d69c9e112b8b 100644 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -135,17 +135,23 @@ let rec AttachRange m (exn:exn) = else match exn with // Strip TargetInvocationException wrappers +#if !FABLE_COMPILER | :? 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 | :? System.ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) +#endif | notARangeDual -> notARangeDual //---------------------------------------------------------------------------- // Error logger interface +#if !FABLE_COMPILER + type Exiter = abstract Exit : int -> 'T @@ -159,6 +165,7 @@ let QuitProcessExiter = () FSComp.SR.elSysEnvExitDidntExit() |> failwith } +#endif /// Closed enumeration of build phases. [] @@ -339,13 +346,21 @@ module ErrorLoggerExtensions = // 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 = typeof.GetMethod("InternalPreserveStackTrace", BindingFlags.Instance ||| BindingFlags.NonPublic) @@ -354,6 +369,7 @@ module ErrorLoggerExtensions = // This is probably only the mono case. System.Diagnostics.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) = @@ -372,11 +388,12 @@ module ErrorLoggerExtensions = type ErrorLogger with member x.ErrorR exn = +#if !FABLE_COMPILER match exn with | InternalError (s, _) | Failure s as exn -> System.Diagnostics.Debug.Assert(false, sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) | _ -> () - +#endif match exn with | StopProcessing | ReportedError _ -> @@ -404,8 +421,10 @@ module ErrorLoggerExtensions = // 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 | WrappedError(StopProcessing, _) -> PreserveStackTrace exn diff --git a/src/fsharp/ErrorResolutionHints.fs b/src/fsharp/ErrorResolutionHints.fs index ee80985935e3..ca737ea80e44 100644 --- a/src/fsharp/ErrorResolutionHints.fs +++ b/src/fsharp/ErrorResolutionHints.fs @@ -37,7 +37,7 @@ type SuggestionBufferEnumerator(tail: int, data: KeyValuePair []) interface IEnumerator with member __.Current with get () = - let kvpr = &data.[current] + let kvpr = data.[current] kvpr.Value interface System.Collections.IEnumerator with member __.Current with get () = box data.[current].Value @@ -57,11 +57,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/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 54d959fb13e5..393a4e055e83 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -140,7 +140,11 @@ let ReportStatistics (oc: TextWriter) = let NewCounter nm = let count = ref 0 +#if FABLE_COMPILER + ignore nm +#else AddReport (fun oc -> if !count <> 0 then oc.WriteLine (string !count + " " + nm)) +#endif (fun () -> incr count) let CountClosure = NewCounter "closures" @@ -916,6 +920,7 @@ let AddTyparsToEnv typars (eenv: IlxGenEnv) = {eenv with tyenv = eenv.tyenv.Add let AddSignatureRemapInfo _msg (rpi, mhi) eenv = { eenv with sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: eenv.sigToImplRemapInfo } +#if !FABLE_COMPILER let OutputStorage (pps: TextWriter) s = match s with | StaticField _ -> pps.Write "(top)" @@ -925,6 +930,7 @@ let OutputStorage (pps: TextWriter) s = | Arg _ -> pps.Write "(arg)" | Env _ -> pps.Write "(env)" | Null -> pps.Write "(null)" +#endif //-------------------------------------------------------------------------- // Augment eenv with values @@ -959,7 +965,11 @@ let AddStorageForLocalVals g vals eenv = List.foldBack (fun (v, s) acc -> AddStorageForVal g (v, notlazy s) acc) vals eenv let AddStorageForLocalWitness eenv (w,s) = +#if FABLE_COMPILER + { eenv with witnessesInScope = eenv.witnessesInScope.Add (w, s) } +#else { eenv with witnessesInScope = eenv.witnessesInScope.SetItem (w, s) } +#endif let AddStorageForLocalWitnesses witnesses eenv = (eenv, witnesses) ||> List.fold AddStorageForLocalWitness @@ -983,9 +993,13 @@ let ComputeGenerateWitnesses (g: TcGlobals) eenv = g.generateWitnesses && not eenv.witnessesInScope.IsEmpty && 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 @@ -1318,7 +1332,11 @@ let GenPossibleILSourceMarker 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 = @@ -1515,7 +1533,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu let ilProperties = mkILProperties [ for (i, (propName, _fldName, fldTy)) in List.indexed flds -> - ILPropertyDef(name=propName, + ILPropertyDef.Create(name=propName, attributes=PropertyAttributes.None, setMethod=None, getMethod=Some(mkILMethRef(ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], fldTy )), @@ -2244,7 +2262,9 @@ let rec GenExpr cenv cgbuf eenv sp (expr: Expr) sequel = cenv.exprRecursionDepth <- cenv.exprRecursionDepth + 1 if cenv.exprRecursionDepth > 1 then +#if !FABLE_COMPILER StackGuard.EnsureSufficientExecutionStack cenv.exprRecursionDepth +#endif GenExprAux cenv cgbuf eenv sp expr sequel else GenExprWithStackGuard cenv cgbuf eenv sp expr sequel @@ -4536,7 +4556,7 @@ and GenClosureTypeDefs cenv (tref: ILTypeRef, ilGenParams, attrs, ilCloAllFreeVa cloCode=notlazy ilCtorBody } let tdef = - ILTypeDef(name = tref.Name, + ILTypeDef.Create(name = tref.Name, layout = ILTypeDefLayout.Auto, attributes = enum 0, genericParams = ilGenParams, @@ -4599,7 +4619,7 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars e let ilContractMeths = [ilContractCtor; mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, ilContractMethTyargs, [], mkILReturn ilContractFormalRetTy, MethodBody.Abstract) ] let ilContractTypeDef = - ILTypeDef(name = ilContractTypeRef.Name, + ILTypeDef.Create(name = ilContractTypeRef.Name, layout = ILTypeDefLayout.Auto, attributes = enum 0, genericParams = ilContractGenericParams, @@ -5610,7 +5630,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) star let ilAttribs = GenAttrs cenv eenv vspec.Attribs let ilTy = ilGetterMethSpec.FormalReturnType let ilPropDef = - ILPropertyDef(name = PrettyNaming.ChopPropertyName ilGetterMethSpec.Name, + ILPropertyDef.Create(name = PrettyNaming.ChopPropertyName ilGetterMethSpec.Name, attributes = PropertyAttributes.None, setMethod = None, getMethod = Some ilGetterMethSpec.MethodRef, @@ -5682,7 +5702,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) star |> List.filter (fun (Attrib(_, _, _, _, _, targets, _)) -> canTarget(targets, System.AttributeTargets.Property)) |> GenAttrs cenv eenv // property only gets attributes that target properties let ilPropDef = - ILPropertyDef(name=ilPropName, + ILPropertyDef.Create(name=ilPropName, attributes = PropertyAttributes.None, setMethod=(if mut || cenv.opts.isInteractiveItExpr then Some ilSetterMethRef else None), getMethod=Some ilGetterMethRef, @@ -5972,7 +5992,7 @@ and GenReturnInfo cenv eenv returnTy ilRetTy (retInfo: ArgReprInfo) : ILReturn = and GenPropertyForMethodDef compileAsInstance tref mdef (v: Val) (memberInfo: ValMemberInfo) ilArgTys ilPropTy ilAttrs compiledName = let name = match compiledName with | Some n -> n | _ -> v.PropertyName in (* chop "get_" *) - ILPropertyDef(name = name, + ILPropertyDef.Create(name = name, attributes = PropertyAttributes.None, setMethod = (if memberInfo.MemberFlags.MemberKind= MemberKind.PropertySet then Some(mkRefToILMethod(tref, mdef)) else None), getMethod = (if memberInfo.MemberFlags.MemberKind= MemberKind.PropertyGet then Some(mkRefToILMethod(tref, mdef)) else None), @@ -5990,7 +6010,7 @@ and GenEventForProperty cenv eenvForMeth (mspec: ILMethodSpec) (v: Val) ilAttrsT let ilThisTy = mspec.DeclaringType let addMethRef = mkILMethRef (ilThisTy.TypeRef, mspec.CallingConv, "add_" + evname, 0, [ilDelegateTy], ILType.Void) let removeMethRef = mkILMethRef (ilThisTy.TypeRef, mspec.CallingConv, "remove_" + evname, 0, [ilDelegateTy], ILType.Void) - ILEventDef(eventType = Some ilDelegateTy, + ILEventDef.Create(eventType = Some ilDelegateTy, name= evname, attributes = EventAttributes.None, addMethod = addMethRef, @@ -7445,7 +7465,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let literalValue = Option.map (GenFieldInit m) fspec.LiteralValue let fdef = - ILFieldDef(name = ilFieldName, + ILFieldDef.Create(name = ilFieldName, fieldType = ilPropType, attributes = enum 0, data = None, @@ -7473,7 +7493,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilHasSetter = isCLIMutable || isFSharpMutable let ilFieldAttrs = GenAttrs cenv eenv propAttribs @ [mkCompilationMappingAttrWithSeqNum g (int SourceConstructFlags.Field) i] yield - ILPropertyDef(name= ilPropName, + ILPropertyDef.Create(name= ilPropName, attributes= PropertyAttributes.None, setMethod= (if ilHasSetter then Some(mkILMethRef(tref, ilCallingConv, "set_" + ilPropName, 0, [ilPropType], ILType.Void)) else None), getMethod= Some(mkILMethRef(tref, ilCallingConv, "get_" + ilPropName, 0, [], ilPropType)), @@ -7767,7 +7787,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = then SourceConstructFlags.SumType ||| SourceConstructFlags.NonPublicRepresentation else SourceConstructFlags.SumType)) ]) let tdef = - ILTypeDef(name = ilTypeName, + ILTypeDef.Create(name = ilTypeName, layout = layout, attributes = enum 0, genericParams = ilGenParams, @@ -7846,7 +7866,7 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = let ilMethodDef = mkLdfldMethodDef (ilMethName, reprAccess, false, ilThisTy, ilFieldName, ilPropType) let ilFieldDef = IL.mkILInstanceField(ilFieldName, ilPropType, None, ILMemberAccess.Assembly) let ilPropDef = - ILPropertyDef(name = ilPropName, + ILPropertyDef.Create(name = ilPropName, attributes = PropertyAttributes.None, setMethod = None, getMethod = Some(mkILMethRef(tref, ILCallingConv.Instance, ilMethName, 0, [], ilPropType)), @@ -8063,6 +8083,8 @@ type ExecutionContext = LookupTypeRef: (ILTypeRef -> Type) 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 = @@ -8164,6 +8186,8 @@ let ClearGeneratedValue (ctxt: ExecutionContext) (g: TcGlobals) 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) = @@ -8198,6 +8222,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai delayedGenMethods = Queue () } 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 tcGlobals ilxGenEnv v @@ -8206,4 +8231,5 @@ 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 amap ctxt ilxGenEnv v +#endif //!FABLE_COMPILER diff --git a/src/fsharp/IlxGen.fsi b/src/fsharp/IlxGen.fsi index 8bd6bf7e3485..957b0a0f1e2c 100644 --- a/src/fsharp/IlxGen.fsi +++ b/src/fsharp/IlxGen.fsi @@ -101,6 +101,7 @@ type public IlxAssemblyGenerator = /// Generate ILX code for an assembly fragment member GenerateCode: IlxGenOptions * TypedAssemblyAfterOptimization * 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 @@ -109,6 +110,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 * System.Type) option +#endif //!FABLE_COMPILER val ReportStatistics: TextWriter -> unit diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index 1d4535d343d1..2163d5a163d9 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -121,18 +121,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 this.Compile(args : string array) = diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index ee776d162fc6..d9bcb629486b 100644 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -428,7 +428,11 @@ type TokenTupPool() = let maxSize = 100 let mutable currentPoolSize = 0 +#if FABLE_COMPILER + let stack = Internal.Utilities.Text.Parsing.Stack<_>(maxSize) +#else let stack = System.Collections.Generic.Stack(10) +#endif member this.Rent() = if stack.Count = 0 then @@ -614,7 +618,11 @@ type LexFilterImpl (lightStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbu // Fetch a raw token, either from the old lexer or from our delayedStack //-------------------------------------------------------------------------- +#if FABLE_COMPILER + let delayedStack = Internal.Utilities.Text.Parsing.Stack(100) +#else let delayedStack = System.Collections.Generic.Stack() +#endif let mutable tokensThatNeedNoProcessingCount = 0 let delayToken tokenTup = delayedStack.Push tokenTup @@ -2373,7 +2381,11 @@ type LexFilter (lightStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: U // We don't interact with lexbuf state at all, any inserted tokens have same state/location as the real one read, so // we don't have to do any of the wrapped lexbuf magic that you see in LexFilterImpl. +#if FABLE_COMPILER + let delayedStack = Internal.Utilities.Text.Parsing.Stack(100) +#else let delayedStack = System.Collections.Generic.Stack() +#endif let delayToken tok = delayedStack.Push tok let popNextToken() = diff --git a/src/fsharp/Logger.fs b/src/fsharp/Logger.fs index 8923464ed727..9847c2ff05a1 100644 --- a/src/fsharp/Logger.fs +++ b/src/fsharp/Logger.fs @@ -5,6 +5,13 @@ namespace FSharp.Compiler 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/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 77fa96efaa6c..b7f813f52b5a 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -71,7 +71,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/fsharp/OptimizeInputs.fs b/src/fsharp/OptimizeInputs.fs index 62649fc0d169..e88c26c4a7ec 100644 --- a/src/fsharp/OptimizeInputs.fs +++ b/src/fsharp/OptimizeInputs.fs @@ -10,7 +10,9 @@ open System.IO open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.ILPdbWriter +#endif open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.AbstractIL.Extensions.ILX @@ -32,6 +34,7 @@ open FSharp.Compiler.ErrorLogger open Internal.Utilities open Internal.Utilities.StructuredFormat +#if !FABLE_COMPILER //---------------------------------------------------------------------------- // PrintWholeAssemblyImplementation @@ -49,6 +52,9 @@ let PrintWholeAssemblyImplementation g (tcConfig:TcConfig) outfile header expr = dprintf "\n------------------\nshowTerm: %s:\n" header Layout.outL stderr (Display.squashTo 192 (DebugPrint.implFilesL g expr)) dprintf "\n------------------\n" + +#endif //!FABLE_COMPILER + let AddExternalCcuToOptimizationEnv tcGlobals optEnv (ccuinfo: ImportedAssembly) = match ccuinfo.FSharpOptimizationData.Force() with | None -> optEnv @@ -60,14 +66,19 @@ let GetInitialOptimizationEnv (tcImports:TcImports, tcGlobals:TcGlobals) = let optEnv = List.fold (AddExternalCcuToOptimizationEnv tcGlobals) optEnv ccuinfos optEnv -let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importMap, isIncrementalFragment, optEnv, ccu:CcuThunk, implFiles) = +let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile: string, importMap, isIncrementalFragment, optEnv, ccu:CcuThunk, implFiles) = // NOTE: optEnv - threads through // // 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 +#endif +#if !FABLE_COMPILER PrintWholeAssemblyImplementation tcGlobals tcConfig outfile "pass-start" implFiles -#if DEBUG +#endif +#if DEBUG && !FABLE_COMPILER if tcConfig.showOptimizationData then dprintf "Expression prior to optimization:\n%s\n" (Layout.showL (Display.squashTo 192 (DebugPrint.implFilesL tcGlobals implFiles))) @@ -76,7 +87,9 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM #endif 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 @@ -99,7 +112,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM // Only do this on the first pass! let optSettings = { optSettings with abstractBigTargets = false; reportingPhase = false } -#if DEBUG +#if DEBUG && !FABLE_COMPILER if tcConfig.showOptimizationData then dprintf "Optimization implFileOptData:\n%s\n" (Layout.showL (Display.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData))) #endif @@ -158,10 +171,14 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let implFiles, implFileOptDatas = List.unzip results let assemblyOptData = Optimizer.UnionOptimizationInfos implFileOptDatas let tassembly = TypedAssemblyAfterOptimization implFiles +#if !FABLE_COMPILER PrintWholeAssemblyImplementation tcGlobals tcConfig outfile "pass-end" (implFiles |> List.map (fun implFile -> implFile.ImplFile)) ReportTime tcConfig ("Ending Optimizations") +#endif tassembly, assemblyOptData, optEnvFirstLoop +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // ILX generation //---------------------------------------------------------------------------- @@ -215,8 +232,9 @@ let NormalizeAssemblyRefs (ctok, ilGlobals: ILGlobals, tcImports:TcImports) scor | 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 = match t with CompilerTarget.Dll -> "dll" | CompilerTarget.Module -> "netmodule" | _ -> "exe" s + "." + ext - diff --git a/src/fsharp/OptimizeInputs.fsi b/src/fsharp/OptimizeInputs.fsi index c52eab8645d5..5c14d3b0f91f 100644 --- a/src/fsharp/OptimizeInputs.fsi +++ b/src/fsharp/OptimizeInputs.fsi @@ -22,6 +22,8 @@ val AddExternalCcuToOptimizationEnv : TcGlobals -> IncrementalOptimizationEnv -> val ApplyAllOptimizations : TcConfig * TcGlobals * ConstraintSolver.TcValF * string * ImportMap * bool * IncrementalOptimizationEnv * CcuThunk * TypedImplFile list -> TypedAssemblyAfterOptimization * Optimizer.LazyModuleInfo * IncrementalOptimizationEnv +#if !FABLE_COMPILER + val CreateIlxAssemblyGenerator : TcConfig * TcImports * TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxAssemblyGenerator val GenerateIlxCode : IlxGen.IlxGenBackend * isInteractiveItExpr:bool * isInteractiveOnMono:bool * TcConfig * TopAttribs * TypedAssemblyAfterOptimization * fragName:string * IlxGen.IlxAssemblyGenerator -> IlxGenResults @@ -30,3 +32,5 @@ val GenerateIlxCode : IlxGen.IlxGenBackend * isInteractiveItExpr:bool * isIntera val NormalizeAssemblyRefs : CompilationThreadToken * ILGlobals * TcImports -> (ILScopeRef -> ILScopeRef) val GetGeneratedILModuleName : CompilerTarget -> string -> string + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 9408e49e588b..751dc4aa5579 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -33,7 +33,7 @@ open FSharp.Compiler.TypeRelations open System.Collections.Generic -#if DEBUG +#if DEBUG && !FABLE_COMPILER let verboseOptimizationInfo = try not (System.String.IsNullOrEmpty (System.Environment.GetEnvironmentVariable "FSHARP_verboseOptimizationInfo")) with _ -> false let verboseOptimizations = @@ -630,7 +630,12 @@ let TryGetInfoForNonLocalEntityRef env (nleref: NonLocalEntityRef) = let GetInfoForNonLocalVal cenv env (vref: ValRef) = if vref.IsDispatchSlot then UnknownValInfo - // REVIEW: optionally turn x-module on/off on per-module basis or +#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.crossModuleOpt () || vref.MustInline then match TryGetInfoForNonLocalEntityRef env vref.nlr.EnclosingEntity.nlr with | Some structInfo -> @@ -1250,17 +1255,17 @@ let RemapOptimizationInfo g tmenv = /// Hide information when a value is no longer visible let AbstractAndRemapModulInfo msg g m (repackage, hidden) info = let mrpi = mkRepackageRemapping repackage -#if DEBUG +#if DEBUG && !FABLE_COMPILER if verboseOptimizationInfo then dprintf "%s - %a - Optimization data prior to trim: \n%s\n" msg outputRange m (Layout.showL (Display.squashTo 192 (moduleInfoL g info))) #else ignore (msg, m) #endif let info = info |> AbstractLazyModulInfoByHiding false hidden -#if DEBUG +#if DEBUG && !FABLE_COMPILER if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after trim:\n%s\n" msg outputRange m (Layout.showL (Display.squashTo 192 (moduleInfoL g info))) #endif let info = info |> RemapOptimizationInfo g mrpi -#if DEBUG +#if DEBUG && !FABLE_COMPILER if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after remap:\n%s\n" msg outputRange m (Layout.showL (Display.squashTo 192 (moduleInfoL g info))) #endif info @@ -1442,6 +1447,9 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = // Immediate consumption of value by a pattern match 'let x = e in match x with ...' | Expr.Match (spMatch, _exprm, TDSwitch(Expr.Val (VRefLocal vspec2, _, _), 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)) -> @@ -2535,7 +2543,12 @@ and OptimizeVal cenv env expr (v: ValRef, m) = e, AddValEqualityInfo cenv.g m v einfo | None -> - if v.MustInline then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) + if v.MustInline +#if FABLE_COMPILER + // no inlining for FSharp.Core + && not (v.ToString().StartsWith("Microsoft.FSharp.")) +#endif + then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) expr, (AddValEqualityInfo cenv.g m v { Info=valInfoForVal.ValExprInfo HasEffect=false diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 2181e4f3ebd5..b2ec65961be9 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -20,7 +20,9 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports +#if !FABLE_COMPILER open FSharp.Compiler.DotNetFrameworkDependencies +#endif open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Lexhelp open FSharp.Compiler.Lib @@ -299,7 +301,11 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp printf "tokenize - getting one token from %s\n" shortFilename let t = tokenizer.Lexer lexbuf printf "tokenize - got %s @ %a\n" (Parser.token_to_string t) outputRange lexbuf.LexemeRange +#if FABLE_COMPILER + (match t with Parser.EOF _ -> () | _ -> ()) +#else (match t with Parser.EOF _ -> exit 0 | _ -> ()) +#endif if lexbuf.IsPastEndOfStream then printf "!!! at end of stream\n" if tcConfig.testInteractionParser then @@ -307,7 +313,11 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp match (Parser.interaction tokenizer.Lexer lexbuf) with | IDefns(l, m) -> dprintf "Parsed OK, got %d defs @ %a\n" l.Length outputRange m | IHash (_, m) -> dprintf "Parsed OK, got hash @ %a\n" outputRange m +#if FABLE_COMPILER + () +#else exit 0 +#endif let res = ParseInput(tokenizer.Lexer, errorLogger, lexbuf, None, filename, isLastCompiland) @@ -330,6 +340,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp Some input with e -> (* errorR(Failure("parse failed")); *) errorRecovery e rangeStartup; None +#if !FABLE_COMPILER let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = try @@ -494,6 +505,8 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig: TcConfig, inp: ParsedInput, (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 @@ -512,6 +525,8 @@ let GetInitialTcEnv (assemblyName: string, initm: range, tcConfig: TcConfig, tcI else tcEnv +#if !FABLE_COMPILER + /// Inject faults into checking let CheckSimulateException(tcConfig: TcConfig) = match tcConfig.simulateException with @@ -536,6 +551,8 @@ let CheckSimulateException(tcConfig: TcConfig) = | Some("tc-fail") -> failwith "simulated" | _ -> () +#endif //!FABLE_COMPILER + //---------------------------------------------------------------------------- // Type-check sets of files //-------------------------------------------------------------------------- @@ -629,7 +646,9 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: let! ctok = Eventually.token RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST +#if !FABLE_COMPILER CheckSimulateException tcConfig +#endif let m = inp.Range let amap = tcImports.GetImportMap() diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index d211bfa0907d..e6c9828b2e1f 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -15,7 +15,10 @@ open FSharp.Compiler.Range open FSharp.Compiler.SyntaxTree open FSharp.Compiler.TypedTree open FSharp.Compiler.TcGlobals + +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif val IsScript: string -> bool @@ -32,6 +35,8 @@ val DeduplicateParsedInputModuleName: ModuleNamesDict -> ParsedInput -> ParsedIn /// Parse a single input (A signature file or implementation file) val ParseInput: (UnicodeLexing.Lexbuf -> Parser.token) * ErrorLogger * UnicodeLexing.Lexbuf * string option * string * isLastCompiland:(bool * bool) -> ParsedInput +#if !FABLE_COMPILER + /// A general routine to process hash directives val ProcessMetaCommandsFromInput : (('T -> range * string -> 'T) * @@ -49,6 +54,8 @@ val ApplyNoWarnsToTcConfig: TcConfig * ParsedInput * string -> TcConfig /// Parse one input file val ParseOneInputFile: TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: (bool * bool) * ErrorLogger * (*retryLocked*) bool -> ParsedInput option +#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 diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index 2a6d0a64d896..3a5a6ec323a5 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -482,7 +482,11 @@ let CompilerGeneratedName nm = if IsCompilerGeneratedName nm then nm else 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/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 9aa64ae73aa1..109958127a27 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -22,7 +22,11 @@ open System.Collections.Immutable module QP = FSharp.Compiler.QuotationPickler +#if FABLE_COMPILER +let verboseCReflect = false +#else let verboseCReflect = condition "VERBOSE_CREFLECT" +#endif [] type IsReflectedDefinition = @@ -717,9 +721,13 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let inWitnessPassingScope = not env.witnessesInScope.IsEmpty let witnessArgInfo = if g.generateWitnesses && inWitnessPassingScope then +#if FABLE_COMPILER + env.witnessesInScope.TryFind traitInfo.TraitKey +#else match env.witnessesInScope.TryGetValue traitInfo.TraitKey with | true, storage -> Some storage | _ -> None +#endif else None diff --git a/src/fsharp/ScriptClosure.fs b/src/fsharp/ScriptClosure.fs index e08910609e3d..2b0623c0da37 100644 --- a/src/fsharp/ScriptClosure.fs +++ b/src/fsharp/ScriptClosure.fs @@ -14,7 +14,9 @@ open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports +#if !FABLE_COMPILER open FSharp.Compiler.DotNetFrameworkDependencies +#endif open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Lib open FSharp.Compiler.ParseAndCheckInputs @@ -23,7 +25,9 @@ open FSharp.Compiler.Range open FSharp.Compiler.ReferenceResolver open FSharp.Compiler.Text +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif [] type LoadClosureInput = @@ -72,6 +76,8 @@ type CodeContext = | Compilation // in fsc.exe | Editing // in VS +#if !FABLE_COMPILER + module ScriptPreprocessClosure = open Internal.Utilities.Text.Lexing @@ -456,3 +462,5 @@ type LoadClosure with use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptFiles (ctok, tcConfig, files, implicitDefines, lexResourceManager, dependencyProvider) + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/ScriptClosure.fsi b/src/fsharp/ScriptClosure.fsi index f5c85d2bfc25..68cd60a3fb11 100644 --- a/src/fsharp/ScriptClosure.fsi +++ b/src/fsharp/ScriptClosure.fsi @@ -12,7 +12,9 @@ open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Range open FSharp.Compiler.SyntaxTree open FSharp.Compiler.Text +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif [] type CodeContext = @@ -59,6 +61,8 @@ type LoadClosure = /// Diagnostics seen while processing the compiler options implied root of closure LoadClosureRootFileDiagnostics: (PhasedDiagnostic * bool) list } +#if !FABLE_COMPILER + /// Analyze a script text and find the closure of its references. /// Used from FCS, when editing a script file. // @@ -93,3 +97,4 @@ type LoadClosure = dependencyProvider: DependencyProvider -> LoadClosure +#endif //!FABLE_COMPILER diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 76ab9937fd5f..994739b926dd 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -1844,21 +1844,21 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en // We do not need to lock this mutable state this it is only ever accessed from the compiler thread. let activePatternElemRefCache: NameMap option ref = ref None - let mutable modulesByDemangledNameCache: NameMap option = None + let modulesByDemangledNameCache: NameMap option ref = ref None - let mutable exconsByDemangledNameCache: NameMap option = None + let exconsByDemangledNameCache: NameMap option ref = ref None - let mutable tyconsByDemangledNameAndArityCache: LayeredMap option = None + let tyconsByDemangledNameAndArityCache: LayeredMap option ref = ref None - let mutable tyconsByAccessNamesCache: LayeredMultiMap option = None + let tyconsByAccessNamesCache: LayeredMultiMap option ref = ref None - let mutable tyconsByMangledNameCache: NameMap option = None + let tyconsByMangledNameCache: NameMap option ref = ref None - let mutable allEntitiesByMangledNameCache: NameMap option = None + let allEntitiesByMangledNameCache: NameMap option ref = ref None - let mutable allValsAndMembersByPartialLinkageKeyCache: MultiMap option = None + let allValsAndMembersByPartialLinkageKeyCache: MultiMap option ref = ref None - let mutable allValsByLogicalNameCache: NameMap option = None + let allValsByLogicalNameCache: NameMap option ref = ref None /// Namespace or module-compiled-as-type? member _.ModuleOrNamespaceKind = kind @@ -1875,17 +1875,17 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en /// Mutation used during compilation of FSharp.Core.dll member _.AddModuleOrNamespaceByMutation(modul: ModuleOrNamespace) = entities <- QueueList.appendOne entities modul - modulesByDemangledNameCache <- None - allEntitiesByMangledNameCache <- None + modulesByDemangledNameCache := None + allEntitiesByMangledNameCache := None #if !NO_EXTENSIONTYPING /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace member mtyp.AddProvidedTypeEntity(entity: Entity) = entities <- QueueList.appendOne entities entity - tyconsByMangledNameCache <- None - tyconsByDemangledNameAndArityCache <- None - tyconsByAccessNamesCache <- None - allEntitiesByMangledNameCache <- None + tyconsByMangledNameCache := None + tyconsByDemangledNameAndArityCache := None + tyconsByAccessNamesCache := None + allEntitiesByMangledNameCache := None #endif /// Return a new module or namespace type with an entity added. @@ -1915,19 +1915,19 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en /// table is indexed by both name and generic arity. This means that for generic /// types "List`1", the entry (List, 1) will be present. member mtyp.TypesByDemangledNameAndArity = - cacheOptByref &tyconsByDemangledNameAndArityCache (fun () -> + cacheOptRef tyconsByDemangledNameAndArityCache (fun () -> LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc: Tycon) -> Construct.KeyTyconByDecodedName tc.LogicalName tc) |> List.toArray)) /// Get a table of types defined within this module, namespace or type. The /// table is indexed by both name and, for generic types, also by mangled name. member mtyp.TypesByAccessNames = - cacheOptByref &tyconsByAccessNamesCache (fun () -> + cacheOptRef tyconsByAccessNamesCache (fun () -> LayeredMultiMap.Empty.AddAndMarkAsCollapsible (mtyp.TypeAndExceptionDefinitions |> List.toArray |> Array.collect (fun (tc: Tycon) -> Construct.KeyTyconByAccessNames tc.LogicalName tc))) // REVIEW: we can remove this lookup and use AllEntitiesByMangledName instead? member mtyp.TypesByMangledName = let addTyconByMangledName (x: Tycon) tab = NameMap.add x.LogicalName x tab - cacheOptByref &tyconsByMangledNameCache (fun () -> + cacheOptRef tyconsByMangledNameCache (fun () -> List.foldBack addTyconByMangledName mtyp.TypeAndExceptionDefinitions Map.empty) /// Get a table of entities indexed by both logical and compiled names @@ -1939,7 +1939,7 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en if name1 = name2 then tab else NameMap.add name2 x tab - cacheOptByref &allEntitiesByMangledNameCache (fun () -> + cacheOptRef allEntitiesByMangledNameCache (fun () -> QueueList.foldBack addEntityByMangledName entities Map.empty) /// Get a table of entities indexed by both logical name @@ -1956,7 +1956,7 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en MultiMap.add key x tab else tab - cacheOptByref &allValsAndMembersByPartialLinkageKeyCache (fun () -> + cacheOptRef allValsAndMembersByPartialLinkageKeyCache (fun () -> QueueList.foldBack addValByMangledName vals MultiMap.empty) /// Try to find the member with the given linkage key in the given module. @@ -1977,7 +1977,7 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en NameMap.add x.LogicalName x tab else tab - cacheOptByref &allValsByLogicalNameCache (fun () -> + cacheOptRef allValsByLogicalNameCache (fun () -> QueueList.foldBack addValByName vals Map.empty) /// Compute a table of values and members indexed by logical name. @@ -1992,7 +1992,7 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en /// Get a table of F# exception definitions indexed by demangled name, so 'FailureException' is indexed by 'Failure' member mtyp.ExceptionDefinitionsByDemangledName = let add (tycon: Tycon) acc = NameMap.add tycon.LogicalName tycon acc - cacheOptByref &exconsByDemangledNameCache (fun () -> + cacheOptRef exconsByDemangledNameCache (fun () -> List.foldBack add mtyp.ExceptionDefinitions Map.empty) /// Get a table of nested module and namespace fragments indexed by demangled name (so 'ListModule' becomes 'List') @@ -2001,7 +2001,7 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en if entity.IsModuleOrNamespace then NameMap.add entity.DemangledModuleOrNamespaceName entity acc else acc - cacheOptByref &modulesByDemangledNameCache (fun () -> + cacheOptRef modulesByDemangledNameCache (fun () -> QueueList.foldBack add entities Map.empty) [] @@ -2298,7 +2298,11 @@ type TyparConstraint = override x.ToString() = sprintf "%+A" x +#if FABLE_COMPILER +[] +#else [] +#endif type TraitWitnessInfo = | TraitWitnessInfo of TTypes * string * MemberFlags * TTypes * TType option @@ -2313,6 +2317,13 @@ type TraitWitnessInfo = override x.ToString() = "TTrait(" + 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 = @@ -5432,7 +5443,7 @@ type Construct() = #endif /// Create a new entity node for a module or namespace - static member NewModuleOrNamespace cpath access (id: Ident) xml attribs mtype = + static member NewModuleOrNamespace cpath access (id: Ident) (xml: XmlDoc) attribs mtype = let stamp = newStamp() // Put the module suffix on if needed Tycon.New "mspec" diff --git a/src/fsharp/TypedTreeBasics.fs b/src/fsharp/TypedTreeBasics.fs index 8c74d6bdbeb6..2329ee7736b6 100644 --- a/src/fsharp/TypedTreeBasics.fs +++ b/src/fsharp/TypedTreeBasics.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.Range open FSharp.Compiler.SyntaxTree open FSharp.Compiler.TypedTree -#if DEBUG +#if DEBUG && !FABLE_COMPILER assert (sizeof = 8) assert (sizeof = 8) assert (sizeof = 4) diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index ef2c7acc7d25..853a0019a5dc 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -9301,6 +9301,23 @@ let CombineCcuContentFragments m 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 type TraitWitnessInfoHashMap<'T> = ImmutableDictionary /// Create an empty immutable mapping from witnesses to some data @@ -9310,6 +9327,7 @@ let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = member __.Equals(a, b) = traitKeysAEquiv g TypeEquivEnv.Empty a b member __.GetHashCode(a) = hash a.MemberName }) +#endif let (|WhileExpr|_|) expr = match expr with diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index b599a8a68bf8..d5d9ac99d1c9 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2383,7 +2383,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/fsharp/UnicodeLexing.fs b/src/fsharp/UnicodeLexing.fs index 822ddf89f183..5c98662604b2 100644 --- a/src/fsharp/UnicodeLexing.fs +++ b/src/fsharp/UnicodeLexing.fs @@ -24,6 +24,7 @@ let FunctionAsLexbuf (supportsFeature, bufferFiller) = let SourceTextAsLexbuf (supportsFeature, sourceText) = LexBuffer.FromSourceText(supportsFeature, sourceText) +#if !FABLE_COMPILER let StreamReaderAsLexbuf (supportsFeature, reader: StreamReader) = let mutable isFinished = false FunctionAsLexbuf (supportsFeature, fun (chars, start, length) -> @@ -36,3 +37,4 @@ let StreamReaderAsLexbuf (supportsFeature, reader: StreamReader) = else nBytesRead ) +#endif diff --git a/src/fsharp/UnicodeLexing.fsi b/src/fsharp/UnicodeLexing.fsi index 15c0c2acdda5..dcb48d1ed9cd 100644 --- a/src/fsharp/UnicodeLexing.fsi +++ b/src/fsharp/UnicodeLexing.fsi @@ -15,5 +15,7 @@ val public FunctionAsLexbuf: (LanguageFeature -> bool) * (LexBufferChar[] * int val public SourceTextAsLexbuf: (LanguageFeature -> bool) * ISourceText -> Lexbuf +#if !FABLE_COMPILER /// Will not dispose of the stream reader. val public StreamReaderAsLexbuf: (LanguageFeature -> bool) * StreamReader -> Lexbuf +#endif diff --git a/src/fsharp/XmlDoc.fs b/src/fsharp/XmlDoc.fs index 9f53e338f3ae..085d3d95eb46 100644 --- a/src/fsharp/XmlDoc.fs +++ b/src/fsharp/XmlDoc.fs @@ -3,7 +3,9 @@ module public FSharp.Compiler.XmlDoc open System +#if !FABLE_COMPILER open System.Xml.Linq +#endif open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Lib open FSharp.Compiler.AbstractIL.Internal.Library @@ -54,6 +56,7 @@ type XmlDoc(unprocessedLines: string[], range: range) = 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 @@ -102,6 +105,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) = @@ -197,8 +201,10 @@ type PreXmlDoc = let lines = Array.map fst preLines let m = Array.reduce Range.unionRanges (Array.map snd preLines) let doc = XmlDoc (lines, m) +#if !FABLE_COMPILER if check then doc.Check(paramNamesOpt) +#endif doc static member CreateFromGrabPoint(collector: XmlDocCollector, grabPointPos) = diff --git a/src/fsharp/absil/bytes.fs b/src/fsharp/absil/bytes.fs index 7d231337d634..89e3386dfb57 100644 --- a/src/fsharp/absil/bytes.fs +++ b/src/fsharp/absil/bytes.fs @@ -5,10 +5,12 @@ namespace FSharp.Compiler.AbstractIL.Internal open System open System.IO +#if !FABLE_COMPILER open System.IO.MemoryMappedFiles open System.Runtime.InteropServices open System.Runtime.CompilerServices open FSharp.NativeInterop +#endif #nowarn "9" @@ -57,7 +59,11 @@ module internal Bytes = [] type ByteMemory () = +#if FABLE_COMPILER + abstract Item: int -> byte with get +#else abstract Item: int -> byte with get, set +#endif abstract Length: int @@ -71,15 +77,19 @@ type 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 abstract AsStream: unit -> Stream abstract AsReadOnlyStream: unit -> Stream +#endif [] type ByteArrayMemory(bytes: byte[], offset, length) = @@ -98,7 +108,9 @@ type ByteArrayMemory(bytes: byte[], offset, length) = override _.Item with get i = bytes.[offset + i] +#if !FABLE_COMPILER and set i v = bytes.[offset + i] <- v +#endif override _.Length = length @@ -136,9 +148,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 @@ -151,6 +165,7 @@ type ByteArrayMemory(bytes: byte[], offset, length) = else Array.empty +#if !FABLE_COMPILER override _.AsStream() = if length > 0 then new MemoryStream(bytes, offset, length) :> Stream @@ -162,6 +177,9 @@ type ByteArrayMemory(bytes: byte[], offset, length) = new MemoryStream(bytes, offset, length, false) :> Stream else new MemoryStream([||], 0, 0, false) :> Stream +#endif + +#if !FABLE_COMPILER [] type SafeUnmanagedMemoryStream = @@ -284,6 +302,8 @@ type RawByteMemory(addr: nativeptr, length: int, holder: obj) = else new MemoryStream([||], 0, 0, false) :> Stream +#endif //!FABLE_COMPILER + [] type ReadOnlyByteMemory(bytes: ByteMemory) = @@ -301,12 +321,15 @@ 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 @@ -341,6 +364,7 @@ module MemoryMappedFileExtensions = with | _ -> None +#endif type ByteMemory with @@ -348,6 +372,7 @@ type ByteMemory with 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)) @@ -406,11 +431,12 @@ type ByteMemory with 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 - static member FromArray bytes = + static member FromArray (bytes: byte[]) = if bytes.Length = 0 then ByteMemory.Empty else @@ -524,6 +550,8 @@ type internal ByteBuffer = { bbArray=Bytes.zeroCreate sz bbCurrent = 0 } +#if !FABLE_COMPILER + [] type ByteStorage(getByteMemory: unit -> ReadOnlyByteMemory) = @@ -563,4 +591,4 @@ 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/fsharp/absil/bytes.fsi b/src/fsharp/absil/bytes.fsi index 6471f9310e4b..b4f0edebb328 100644 --- a/src/fsharp/absil/bytes.fsi +++ b/src/fsharp/absil/bytes.fsi @@ -3,8 +3,10 @@ /// Blobs of bytes, cross-compiling namespace FSharp.Compiler.AbstractIL.Internal +#if !FABLE_COMPILER open System.IO open System.IO.MemoryMappedFiles +#endif open Internal.Utilities open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.Internal @@ -44,12 +46,15 @@ type internal 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 @@ -58,6 +63,7 @@ type internal 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 = @@ -78,12 +84,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 [] @@ -94,11 +103,13 @@ module internal MemoryMappedFileExtensions = /// Create a memory mapped file based on the given ByteMemory's contents. /// If the given ByteMemory's length is zero or a memory mapped file is not supported, the result will be None. static member TryFromByteMemory : bytes: ReadOnlyByteMemory -> MemoryMappedFile option +#endif type internal ByteMemory with member AsReadOnly: unit -> ReadOnlyByteMemory +#if !FABLE_COMPILER /// Empty byte memory. static member Empty: ByteMemory @@ -111,6 +122,7 @@ type internal ByteMemory with /// 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 @@ -150,6 +162,8 @@ type internal ByteStream = member Skip : int -> unit #endif +#if !FABLE_COMPILER + [] type internal ByteStorage = @@ -165,4 +179,6 @@ type internal ByteStorage = static member FromByteMemoryAndCopy : ReadOnlyByteMemory * useBackingMemoryMappedFile: bool -> ByteStorage /// Creates a ByteStorage that has a copy of the given byte array. - static member FromByteArrayAndCopy : byte [] * useBackingMemoryMappedFile: bool -> ByteStorage \ No newline at end of file + static member FromByteArrayAndCopy : byte [] * useBackingMemoryMappedFile: bool -> ByteStorage + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/absil/il.fs b/src/fsharp/absil/il.fs index acd83f4a3abf..156e33e41ae0 100644 --- a/src/fsharp/absil/il.fs +++ b/src/fsharp/absil/il.fs @@ -401,6 +401,7 @@ type ILAssemblyRef(data) = assemRefVersion=version assemRefLocale=locale } +#if !FABLE_COMPILER static member FromAssemblyName (aname: AssemblyName) = let locale = None @@ -422,6 +423,7 @@ type ILAssemblyRef(data) = let retargetable = aname.Flags = AssemblyNameFlags.Retargetable ILAssemblyRef.Create (aname.Name, None, publicKey, retargetable, version, locale) +#endif member aref.QualifiedName = let b = StringBuilder(100) @@ -1611,12 +1613,16 @@ let inline conditionalAdd condition flagToAdd source = if condition then source let NoMetadataIdx = -1 -[] +[] type ILMethodDef (name: string, attributes: MethodAttributes, implAttributes: MethodImplAttributes, callingConv: ILCallingConv, parameters: ILParameters, ret: ILReturn, body: ILLazyMethodBody, isEntryPoint: bool, genericParams: ILGenericParameterDefs, securityDeclsStored: ILSecurityDeclsStored, customAttrsStored: ILAttributesStored, metadataIndex: int32) = - new (name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, securityDecls, customAttrs) = + static member CreateStored (name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, securityDeclsStored, customAttrsStored, metadataIndex) = + ILMethodDef(name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, + securityDeclsStored, customAttrsStored, metadataIndex) + + static member Create (name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, securityDecls, customAttrs) = ILMethodDef (name, attributes, implAttributes, callingConv, parameters, ret, body, isEntryPoint, genericParams, storeILSecurityDecls securityDecls, storeILCustomAttrs customAttrs, NoMetadataIdx) @@ -1650,7 +1656,7 @@ type ILMethodDef (name: string, attributes: MethodAttributes, implAttributes: Me ?body: ILLazyMethodBody, ?securityDecls: ILSecurityDecls, ?isEntryPoint: bool, ?genericParams: ILGenericParameterDefs, ?customAttrs: ILAttributes) = - ILMethodDef (name = defaultArg name x.Name, + ILMethodDef.Create (name = defaultArg name x.Name, attributes = defaultArg attributes x.Attributes, implAttributes = defaultArg implAttributes x.ImplAttributes, callingConv = defaultArg callingConv x.CallingConv, @@ -1770,12 +1776,15 @@ type ILMethodDefs(f : (unit -> ILMethodDef[])) = x.FindByName nm |> List.tryFind (fun x -> not x.IsStatic && x.CallingSignature = callingSig) -[] +[] type ILEventDef(eventType: ILType option, name: string, attributes: EventAttributes, addMethod: ILMethodRef, removeMethod: ILMethodRef, fireMethod: ILMethodRef option, otherMethods: ILMethodRef list, customAttrsStored: ILAttributesStored, metadataIndex: int32) = - new (eventType, name, attributes, addMethod, removeMethod, fireMethod, otherMethods, customAttrs) = + static member CreateStored (eventType, name, attributes, addMethod, removeMethod, fireMethod, otherMethods, customAttrsStored, metadataIndex) = + ILEventDef(eventType, name, attributes, addMethod, removeMethod, fireMethod, otherMethods, customAttrsStored, metadataIndex) + + static member Create (eventType, name, attributes, addMethod, removeMethod, fireMethod, otherMethods, customAttrs) = ILEventDef(eventType, name, attributes, addMethod, removeMethod, fireMethod, otherMethods, storeILCustomAttrs customAttrs, NoMetadataIdx) member __.EventType = eventType @@ -1790,7 +1799,7 @@ type ILEventDef(eventType: ILType option, name: string, attributes: EventAttribu member x.CustomAttrs = customAttrsStored.GetCustomAttrs x.MetadataIndex member x.With(?eventType, ?name, ?attributes, ?addMethod, ?removeMethod, ?fireMethod, ?otherMethods, ?customAttrs) = - ILEventDef(eventType= defaultArg eventType x.EventType, + ILEventDef.Create(eventType= defaultArg eventType x.EventType, name= defaultArg name x.Name, attributes= defaultArg attributes x.Attributes, addMethod=defaultArg addMethod x.AddMethod, @@ -1816,12 +1825,15 @@ type ILEventDefs = member x.LookupByName s = let (ILEvents t) = x in t.[s] -[] +[] type ILPropertyDef(name: string, attributes: PropertyAttributes, setMethod: ILMethodRef option, getMethod: ILMethodRef option, callingConv: ILThisConvention, propertyType: ILType, init: ILFieldInit option, args: ILTypes, customAttrsStored: ILAttributesStored, metadataIndex: int32) = - new (name, attributes, setMethod, getMethod, callingConv, propertyType, init, args, customAttrs) = + static member CreateStored (name, attributes, setMethod, getMethod, callingConv, propertyType, init, args, customAttrsStored, metadataIndex) = + ILPropertyDef(name, attributes, setMethod, getMethod, callingConv, propertyType, init, args, customAttrsStored, metadataIndex) + + static member Create (name, attributes, setMethod, getMethod, callingConv, propertyType, init, args, customAttrs) = ILPropertyDef(name, attributes, setMethod, getMethod, callingConv, propertyType, init, args, storeILCustomAttrs customAttrs, NoMetadataIdx) member x.Name = name @@ -1837,7 +1849,7 @@ type ILPropertyDef(name: string, attributes: PropertyAttributes, setMethod: ILMe member x.MetadataIndex = metadataIndex member x.With(?name, ?attributes, ?setMethod, ?getMethod, ?callingConv, ?propertyType, ?init, ?args, ?customAttrs) = - ILPropertyDef(name=defaultArg name x.Name, + ILPropertyDef.Create(name=defaultArg name x.Name, attributes=defaultArg attributes x.Attributes, setMethod=defaultArg setMethod x.SetMethod, getMethod=defaultArg getMethod x.GetMethod, @@ -1874,13 +1886,17 @@ let convertFieldAccess (ilMemberAccess: ILMemberAccess) = | ILMemberAccess.Private -> FieldAttributes.Private | ILMemberAccess.Public -> FieldAttributes.Public -[] +[] type ILFieldDef(name: string, fieldType: ILType, attributes: FieldAttributes, data: byte[] option, literalValue: ILFieldInit option, offset: int32 option, marshal: ILNativeType option, customAttrsStored: ILAttributesStored, metadataIndex: int32) = - new (name, fieldType, attributes, data, literalValue, offset, marshal, customAttrs) = + static member CreateStored (name, fieldType, attributes, data, literalValue, offset, marshal, customAttrsStored, metadataIndex) = + ILFieldDef(name, fieldType, attributes, data, literalValue, offset, marshal, customAttrsStored, metadataIndex) + + static member Create (name, fieldType, attributes, data, literalValue, offset, marshal, customAttrs) = ILFieldDef(name, fieldType, attributes, data, literalValue, offset, marshal, storeILCustomAttrs customAttrs, NoMetadataIdx) + member __.Name=name member __.FieldType = fieldType member __.Attributes=attributes @@ -1893,7 +1909,7 @@ type ILFieldDef(name: string, fieldType: ILType, attributes: FieldAttributes, da member x.MetadataIndex = metadataIndex member x.With(?name: string, ?fieldType: ILType, ?attributes: FieldAttributes, ?data: byte[] option, ?literalValue: ILFieldInit option, ?offset: int32 option, ?marshal: ILNativeType option, ?customAttrs: ILAttributes) = - ILFieldDef(name=defaultArg name x.Name, + ILFieldDef.Create(name=defaultArg name x.Name, fieldType=defaultArg fieldType x.FieldType, attributes=defaultArg attributes x.Attributes, data=defaultArg data x.Data, @@ -2045,14 +2061,17 @@ let convertInitSemantics (init: ILTypeInit) = | ILTypeInit.BeforeField -> TypeAttributes.BeforeFieldInit | ILTypeInit.OnAny -> enum 0 -[] +[] type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout, implements: ILTypes, genericParams: ILGenericParameterDefs, extends: ILType option, methods: ILMethodDefs, nestedTypes: ILTypeDefs, fields: ILFieldDefs, methodImpls: ILMethodImplDefs, events: ILEventDefs, properties: ILPropertyDefs, securityDeclsStored: ILSecurityDeclsStored, customAttrsStored: ILAttributesStored, metadataIndex: int32) = let mutable customAttrsStored = customAttrsStored - new (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, securityDecls, customAttrs) = + static member CreateStored (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, securityDeclsStored, customAttrsStored, metadataIndex) = + ILTypeDef (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, securityDeclsStored, customAttrsStored, metadataIndex) + + static member Create (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, securityDecls, customAttrs) = ILTypeDef (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, storeILSecurityDecls securityDecls, storeILCustomAttrs customAttrs, NoMetadataIdx) member __.Name = name @@ -2072,7 +2091,7 @@ type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout member __.MetadataIndex = metadataIndex member x.With(?name, ?attributes, ?layout, ?implements, ?genericParams, ?extends, ?methods, ?nestedTypes, ?fields, ?methodImpls, ?events, ?properties, ?customAttrs, ?securityDecls) = - ILTypeDef(name=defaultArg name x.Name, + ILTypeDef.Create(name=defaultArg name x.Name, attributes=defaultArg attributes x.Attributes, layout=defaultArg layout x.Layout, genericParams = defaultArg genericParams x.GenericParams, @@ -2176,10 +2195,15 @@ 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 = @@ -2235,7 +2259,11 @@ type ILResourceAccess = [] type ILResourceLocation = +#if FABLE_COMPILER + | Local of ByteMemory +#else | Local of ByteStorage +#endif | File of ILModuleRef * int32 | Assembly of ILAssemblyRef @@ -2249,7 +2277,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 @@ -2462,7 +2494,11 @@ let formatCodeLabel (x: int) = "L"+string x // ++GLOBAL MUTABLE STATE (concurrency safe) let codeLabelCount = ref 0 +#if FABLE_COMPILER +let generateCodeLabel() = codeLabelCount := !codeLabelCount + 1; !codeLabelCount +#else let generateCodeLabel() = Interlocked.Increment codeLabelCount +#endif let instrIsRet i = match i with @@ -2942,7 +2978,7 @@ let methBodyAbstract = mkMethBodyAux MethodBody.Abstract let methBodyNative = mkMethBodyAux MethodBody.Native let mkILCtor (access, args, impl) = - ILMethodDef(name=".ctor", + ILMethodDef.Create(name=".ctor", attributes=(convertMemberAccess access ||| MethodAttributes.SpecialName ||| MethodAttributes.RTSpecialName), implAttributes=MethodImplAttributes.Managed, callingConv=ILCallingConv.Instance, @@ -2987,7 +3023,7 @@ let mkILNonGenericEmptyCtor tag superTy = // -------------------------------------------------------------------- let mkILStaticMethod (genparams, nm, access, args, ret, impl) = - ILMethodDef(genericParams=genparams, + ILMethodDef.Create(genericParams=genparams, name=nm, attributes=(convertMemberAccess access ||| MethodAttributes.Static), implAttributes=MethodImplAttributes.Managed, @@ -3003,7 +3039,7 @@ let mkILNonGenericStaticMethod (nm, access, args, ret, impl) = mkILStaticMethod (mkILEmptyGenericParams, nm, access, args, ret, impl) let mkILClassCtor impl = - ILMethodDef(name=".cctor", + ILMethodDef.Create(name=".cctor", attributes=(MethodAttributes.Private ||| MethodAttributes.Static ||| MethodAttributes.SpecialName ||| MethodAttributes.RTSpecialName), implAttributes=MethodImplAttributes.Managed, callingConv=ILCallingConv.Static, @@ -3024,7 +3060,7 @@ let mk_ospec (ty: ILType, callconv, nm, genparams, formal_args, formal_ret) = OverridesSpec (mkILMethRef (ty.TypeRef, callconv, nm, genparams, formal_args, formal_ret), ty) let mkILGenericVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = - ILMethodDef(name=nm, + ILMethodDef.Create(name=nm, attributes= (convertMemberAccess access ||| MethodAttributes.CheckAccessOnOverride ||| @@ -3043,7 +3079,7 @@ let mkILNonGenericVirtualMethod (nm, access, args, ret, impl) = mkILGenericVirtualMethod (nm, access, mkILEmptyGenericParams, args, ret, impl) let mkILGenericNonVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = - ILMethodDef(name=nm, + ILMethodDef.Create(name=nm, attributes=(convertMemberAccess access ||| MethodAttributes.HideBySig), implAttributes=MethodImplAttributes.Managed, genericParams=genparams, @@ -3130,7 +3166,7 @@ let prependInstrsToClassCtor instrs tag cd = cdef_cctorCode2CodeOrCreate tag (prependInstrsToMethod instrs) cd let mkILField (isStatic, nm, ty, (init: ILFieldInit option), (at: byte [] option), access, isLiteral) = - ILFieldDef(name=nm, + ILFieldDef.Create(name=nm, fieldType=ty, attributes= (convertFieldAccess access ||| @@ -3253,7 +3289,7 @@ let mkILSimpleStorageCtor (tag, baseTySpec, ty, extraParams, flds, access) = let mkILStorageCtor (tag, preblock, ty, flds, access) = mkILStorageCtorWithParamNames (tag, preblock, ty, [], addParamNames flds, access) let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nestedTypes, props, events, attrs, init) = - ILTypeDef(name=nm, + ILTypeDef.Create(name=nm, attributes=(convertTypeAccessFlags access ||| TypeAttributes.AutoLayout ||| TypeAttributes.Class ||| (match init with | ILTypeInit.BeforeField -> TypeAttributes.BeforeFieldInit | _ -> enum 0) ||| TypeAttributes.AnsiClass), genericParams= genparams, @@ -3270,7 +3306,7 @@ let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nes securityDecls=emptyILSecurityDecls) let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm, size, pack) = - ILTypeDef(name = nm, + ILTypeDef.Create(name = nm, genericParams= [], attributes = (TypeAttributes.NotPublic ||| TypeAttributes.Sealed ||| TypeAttributes.ExplicitLayout ||| TypeAttributes.BeforeFieldInit ||| TypeAttributes.AnsiClass), @@ -3862,7 +3898,11 @@ type ILTypeSigParser (tstring : string) = yield grabScopeComponent() // culture yield grabScopeComponent() // public key token ] |> String.concat "," +#if FABLE_COMPILER + ILScopeRef.Assembly(mkSimpleAssemblyRef scope) +#else ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(AssemblyName scope)) +#endif else ILScopeRef.Local @@ -4010,7 +4050,11 @@ let decodeILAttribData (ilg: ILGlobals) (ca: ILAttribute) = pieces.[0], None 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 -> ilg.primaryAssemblyScopeRef let tref = mkILTyRef (scoref, unqualified_tname) @@ -4286,11 +4330,17 @@ 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 = System.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 let minorRevision = if version.Revision = -1 then 0us else 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 diff --git a/src/fsharp/absil/il.fsi b/src/fsharp/absil/il.fsi index a4dffcf91158..a4333a8cdc51 100644 --- a/src/fsharp/absil/il.fsi +++ b/src/fsharp/absil/il.fsi @@ -71,7 +71,9 @@ type ILVersionInfo = [] type ILAssemblyRef = static member Create: name: string * hash: byte[] option * publicKey: PublicKey option * retargetable: bool * version: ILVersionInfo option * locale: string option -> ILAssemblyRef +#if !FABLE_COMPILER static member FromAssemblyName: System.Reflection.AssemblyName -> ILAssemblyRef +#endif member Name: string /// The fully qualified name of the assembly reference, e.g. mscorlib, Version=1.0.3705 etc. @@ -976,16 +978,16 @@ type ILLazyMethodBody = member Contents: MethodBody /// IL Method definitions. -[] +[] type ILMethodDef = /// Functional creation of a value, with delayed reading of some elements via a metadata index - new: name: string * attributes: MethodAttributes * implAttributes: MethodImplAttributes * callingConv: ILCallingConv * + static member CreateStored: name: string * attributes: MethodAttributes * implAttributes: MethodImplAttributes * callingConv: ILCallingConv * parameters: ILParameters * ret: ILReturn * body: ILLazyMethodBody * isEntryPoint:bool * genericParams: ILGenericParameterDefs * securityDeclsStored: ILSecurityDeclsStored * customAttrsStored: ILAttributesStored * metadataIndex: int32 -> ILMethodDef /// Functional creation of a value, immediate - new: name: string * attributes: MethodAttributes * implAttributes: MethodImplAttributes * callingConv: ILCallingConv * + static member Create: name: string * attributes: MethodAttributes * implAttributes: MethodImplAttributes * callingConv: ILCallingConv * parameters: ILParameters * ret: ILReturn * body: ILLazyMethodBody * isEntryPoint:bool * genericParams: ILGenericParameterDefs * securityDecls: ILSecurityDecls * customAttrs: ILAttributes -> ILMethodDef @@ -1080,16 +1082,16 @@ type ILMethodDefs = member TryFindInstanceByNameAndCallingSignature: string * ILCallingSignature -> ILMethodDef option /// Field definitions. -[] +[] type ILFieldDef = /// Functional creation of a value using delayed reading via a metadata index - new: name: string * fieldType: ILType * attributes: FieldAttributes * data: byte[] option * + static member CreateStored: name: string * fieldType: ILType * attributes: FieldAttributes * data: byte[] option * literalValue: ILFieldInit option * offset: int32 option * marshal: ILNativeType option * customAttrsStored: ILAttributesStored * metadataIndex: int32 -> ILFieldDef /// Functional creation of a value, immediate - new: name: string * fieldType: ILType * attributes: FieldAttributes * data: byte[] option * + static member Create: name: string * fieldType: ILType * attributes: FieldAttributes * data: byte[] option * literalValue: ILFieldInit option * offset: int32 option * marshal: ILNativeType option * customAttrs: ILAttributes -> ILFieldDef @@ -1129,16 +1131,16 @@ type ILFieldDefs = member LookupByName: string -> ILFieldDef list /// Event definitions. -[] +[] type ILEventDef = /// Functional creation of a value, using delayed reading via a metadata index, for ilread.fs - new: eventType: ILType option * name: string * attributes: EventAttributes * addMethod: ILMethodRef * + static member CreateStored: eventType: ILType option * name: string * attributes: EventAttributes * addMethod: ILMethodRef * removeMethod: ILMethodRef * fireMethod: ILMethodRef option * otherMethods: ILMethodRef list * customAttrsStored: ILAttributesStored * metadataIndex: int32 -> ILEventDef /// Functional creation of a value, immediate - new: eventType: ILType option * name: string * attributes: EventAttributes * addMethod: ILMethodRef * + static member Create: eventType: ILType option * name: string * attributes: EventAttributes * addMethod: ILMethodRef * removeMethod: ILMethodRef * fireMethod: ILMethodRef option * otherMethods: ILMethodRef list * customAttrs: ILAttributes -> ILEventDef @@ -1165,16 +1167,16 @@ type ILEventDefs = member LookupByName: string -> ILEventDef list /// Property definitions -[] +[] type ILPropertyDef = /// Functional creation of a value, using delayed reading via a metadata index, for ilread.fs - new: name: string * attributes: PropertyAttributes * setMethod: ILMethodRef option * getMethod: ILMethodRef option * + static member CreateStored: name: string * attributes: PropertyAttributes * setMethod: ILMethodRef option * getMethod: ILMethodRef option * callingConv: ILThisConvention * propertyType: ILType * init: ILFieldInit option * args: ILTypes * customAttrsStored: ILAttributesStored * metadataIndex: int32 -> ILPropertyDef /// Functional creation of a value, immediate - new: name: string * attributes: PropertyAttributes * setMethod: ILMethodRef option * getMethod: ILMethodRef option * + static member Create: name: string * attributes: PropertyAttributes * setMethod: ILMethodRef option * getMethod: ILMethodRef option * callingConv: ILThisConvention * propertyType: ILType * init: ILFieldInit option * args: ILTypes * customAttrs: ILAttributes -> ILPropertyDef @@ -1270,16 +1272,16 @@ type ILTypeDefs = member FindByName: string -> ILTypeDef /// Represents IL Type Definitions. -and [] +and [] ILTypeDef = /// Functional creation of a value, using delayed reading via a metadata index, for ilread.fs - new: name: string * attributes: TypeAttributes * layout: ILTypeDefLayout * implements: ILTypes * genericParams: ILGenericParameterDefs * + static member CreateStored: name: string * attributes: TypeAttributes * layout: ILTypeDefLayout * implements: ILTypes * genericParams: ILGenericParameterDefs * extends: ILType option * methods: ILMethodDefs * nestedTypes: ILTypeDefs * fields: ILFieldDefs * methodImpls: ILMethodImplDefs * events: ILEventDefs * properties: ILPropertyDefs * securityDeclsStored: ILSecurityDeclsStored * customAttrsStored: ILAttributesStored * metadataIndex: int32 -> ILTypeDef /// Functional creation of a value, immediate - new: name: string * attributes: TypeAttributes * layout: ILTypeDefLayout * implements: ILTypes * genericParams: ILGenericParameterDefs * + static member Create: name: string * attributes: TypeAttributes * layout: ILTypeDefLayout * implements: ILTypes * genericParams: ILGenericParameterDefs * extends: ILType option * methods: ILMethodDefs * nestedTypes: ILTypeDefs * fields: ILFieldDefs * methodImpls: ILMethodImplDefs * events: ILEventDefs * properties: ILPropertyDefs * securityDecls: ILSecurityDecls * customAttrs: ILAttributes -> ILTypeDef @@ -1425,7 +1427,12 @@ type ILResourceAccess = type ILResourceLocation = internal /// 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/fsharp/absil/ildiag.fs b/src/fsharp/absil/ildiag.fs index d43bdf8dca44..6aec197182fb 100644 --- a/src/fsharp/absil/ildiag.fs +++ b/src/fsharp/absil/ildiag.fs @@ -5,6 +5,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 @@ -20,3 +28,4 @@ let dprintf (fmt: Format<_,_,_,_>) = let dprintfn (fmt: Format<_,_,_,_>) = Printf.kfprintf dflushn (match diagnosticsLog with None -> System.IO.TextWriter.Null | Some d -> d) fmt +#endif \ No newline at end of file diff --git a/src/fsharp/absil/ildiag.fsi b/src/fsharp/absil/ildiag.fsi index 4be1d87bc4cf..850569d0546f 100644 --- a/src/fsharp/absil/ildiag.fsi +++ b/src/fsharp/absil/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/fsharp/absil/illex.fsl b/src/fsharp/absil/illex.fsl index d0269e20dbdc..798c469d7092 100644 --- a/src/fsharp/absil/illex.fsl +++ b/src/fsharp/absil/illex.fsl @@ -17,7 +17,16 @@ open FSharp.Compiler.AbstractIL.Internal.AsciiConstants let lexeme (lexbuf : LexBuffer<_>) = LexBuffer<_>.LexemeString lexbuf -let lexemeChar (lexbuf : LexBuffer) n = lexbuf.LexemeChar n +let lexemeChar (lexbuf : LexBuffer<_>) n = lexbuf.LexemeChar n |> char + +/// Trim n chars from both sides of lexbuf, return string +let lexemeTrimBoth (lexbuf : LexBuffer<_>) (n:int) (m:int) = +#if FABLE_COMPILER + LexBuffer<_>.LexemeSliceToString (lexbuf, n, lexbuf.LexemeLength - (n+m)) +#else + let s = lexbuf.LexemeView + s.Slice(n, s.Length - (n+m)).ToString() +#endif let unexpectedChar _lexbuf = raise Parsing.RecoverableParseError ;; @@ -115,8 +124,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/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 332664d04ea3..1257b8610c9b 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -43,6 +43,7 @@ let inline (===) x y = LanguagePrimitives.PhysicalEquality x y /// We set the limit to be 80k to account for larger pointer sizes for when F# is running 64-bit. let LOH_SIZE_THRESHOLD_BYTES = 80_000 +#if !FABLE_COMPILER // no Process support //--------------------------------------------------------------------- // Library: ReportTime //--------------------------------------------------------------------- @@ -56,13 +57,19 @@ let reportTime = let first = match tFirst with None -> (tFirst <- Some t; t) | Some t -> t printf "ilwrite: TIME %10.3f (total) %10.3f (delta) - %s\n" (t - first) (t - prev) descr tPrev <- Some t +#endif //------------------------------------------------------------------------- // Library: projections //------------------------------------------------------------------------ -[] /// An efficient lazy for inline storage in a class type. Results in fewer thunks. +#if FABLE_COMPILER // no threading support +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) = {store = Unchecked.defaultof<'T>; func = Func<_>(f) } val mutable store : 'T @@ -75,6 +82,7 @@ type InlineDelayInit<'T when 'T : not struct> = let res = LazyInitializer.EnsureInitialized(&x.store, x.func) x.func <- Unchecked.defaultof<_> res +#endif //------------------------------------------------------------------------- // Library: projections @@ -290,7 +298,9 @@ module List = | _ -> true let mapq (f: 'T -> 'T) inp = +#if !FABLE_COMPILER assert not (typeof<'T>.IsValueType) +#endif match inp with | [] -> inp | [h1a] -> @@ -465,7 +475,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 @@ -533,7 +547,7 @@ module String = let lowerCaseFirstChar (str: string) = if String.IsNullOrEmpty str - || Char.IsLower(str, 0) then str else + || Char.IsLower(str.[0]) then str else let strArr = toCharArray str match Array.tryHead strArr with | None -> str @@ -562,17 +576,17 @@ module String = let split options (separator: string []) (value: string) = if isNull value then null else value.Split(separator, options) - let (|StartsWith|_|) pattern value = + let (|StartsWith|_|) (pattern: string) value = if String.IsNullOrWhiteSpace value then None elif value.StartsWithOrdinal pattern then Some() else None - let (|Contains|_|) pattern value = + let (|Contains|_|) (pattern: string) value = if String.IsNullOrWhiteSpace value then None - elif value.Contains pattern then + elif value.Contains(pattern) then Some() else None @@ -591,6 +605,7 @@ module String = // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak yield String.Empty |] +#endif module Dictionary = let inline newWithSize (size: int) = Dictionary<_, _>(size, HashIdentity.Structural) @@ -648,10 +663,12 @@ let AssumeAnyCallerThreadWithoutEvidence () = Unchecked.defaultof 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 @@ -757,7 +774,11 @@ module Cancellable = /// Run the computation in a mode where it may not be cancelled. The computation never results in a /// ValueOrCancelled.Cancelled. let runWithoutCancellation comp = +#if FABLE_COMPILER + let res = run (CancellationToken()) comp +#else let res = run CancellationToken.None comp +#endif match res with | ValueOrCancelled.Cancelled _ -> failwith "unexpected cancellation" | ValueOrCancelled.Value r -> r @@ -861,6 +882,7 @@ module Eventually = let force ctok e = Option.get (forceWhile ctok (fun () -> true) e) +#if !FABLE_COMPILER /// Keep running the computation bit by bit until a time limit is reached. /// The runner gets called each time the computation is restarted /// @@ -895,6 +917,7 @@ module Eventually = return! loop r } loop e +#endif let rec bind k e = match e with @@ -1040,12 +1063,16 @@ type LazyWithContext<'T, 'ctxt> = match x.funcOrException with | null -> x.value | _ -> +#if FABLE_COMPILER // no threading support + x.UnsynchronizedForce(ctxt) +#else // Enter the lock in case another thread is in the process of evaluating the result Monitor.Enter x; try x.UnsynchronizedForce ctxt finally Monitor.Exit x +#endif member x.UnsynchronizedForce ctxt = match x.funcOrException with @@ -1273,6 +1300,7 @@ module Shim = type IFileSystem = +#if !FABLE_COMPILER /// A shim over File.ReadAllBytes abstract ReadAllBytesShim: fileName: string -> byte[] @@ -1284,6 +1312,7 @@ module Shim = /// A shim over FileStream with FileMode.Open, FileAccess.Write, FileShare.Read abstract FileStreamWriteExistingShim: fileName: string -> Stream +#endif /// 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) @@ -1296,6 +1325,7 @@ module Shim = /// A shim over Path.IsInvalidPath abstract IsInvalidPathShim: filename: string -> bool +#if !FABLE_COMPILER /// A shim over Path.GetTempPath abstract GetTempPathShim : unit -> string @@ -1316,11 +1346,13 @@ module Shim = /// Used to determine if a file will not be subject to deletion during the lifetime of a typical client process. abstract IsStableFileHeuristic: fileName: string -> bool +#endif type DefaultFileSystem() = interface IFileSystem with +#if !FABLE_COMPILER member __.AssemblyLoadFrom(fileName: string) = Assembly.UnsafeLoadFrom fileName @@ -1336,6 +1368,9 @@ module Shim = member __.FileStreamWriteExistingShim (fileName: string) = new FileStream(fileName, FileMode.Open, FileAccess.Write, FileShare.Read, 0x1000, false) :> Stream member __.GetFullPathShim (fileName: string) = System.IO.Path.GetFullPath fileName +#else //FABLE_COMPILER + member __.GetFullPathShim (fileName: string) = fileName +#endif member __.IsPathRootedShim (path: string) = Path.IsPathRooted path @@ -1354,6 +1389,7 @@ module Shim = let filename = Path.GetFileName path isInvalidDirectory directory || isInvalidFilename filename +#if !FABLE_COMPILER member __.GetTempPathShim() = Path.GetTempPath() member __.GetLastWriteTimeShim (fileName: string) = File.GetLastWriteTimeUtc fileName @@ -1369,9 +1405,12 @@ module Shim = directory.Contains("packages/") || directory.Contains("packages\\") || directory.Contains("lib/mono/") +#endif let mutable FileSystem = DefaultFileSystem() :> IFileSystem +#if !FABLE_COMPILER + // The choice of 60 retries times 50 ms is not arbitrary. The NTFS FILETIME structure // uses 2 second resolution for LastWriteTime. We retry long enough to surpass this threshold // plus 1 second. Once past the threshold the incremental builder will be able to retry asynchronously based @@ -1424,3 +1463,4 @@ module Shim = static member OpenReaderAndRetry (filename, codepage, retryLocked) = getReader (filename, codepage, retryLocked) +#endif diff --git a/src/fsharp/absil/ilread.fs b/src/fsharp/absil/ilread.fs index 82d53b07959e..461ba8356a38 100644 --- a/src/fsharp/absil/ilread.fs +++ b/src/fsharp/absil/ilread.fs @@ -15,8 +15,10 @@ open System.Collections.Generic open System.Collections.Immutable open System.Diagnostics open System.IO +#if !FABLE_COMPILER open System.IO.MemoryMappedFiles open System.Runtime.InteropServices +#endif open System.Text open Internal.Utilities open Internal.Utilities.Collections @@ -26,7 +28,9 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.BinaryConstants open FSharp.Compiler.AbstractIL.Internal.Library +#if !FABLE_COMPILER open FSharp.Compiler.AbstractIL.Internal.Support +#endif open FSharp.Compiler.AbstractIL.Internal.Utils open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Range @@ -37,10 +41,17 @@ open System.Reflection let checking = false let logging = false 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 let noStableFileHeuristic = try (System.Environment.GetEnvironmentVariable("FSharp_NoStableFileHeuristic") <> null) with _ -> false let alwaysMemoryMapFSC = try (System.Environment.GetEnvironmentVariable("FSharp_AlwaysMemoryMapCommandLineCompiler") <> null) with _ -> false let stronglyHeldReaderCacheSizeDefault = 30 let stronglyHeldReaderCacheSize = try (match System.Environment.GetEnvironmentVariable("FSharp_StronglyHeldBinaryReaderCacheSize") with null -> stronglyHeldReaderCacheSizeDefault | s -> int32 s) with _ -> stronglyHeldReaderCacheSizeDefault +#endif let singleOfBits (x: int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes x, 0) let doubleOfBits (x: int64) = System.BitConverter.Int64BitsToDouble x @@ -115,6 +126,7 @@ 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. @@ -125,6 +137,7 @@ type RawMemoryFile(fileName: string, obj: obj, addr: nativeint, length: int) = member __.FileName = fileName interface BinaryFile with override __.GetView() = view +#endif //!FABLE_COMPILER /// A BinaryFile backed by an array of bytes held strongly as managed memory [] @@ -135,6 +148,7 @@ type ByteFile(fileName: string, bytes: byte[]) = interface BinaryFile with override bf.GetView() = view +#if !FABLE_COMPILER /// Same as ByteFile but holds the bytes weakly. The bytes will be re-read from the backing file when a view is requested. /// This is the default implementation used by F# Compiler Services when accessing "stable" binaries. It is not used /// by Visual Studio, where tryGetMetadataSnapshot provides a RawMemoryFile backed by Roslyn data. @@ -173,6 +187,7 @@ type WeakByteFile(fileName: string, chunk: (int * int) option) = tg ByteMemory.FromArray(strongBytes).AsReadOnly() +#endif //!FABLE_COMPILER let seekReadByte (mdv: BinaryView) addr = mdv.[addr] @@ -934,13 +949,19 @@ type ILMetadataReader = typeDefReader: ILTypeDefStored } type ISeekReadIndexedRowReader<'RowT, 'KeyT, 'T when 'RowT : struct> = - abstract GetRow: int * byref<'RowT> -> unit - abstract GetKey: byref<'RowT> -> 'KeyT + abstract GetRow: int * ref<'RowT> -> unit + abstract GetKey: ref<'RowT> -> 'KeyT abstract CompareKey: 'KeyT -> int - abstract ConvertRow: byref<'RowT> -> 'T + abstract ConvertRow: ref<'RowT> -> 'T -let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader<'RowT, _, _>) = - let mutable row = Unchecked.defaultof<'RowT> +[] +type CustomAttributeRow = + val mutable parentIndex: TaggedIndex + val mutable typeIndex: TaggedIndex + val mutable valueIndex: int + +let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedRowReader) = + let mutable row = ref Unchecked.defaultof if binaryChop then let mutable low = 0 let mutable high = numRows + 1 @@ -951,8 +972,8 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR fin <- true else let mid = (low + high) / 2 - reader.GetRow(mid, &row) - let c = reader.CompareKey(reader.GetKey(&row)) + reader.GetRow(mid, row) + let c = reader.CompareKey(reader.GetKey(row)) if c > 0 then low <- mid elif c < 0 then @@ -972,9 +993,9 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR if curr = 0 then fin <- true else - reader.GetRow(curr, &row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + reader.GetRow(curr, row) + if reader.CompareKey(reader.GetKey(row)) = 0 then + res.Add(reader.ConvertRow(row)) else fin <- true curr <- curr - 1 @@ -988,9 +1009,9 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR if curr > numRows then fin <- true else - reader.GetRow(curr, &row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + reader.GetRow(curr, row) + if reader.CompareKey(reader.GetKey(row)) = 0 then + res.Add(reader.ConvertRow(row)) else fin <- true curr <- curr + 1 @@ -999,75 +1020,72 @@ let seekReadIndexedRowsByInterface numRows binaryChop (reader: ISeekReadIndexedR else let res = ImmutableArray.CreateBuilder() for i = 1 to numRows do - reader.GetRow(i, &row) - if reader.CompareKey(reader.GetKey(&row)) = 0 then - res.Add(reader.ConvertRow(&row)) + reader.GetRow(i, row) + if reader.CompareKey(reader.GetKey(row)) = 0 then + res.Add(reader.ConvertRow(row)) res.ToArray() -[] -type CustomAttributeRow = - val mutable parentIndex: TaggedIndex - val mutable typeIndex: TaggedIndex - val mutable valueIndex: int +let inline rowAddr (ctxt: ILMetadataReader) (tn: TableName) (idx: int) = + ref (ctxt.rowAddr tn idx) -let seekReadUInt16Adv mdv (addr: byref) = - let res = seekReadUInt16 mdv addr - addr <- addr + 2 +let seekReadUInt16Adv mdv (addr: ref) = + let res = seekReadUInt16 mdv !addr + addr := !addr + 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 + addr := !addr + 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 + addr := !addr + 2 res -let inline seekReadTaggedIdx f nbits big mdv (addr: byref) = - let tok = if big then seekReadInt32Adv mdv &addr else seekReadUInt16AsInt32Adv mdv &addr +let inline seekReadTaggedIdx f nbits big mdv (addr: ref) = + let tok = if big then seekReadInt32Adv mdv addr else seekReadUInt16AsInt32Adv mdv addr tokToTaggedIdx f nbits tok -let seekReadIdx big mdv (addr: byref) = - if big then seekReadInt32Adv mdv &addr else seekReadUInt16AsInt32Adv mdv &addr - -let seekReadUntaggedIdx (tab: TableName) (ctxt: ILMetadataReader) mdv (addr: byref) = - seekReadIdx ctxt.tableBigness.[tab.Index] mdv &addr - -let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv &addr -let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv &addr -let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv &addr -let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv &addr -let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv &addr -let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv &addr -let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv &addr -let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv &addr -let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv &addr -let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv &addr -let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv &addr -let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv &addr -let seekReadCustomAttributeTypeIdx (ctxt: ILMetadataReader) mdv (addr: byref) = seekReadTaggedIdx mkILCustomAttributeTypeTag 3 ctxt.catBigness mdv &addr -let seekReadStringIdx (ctxt: ILMetadataReader) mdv (addr: byref) = 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 seekReadIdx big mdv (addr: ref) = + if big then seekReadInt32Adv mdv addr else seekReadUInt16AsInt32Adv mdv addr + +let seekReadUntaggedIdx (tab: TableName) (ctxt: ILMetadataReader) mdv (addr: ref) = + seekReadIdx ctxt.tableBigness.[tab.Index] mdv addr + +let seekReadResolutionScopeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkResolutionScopeTag 2 ctxt.rsBigness mdv addr +let seekReadTypeDefOrRefOrSpecIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkTypeDefOrRefOrSpecTag 2 ctxt.tdorBigness mdv addr +let seekReadTypeOrMethodDefIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkTypeOrMethodDefTag 1 ctxt.tomdBigness mdv addr +let seekReadHasConstantIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkHasConstantTag 2 ctxt.hcBigness mdv addr +let seekReadHasCustomAttributeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkHasCustomAttributeTag 5 ctxt.hcaBigness mdv addr +let seekReadHasFieldMarshalIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkHasFieldMarshalTag 1 ctxt.hfmBigness mdv addr +let seekReadHasDeclSecurityIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkHasDeclSecurityTag 2 ctxt.hdsBigness mdv addr +let seekReadMemberRefParentIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkMemberRefParentTag 3 ctxt.mrpBigness mdv addr +let seekReadHasSemanticsIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkHasSemanticsTag 1 ctxt.hsBigness mdv addr +let seekReadMethodDefOrRefIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkMethodDefOrRefTag 1 ctxt.mdorBigness mdv addr +let seekReadMemberForwardedIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkMemberForwardedTag 1 ctxt.mfBigness mdv addr +let seekReadImplementationIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkImplementationTag 2 ctxt.iBigness mdv addr +let seekReadCustomAttributeTypeIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadTaggedIdx mkILCustomAttributeTypeTag 3 ctxt.catBigness mdv addr +let seekReadStringIdx (ctxt: ILMetadataReader) mdv (addr: ref) = seekReadIdx ctxt.stringsBigness 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. @@ -1075,55 +1093,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. @@ -1131,83 +1149,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 + row.parentIndex <- seekReadHasCustomAttributeIdx ctxt mdv addr + row.typeIndex <- seekReadCustomAttributeTypeIdx ctxt mdv addr + row.valueIndex <- seekReadBlobIdx ctxt mdv addr + attrRow := 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. @@ -1215,101 +1235,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. @@ -1317,32 +1337,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) @@ -1414,13 +1434,15 @@ let readBlobHeapAsDouble ctxt vidx = fst (sigptrGetDouble (readBlobHeap ctxt vid let readNativeResources (pectxt: PEReader) = [ if pectxt.nativeResourcesSize <> 0x0 && pectxt.nativeResourcesAddr <> 0x0 then let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr) +#if !FABLE_COMPILER if pectxt.noFileOnDisk then let unlinkedResource = let linkedResource = seekReadBytes (pectxt.pefile.GetView()) start pectxt.nativeResourcesSize unlinkResource pectxt.nativeResourcesAddr linkedResource yield ILNativeResource.Out unlinkedResource else - yield ILNativeResource.In (pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize ) ] +#endif + yield ILNativeResource.In (pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize ) ] let getDataEndPointsDelayed (pectxt: PEReader) ctxtH = @@ -1668,7 +1690,7 @@ and typeDefReader ctxtH: ILTypeDefStored = let mimpls = seekReadMethodImpls ctxt numtypars idx let props = seekReadProperties ctxt numtypars idx let events = seekReadEvents ctxt numtypars idx - ILTypeDef(name=nm, + ILTypeDef.CreateStored(name=nm, genericParams=typars, attributes= enum(flags), layout = layout, @@ -1860,7 +1882,7 @@ and seekReadField ctxt mdv (numtypars, hasLayout) (idx: int) = let (flags, nameIdx, typeIdx) = seekReadFieldRow ctxt mdv idx let nm = readStringHeap ctxt nameIdx let isStatic = (flags &&& 0x0010) <> 0 - ILFieldDef(name = nm, + ILFieldDef.CreateStored(name = nm, fieldType= readBlobHeapAsFieldSig ctxt numtypars typeIdx, attributes = enum(flags), literalValue = (if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef, idx)))), @@ -2262,7 +2284,7 @@ and seekReadMethod (ctxt: ILMetadataReader) mdv numtypars (idx: int) = | None -> methBodyNotAvailable | Some pectxt -> seekReadMethodRVA pectxt ctxt (idx, nm, internalcall, noinline, aggressiveinline, numtypars) codeRVA - ILMethodDef(name=nm, + ILMethodDef.CreateStored(name=nm, attributes = enum(flags), implAttributes= enum(implflags), securityDeclsStored=ctxt.securityDeclsReader_MethodDef, @@ -2348,7 +2370,7 @@ and seekReadMethodSemantics ctxt id = and seekReadEvent ctxt mdv numtypars idx = let (flags, nameIdx, typIdx) = seekReadEventRow ctxt mdv idx - ILEventDef(eventType = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx, + ILEventDef.CreateStored(eventType = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx, name = readStringHeap ctxt nameIdx, attributes = enum(flags), addMethod= seekReadMethodSemantics ctxt (0x0008, TaggedIndex(hs_Event, idx)), @@ -2392,7 +2414,7 @@ and seekReadProperty ctxt mdv numtypars idx = | Some mref -> mref.CallingConv .ThisConv | None -> cc - ILPropertyDef(name=readStringHeap ctxt nameIdx, + ILPropertyDef.CreateStored(name=readStringHeap ctxt nameIdx, callingConv = cc2, attributes = enum(flags), setMethod=setter, @@ -2428,10 +2450,10 @@ and customAttrsReader ctxtH tag: ILAttributesStored = let mdv = ctxt.mdfile.GetView() let reader = { new ISeekReadIndexedRowReader, ILAttribute> with - member _.GetRow(i, row) = seekReadCustomAttributeRow ctxt mdv i &row - member _.GetKey(attrRow) = attrRow.parentIndex + member _.GetRow(i, row) = seekReadCustomAttributeRow ctxt mdv i row + member _.GetKey(attrRow) = (!attrRow).parentIndex member _.CompareKey(key) = hcaCompare (TaggedIndex(tag, idx)) key - member _.ConvertRow(attrRow) = seekReadCustomAttr ctxt (attrRow.typeIndex, attrRow.valueIndex) + member _.ConvertRow(attrRow) = seekReadCustomAttr ctxt ((!attrRow).typeIndex, (!attrRow).valueIndex) } seekReadIndexedRowsByInterface (ctxt.getNumRows TableNames.CustomAttribute) (isSorted ctxt TableNames.CustomAttribute) reader) @@ -3109,7 +3131,12 @@ and seekReadManifestResources (ctxt: ILMetadataReader) canReduceMemory (mdv: Bin let offsetOfBytesFromStartOfPhysicalPEFile = start + 4 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) | ILScopeRef.Module mref -> ILResourceLocation.File (mref, offset) @@ -3831,6 +3858,15 @@ type ILModuleReaderImpl(ilModule: ILModuleDef, ilAssemblyRefs: Lazy BinaryFile + let ilModule, ilAssemblyRefs, pdb = openPE (fileName, pefile, opts.pdbDirPath, (opts.reduceMemoryUsage = ReduceMemoryFlag.Yes), true) + new ILModuleReaderImpl(ilModule, ilAssemblyRefs, (fun () -> ClosePdbReader pdb)) :> ILModuleReader + +#else + // ++GLOBAL MUTABLE STATE (concurrency safe via locking) type ILModuleReaderCacheKey = ILModuleReaderCacheKey of string * DateTime * bool * ReduceMemoryFlag * MetadataOnlyFlag @@ -4013,3 +4049,5 @@ module Shim = OpenILModuleReader filename readerOptions let mutable AssemblyReader = DefaultAssemblyReader() :> IAssemblyReader + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/absil/ilread.fsi b/src/fsharp/absil/ilread.fsi index 4ca7ebe51bd2..e32b77f49c87 100644 --- a/src/fsharp/absil/ilread.fsi +++ b/src/fsharp/absil/ilread.fsi @@ -72,6 +72,7 @@ type 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. @@ -80,6 +81,8 @@ val internal OpenILModuleReader: string -> ILReaderOptions -> ILModuleReader val internal ClearAllILModuleReaderCache : unit -> unit +#endif + /// Open a binary reader based on the given bytes. val internal OpenILModuleReaderFromBytes: fileName:string -> assemblyContents: byte[] -> options: ILReaderOptions -> ILModuleReader @@ -92,6 +95,8 @@ type Statistics = val GetStatistics : unit -> Statistics +#if !FABLE_COMPILER + [] module Shim = @@ -103,3 +108,5 @@ module Shim = interface IAssemblyReader val mutable AssemblyReader: IAssemblyReader + +#endif diff --git a/src/fsharp/ilx/EraseClosures.fs b/src/fsharp/ilx/EraseClosures.fs index abc5e4bc977b..a7fe3b002bc6 100644 --- a/src/fsharp/ilx/EraseClosures.fs +++ b/src/fsharp/ilx/EraseClosures.fs @@ -483,7 +483,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = |> cenv.addMethodGeneratedAttrs let cloTypeDef = - ILTypeDef(name = td.Name, + ILTypeDef.Create(name = td.Name, genericParams= td.GenericParams, attributes = td.Attributes, implements = [], @@ -580,7 +580,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = ILMemberAccess.Assembly) |> cenv.addMethodGeneratedAttrs - ILTypeDef(name = td.Name, + ILTypeDef.Create(name = td.Name, genericParams= td.GenericParams, attributes = td.Attributes, implements = [], diff --git a/src/fsharp/ilx/EraseUnions.fs b/src/fsharp/ilx/EraseUnions.fs index c24a30a6105f..99af1becfdcd 100644 --- a/src/fsharp/ilx/EraseUnions.fs +++ b/src/fsharp/ilx/EraseUnions.fs @@ -612,7 +612,7 @@ let mkMethodsAndPropertiesForFields (addMethodGeneratedAttrs, addPropertyGenerat let basicProps = fields |> Array.map (fun field -> - ILPropertyDef(name = adjustFieldName hasHelpers field.Name, + ILPropertyDef.Create(name = adjustFieldName hasHelpers field.Name, attributes = PropertyAttributes.None, setMethod = None, getMethod = Some (mkILMethRef (ilTy.TypeRef, ILCallingConv.Instance, "get_" + adjustFieldName hasHelpers field.Name, 0, [], field.Type)), @@ -696,7 +696,7 @@ let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addP mkMethodBody(true,[],2,nonBranchingInstrsToCode ([ mkLdarg0 ] @ mkIsData ilg (true, cuspec, num)), attr)) |> addMethodGeneratedAttrs ], - [ ILPropertyDef(name = mkTesterName altName, + [ ILPropertyDef.Create(name = mkTesterName altName, attributes = PropertyAttributes.None, setMethod = None, getMethod = Some (mkILMethRef (baseTy.TypeRef, ILCallingConv.Instance, "get_" + mkTesterName altName, 0, [], ilg.typ_Bool)), @@ -724,7 +724,7 @@ let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addP let nullaryProp = - ILPropertyDef(name = altName, + ILPropertyDef.Create(name = altName, attributes = PropertyAttributes.None, setMethod = None, getMethod = Some (mkILMethRef (baseTy.TypeRef, ILCallingConv.Static, "get_" + altName, 0, [], baseTy)), @@ -825,7 +825,7 @@ let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addP let debugProxyGetterProps = fields |> Array.map (fun fdef -> - ILPropertyDef(name = fdef.Name, + ILPropertyDef.Create(name = fdef.Name, attributes = PropertyAttributes.None, setMethod = None, getMethod = Some(mkILMethRef(debugProxyTy.TypeRef,ILCallingConv.Instance,"get_" + fdef.Name,0,[],fdef.Type)), @@ -1037,7 +1037,7 @@ let mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addProp [ mkILNonGenericInstanceMethod("get_" + tagPropertyName,cud.cudHelpersAccess,[],mkILReturn tagFieldType,body) |> addMethodGeneratedAttrs ], - [ ILPropertyDef(name = tagPropertyName, + [ ILPropertyDef.Create(name = tagPropertyName, attributes = PropertyAttributes.None, setMethod = None, getMethod = Some(mkILMethRef(baseTy.TypeRef,ILCallingConv.Instance,"get_" + tagPropertyName,0,[], tagFieldType)), @@ -1064,7 +1064,7 @@ let mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addProp None else let tdef = - ILTypeDef(name = "Tags", + ILTypeDef.Create(name = "Tags", nestedTypes = emptyILTypeDefs, genericParams= td.GenericParams, attributes = enum 0, diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs index 22c92e56acf8..7dac293fef5a 100644 --- a/src/fsharp/layout.fs +++ b/src/fsharp/layout.fs @@ -309,6 +309,7 @@ let taggedTextListR collector = member _.Finish rstrs = NoResult } +#if !FABLE_COMPILER /// channel LayoutRenderer let channelR (chan:TextWriter) = { new LayoutRenderer with @@ -317,6 +318,7 @@ let channelR (chan:TextWriter) = member r.AddBreak z n = chan.WriteLine(); chan.Write (spaces n); z member r.AddTag z (tag, attrs, start) = z member r.Finish z = NoResult } +#endif /// buffer render let bufferR os = @@ -332,5 +334,7 @@ let bufferR os = //-------------------------------------------------------------------------- let showL layout = renderL stringR layout +#if !FABLE_COMPILER let outL (chan:TextWriter) layout = renderL (channelR chan) layout |> ignore -let bufferL os layout = renderL (bufferR os) layout |> ignore \ No newline at end of file +#endif +let bufferL os layout = renderL (bufferR os) layout |> ignore diff --git a/src/fsharp/layout.fsi b/src/fsharp/layout.fsi index 95f81f6cf832..c3b7b60f433d 100644 --- a/src/fsharp/layout.fsi +++ b/src/fsharp/layout.fsi @@ -79,7 +79,9 @@ val listL : ('a -> Layout) -> 'a list -> Layout val showL : Layout -> string +#if !FABLE_COMPILER val outL : TextWriter -> Layout -> unit +#endif val bufferL : StringBuilder -> Layout -> unit @@ -221,8 +223,10 @@ val renderL : LayoutRenderer<'b,'a> -> Layout -> 'b /// Render layout to string val stringR : LayoutRenderer +#if !FABLE_COMPILER /// Render layout to channel val channelR : TextWriter -> LayoutRenderer +#endif /// Render layout to StringBuilder val bufferR : StringBuilder -> LayoutRenderer diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index dc64af672211..5aacf0d2b76f 100644 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -48,8 +48,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<_>.LexemeSliceToString (lexbuf, 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 @@ -71,10 +75,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 @@ -83,10 +94,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"))) @@ -104,6 +122,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 @@ -112,6 +140,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) @@ -121,10 +150,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)) @@ -166,7 +202,7 @@ let startString args (lexbuf: UnicodeLexing.Lexbuf) = // Utility functions for processing XML documentation -let trySaveXmlDoc (lexbuf: LexBuffer) (buff: (range * StringBuilder) option) = +let trySaveXmlDoc (lexbuf: LexBuffer<_>) (buff: (range * StringBuilder) option) = match buff with | None -> () | Some (start, sb) -> @@ -483,16 +519,25 @@ 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 diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index 8c13edb3fcab..082d738f8252 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -368,7 +368,11 @@ module Keywords = if String.IsNullOrWhiteSpace(filename) then String.Empty else if filename = stdinMockFilename then +#if !FABLE_COMPILER System.IO.Directory.GetCurrentDirectory() +#else //FABLE_COMPILER + "." +#endif else filename |> FileSystem.GetFullPathShim (* asserts that path is already absolute *) diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 8d89ac8fb377..43af443bc952 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -16,12 +16,17 @@ let verbose = false let mutable progress = false let mutable tracking = false // intended to be a general hook to control diagnostic output when tracking down bugs +#if FABLE_COMPILER +let condition _s = false +let GetEnvInteger _e dflt = dflt +#else let condition s = try (System.Environment.GetEnvironmentVariable(s) <> null) with _ -> false let GetEnvInteger e dflt = match System.Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt let dispose (x:System.IDisposable) = match x with null -> () | x -> x.Dispose() +#endif //------------------------------------------------------------------------- // Library: bits @@ -308,11 +313,13 @@ let bufs f = f buf buf.ToString() +#if !FABLE_COMPILER // writing to output stream via a string buffer. let writeViaBuffer (os: TextWriter) f x = let buf = System.Text.StringBuilder 100 f buf x os.Write(buf.ToString()) +#endif //--------------------------------------------------------------------------- // Imperative Graphs @@ -405,6 +412,7 @@ type Dumper(x:obj) = member self.Dump = sprintf "%A" x #endif +#if !FABLE_COMPILER //--------------------------------------------------------------------------- // AsyncUtil //--------------------------------------------------------------------------- @@ -549,6 +557,8 @@ module StackGuard = if recursionDepth > MaxUncheckedRecursionDepth then RuntimeHelpers.EnsureSufficientExecutionStack () +#endif //!FABLE_COMPILER + [] type MaybeLazy<'T> = | Strict of 'T @@ -564,4 +574,4 @@ type MaybeLazy<'T> = | Strict x -> x | Lazy x -> x.Force() -let inline vsnd ((_, y): struct('T * 'T)) = y \ No newline at end of file +let inline vsnd ((_, y): struct('T * 'T)) = y diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 877991ec57e7..dbf8aee2519a 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -325,7 +325,7 @@ let rangeOfLongIdent(lid:LongIdent) = %type typedSeqExprBlock %type atomicExpr %type tyconDefnOrSpfnSimpleRepr -%type <(SyntaxTree.SynEnumCase, SyntaxTree.SynUnionCase) Choice list> unionTypeRepr +%type list> unionTypeRepr %type tyconDefnAugmentation %type exconDefn %type exconCore @@ -3973,15 +3973,15 @@ minusExpr: | PLUS_MINUS_OP minusExpr { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()) - mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"^($1)) $2 } + mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"+($1)) $2 } | ADJACENT_PREFIX_OP minusExpr { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()) - mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"^($1)) $2 } + mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"+($1)) $2 } | PERCENT_OP minusExpr { if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt $2.Range (FSComp.SR.parsInvalidPrefixOperator()) - mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"^($1)) $2 } + mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) ("~"+($1)) $2 } | AMP minusExpr { SynExpr.AddressOf (true, $2, rhs parseState 1, unionRanges (rhs parseState 1) $2.Range) } @@ -4020,7 +4020,7 @@ argExpr: { let arg2, hpa2 = $2 if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt arg2.Range (FSComp.SR.parsInvalidPrefixOperator()) if hpa2 then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsSuccessiveArgsShouldBeSpacedOrTupled()) - mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) arg2.Range) ("~"^($1)) arg2 } + mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) arg2.Range) ("~"+($1)) arg2 } | atomicExpr { let arg, hpa = $1 diff --git a/src/fsharp/range.fs b/src/fsharp/range.fs index b20cee5c3bed..f2691c78afaf 100755 --- a/src/fsharp/range.fs +++ b/src/fsharp/range.fs @@ -157,14 +157,22 @@ type FileIndexTable() = | true, idx -> // Record the non-normalized entry if necessary if filePath <> normalizedFilePath then +#if FABLE_COMPILER + ( +#else lock fileToIndexTable (fun () -> +#endif fileToIndexTable.[filePath] <- idx) // Return the index idx | _ -> +#if FABLE_COMPILER + ( +#else lock fileToIndexTable (fun () -> +#endif // Get the new index let idx = indexToFileTable.Count @@ -250,6 +258,7 @@ type range(code1:int64, code2: int64) = member r.Code2 = code2 +#if !FABLE_COMPILER member r.DebugCode = let name = r.FileName if name = unknownFileName || name = startupFileName || name = commandLineArgsFileName then name else @@ -267,6 +276,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 member r.ToShortString() = sprintf "(%d,%d--%d,%d)" r.StartLine r.StartColumn r.EndLine r.EndColumn @@ -365,8 +375,11 @@ module Line = // Visual Studio uses line counts starting at 0, F# uses them starting at 1 let fromZ (line:Line0) = int line+1 - +#if FABLE_COMPILER + let toZ (line:int) : Line0 = int (line - 1) +#else let toZ (line:int) : Line0 = LanguagePrimitives.Int32WithMeasure(line - 1) +#endif module Pos = diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index c8f7f2e6003b..295762b7353b 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -58,12 +58,20 @@ module internal FSharpCheckerResultsSettings = /// to enable other requests to be serviced. Yielding means returning a continuation function /// (via an Eventually<_> value of case NotYetDone) that can be called as the next piece of work. let maxTimeShareMilliseconds = +#if FABLE_COMPILER + 100L +#else match System.Environment.GetEnvironmentVariable("FCS_MaxTimeShare") with | null | "" -> 100L | s -> int64 s +#endif // 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 FSharpFindDeclFailureReason = @@ -512,7 +520,10 @@ type internal TypeCheckInfo nameMatchesResidue n1 || meths |> List.exists (fun meth -> let tcref = meth.ApparentEnclosingTyconRef - tcref.IsProvided || nameMatchesResidue tcref.DisplayName) +#if !NO_EXTENSIONTYPING + tcref.IsProvided || +#endif + nameMatchesResidue tcref.DisplayName) | _ -> residue = n1) /// Post-filter items to make sure they have precisely the right name @@ -1580,6 +1591,7 @@ module internal ParseAndCheckFile = errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors +#if !FABLE_COMPILER let ApplyLoadClosure(tcConfig, parsedMainInput, mainInputFileName, loadClosure: LoadClosure option, tcImports: TcImports, backgroundDiagnostics) = // If additional references were brought in by the preprocessor then we need to process them @@ -1640,6 +1652,7 @@ module internal ParseAndCheckFile = | None -> // For non-scripts, check for disallow #r and #load. ApplyMetaCommandsFromInputToTcConfig (tcConfig, parsedMainInput, Path.GetDirectoryName mainInputFileName, tcImports.DependencyProvider) |> ignore +#endif // Type check a single file against an initial context, gleaning both errors and intellisense information. let CheckOneFile @@ -1659,13 +1672,19 @@ module internal ParseAndCheckFile = // Used by 'FSharpDeclarationListInfo' to check the IncrementalBuilder is still alive. textSnapshotInfo : obj option, userOpName: string, - suggestNamesForErrors: bool) = async { - + suggestNamesForErrors: bool) = +#if !FABLE_COMPILER + async { +#endif use _logBlock = Logger.LogBlock LogCompilerFunctionId.Service_CheckOneFile match parseResults.ParseTree with // When processing the following cases, we don't need to type-check +#if FABLE_COMPILER + | None -> [||], Result.Error() +#else | None -> return [||], Result.Error() +#endif // Run the type checker... | Some parsedMainInput -> @@ -1676,8 +1695,10 @@ module internal ParseAndCheckFile = use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck +#if !FABLE_COMPILER // Apply nowarns to tcConfig (may generate errors, so ensure errorLogger is installed) let tcConfig = ApplyNoWarnsToTcConfig (tcConfig, parsedMainInput,Path.GetDirectoryName mainInputFileName) +#endif // update the error handler with the modified tcConfig errHandler.ErrorSeverityOptions <- tcConfig.errorSeverityOptions @@ -1686,8 +1707,10 @@ module internal ParseAndCheckFile = for err, sev in backgroundDiagnostics do diagnosticSink (err, (sev = FSharpErrorSeverity.Error)) +#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 // A problem arises with nice name generation, which really should only // be done in the backend, but is also done in the typechecker for better or worse. @@ -1697,6 +1720,24 @@ module internal ParseAndCheckFile = // Typecheck the real input. let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) +#if FABLE_COMPILER + ignore userOpName + let resOpt = + try + let ctok = AssumeCompilationThreadWithoutEvidence() + let checkForErrors() = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) + let parsedMainInput, _moduleNamesDict = DeduplicateParsedInputModuleName moduleNamesDict parsedMainInput + let result = + TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) + |> Eventually.force ctok + Some result + with + | e -> + errorR e + let mty = Construct.NewEmptyModuleOrNamespaceType Namespace + Some((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState) +#else //!FABLE_COMPILER + let! ct = Async.CancellationToken let! resOpt = @@ -1730,6 +1771,7 @@ module internal ParseAndCheckFile = let mty = Construct.NewEmptyModuleOrNamespaceType Namespace return Some((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState) } +#endif //!FABLE_COMPILER let errors = errHandler.CollectedDiagnostics @@ -1754,8 +1796,12 @@ module internal ParseAndCheckFile = |> Result.Ok | None -> Result.Error() +#if FABLE_COMPILER + errors, res +#else return errors, res } +#endif [] @@ -1806,10 +1852,12 @@ type FSharpCheckFileResults member __.HasFullTypeCheckInfo = details.IsSome +#if !FABLE_COMPILER member __.TryGetCurrentTcImports () = match builderX with | Some builder -> builder.TryGetCurrentTcImports () | _ -> None +#endif /// Intellisense autocompletions member __.GetDeclarationListInfo(parsedFileResults, line, lineText, partialName, ?getAllEntities, ?hasTextChangedSinceLastTypecheck, ?userOpName: string) = @@ -2022,6 +2070,7 @@ type FSharpCheckFileResults let errors = FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) FSharpCheckFileResults (mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, reactorOps, keepAssemblyContents) +#if !FABLE_COMPILER static member CheckOneFile (parseResults: FSharpParseFileResults, sourceText: ISourceText, @@ -2058,6 +2107,7 @@ type FSharpCheckFileResults let results = FSharpCheckFileResults (mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, reactorOps, keepAssemblyContents) return FSharpCheckFileAnswer.Succeeded(results) } +#endif and [] FSharpCheckFileAnswer = | Aborted @@ -2176,6 +2226,8 @@ type FSharpCheckProjectResults override __.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" +#if !FABLE_COMPILER + type FsiInteractiveChecker(legacyReferenceResolver, ops: IReactorOperations, tcConfig: TcConfig, @@ -2239,3 +2291,4 @@ type FsiInteractiveChecker(legacyReferenceResolver, failwith "unexpected aborted" } +#endif diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 52e241a61b17..0a8ce381faa1 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -75,9 +75,47 @@ type public FSharpParsingOptions = static member internal FromTcConfigBuilder: tcConfigB: TcConfigBuilder * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions +[] +type internal TypeCheckInfo = + internal new : + _sTcConfig: TcConfig * + g: TcGlobals * + ccuSigForFile: ModuleOrNamespaceType * + thisCcu: CcuThunk * + tcImports: TcImports * + tcAccessRights: AccessorDomain * + projectFileName: string * + mainInputFileName: string * + sResolutions: TcResolutions * + sSymbolUses: TcSymbolUses * + sFallback: NameResolutionEnv * + loadClosure : LoadClosure option * + reactorOps : IReactorOperations * + textSnapshotInfo: obj option * + implFileOpt: TypedImplFile option * + openDeclarations: OpenDeclaration[] + -> TypeCheckInfo + member ScopeResolutions: TcResolutions + member ScopeSymbolUses: TcSymbolUses + member TcGlobals: TcGlobals + member TcImports: TcImports + member CcuSigForFile: ModuleOrNamespaceType + member ThisCcu: CcuThunk + member ImplementationFile: TypedImplFile option + /// A handle to the results of CheckFileInProject. [] type public FSharpCheckFileResults = + internal new : + filename: string * + errors: FSharpErrorInfo[] * + scopeOptX: TypeCheckInfo option * + dependencyFiles: string[] * + builderX: IncrementalBuilder option * + reactorOpsX: IReactorOperations * + keepAssemblyContents: bool + -> FSharpCheckFileResults + /// The errors returned by parsing a source file. member Errors : FSharpErrorInfo[] @@ -91,8 +129,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 @@ -284,6 +324,7 @@ type public FSharpCheckFileResults = openDeclarations: OpenDeclaration[] -> FSharpCheckFileResults +#if !FABLE_COMPILER /// Internal constructor - check a file and collect errors static member internal CheckOneFile: parseResults: FSharpParseFileResults * @@ -308,6 +349,7 @@ type public FSharpCheckFileResults = keepAssemblyContents: bool * suggestNamesForErrors: bool -> Async +#endif /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. and [] public FSharpCheckFileAnswer = @@ -379,6 +421,28 @@ module internal ParseAndCheckFile = suggestNamesForErrors: bool -> (range * range)[] +#if FABLE_COMPILER + val CheckOneFile: + parseResults: FSharpParseFileResults * + sourceText: ISourceText * + mainInputFileName: string * + projectFileName: string * + tcConfig: TcConfig * + tcGlobals: TcGlobals * + tcImports: TcImports * + tcState: TcState * + moduleNamesDict: ModuleNamesDict * + loadClosure: LoadClosure option * + backgroundDiagnostics: (PhasedDiagnostic * FSharpErrorSeverity)[] * + reactorOps: IReactorOperations * + textSnapshotInfo : obj option * + userOpName: string * + suggestNamesForErrors: bool + -> FSharpErrorInfo[] * Result +#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 = @@ -397,6 +461,8 @@ type internal FsiInteractiveChecker = ?userOpName: string -> Async +#endif + module internal FSharpCheckerResultsSettings = val defaultFSharpBinariesDir: string diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 07f8a5f75c53..ee8b7399f21c 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -30,11 +30,15 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif open Internal.Utilities open Internal.Utilities.Collections +#if !FABLE_COMPILER + [] module internal IncrementalBuild = @@ -977,6 +981,21 @@ module internal IncrementalBuild = member b.GetInitialPartialBuild(inputs: BuildInput list) = ToBound(ToBuild outputs, inputs) +#endif //!FABLE_COMPILER + + +#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 @@ -2178,3 +2197,5 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput return builderOpt, diagnostics } + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index 1730f23c1060..76e859a1d7d5 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -20,7 +20,19 @@ open FSharp.Compiler.SyntaxTree open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif + +#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 = @@ -315,3 +327,4 @@ module internal IncrementalBuild = /// Set the concrete inputs for this build. member GetInitialPartialBuild : inputs: BuildInput list -> PartialBuild +#endif //!FABLE_COMPILER diff --git a/src/fsharp/service/QuickParse.fs b/src/fsharp/service/QuickParse.fs index 302edc1f69f6..e6b2a81348f8 100644 --- a/src/fsharp/service/QuickParse.fs +++ b/src/fsharp/service/QuickParse.fs @@ -52,7 +52,11 @@ module QuickParse = FSharp.Compiler.Parser.tagOfToken (FSharp.Compiler.Parser.token.IDENT tokenText) 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) @@ -65,8 +69,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/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index 5eeb29fe6678..54e7b1731a45 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -15,6 +15,8 @@ type internal IReactorOperations = abstract EnqueueAndAwaitOpAsync : userOpName:string * opName:string * opArg:string * (CompilationThreadToken -> Cancellable<'T>) -> Async<'T> abstract EnqueueOp: userOpName:string * opName:string * opArg:string * (CompilationThreadToken -> unit) -> unit +#if !FABLE_COMPILER + [] type internal ReactorCommands = /// Kick off a build. @@ -200,3 +202,4 @@ type Reactor() = static member Singleton = theReactor +#endif //!FABLE_COMPILER diff --git a/src/fsharp/service/Reactor.fsi b/src/fsharp/service/Reactor.fsi index 3040ca65eeed..fe515e100aaa 100755 --- a/src/fsharp/service/Reactor.fsi +++ b/src/fsharp/service/Reactor.fsi @@ -14,6 +14,8 @@ type internal IReactorOperations = /// Enqueue an operation and return immediately. abstract EnqueueOp: userOpName:string * opName:string * opArg:string * action: (CompilationThreadToken -> unit) -> unit +#if !FABLE_COMPILER + /// Reactor is intended for long-running but interruptible operations, interleaved /// with one-off asynchronous operations. /// @@ -54,3 +56,4 @@ type internal Reactor = /// Get the reactor static member Singleton : Reactor +#endif //!FABLE_COMPILER diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 4159ed8cd7dd..71d75a6972c8 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -148,7 +148,11 @@ module TcResolutionsExtensions = let duplicates = HashSet(Range.comparer) +#if FABLE_COMPILER + let results = ResizeArray<_>() +#else let results = ImmutableArray.CreateBuilder() +#endif let inline add m typ = if duplicates.Add m then results.Add struct(m, typ) diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index 53a313baeb68..638058ac0822 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -187,6 +187,7 @@ type IAssemblyContentCache = abstract TryGet: AssemblyPath -> AssemblyContentCacheEntry option abstract Set: AssemblyPath -> AssemblyContentCacheEntry -> unit +#if !FABLE_COMPILER module AssemblyContentProvider = open System.IO @@ -375,6 +376,7 @@ module AssemblyContentProvider = | None -> true | Some x when x.IsPublic -> true | _ -> false) +#endif //!FABLE_COMPILER type EntityCache() = let dic = Dictionary() diff --git a/src/fsharp/service/ServiceAssemblyContent.fsi b/src/fsharp/service/ServiceAssemblyContent.fsi index b0cebf4c1ee0..8174bc3ace58 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fsi +++ b/src/fsharp/service/ServiceAssemblyContent.fsi @@ -126,6 +126,7 @@ type public Entity = LastIdent: string } +#if !FABLE_COMPILER /// Provides assembly content. module public AssemblyContentProvider = @@ -139,6 +140,7 @@ module public AssemblyContentProvider = -> fileName: string option -> assemblies: FSharpAssembly list -> AssemblySymbol list +#endif /// Kind of lexical scope. type public ScopeKind = diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index 3fd90b64ae78..4465a2ef3b75 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -440,7 +440,7 @@ module internal DescriptionListsImpl = /// Get rid of groups of overloads an replace them with single items. /// (This looks like it is doing the a similar thing as FlattenItems, this code /// duplication could potentially be removed) - let AnotherFlattenItems g m item = + let AnotherFlattenItems g _m item = match item with | Item.CtorGroup(nm, cinfos) -> List.map (fun minfo -> Item.CtorGroup(nm, [minfo])) cinfos | Item.FakeInterfaceCtor _ @@ -460,7 +460,7 @@ module internal DescriptionListsImpl = let pinfo = List.head pinfos if pinfo.IsIndexer then [item] else [] #if !NO_EXTENSIONTYPING - | SymbolHelpers.ItemIsWithStaticArguments m g _ -> + | SymbolHelpers.ItemIsWithStaticArguments _m g _ -> // we pretend that provided-types-with-static-args are method-like in order to get ParamInfo for them [item] #endif @@ -473,14 +473,15 @@ module internal DescriptionListsImpl = /// An intellisense declaration [] -type FSharpDeclarationListItem(name: string, nameInCode: string, fullName: string, glyph: FSharpGlyph, info, accessibility: FSharpAccessibility option, +type FSharpDeclarationListItem(name: string, nameInCode: string, fullName: string, glyph: FSharpGlyph, _info, accessibility: FSharpAccessibility option, kind: CompletionItemKind, isOwnMember: bool, priority: int, isResolved: bool, namespaceToOpen: string option) = member __.Name = name member __.NameInCode = nameInCode +#if !FABLE_COMPILER member __.StructuredDescriptionTextAsync = let userOpName = "ToolTip" - match info with + match _info with | Choice1Of2 (items: CompletionItem list, infoReader, m, denv, reactor:IReactorOperations) -> // reactor causes the lambda to execute on the background compiler thread, through the Reactor reactor.EnqueueAndAwaitOpAsync (userOpName, "StructuredDescriptionTextAsync", name, fun ctok -> @@ -493,6 +494,7 @@ type FSharpDeclarationListItem(name: string, nameInCode: string, fullName: strin member decl.DescriptionTextAsync = decl.StructuredDescriptionTextAsync |> Tooltips.Map Tooltips.ToFSharpToolTipText +#endif member __.Glyph = glyph member __.Accessibility = accessibility @@ -513,7 +515,7 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[], isForT member __.IsError = isError // Make a 'Declarations' object for a set of selected items - static member Create(infoReader:InfoReader, m: range, denv, getAccessibility, items: CompletionItem list, reactor, currentNamespace: string[] option, isAttributeApplicationContext: bool) = + static member Create(infoReader:InfoReader, m: range, denv, getAccessibility, items: CompletionItem list, reactor: IReactorOperations, currentNamespace: string[] option, isAttributeApplicationContext: bool) = let g = infoReader.g let isForType = items |> List.exists (fun x -> x.Type.IsSome) let items = items |> SymbolHelpers.RemoveExplicitlySuppressedCompletionItems g diff --git a/src/fsharp/service/ServiceDeclarationLists.fsi b/src/fsharp/service/ServiceDeclarationLists.fsi index 462f4d1fe6e0..befe8a902df1 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fsi +++ b/src/fsharp/service/ServiceDeclarationLists.fsi @@ -20,10 +20,12 @@ type public FSharpDeclarationListItem = /// Get the name for the declaration as it's presented in source code. member NameInCode : string +#if !FABLE_COMPILER /// Get the description text, asynchronously. Never returns "Loading...". member StructuredDescriptionTextAsync : Async member DescriptionTextAsync : Async +#endif member Glyph : FSharpGlyph diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index deb608dc107f..fb5acf412bcd 100755 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -624,12 +624,20 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, // so we need to split it into tokens that are used by VS for colorization // Stack for tokens that are split during postprocessing +#if FABLE_COMPILER + let tokenStack = Internal.Utilities.Text.Parsing.Stack<_>(31) +#else let mutable tokenStack = new Stack<_>() +#endif let delayToken tok = tokenStack.Push tok // 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) delay(HASH_IF(range0, "", cont), hashIdx, hashIdx + directiveLength) hashIdx + directiveLength + 1 @@ -1535,9 +1543,14 @@ module Lexer = use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) +#if FABLE_COMPILER + ignore ct +#endif resetLexbufPos "" lexbuf while not lexbuf.IsPastEndOfStream do +#if !FABLE_COMPILER ct.ThrowIfCancellationRequested () +#endif onToken (getNextToken lexbuf) lexbuf.LexemeRange let lex text conditionalCompilationDefines flags supportsFeature lexCallback pathMap ct = @@ -1553,7 +1566,11 @@ module Lexer = ignore filePath // can be removed at later point let conditionalCompilationDefines = defaultArg conditionalCompilationDefines [] let pathMap = defaultArg pathMap Map.Empty +#if FABLE_COMPILER + let ct = defaultArg ct (CancellationToken()) +#else let ct = defaultArg ct CancellationToken.None +#endif let supportsFeature = (LanguageVersion langVersion).SupportsFeature diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index bd24fef3fad7..bd8575a197ca 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -1003,8 +1003,23 @@ module UntypedParseImpl = | ParsedInput.ImplFile input -> walkImplFileInput input type internal TS = AstTraversal.TraverseStep + +#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 /// Try to determine completion context for the given pair (row, columns) let TryGetCompletionContext (pos, parsedInput: ParsedInput, lineStr: string) : CompletionContext option = @@ -1368,6 +1383,26 @@ module UntypedParseImpl = let isLongIdent = 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 // match the most nested paired [< and >] first let matches = insideAttributeApplicationRegex.Matches lineStr @@ -1387,9 +1422,14 @@ module UntypedParseImpl = Some CompletionContext.AttributeApplication else None else None) +#endif 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/fsharp/service/service.fs b/src/fsharp/service/service.fs index a624afdadce8..64c588eb1df0 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -18,7 +18,9 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions +#if !FABLE_COMPILER open FSharp.Compiler.Driver +#endif open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Lib open FSharp.Compiler.ParseAndCheckInputs @@ -28,7 +30,9 @@ open FSharp.Compiler.SyntaxTree open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text +#if !FABLE_COMPILER open Microsoft.DotNet.DependencyManager +#endif open Internal.Utilities open Internal.Utilities.Collections @@ -94,6 +98,8 @@ type FSharpProjectOptions = member po.ProjectDirectory = System.IO.Path.GetDirectoryName(po.ProjectFileName) override this.ToString() = "FSharpProjectOptions(" + this.ProjectFileName + ")" +#if !FABLE_COMPILER + //---------------------------------------------------------------------------- // BackgroundCompiler // @@ -1427,4 +1433,6 @@ module PrettyNaming = let KeywordNames = Lexhelp.Keywords.keywordNames module FSharpFileUtilities = - let isScriptFile (fileName: string) = ParseAndCheckInputs.IsScript fileName \ No newline at end of file + let isScriptFile (fileName: string) = ParseAndCheckInputs.IsScript fileName + +#endif //!FABLE_COMPILER \ No newline at end of file diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index c1a284d658bb..3ebeded1da9f 100755 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -63,6 +63,8 @@ type public FSharpProjectOptions = Stamp: int64 option } +#if !FABLE_COMPILER + [] /// Used to parse and check F# source code. type public FSharpChecker = @@ -536,4 +538,6 @@ module public PrettyNaming = /// A set of helpers for dealing with F# files. module FSharpFileUtilities = - val isScriptFile : string -> bool \ No newline at end of file + val isScriptFile : string -> bool + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index d64780a6011f..f0fe3345da9f 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -1150,8 +1150,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/fsharp/symbols/Exprs.fsi b/src/fsharp/symbols/Exprs.fsi index 488ee13e725d..c32bf785cab4 100644 --- a/src/fsharp/symbols/Exprs.fsi +++ b/src/fsharp/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: TypedImplFile list -> FSharpAssemblyContents +#endif internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * thisCcuType: ModuleOrNamespaceType option * tcImports: TcImports * mimpls: TypedImplFile list -> FSharpAssemblyContents /// The contents of the implementation files in the assembly diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index f7593d8e0b86..9a64c22e4b79 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -460,9 +460,13 @@ module internal SymbolHelpers = | _ -> None /// Work out the source file for an item and fix it up relative to the CCU if it is relative. - let fileNameOfItem (g: TcGlobals) qualProjectDir (m: range) h = + let fileNameOfItem (g: TcGlobals) (qualProjectDir: string option) (m:range) (h:Item) = 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 -> @@ -471,7 +475,8 @@ module internal SymbolHelpers = match qualProjectDir with | None -> file | Some dir -> Path.Combine(dir, file) - else 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 @@ -802,7 +807,11 @@ module internal SymbolHelpers = | ValueSome tcref -> hash tcref.LogicalName | _ -> 1010 | Item.ILField(ILFieldInfo(_, fld)) -> +#if FABLE_COMPILER + (box fld).GetHashCode() // hash on the object identity of the AbstractIL metadata blob for the field +#else System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode fld // hash on the object identity of the AbstractIL metadata blob for the field +#endif | Item.TypeVar (nm, _tp) -> hash nm | Item.CustomOperation (_, _, Some minfo) -> minfo.ComputeHashCode() | Item.CustomOperation (_, _, None) -> 1 @@ -1519,7 +1528,7 @@ module internal SymbolHelpers = (fun err -> FSharpStructuredToolTipElement.CompositionError err) /// Get rid of groups of overloads an replace them with single items. - let FlattenItems g (m: range) item = + let FlattenItems g (_m: range) item = match item with | Item.MethodGroup(nm, minfos, orig) -> minfos |> List.map (fun minfo -> Item.MethodGroup(nm, [minfo], orig)) | Item.CtorGroup(nm, cinfos) -> cinfos |> List.map (fun minfo -> Item.CtorGroup(nm, [minfo])) @@ -1536,7 +1545,7 @@ module internal SymbolHelpers = let pinfo = List.head pinfos if pinfo.IsIndexer then [item] else [] #if !NO_EXTENSIONTYPING - | ItemIsWithStaticArguments m g _ -> [item] // we pretend that provided-types-with-static-args are method-like in order to get ParamInfo for them + | ItemIsWithStaticArguments _m g _ -> [item] // we pretend that provided-types-with-static-args are method-like in order to get ParamInfo for them #endif | Item.CustomOperation(_name, _helpText, _minfo) -> [item] | Item.TypeVar _ -> [] diff --git a/src/fsharp/symbols/SymbolPatterns.fs b/src/fsharp/symbols/SymbolPatterns.fs index fc6fce634ec6..331efb56167d 100644 --- a/src/fsharp/symbols/SymbolPatterns.fs +++ b/src/fsharp/symbols/SymbolPatterns.fs @@ -12,7 +12,12 @@ module Symbol = let isAttribute<'T> (attribute: FSharpAttribute) = // CompiledName throws exception on DataContractAttribute generated by SQLProvider +#if FABLE_COMPILER + ignore attribute + false //TODO: alternative implementation +#else try attribute.AttributeType.CompiledName = typeof<'T>.Name with _ -> false +#endif let tryGetAttribute<'T> (attributes: seq) = attributes |> Seq.tryFind isAttribute<'T> @@ -39,9 +44,14 @@ module Symbol = let isOperator (name: string) = PrettyNaming.IsOperatorName name +#if FABLE_COMPILER + let isUnnamedUnionCaseField (field: FSharpField) = + (field.Name.StartsWith "Item") && not (field.Name.Substring(4) |> String.exists (fun c -> not (System.Char.IsDigit c))) +#else let UnnamedUnionFieldRegex = Regex("^Item(\d+)?$", RegexOptions.Compiled) let isUnnamedUnionCaseField (field: FSharpField) = UnnamedUnionFieldRegex.IsMatch(field.Name) +#endif let (|AbbreviatedType|_|) (entity: FSharpEntity) = if entity.IsFSharpAbbreviation then Some entity.AbbreviatedType diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 23b7acdec52f..6792475f6336 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -77,7 +77,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) = makeReadOnlyCollection doc.UnprocessedLines @@ -412,7 +416,7 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = let fail() = invalidOp (sprintf "the type '%s' does not have a qualified name" x.LogicalName) #if !NO_EXTENSIONTYPING if entity.IsTypeAbbrev || entity.IsProvidedErasedTycon || entity.IsNamespace then fail() - #else +#else if entity.IsTypeAbbrev || entity.IsNamespace then fail() #endif match entity.CompiledRepresentation with @@ -429,7 +433,7 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = if isUnresolved() then None #if !NO_EXTENSIONTYPING elif entity.IsTypeAbbrev || entity.IsProvidedErasedTycon then None - #else +#else elif entity.IsTypeAbbrev then None #endif elif entity.IsNamespace then Some entity.DemangledModuleOrNamespaceName @@ -468,6 +472,7 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member __.ArrayRank = checkIsResolved() rankOfArrayTyconRef cenv.g entity + #if !NO_EXTENSIONTYPING member __.IsProvided = isResolved() && @@ -485,6 +490,7 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = isResolved() && entity.IsProvidedGeneratedTycon #endif + member __.IsClass = isResolved() && match metadataOfTycon entity.Deref with @@ -948,7 +954,11 @@ and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = if isUnresolved() then None else match d.TryRecdField with | Choice1Of3 r -> getLiteralValue r.LiteralValue +#if FABLE_COMPILER + | Choice2Of3 _f -> None +#else | Choice2Of3 f -> f.LiteralValue |> Option.map AbstractIL.ILRuntimeWriter.convFieldInit +#endif | Choice3Of3 _ -> None member __.IsVolatile = @@ -1110,10 +1120,10 @@ and [] FSharpAccessibilityRights(thisCcu: CcuThunk, ad:AccessorDomain) = member internal __.Contents = ad -and FSharpActivePatternCase(cenv, apinfo: PrettyNaming.ActivePatternInfo, ty, n, valOpt: ValRef option, item) = +and FSharpActivePatternCase(cenv, apinfo: PrettyNaming.ActivePatternInfo, ty, n, valOpt: ValRef option, item2) = inherit FSharpSymbol (cenv, - (fun () -> item), + (fun () -> item2), (fun _ _ _ -> true)) member __.Name = apinfo.ActiveTags.[n] @@ -1404,10 +1414,10 @@ and FSharpMemberOrVal = FSharpMemberOrFunctionOrValue and FSharpMemberFunctionOrValue = FSharpMemberOrFunctionOrValue -and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = +and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item2) = inherit FSharpSymbol(cenv, - (fun () -> item), + (fun () -> item2), (fun this thisCcu2 ad -> let this = this :?> FSharpMemberOrFunctionOrValue checkForCrossProjectAccessibility cenv.g.ilg (thisCcu2, ad) (cenv.thisCcu, this.Accessibility.Contents)) @@ -1465,7 +1475,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = checkIsResolved() match d with | M m | C m -> - match item with + match item2 with | Item.MethodGroup (_, methodInfos, _) | Item.CtorGroup (_, methodInfos) -> let isConstructor = x.IsConstructor @@ -1477,9 +1487,9 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = methods |> List.map (fun mi -> if isConstructor then - FSharpMemberOrFunctionOrValue(cenv, C mi, item) + FSharpMemberOrFunctionOrValue(cenv, C mi, item2) else - FSharpMemberOrFunctionOrValue(cenv, M mi, item)) + FSharpMemberOrFunctionOrValue(cenv, M mi, item2)) |> makeReadOnlyCollection |> Some | _ -> None @@ -2047,7 +2057,9 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member x.IsValCompiledAsMethod = match d with +#if !FABLE_COMPILER | V valRef -> IlxGen.IsFSharpValCompiledAsMethod cenv.g valRef.Deref +#endif | _ -> false member x.IsValue = @@ -2277,7 +2289,7 @@ and FSharpType(cenv, ty:TType) = |> makeReadOnlyCollection static member Prettify(parameter: FSharpParameter) = - let prettyTy = parameter.V |> PrettyTypes.PrettifyType parameter.cenv.g |> fst + let prettyTy = parameter.V |> PrettyTypes.PrettifyType parameter.cenv2.g |> fst parameter.AdjustType prettyTy static member Prettify(parameters: IList) = @@ -2285,7 +2297,7 @@ and FSharpType(cenv, ty:TType) = match parameters with | [] -> [] | h :: _ -> - let cenv = h.cenv + let cenv = h.cenv2 let prettyTys = parameters |> List.map (fun p -> p.V) |> PrettyTypes.PrettifyTypes cenv.g |> fst (parameters, prettyTys) ||> List.map2 (fun p pty -> p.AdjustType pty) |> makeReadOnlyCollection @@ -2296,14 +2308,14 @@ and FSharpType(cenv, ty:TType) = match hOpt with | None -> xs | Some h -> - let cenv = h.cenv + let cenv = h.cenv2 let prettyTys = xs |> List.mapSquared (fun p -> p.V) |> PrettyTypes.PrettifyCurriedTypes cenv.g |> fst (xs, prettyTys) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType pty)) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection static member Prettify(parameters: IList>, returnParameter: FSharpParameter) = let xs = parameters |> List.ofSeq |> List.map List.ofSeq - let cenv = returnParameter.cenv + let cenv = returnParameter.cenv2 let prettyTys, prettyRetTy = xs |> List.mapSquared (fun p -> p.V) |> (fun tys -> PrettyTypes.PrettifyCurriedSigTypes cenv.g (tys, returnParameter.V) )|> fst let ps = (xs, prettyTys) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType pty)) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection ps, returnParameter.AdjustType prettyRetTy @@ -2400,7 +2412,7 @@ and FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, own member __.Name = match topArgInfo.Name with None -> None | Some v -> Some v.idText - member __.cenv: SymbolEnv = cenv + member __.cenv2: SymbolEnv = cenv member __.AdjustType ty = FSharpParameter(cenv, ty, topArgInfo, ownerOpt, ownerRangeOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg) diff --git a/src/fsharp/utils/HashMultiMap.fs b/src/fsharp/utils/HashMultiMap.fs index 673a31a2a596..bcb366e5ac2f 100644 --- a/src/fsharp/utils/HashMultiMap.fs +++ b/src/fsharp/utils/HashMultiMap.fs @@ -14,11 +14,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 @@ -41,7 +43,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) @@ -116,6 +122,21 @@ 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() = @@ -149,6 +170,7 @@ type internal HashMultiMap<'Key,'Value>(size: int, comparer: IEqualityComparer<' member s.Remove(k:'Key) = let res = s.ContainsKey(k) in s.Remove(k); res +#endif interface ICollection> with diff --git a/src/fsharp/utils/HashMultiMap.fsi b/src/fsharp/utils/HashMultiMap.fsi index bd05cfc1d7aa..eb189b16fb80 100644 --- a/src/fsharp/utils/HashMultiMap.fsi +++ b/src/fsharp/utils/HashMultiMap.fsi @@ -10,15 +10,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> @@ -58,7 +62,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/fsharp/utils/PathMap.fs b/src/fsharp/utils/PathMap.fs index 3e4f6fad96c2..cda4520ff52c 100644 --- a/src/fsharp/utils/PathMap.fs +++ b/src/fsharp/utils/PathMap.fs @@ -17,7 +17,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 = Path.GetFullPath src +#endif let oldPrefix = if normalSrc.EndsWith dirSepStr then normalSrc diff --git a/src/fsharp/utils/TaggedCollections.fs b/src/fsharp/utils/TaggedCollections.fs index cc52374fab44..9041e0287c55 100644 --- a/src/fsharp/utils/TaggedCollections.fs +++ b/src/fsharp/utils/TaggedCollections.fs @@ -584,10 +584,14 @@ namespace Internal.Utilities.Collections.Tagged 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. @@ -718,28 +722,28 @@ namespace Internal.Utilities.Collections.Tagged let indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException("An index satisfying the predicate was not found in the collection")) - let rec tryGetValue (comparer: IComparer<'Key>) k (v: byref<'Value>) (m: MapTree<'Key, 'Value>) = + let rec tryGetValue (comparer: IComparer<'Key>) k (v: ref<'Value>) (m: MapTree<'Key, 'Value>) = if isEmpty m then false else let c = comparer.Compare(k, m.Key) - if c = 0 then v <- m.Value; true + if c = 0 then v := m.Value; true else match m with | :? MapTreeNode<'Key, 'Value> as mn -> - tryGetValue comparer k &v (if c < 0 then mn.Left else mn.Right) + tryGetValue comparer k v (if c < 0 then mn.Left else mn.Right) | _ -> false let find (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = - let mutable v = Unchecked.defaultof<'Value> - if tryGetValue comparer k &v m then - v + let mutable v = ref Unchecked.defaultof<'Value> + if tryGetValue comparer k v m then + !v else indexNotFound() let tryFind (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = - let mutable v = Unchecked.defaultof<'Value> - if tryGetValue comparer k &v m then - Some v + let mutable v = ref Unchecked.defaultof<'Value> + if tryGetValue comparer k v m then + Some !v else None @@ -1068,10 +1072,14 @@ namespace Internal.Utilities.Collections.Tagged override s.GetEnumerator() = (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/fsharp/utils/prim-lexing.fs b/src/fsharp/utils/prim-lexing.fs index 664ec3f38e13..03bedf1173ce 100644 --- a/src/fsharp/utils/prim-lexing.fs +++ b/src/fsharp/utils/prim-lexing.fs @@ -93,7 +93,11 @@ type StringText(str: string) = if lastIndex <= startIndex || lastIndex >= str.Length then invalidArg "target" "Too big." +#if FABLE_COMPILER + str.IndexOf(target, startIndex) <> -1 +#else str.IndexOf(target, startIndex, target.Length) <> -1 +#endif member __.Length = str.Length @@ -103,7 +107,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 = @@ -229,7 +237,9 @@ namespace Internal.Utilities.Text.Lexing 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] member lexbuf.LexemeContains (c:'Char) = array.IndexOf(buffer, c, bufferScanStart, lexemeLength) >= 0 member lexbuf.BufferLocalStore = (context :> IDictionary<_,_>) @@ -241,6 +251,12 @@ namespace Internal.Utilities.Text.Lexing member lexbuf.BufferAcceptAction with get() = bufferAcceptAction and set v = bufferAcceptAction <- v member lexbuf.RefillBuffer () = filler lexbuf +#if FABLE_COMPILER + static member LexemeSliceToString (lexbuf: LexBuffer, start, length) = + let chars = Array.init length (fun i -> lexbuf.LexemeChar (start + i) |> char) + new System.String(chars) +#endif + static member LexemeString (lexbuf: LexBuffer) = #if FABLE_COMPILER let chars = Array.init lexbuf.LexemeLength (lexbuf.LexemeChar >> char) @@ -352,7 +368,7 @@ namespace Internal.Utilities.Text.Lexing let numUnicodeCategories = 30 let numLowUnicodeChars = 128 let numSpecificUnicodeChars = (trans.[0].Length - 1 - numLowUnicodeChars - numUnicodeCategories)/2 - let lookupUnicodeCharacters state inp = + let lookupUnicodeCharacters state (inp: uint16) = let inpAsInt = int inp // Is it a fast ASCII character? if inpAsInt < numLowUnicodeChars then @@ -367,11 +383,7 @@ namespace Internal.Utilities.Text.Lexing // ways let baseForUnicodeCategories = numLowUnicodeChars+numSpecificUnicodeChars*2 let unicodeCategory = -#if FABLE_COMPILER System.Char.GetUnicodeCategory(char inp) -#else - System.Char.GetUnicodeCategory(inp) -#endif //System.Console.WriteLine("inp = {0}, unicodeCategory = {1}", [| box inp; box unicodeCategory |]); int trans.[state].[baseForUnicodeCategories + int32 unicodeCategory] else diff --git a/src/fsharp/utils/prim-lexing.fsi b/src/fsharp/utils/prim-lexing.fsi index 7cd452db1cef..dd1084b15ec0 100644 --- a/src/fsharp/utils/prim-lexing.fsi +++ b/src/fsharp/utils/prim-lexing.fsi @@ -102,8 +102,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 @@ -111,6 +113,14 @@ 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 + + /// Fast helper to turn the matched characters into a string, avoiding an intermediate array. + static member LexemeSliceToString: LexBuffer * int * int -> string +#endif + /// Fast helper to turn the matched characters into a string, avoiding an intermediate array. static member LexemeString : LexBuffer -> string diff --git a/src/fsharp/utils/prim-parsing.fs b/src/fsharp/utils/prim-parsing.fs index ba12c0d9af82..966c805cdf10 100644 --- a/src/fsharp/utils/prim-parsing.fs +++ b/src/fsharp/utils/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 @@ -97,7 +99,7 @@ type Stack<'a>(n) = Array.blit old 0 contents 0 count member buf.Count = count - member buf.Pop() = count <- count - 1 + member buf.Pop() = count <- count - 1; contents.[count] member buf.Peep() = contents.[count - 1] member buf.Top(n) = [ for x in contents.[max 0 (count-n)..count - 1] -> x ] |> List.rev member buf.Push(x) = @@ -106,9 +108,11 @@ type Stack<'a>(n) = count <- count + 1 member buf.IsEmpty = (count = 0) +#if DEBUG member buf.PrintStack() = for i = 0 to (count - 1) do System.Console.Write("{0}{1}",(contents.[i]),if i=count-1 then ":" else "-") +#endif #if DEBUG @@ -234,6 +238,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 @@ -244,6 +252,7 @@ module internal Implementation = member _.Dispose() = ArrayPool.Shared.Return actionTableCache ArrayPool.Shared.Return gotoTableCache } +#endif let actionTable = AssocTable(tables.actionTableElements, tables.actionTableRowOffsets, actionTableCache, cacheSize) let gotoTable = AssocTable(tables.gotos, tables.sparseGotoTableRowOffsets, gotoTableCache, cacheSize) let stateToProdIdxsTable = new IdxToIdxListTable(tables.stateToProdIdxsTableElements, tables.stateToProdIdxsTableRowOffsets) @@ -302,8 +311,8 @@ module internal Implementation = if Flags.debug then System.Console.WriteLine("popping stack during error recovery") #endif - valueStack.Pop() - stateStack.Pop() + valueStack.Pop() |> ignore + stateStack.Pop() |> ignore popStackUntilErrorShifted(tokenOpt) while not finished do @@ -373,8 +382,8 @@ module internal Implementation = for i = 0 to n - 1 do if valueStack.IsEmpty then failwith "empty symbol stack" let topVal = valueStack.Peep() // Grab topVal - valueStack.Pop() - stateStack.Pop() + valueStack.Pop() |> ignore + stateStack.Pop() |> ignore let ruleIndex = (n-i)-1 ruleValues.[ruleIndex] <- topVal.value diff --git a/src/fsharp/utils/prim-parsing.fsi b/src/fsharp/utils/prim-parsing.fsi index b1b90d6ee044..864f0ab7562d 100644 --- a/src/fsharp/utils/prim-parsing.fsi +++ b/src/fsharp/utils/prim-parsing.fsi @@ -7,7 +7,18 @@ namespace Internal.Utilities.Text.Parsing open Internal.Utilities open Internal.Utilities.Text.Lexing +#if FABLE_COMPILER +type Stack<'T> = + new : int -> Stack<'T> + member Count : int + member Pop : unit -> 'T + member Peep : unit -> 'T + member Top : int -> 'T list + member Push : 'T -> unit + member IsEmpty : bool +#else open System.Collections.Generic +#endif [] type internal IParseState = diff --git a/src/fsharp/utils/sformat.fs b/src/fsharp/utils/sformat.fs index f2192b869a36..ff177e263604 100644 --- a/src/fsharp/utils/sformat.fs +++ b/src/fsharp/utils/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 Internal.Utilities.StructuredFormat #else // FSharp.Core.dll: @@ -315,6 +315,8 @@ module LayoutOps = 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 = @@ -1317,3 +1319,5 @@ module Display = formatter.Format (ShowAll, value, typValue) |> layout_to_string options #endif + +#endif //!FABLE_COMPILER diff --git a/src/fsharp/utils/sformat.fsi b/src/fsharp/utils/sformat.fsi index 9af6458f9796..eb52babc1fc9 100644 --- a/src/fsharp/utils/sformat.fsi +++ b/src/fsharp/utils/sformat.fsi @@ -14,7 +14,7 @@ // Note no layout objects are ever transferred between the above implementations, and in // all 4 cases the layout types are really different types. -#if COMPILER +#if COMPILER || FABLE_COMPILER // fsc.exe: // FSharp.Compiler.Service.dll: namespace Internal.Utilities.StructuredFormat @@ -275,6 +275,8 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl /// If reach maxLength (before exhausting) then truncate. val unfoldL: selector:('T -> Layout) -> folder:('State -> ('T * 'State) option) -> state:'State -> 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. @@ -355,3 +357,5 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl #if COMPILER val fsi_any_to_layout: options:FormatOptions -> value:'T * typValue:Type -> Layout #endif + +#endif //!FABLE_COMPILER \ No newline at end of file