Skip to content

Commit

Permalink
Updated Fable-FCS to F# 9
Browse files Browse the repository at this point in the history
  • Loading branch information
ncave authored and MangelMaxime committed Nov 26, 2024
1 parent 6498a3d commit 0529649
Show file tree
Hide file tree
Showing 305 changed files with 44,223 additions and 22,040 deletions.
45 changes: 27 additions & 18 deletions src/fcs-fable/FSStrings.fs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,18 @@ let resources =
( "ConstraintSolverMissingConstraint",
"A type parameter is missing a constraint '{0}'"
);
( "ConstraintSolverNullnessWarningEquivWithTypes",
"Nullness warning: The types '{0}' and '{1}' do not have equivalent nullability."
);
( "ConstraintSolverNullnessWarningWithTypes",
"Nullness warning: The types '{0}' and '{1}' do not have compatible nullability."
);
( "ConstraintSolverNullnessWarningWithType",
"Nullness warning: The type '{0}' does not support 'null'."
);
( "ConstraintSolverNullnessWarning",
"Nullness warning: {0}."
);
( "ConstraintSolverTypesNotInEqualityRelation1",
"The unit of measure '{0}' does not match the unit of measure '{1}'"
);
Expand Down Expand Up @@ -69,7 +81,7 @@ let resources =
"Duplicate definition of {0} '{1}'"
);
( "NameClash2",
"The {0} '{1}' can not be defined because the name '{2}' clashes with the {3} '{4}' in this type or module"
"The {0} '{1}' cannot be defined because the name '{2}' clashes with the {3} '{4}' in this type or module"
);
( "Duplicate1",
"Two members called '{0}' have the same signature"
Expand Down Expand Up @@ -105,7 +117,7 @@ let resources =
"A coercion from the value type \n {0} \nto the type \n {1} \nwill involve boxing. Consider using 'box' instead"
);
( "TypeIsImplicitlyAbstract",
"This type is 'abstract' since some abstract members have not been given an implementation. If this is intentional then add the '[<AbstractClass>]' attribute to your type."
"Non-abstract classes cannot contain abstract members. Either provide a default member implementation or add the '[<AbstractClass>]' 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}'."
Expand Down Expand Up @@ -299,6 +311,9 @@ let resources =
( "Parser.TOKEN.BAR.RBRACE",
"symbol '|}'"
);
( "Parser.TOKEN.BAR_JUST_BEFORE_NULL",
"symbol '|' (directly before 'null')"
);
( "Parser.TOKEN.GREATER.RBRACE",
"symbol '>}'"
);
Expand Down Expand Up @@ -914,20 +929,11 @@ let resources =
( "MissingFields",
"The following fields require values: {0}"
);
( "ValueRestriction1",
"Value restriction. The value '{0}' has generic type\n {1} \nEither make the arguments to '{2}' explicit or, if you do not intend for it to be generic, add a type annotation."
( "ValueRestrictionFunction",
"""Value restriction: The value '{0}' has an inferred generic function type\n {1}\nHowever, values cannot have generic type variables like '_a in "let f: '_a". You should define '{2}' as a function instead by doing one of the following:\n- Add an explicit parameter that is applied instead of using a partial application "let f param"\n- Add a unit parameter like "let f()"\n- Write explicit type parameters like "let f<'a>"\nor if you do not intend for it to be generic, either:\n- Add an explicit type annotation like "let f : obj -> obj"\n- Apply arguments of non-generic types to the function value in later code for type inference like "do f()".\nThis error is because a let binding without parameters defines a value, not a function. Values cannot be generic because reading a value is assumed to result in the same everywhere but generic type parameters may invalidate this assumption by enabling type-dependent results."""
);
( "ValueRestriction2",
"Value restriction. The value '{0}' has generic type\n {1} \nEither make '{2}' into a function with explicit arguments or, if you do not intend for it to be generic, add a type annotation."
);
( "ValueRestriction3",
"Value restriction. This member has been inferred to have generic type\n {0} \nConstructors and property getters/setters cannot be more generic than the enclosing type. Add a type annotation to indicate the exact types involved."
);
( "ValueRestriction4",
"Value restriction. The value '{0}' has been inferred to have generic type\n {1} \nEither make the arguments to '{2}' explicit or, if you do not intend for it to be generic, add a type annotation."
);
( "ValueRestriction5",
"Value restriction. The value '{0}' has been inferred to have generic type\n {1} \nEither define '{2}' as a simple data term, make it a function with explicit arguments or, if you do not intend for it to be generic, add a type annotation."
( "ValueRestriction",
"""Value restriction: The value '{0}' has an inferred generic type\n {1}\nHowever, values cannot have generic type variables like '_a in "let x: '_a". You can do one of the following:\n- Define it as a simple data term like an integer literal, a string literal or a union case like "let x = 1"\n- Add an explicit type annotation like "let x : int"\n- Use the value as a non-generic type in later code for type inference like "do x"\nor if you still want type-dependent results, you can define '{2}' as a function instead by doing either:\n- Add a unit parameter like "let x()"\n- Write explicit type parameters like "let x<'a>".\nThis error is because a let binding without parameters defines a value, not a function. Values cannot be generic because reading a value is assumed to result in the same everywhere but generic type parameters may invalidate this assumption by enabling type-dependent results."""
);
( "RecoverableParseError",
"syntax error"
Expand All @@ -945,7 +951,7 @@ let resources =
"Override implementations should be given as part of the initial declaration of a type."
);
( "IntfImplInIntrinsicAugmentation",
"Interface implementations should normally be given on the initial declaration of a type. Interface implementations in augmentations may lead to accessing static bindings before they are initialized, though only if the interface implementation is invoked during initialization of the static data, and in turn access the static data. You may remove this warning using #nowarn \"69\" if you have checked this is not the case."
"Interface implementations should normally be given on the initial declaration of a type. Interface implementations in augmentations may lead to accessing static bindings before they are initialized, though only if the interface implementation is invoked during initialization of the static data, and in turn access the static data. You may remove this warning using '#nowarn \"69\"' if you have checked this is not the case."
);
( "IntfImplInExtrinsicAugmentation",
"Interface implementations should be given on the initial declaration of a type."
Expand All @@ -957,10 +963,10 @@ let resources =
"The type referenced through '{0}' is defined in an assembly that is not referenced. You must add a reference to assembly '{1}'."
);
( "HashIncludeNotAllowedInNonScript",
"#I directives may only occur in F# script files (extensions .fsx or .fsscript). Either move this code to a script file, add a '-I' compiler option for this reference or delimit the directive with delimit it with '#if INTERACTIVE'/'#endif'."
"#I directives may only be used in F# script files (extensions .fsx or .fsscript). Either move this code to a script file, add a '-I' compiler option for this reference or delimit the directive with delimit it with '#if INTERACTIVE'/'#endif'."
);
( "HashReferenceNotAllowedInNonScript",
"#r directives may only occur in F# script files (extensions .fsx or .fsscript). Either move this code to a script file or replace this reference with the '-r' compiler option. If this directive is being executed as user input, you may delimit it with '#if INTERACTIVE'/'#endif'."
"#r directives may only be used in F# script files (extensions .fsx or .fsscript). Either move this code to a script file or replace this reference with the '-r' compiler option. If this directive is being executed as user input, you may delimit it with '#if INTERACTIVE'/'#endif'."
);
( "HashDirectiveNotAllowedInNonScript",
"This directive may only be used in F# script files (extensions .fsx or .fsscript). Either remove the directive, move this code to a script file or delimit the directive with '#if INTERACTIVE'/'#endif'."
Expand Down Expand Up @@ -1007,6 +1013,9 @@ let resources =
( "ArgumentsInSigAndImplMismatch",
"The argument names in the signature '{0}' and implementation '{1}' do not match. The argument name from the signature file will be used. This may cause problems when debugging or profiling."
);
( "DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer",
"The {0} definitions for type '{1}' in the signature and implementation are not compatible because the abbreviations differ:\n {2}\nversus\n {3}"
);
( "Parser.TOKEN.WHILE.BANG",
"keyword 'while!'"
);
Expand Down
9 changes: 8 additions & 1 deletion src/fcs-fable/SR.fs
Original file line number Diff line number Diff line change
Expand Up @@ -5,11 +5,18 @@
namespace FSharp.Compiler

module SR =
let GetString(name: string) =
let GetString (name: string) =
match SR.Resources.resources.TryGetValue(name) with
| true, value -> value
| _ -> "Missing FSStrings error message for: " + name

module FSComp =
module SR =
let GetTextOpt (name: string) =
match SR.Resources.resources.TryGetValue(name) with
| true, value -> Some value
| _ -> None

module DiagnosticMessage =
type ResourceString<'T>(sfmt: string, fmt: string) =
member x.Format =
Expand Down
45 changes: 41 additions & 4 deletions src/fcs-fable/System.Collections.fs
Original file line number Diff line number Diff line change
Expand Up @@ -7,15 +7,19 @@ namespace System.Collections
module Immutable =
open System.Collections.Generic

// not immutable, just a ResizeArray // TODO: immutable implementation
type ImmutableArray<'T> =
static member CreateBuilder() = ResizeArray<'T>()
// not immutable, just an Array // TODO: immutable implementation
type ImmutableArray<'T> = 'T array

module ImmutableArray =
let CreateBuilder<'T>() = ResizeArray<'T>()
let Create<'T>(items: 'T[], start: int, length: int) =
items[start..(start + length - 1)]

[<Sealed>]
type ImmutableHashSet<'T when 'T: equality>(values: 'T seq) =
let xs = HashSet<'T>(values)

static member Create<'T>(values) = ImmutableHashSet<'T>(values)
static member Create<'T>(values: 'T seq) = ImmutableHashSet<'T>(values)
static member Empty = ImmutableHashSet<'T>(Array.empty)

member _.Add (value: 'T) =
Expand Down Expand Up @@ -187,3 +191,36 @@ module Concurrent =
interface System.Collections.IEnumerable with
member _.GetEnumerator() =
(xs.GetEnumerator() :> System.Collections.IEnumerator)

interface ICollection<KeyValuePair<'K, 'V>> with
member _.Add(item: KeyValuePair<'K, 'V>) : unit =
(xs :> ICollection<_>).Add(item)

member _.Clear() : unit = (xs :> ICollection<_>).Clear()

member _.Contains(item: KeyValuePair<'K, 'V>) : bool =
(xs :> ICollection<_>).Contains(item)

member _.CopyTo(array: KeyValuePair<'K, 'V>[], arrayIndex: int) : unit =
(xs :> ICollection<_>).CopyTo(array, arrayIndex)

member _.Count: int = (xs :> ICollection<_>).Count
member _.IsReadOnly: bool = (xs :> ICollection<_>).IsReadOnly

member _.Remove(item: KeyValuePair<'K, 'V>) : bool =
(xs :> ICollection<_>).Remove(item)

interface IDictionary<'K, 'V> with
member _.Add(key: 'K, value: 'V) = xs.Add(key, value)
member _.ContainsKey(key: 'K) = xs.ContainsKey(key)

member _.Item
with get (key: 'K): 'V = xs.[key]
and set (key: 'K) (v: 'V): unit = xs.[key] <- v

member _.TryGetValue(key: 'K, value: byref<'V>) =
xs.TryGetValue(key, &value)

member _.Remove(key: 'K) = xs.Remove(key)
member _.Keys = xs.Keys
member _.Values = xs.Values
48 changes: 32 additions & 16 deletions src/fcs-fable/TcImports_shim.fs
Original file line number Diff line number Diff line change
Expand Up @@ -45,16 +45,14 @@ module TcImports =
let tcImports = TcImports ()

let sigDataReaders ilModule =
[ for resource in ilModule.Resources.AsList() do
if IsSignatureDataResource resource then
let _ccuName, getBytes = GetResourceNameAndSignatureDataFunc resource
getBytes() ]
ilModule.Resources.AsList()
|> GetResourceNameAndSignatureDataFuncs
|> List.map snd

let optDataReaders ilModule =
[ for resource in ilModule.Resources.AsList() do
if IsOptimizationDataResource resource then
let _ccuName, getBytes = GetResourceNameAndOptimizationDataFunc resource
getBytes() ]
ilModule.Resources.AsList()
|> GetResourceNameAndOptimizationDataFuncs
|> List.map snd

let LoadMod (ccuName: string) =
let fileName =
Expand All @@ -71,11 +69,25 @@ module TcImports =
let reader = ILBinaryReader.OpenILModuleReaderFromBytes fileName bytes opts
reader.ILModuleDef //, reader.ILAssemblyRefs

let GetSignatureData (fileName:string, ilScopeRef, ilModule:ILModuleDef option, bytes: ReadOnlyByteMemory) =
unpickleObjWithDanglingCcus fileName ilScopeRef ilModule unpickleCcuInfo bytes
let GetSignatureData (file, ilScopeRef, ilModule, byteReaderA, byteReaderB) : PickledDataWithReferences<PickledCcuInfo> =
let memA = byteReaderA ()

let GetOptimizationData (fileName:string, ilScopeRef, ilModule:ILModuleDef option, bytes: ReadOnlyByteMemory) =
unpickleObjWithDanglingCcus fileName ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo bytes
let memB =
(match byteReaderB with
| None -> ByteMemory.Empty.AsReadOnly()
| Some br -> br ())

unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleCcuInfo memA memB

let GetOptimizationData (file:string, ilScopeRef, ilModule, byteReaderA, byteReaderB) =
let memA = byteReaderA ()

let memB =
(match byteReaderB with
| None -> ByteMemory.Empty.AsReadOnly()
| Some br -> br ())

unpickleObjWithDanglingCcus file ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo memA memB

let memoize_mod = new MemoizationTable<_,_> (LoadMod, keyComparer=HashIdentity.Structural)

Expand All @@ -86,7 +98,7 @@ module TcImports =
let fileName = ilModule.Name //TODO: try with ".sigdata" extension
match sigDataReaders ilModule with
| [] -> None
| bytes::_ -> Some (GetSignatureData (fileName, ilScopeRef, Some ilModule, bytes))
| (readerA, readerB)::_ -> Some (GetSignatureData (fileName, ilScopeRef, Some ilModule, readerA, readerB))

let LoadOptData ccuName =
let ilModule = memoize_mod.Apply ccuName
Expand All @@ -95,7 +107,7 @@ module TcImports =
let fileName = ilModule.Name //TODO: try with ".optdata" extension
match optDataReaders ilModule with
| [] -> None
| bytes::_ -> Some (GetOptimizationData (fileName, ilScopeRef, Some ilModule, bytes))
| (readerA, readerB)::_ -> Some (GetOptimizationData (fileName, ilScopeRef, Some ilModule, readerA, readerB))

let memoize_sig = new MemoizationTable<_,_> (LoadSigData, keyComparer=HashIdentity.Structural)
let memoize_opt = new MemoizationTable<_,_> (LoadOptData, keyComparer=HashIdentity.Structural)
Expand Down Expand Up @@ -250,6 +262,7 @@ module TcImports =
#endif
None

let fslibCcu = fslibCcuInfo.FSharpViewOfMetadata
let primaryScopeRef = primaryCcuInfo.ILScopeRef
let fsharpCoreScopeRef = fslibCcuInfo.ILScopeRef
let assembliesThatForwardToPrimaryAssembly = []
Expand All @@ -259,16 +272,19 @@ module TcImports =
TcGlobals(
tcConfig.compilingFSharpCore,
ilGlobals,
fslibCcuInfo.FSharpViewOfMetadata,
fslibCcu,
tcConfig.implicitIncludeDir,
tcConfig.mlCompatibility,
tcConfig.isInteractive,
tcConfig.checkNullness,
tcConfig.useReflectionFreeCodeGen,
tryFindSysTypeCcu,
tcConfig.emitDebugInfoInQuotations,
tcConfig.noDebugAttributes,
tcConfig.pathMap,
tcConfig.langVersion
tcConfig.langVersion,
tcConfig.realsig,
tcConfig.compilationMode
)

#if DEBUG
Expand Down
Loading

0 comments on commit 0529649

Please sign in to comment.