From ae00b0683fb86b05f364f1c85fb0f0d05e63b647 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Mon, 6 Jul 2020 14:13:29 +0900 Subject: [PATCH 1/8] Tail-call for deepExists --- src/Fable.Transforms/FableTransforms.fs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 04deeea20..039a6055b 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -160,13 +160,18 @@ let getSubExpressions = function | DecisionTree(expr, targets) -> expr::(List.map snd targets) | DecisionTreeSuccess(_, boundValues, _) -> boundValues -let rec deepExists f expr = - f expr || (getSubExpressions expr |> List.exists (deepExists f)) - -let rec deepExistsWithShortcircuit f expr = - match f expr with - | Some res -> res - | None -> getSubExpressions expr |> List.exists (deepExistsWithShortcircuit f) +let deepExists (f: Expr -> bool) expr = + let rec deepExistsInner (exprs: ResizeArray) = + let mutable found = false + let subExprs = ResizeArray() + for e in exprs do + if not found then + subExprs.AddRange(getSubExpressions e) + found <- f e + if found then true + elif subExprs.Count > 0 then deepExistsInner subExprs + else false + ResizeArray [|expr|] |> deepExistsInner let replaceValues replacements expr = if Map.isEmpty replacements From 725706ad8b072d167c4cd8c6f91fbc89e9bd2146 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Sun, 12 Jul 2020 23:37:52 +0900 Subject: [PATCH 2/8] Better JS names --- src/Fable.Core/Fable.Core.Types.fs | 4 - src/Fable.Transforms/AST/AST.Fable.fs | 49 +++-- src/Fable.Transforms/FSharp2Fable.Util.fs | 240 +++++++++----------- src/Fable.Transforms/FSharp2Fable.fs | 209 ++++++++---------- src/Fable.Transforms/Fable2Babel.fs | 191 ++++++++-------- src/Fable.Transforms/FableTransforms.fs | 29 +-- src/Fable.Transforms/Global/Compiler.fs | 1 - src/Fable.Transforms/Global/Prelude.fs | 254 ++++++++++++++++++---- src/Fable.Transforms/Replacements.fs | 44 ++-- src/Fable.Transforms/State.fs | 5 - src/Fable.Transforms/Transforms.Util.fs | 33 +-- src/quicktest/QuickTest.fs | 31 +++ 12 files changed, 607 insertions(+), 483 deletions(-) diff --git a/src/Fable.Core/Fable.Core.Types.fs b/src/Fable.Core/Fable.Core.Types.fs index a6803198b..11d35caeb 100644 --- a/src/Fable.Core/Fable.Core.Types.fs +++ b/src/Fable.Core/Fable.Core.Types.fs @@ -52,10 +52,6 @@ type ImportAllAttribute(from: string) = type EmitAttribute(macro: string) = inherit Attribute() -/// The declaration value will be replaced with the JS code. -type EmitDeclarationAttribute(macro: string) = - inherit Attribute() - /// Same as `Emit("$0.methodName($1...)")` type EmitMethodAttribute(methodName: string) = inherit Attribute() diff --git a/src/Fable.Transforms/AST/AST.Fable.fs b/src/Fable.Transforms/AST/AST.Fable.fs index c5cd07243..892711114 100644 --- a/src/Fable.Transforms/AST/AST.Fable.fs +++ b/src/Fable.Transforms/AST/AST.Fable.fs @@ -89,45 +89,52 @@ type ConstructorInfo(entity, entityName, ?isEntityPublic, ?isUnion, ?range) = member _.Range: SourceLocation option = range type ClassImplicitConstructorInfo(entity, constructorName, entityName, - arguments, boundThis, body, baseCall, - ?hasSpread, ?isConstructorPublic, - ?isEntityPublic, ?range) = + arguments, body, baseCall, ?hasSpread, + ?isConstructorPublic, ?isEntityPublic, ?range) = inherit ConstructorInfo(entity, entityName, ?isEntityPublic=isEntityPublic, ?range=range) member _.ConstructorName: string = constructorName member _.Arguments: Ident list = arguments - member _.BoundThis: Ident = boundThis member _.Body: Expr = body member _.BaseCall: Expr option = baseCall member _.IsConstructorPublic = defaultArg isConstructorPublic false member _.HasSpread = defaultArg hasSpread false member _.WithBodyAndBaseCall(body, baseCall) = - ClassImplicitConstructorInfo(entity, constructorName, entityName, arguments, boundThis, + ClassImplicitConstructorInfo(entity, constructorName, entityName, arguments, body, baseCall, ?hasSpread=hasSpread, ?isConstructorPublic=isConstructorPublic, ?isEntityPublic=isEntityPublic, ?range=range) +type UsedNames = Set + type Declaration = - | ActionDeclaration of Expr + | ActionDeclaration of Expr * UsedNames /// Note: Non-attached type members become module members - | ModuleMemberDeclaration of args: Ident list * body: Expr * ModuleMemberInfo + | ModuleMemberDeclaration of args: Ident list * body: Expr * ModuleMemberInfo * UsedNames /// Interface and abstract class implementations - | AttachedMemberDeclaration of args: Ident list * body: Expr * AttachedMemberInfo * declaringEntity: FSharpEntity + | AttachedMemberDeclaration of args: Ident list * body: Expr * AttachedMemberInfo * declaringEntity: FSharpEntity * UsedNames /// For unions, records and structs | CompilerGeneratedConstructorDeclaration of ConstructorInfo - | ClassImplicitConstructorDeclaration of ClassImplicitConstructorInfo + | ClassImplicitConstructorDeclaration of ClassImplicitConstructorInfo * UsedNames + + member this.UsedNames = + match this with + | ActionDeclaration(_,u) + | ModuleMemberDeclaration(_,_,_,u) + | AttachedMemberDeclaration(_,_,_,_,u) + | ClassImplicitConstructorDeclaration(_,u) -> u + | CompilerGeneratedConstructorDeclaration _ -> Set.empty -type File(sourcePath, decls, ?usedVarNames, ?inlineDependencies) = +type File(sourcePath, decls, ?usedRootNames, ?inlineDependencies) = member __.SourcePath: string = sourcePath member __.Declarations: Declaration list = decls - member __.UsedVarNames: Set = defaultArg usedVarNames Set.empty + member __.UseNamesInRootScope: UsedNames = defaultArg usedRootNames Set.empty member __.InlineDependencies: Set = defaultArg inlineDependencies Set.empty type IdentKind = | UserDeclared | CompilerGenerated - | BaseValueIdent - | ThisArgIdentDeclaration + | ThisArgIdent type Ident = { Name: string @@ -140,14 +147,9 @@ type Ident = | CompilerGenerated -> true | _ -> false - member x.IsBaseValue = - match x.Kind with - | BaseValueIdent -> true - | _ -> false - - member x.IsThisArgDeclaration = + member x.IsThisArgIdent = match x.Kind with - | ThisArgIdentDeclaration -> true + | ThisArgIdent -> true | _ -> false member x.DisplayName = @@ -169,6 +171,11 @@ type NewRecordKind = | AnonymousRecord of fieldNames: string [] type ValueKind = + // The AST from F# compiler is a bit inconsistent with ThisValue and BaseValue. + // ThisValue only appears in constructors and not in instance members (where `this` is passed as first argument) + // BaseValue can appear both in constructor and instance members (where they're associated to this arg) + | ThisValue of Type + | BaseValue of boundIdent: Ident option * Type | TypeInfo of Type | Null of Type | UnitConstant @@ -186,6 +193,8 @@ type ValueKind = | NewUnion of Expr list * FSharpUnionCase * FSharpEntity * genArgs: Type list member this.Type = match this with + | ThisValue t + | BaseValue(_,t) -> t | TypeInfo _ -> MetaType | Null t -> t | UnitConstant -> Unit diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 93558a19c..5e4f93a02 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -12,6 +12,8 @@ open Fable.Transforms type Context = { Scope: (FSharpMemberOrFunctionOrValue * Fable.Ident * Fable.Expr option) list ScopeInlineValues: (FSharpMemberOrFunctionOrValue * FSharpExpr) list + UseNamesInRootScope: Set + UseNamesInDeclarationScope: HashSet GenericArgs: Map EnclosingMember: FSharpMemberOrFunctionOrValue option EnclosingEntity: FSharpEntity option @@ -22,9 +24,11 @@ type Context = InlinePath: Log.InlinePath list CaptureBaseConsCall: (FSharpEntity * (Fable.Expr -> unit)) option } - static member Create(enclosingEntity) = + static member Create(enclosingEntity, usedRootNames) = { Scope = [] ScopeInlineValues = [] + UseNamesInRootScope = usedRootNames + UseNamesInDeclarationScope = Unchecked.defaultof<_> GenericArgs = Map.empty EnclosingMember = None EnclosingEntity = enclosingEntity @@ -45,8 +49,6 @@ type IFableCompiler = genArgs: ((string * Fable.Type) list) * FSharpParameter -> Fable.Expr abstract GetInlineExpr: FSharpMemberOrFunctionOrValue -> InlineExpr abstract TryGetImplementationFile: filename: string -> FSharpImplementationFileContents option - abstract AddUsedVarName: string * ?isRoot: bool -> unit - abstract IsUsedVarName: string -> bool abstract AddInlineDependency: string -> unit module Helpers = @@ -97,26 +99,19 @@ module Helpers = | Some fullName -> let loc = getEntityLocation ent let rootMod = com.GetRootModule(loc.FileName) - if fullName.StartsWith(rootMod) - then fullName.Substring(rootMod.Length).TrimStart('.') + if fullName.StartsWith(rootMod) then + fullName.Substring(rootMod.Length).TrimStart('.') else fullName | None -> ent.CompiledName + let cleanNameAsJsIdentifier (name: string) = + name.Replace('.','_').Replace('`','_') + let getEntityDeclarationName (com: ICompiler) (ent: FSharpEntity) = - (getEntityMangledName com true ent, Naming.NoMemberPart) + let entityName = getEntityMangledName com true ent |> cleanNameAsJsIdentifier + (entityName, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun _ -> false) - let isUnit (typ: FSharpType) = - let typ = nonAbbreviatedType typ - if typ.HasTypeDefinition - then typ.TypeDefinition.TryFullName = Some Types.unit - else false - - let getInterfaceImplementationName com (implementingEntity: FSharpEntity) (interfaceEntityFullName: string) = - let entityName = getEntityMangledName com true implementingEntity - let memberPart = Naming.StaticMemberPart(interfaceEntityFullName, "") - Naming.sanitizeIdent (fun _ -> false) entityName memberPart - let private getMemberMangledName (com: ICompiler) trimRootModule (memb: FSharpMemberOrFunctionOrValue) = if memb.IsExtensionMember then let overloadSuffix = OverloadSuffix.getExtensionHash memb @@ -139,14 +134,10 @@ module Helpers = /// Returns the sanitized name for the member declaration and whether it has an overload suffix let getMemberDeclarationName (com: ICompiler) (memb: FSharpMemberOrFunctionOrValue) = let name, part = getMemberMangledName com true memb + let name = cleanNameAsJsIdentifier name + let part = part.Replace(fun s -> if s = ".ctor" then "$ctor" else s) let sanitizedName = Naming.sanitizeIdent (fun _ -> false) name part - let hasOverloadSuffix = - match part with - | Naming.InstanceMemberPart(_, overloadSuffix) - | Naming.StaticMemberPart(_, overloadSuffix) -> - String.IsNullOrEmpty(overloadSuffix) |> not - | Naming.NoMemberPart -> false - sanitizedName, hasOverloadSuffix + sanitizedName, not(String.IsNullOrEmpty(part.OverloadSuffix)) /// Used to identify members uniquely in the inline expressions dictionary let getMemberUniqueName (com: ICompiler) (memb: FSharpMemberOrFunctionOrValue): string = @@ -154,8 +145,8 @@ module Helpers = ||> Naming.buildNameWithoutSanitation let getMemberFullName (memb: FSharpMemberOrFunctionOrValue) = - if memb.IsExplicitInterfaceImplementation - then true, memb.CompiledName.Replace("-",".") + if memb.IsExplicitInterfaceImplementation then + true, memb.CompiledName.Replace("-",".") else let ent = memb.ApparentEnclosingEntity ent.IsInterface, memb.FullName @@ -163,6 +154,20 @@ module Helpers = let getMemberDisplayName (memb: FSharpMemberOrFunctionOrValue) = Naming.removeGetSetPrefix memb.DisplayName + let isUsedName (ctx: Context) name = + ctx.UseNamesInRootScope.Contains name || ctx.UseNamesInDeclarationScope.Contains name + + let getIdentUniqueName (ctx: Context) name = + let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (isUsedName ctx) + ctx.UseNamesInDeclarationScope.Add(name) |> ignore + name + + let isUnit (typ: FSharpType) = + let typ = nonAbbreviatedType typ + if typ.HasTypeDefinition then + typ.TypeDefinition.TryFullName = Some Types.unit + else false + let tryFindAtt fullName (atts: #seq) = atts |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with @@ -665,7 +670,7 @@ module TypeHelpers = | Some ent -> match countConflictingCases 0 ent name with | 0 -> name - | n -> Naming.appendSuffix name (string n) + | n -> name + "_" + (string n) let rec getOwnAndInheritedFsharpMembers (tdef: FSharpEntity) = seq { yield! tdef.TryGetMembersFunctionsAndValues @@ -699,7 +704,7 @@ module TypeHelpers = if t.HasTypeDefinition then Some t.TypeDefinition else None else None - let tryFindMember com (entity: FSharpEntity) genArgs _COMPILED_NAME isInstance (argTypes: Fable.Type list) = + let tryFindMember com (entity: FSharpEntity) genArgs compiledName isInstance (argTypes: Fable.Type list) = let argsEqual (args1: Fable.Type list) args1Length (args2: IList>) = let args2Length = args2 |> Seq.sumBy (fun g -> g.Count) if args1Length = args2Length then @@ -711,24 +716,10 @@ module TypeHelpers = else false let argTypesLength = List.length argTypes getOwnAndInheritedFsharpMembers entity |> Seq.tryFind (fun m2 -> - if m2.IsInstanceMember = isInstance && m2.CompiledName = _COMPILED_NAME + if m2.IsInstanceMember = isInstance && m2.CompiledName = compiledName then argsEqual argTypes argTypesLength m2.CurriedParameterGroups else false) - // let tryFindMember com (entity: FSharpEntity) genArgs membCompiledName isInstance (argTypes : list) = - // let argsEqual (args1 : Fable.Type list) args1Length (args2: IList>)= - // let args2Length = args2 |> Seq.sumBy (fun g -> g.Count) - // if args1Length = args2Length then - // let args2 = args2 |> Seq.collect (fun g -> - // g |> Seq.map (fun p -> makeType com genArgs p.Type) |> Seq.toList) - // listEquals (typeEquals false) args1 (Seq.toList args2) - // else false - // let argTypesLength = List.length argTypes - // getOwnAndInheritedFsharpMembers entity |> Seq.tryFind (fun m2 -> - // if m2.IsInstanceMember = isInstance && m2.CompiledName = membCompiledName - // then argsEqual argTypes argTypesLength m2.CurriedParameterGroups - // else false) - let inline (|FableType|) com (ctx: Context) t = makeType com ctx.GenericArgs t module Identifiers = @@ -740,11 +731,8 @@ module Identifiers = let makeIdentFrom (com: IFableCompiler) (ctx: Context) (fsRef: FSharpMemberOrFunctionOrValue): Fable.Ident = let sanitizedName = (fsRef.CompiledName, Naming.NoMemberPart) - ||> Naming.sanitizeIdent com.IsUsedVarName - // Track all used var names in the file so they're not used for imports - // Also, in some situations variable names in different scopes can conflict - // so just try to give a unique name to each identifier per file for safety - com.AddUsedVarName sanitizedName + ||> Naming.sanitizeIdent (isUsedName ctx) + ctx.UseNamesInDeclarationScope.Add(sanitizedName) |> ignore { Name = sanitizedName Type = makeType com ctx.GenericArgs fsRef.FullType Kind = if fsRef.IsCompilerGenerated then Fable.CompilerGenerated else Fable.UserDeclared @@ -762,13 +750,14 @@ module Identifiers = let ident = makeIdentFrom com ctx fsRef putIdentInScope ctx fsRef ident (Some value), ident - let inline tryGetIdentFromScopeIf (ctx: Context) r predicate = - match List.tryFind (fun (fsRef,_,_) -> predicate fsRef) ctx.Scope with - | Some(_,ident,_) -> - let originalName = ident.Range |> Option.bind (fun r -> r.identifierName) - { ident with Range = r |> Option.map (fun r -> { r with identifierName = originalName }) } - |> Fable.IdentExpr |> Some - | None -> None + let identWithRange r (ident: Fable.Ident) = + let originalName = ident.Range |> Option.bind (fun r -> r.identifierName) + { ident with Range = r |> Option.map (fun r -> { r with identifierName = originalName }) } + + let tryGetIdentFromScopeIf (ctx: Context) r predicate = + ctx.Scope |> List.tryPick (fun (fsRef, ident, _) -> + if predicate fsRef then identWithRange r ident |> Fable.IdentExpr |> Some + else None) /// Get corresponding identifier to F# value in current scope let tryGetIdentFromScope (ctx: Context) r (fsRef: FSharpMemberOrFunctionOrValue) = @@ -800,15 +789,10 @@ module Util = let bindMemberArgs com ctx (args: FSharpMemberOrFunctionOrValue list list) = let ctx, transformedArgs, args = match args with - // Within private members (first arg is ConstructorThisValue) F# AST uses - // ThisValue instead of Value (with .IsMemberConstructorThisValue = true) - | (firstArg::restArgs1)::restArgs2 when firstArg.IsConstructorThisValue || firstArg.IsMemberThisValue -> + | (firstArg::restArgs1)::restArgs2 when firstArg.IsMemberThisValue -> let ctx, thisArg = putArgInScope com ctx firstArg - let thisArg = { thisArg with Kind = Fable.ThisArgIdentDeclaration } - let ctx = - if firstArg.IsConstructorThisValue - then { ctx with BoundConstructorThis = Some thisArg } - else { ctx with BoundMemberThis = Some thisArg } + let thisArg = { thisArg with Kind = Fable.ThisArgIdent } + let ctx = { ctx with BoundMemberThis = Some thisArg } ctx, [thisArg], restArgs1::restArgs2 | _ -> ctx, [], args let ctx, args = @@ -874,62 +858,63 @@ module Util = |> Path.getRelativePath com.CurrentFile else path - let (|ImportAtt|EmitDeclarationAtt|NoAtt|) (atts: #seq) = + let (|GlobalAtt|ImportAtt|NoGlobalNorImport|) (atts: #seq) = atts |> Seq.tryPick (function - | AttFullName(Atts.import, AttArguments [(:? string as selector); (:? string as path)]) -> - Choice1Of3(selector.Trim(), path.Trim()) |> Some - | AttFullName(Atts.importAll, AttArguments [(:? string as path)]) -> - Choice1Of3("*", path.Trim()) |> Some - | AttFullName(Atts.importDefault, AttArguments [(:? string as path)]) -> - Choice1Of3("default", path.Trim()) |> Some - | AttFullName(Atts.importMember, AttArguments [(:? string as path)]) -> - Choice1Of3(Naming.placeholder, path.Trim()) |> Some - | AttFullName(Atts.emitDeclaration, AttArguments [(:? string as macro)]) -> - Choice2Of3(macro) |> Some + | AttFullName(Atts.global_, att) -> + match att with + | AttArguments [:? string as customName] -> GlobalAtt(Some customName) |> Some + | _ -> GlobalAtt(None) |> Some + + | AttFullName(Naming.StartsWith Atts.import _ as fullName, att) -> + match fullName, att with + | Atts.importAll, AttArguments [(:? string as path)] -> + ImportAtt("*", path.Trim()) |> Some + | Atts.importDefault, AttArguments [(:? string as path)] -> + ImportAtt("default", path.Trim()) |> Some + | Atts.importMember, AttArguments [(:? string as path)] -> + ImportAtt(Naming.placeholder, path.Trim()) |> Some + | _, AttArguments [(:? string as selector); (:? string as path)] -> + ImportAtt(selector.Trim(), path.Trim()) |> Some + | _ -> None + | _ -> None) - |> Option.defaultValue (Choice3Of3 ()) + |> Option.defaultValue NoGlobalNorImport /// Function used to check if calls must be replaced by global idents or direct imports let tryGlobalOrImportedMember com typ (memb: FSharpMemberOrFunctionOrValue) = let getImportPath path = lazy getMemberLocation memb |> fixImportedRelativePath com path - memb.Attributes |> Seq.tryPick (function - | AttFullName(Atts.global_, att) -> - match att with - | AttArguments [:? string as customName] -> - makeTypedIdentNonMangled typ customName |> Fable.IdentExpr |> Some - | _ -> getMemberDisplayName memb |> makeTypedIdentNonMangled typ |> Fable.IdentExpr |> Some - | AttFullName(Atts.import, AttArguments [(:? string as selector); (:? string as path)]) -> - getImportPath path |> makeCustomImport typ selector |> Some - | AttFullName(Atts.importAll, AttArguments [(:? string as path)]) -> - getImportPath path |> makeCustomImport typ "*" |> Some - | AttFullName(Atts.importDefault, AttArguments [(:? string as path)]) -> - getImportPath path |> makeCustomImport typ "default" |> Some - | AttFullName(Atts.importMember, AttArguments [(:? string as path)]) -> - let selector = getMemberDisplayName memb - getImportPath path |> makeCustomImport typ selector |> Some - | _ -> None) + match memb.Attributes with + | GlobalAtt(Some customName) -> + makeTypedIdent typ customName |> Fable.IdentExpr |> Some + | GlobalAtt None -> + getMemberDisplayName memb |> makeTypedIdent typ |> Fable.IdentExpr |> Some + | ImportAtt(selector, path) -> + let selector = + if selector = Naming.placeholder then getMemberDisplayName memb + else selector + let path = + lazy getMemberLocation memb + |> fixImportedRelativePath com path + makeCustomImport typ selector path |> Some + | _ -> None let tryGlobalOrImportedEntity (com: ICompiler) (ent: FSharpEntity) = - let getImportPath path = - lazy getEntityLocation ent - |> fixImportedRelativePath com path - ent.Attributes |> Seq.tryPick (function - | AttFullName(Atts.global_, att) -> - match att with - | AttArguments [:? string as customName] -> - makeTypedIdentNonMangled Fable.Any customName |> Fable.IdentExpr |> Some - | _ -> ent.DisplayName |> makeTypedIdentNonMangled Fable.Any |> Fable.IdentExpr |> Some - | AttFullName(Atts.import, AttArguments [(:? string as selector); (:? string as path)]) -> - getImportPath path |> makeCustomImport Fable.Any selector |> Some - | AttFullName(Atts.importAll, AttArguments [(:? string as path)]) -> - getImportPath path |> makeCustomImport Fable.Any "*" |> Some - | AttFullName(Atts.importDefault, AttArguments [(:? string as path)]) -> - getImportPath path |> makeCustomImport Fable.Any "default" |> Some - | AttFullName(Atts.importMember, AttArguments [(:? string as path)]) -> - getImportPath path |> makeCustomImport Fable.Any ent.DisplayName |> Some - | _ -> None) + match ent.Attributes with + | GlobalAtt(Some customName) -> + makeTypedIdent Fable.Any customName |> Fable.IdentExpr |> Some + | GlobalAtt None -> + ent.DisplayName |> makeTypedIdent Fable.Any |> Fable.IdentExpr |> Some + | ImportAtt(selector, path) -> + let selector = + if selector = Naming.placeholder then ent.DisplayName + else selector + let path = + lazy getEntityLocation ent + |> fixImportedRelativePath com path + makeCustomImport Fable.Any selector path |> Some + | _ -> None let isErasedOrStringEnumEntity (ent: FSharpEntity) = ent.Attributes |> Seq.exists (fun att -> @@ -937,17 +922,10 @@ module Util = | Some(Atts.erase | Atts.stringEnum) -> true | _ -> false) - let isErasedOrStringEnumOrGlobalOrImportedEntity (ent: FSharpEntity) = - ent.Attributes |> Seq.exists (fun att -> - match att.AttributeType.TryFullName with - | Some(Atts.erase | Atts.stringEnum - | Atts.global_ | Atts.import | Atts.importAll | Atts.importDefault | Atts.importMember) -> true - | _ -> false) - let isGlobalOrImportedEntity (ent: FSharpEntity) = ent.Attributes |> Seq.exists (fun att -> match att.AttributeType.TryFullName with - | Some(Atts.global_ | Atts.import | Atts.importAll | Atts.importDefault | Atts.importMember) -> true + | Some(Atts.global_ | Naming.StartsWith Atts.import _) -> true | _ -> false) /// Entities coming from assemblies (we don't have access to source code) are candidates for replacement @@ -970,10 +948,9 @@ module Util = else let entLoc = getEntityLocation ent let file = Path.normalizePathAndEnsureFsExtension entLoc.FileName - let entityName = getEntityDeclarationName com ent - let entityName = Naming.appendSuffix entityName suffix + let entityName = getEntityDeclarationName com ent + suffix if file = com.CurrentFile then - makeIdentExprNonMangled entityName + makeIdentExpr entityName elif isPublicEntity ent then makeInternalImport com Fable.Any entityName file else @@ -1000,7 +977,7 @@ module Util = // We assume the member belongs to the current file | None -> com.CurrentFile if file = com.CurrentFile then - { makeTypedIdentNonMangled typ memberName with Range = r } + { makeTypedIdent typ memberName with Range = r } |> Fable.IdentExpr elif isPublicMember memb then // If the overload suffix changes, we need to recompile the files that call this member @@ -1111,7 +1088,7 @@ module Util = let (|Emitted|_|) com r typ callInfo (memb: FSharpMemberOrFunctionOrValue) = memb.Attributes |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with - | Some(Naming.StartsWith "Fable.Core.Emit" _ as attFullName) -> + | Some(Naming.StartsWith Atts.emit _ as attFullName) -> let callInfo = // Allow combination of Import and Emit attributes match callInfo, tryGlobalOrImportedMember com Fable.Any memb with @@ -1122,16 +1099,15 @@ module Util = match Seq.tryHead att.ConstructorArguments with | Some(_, (:? string as macro)) -> macro | _ -> "" - match attFullName with - | Atts.emit -> Some macro - | Atts.emitMethod -> "$0." + macro + "($1...)" |> Some - | Atts.emitConstructor -> "new $0($1...)" |> Some - | Atts.emitIndexer -> "$0[$1]{{=$2}}" |> Some - | Atts.emitProperty -> "$0." + macro + "{{=$1}}" |> Some - | _ -> None - |> Option.map (fun macro -> Fable.Operation(Fable.Emit(macro, callInfo), typ, r)) - | _ -> None - ) + let macro = + match attFullName with + | Atts.emitMethod -> "$0." + macro + "($1...)" + | Atts.emitConstructor -> "new $0($1...)" + | Atts.emitIndexer -> "$0[$1]{{=$2}}" + | Atts.emitProperty -> "$0." + macro + "{{=$1}}" + | _ -> macro + Fable.Operation(Fable.Emit(macro, callInfo), typ, r) |> Some + | _ -> None) let (|Imported|_|) com r typ callInfo (memb: FSharpMemberOrFunctionOrValue, entity: FSharpEntity option) = let importValueType = if Option.isSome callInfo then Fable.Any else typ diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index e94598f2c..c85ffca71 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -360,7 +360,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs) let byrefType = makeType com ctx.GenericArgs (List.last membArgs).Type let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple - let tupleIdent = makeIdentUnique com "tuple" + let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent let tupleIdentExpr = Fable.IdentExpr tupleIdent let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleGet 1, tupleType, None) @@ -394,7 +394,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs) let byrefType = makeType com ctx.GenericArgs (List.last membArgs).Type let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple - let tupleIdent = makeIdentUnique com "tuple" + let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent let tupleIdentExpr = Fable.IdentExpr tupleIdent let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb let id1Expr = Fable.Get(tupleIdentExpr, Fable.TupleGet 0, tupleType, None) @@ -448,30 +448,23 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = return Replacements.makeTypeConst (makeRangeFrom fsExpr) typ value | BasicPatterns.BaseValue typ -> + let r = makeRangeFrom fsExpr let typ = makeType com Map.empty typ - match ctx.BoundMemberThis, ctx.BoundConstructorThis with - | Some thisArg, _ | _, Some thisArg -> - return { thisArg with Kind = Fable.BaseValueIdent; Type = typ } |> Fable.IdentExpr - | _ -> - addError com ctx.InlinePath (makeRangeFrom fsExpr) "Unexpected unbound this for base value" - return Fable.Value(Fable.Null Fable.Any, None) + return Fable.Value(Fable.BaseValue(ctx.BoundMemberThis, typ), r) + // F# compiler doesn't represent `this` in non-constructors as BasicPatterns.ThisValue (but BasicPatterns.Value) | BasicPatterns.ThisValue typ -> - let fail r msg = - addError com ctx.InlinePath r msg - Fable.Value(Fable.Null Fable.Any, None) - // NOTE: We don't check ctx.BoundMemberThis here because F# compiler doesn't represent - // `this` in members as BasicPatterns.ThisValue (but BasicPatterns.Value) + let r = makeRangeFrom fsExpr return match typ, ctx.BoundConstructorThis with - // When the type is a ref type, it means this is a reference to a constructor this value `type C() as x` + // When it's ref type, this is the x in `type C() as x =` | RefType _, _ -> - let r = makeRangeFrom fsExpr - match tryGetIdentFromScopeIf ctx r (fun fsRef -> fsRef.IsConstructorThisValue) with - | Some e -> e - | None -> fail r "Cannot find ConstructorThisValue" - | _, Some thisArg -> Fable.IdentExpr thisArg - | _ -> fail (makeRangeFrom fsExpr) "Unexpected unbound this" + tryGetIdentFromScopeIf ctx r (fun fsRef -> fsRef.IsConstructorThisValue) + |> Option.defaultWith (fun () -> "Cannot find ConstructorThisValue" + |> addErrorAndReturnNull com ctx.InlinePath r) + // Check if `this` has been bound previously to avoid conflicts with an object expression + | _, Some i -> identWithRange r i |> Fable.IdentExpr + | _, None -> Fable.Value(makeType com Map.empty typ |> Fable.ThisValue, r) | BasicPatterns.Value var -> let r = makeRangeFrom fsExpr @@ -714,7 +707,16 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = return Fable.NewTuple(argExprs) |> makeValue (makeRangeFrom fsExpr) | BasicPatterns.ObjectExpr(objType, baseCall, overrides, otherOverrides) -> - return! transformObjExpr com ctx objType baseCall overrides otherOverrides + let objExpr ctx = + transformObjExpr com ctx objType baseCall overrides otherOverrides + match ctx.EnclosingMember with + | Some m when m.IsImplicitConstructor -> + let thisArg = getIdentUniqueName ctx "_this" |> makeIdent + let thisValue = Fable.Value(Fable.ThisValue Fable.Any, None) + let ctx = { ctx with BoundConstructorThis = Some thisArg } + let! objExpr = transformObjExpr com ctx objType baseCall overrides otherOverrides + return Fable.Let([thisArg, thisValue], objExpr) + | _ -> return! transformObjExpr com ctx objType baseCall overrides otherOverrides | BasicPatterns.NewObject(memb, genArgs, args) -> // TODO: Check arguments passed byref here too? @@ -828,8 +830,7 @@ let private isIgnoredNonAttachedMember (meth: FSharpMemberOrFunctionOrValue) = Option.isSome meth.LiteralValue || meth.Attributes |> Seq.exists (fun att -> match att.AttributeType.TryFullName with - | Some(Atts.global_ | Atts.import | Atts.importAll | Atts.importDefault | Atts.importMember - | Atts.emit | Atts.emitMethod | Atts.emitConstructor | Atts.emitIndexer | Atts.emitProperty) -> true + | Some(Atts.global_ | Naming.StartsWith Atts.import _ | Naming.StartsWith Atts.emit _) -> true | _ -> false) || (match meth.DeclaringEntity with | Some ent -> isGlobalOrImportedEntity ent @@ -848,10 +849,6 @@ let private transformImplicitConstructor com (ctx: Context) | None -> "Unexpected constructor without declaring entity: " + memb.FullName |> addError com ctx.InlinePath None; [] | Some ent -> - let bodyCtx, args = bindMemberArgs com ctx args - let genArgs = ent.GenericParameters |> Seq.map (resolveGenParam ctx.GenericArgs) |> Seq.toList - let entType = Fable.DeclaredType(ent, genArgs) - let boundThis = makeTypedIdentUnique com entType "this" let mutable baseRefAndConsCall = None let captureBaseCall = ent.BaseType |> Option.bind (fun (NonAbbreviatedType baseType) -> @@ -862,18 +859,16 @@ let private transformImplicitConstructor com (ctx: Context) Some(ent, fun c -> baseRefAndConsCall <- Some c) | _ -> None else None) - let bodyCtx = { bodyCtx with BoundConstructorThis = Some boundThis - CaptureBaseConsCall = captureBaseCall } + let bodyCtx, args = bindMemberArgs com ctx args + let bodyCtx = { bodyCtx with CaptureBaseConsCall = captureBaseCall } let body = transformExpr com bodyCtx body |> run let consName, _ = getMemberDeclarationName com memb let entityName = getEntityDeclarationName com ent - com.AddUsedVarName(consName) - com.AddUsedVarName(entityName) let r = getEntityLocation ent |> makeRange let info = Fable.ClassImplicitConstructorInfo(ent, consName, entityName, - args, boundThis, body, baseRefAndConsCall, hasSeqSpread memb, + args, body, baseRefAndConsCall, hasSeqSpread memb, isPublicMember memb, isPublicEntity ent, r) - [Fable.ClassImplicitConstructorDeclaration info] + [Fable.ClassImplicitConstructorDeclaration(info, set ctx.UseNamesInDeclarationScope)] /// When using `importMember`, uses the member display name as selector let private importExprSelector (memb: FSharpMemberOrFunctionOrValue) selector = @@ -888,7 +883,7 @@ let private transformImport com r typ isMutable isPublic name selector path = |> addError com [] None let info = Fable.ModuleMemberInfo(name, isValue=true, isPublic=isPublic, isMutable=isMutable) let fableValue = Fable.Import(selector, path, Fable.CustomImport, typ, r) - [Fable.ModuleMemberDeclaration([], fableValue, info)] + [Fable.ModuleMemberDeclaration([], fableValue, info, Set.empty)] let private transformMemberValue (com: IFableCompiler) ctx isPublic name (memb: FSharpMemberOrFunctionOrValue) (value: FSharpExpr) = let value = transformExpr com ctx value |> run @@ -908,7 +903,7 @@ let private transformMemberValue (com: IFableCompiler) ctx isPublic name (memb: let r = makeRange memb.DeclarationLocation let info = Fable.ModuleMemberInfo(name, ?declaringEntity=memb.DeclaringEntity, isValue=true, isPublic=isPublic, isMutable=memb.IsMutable, range=r) - [Fable.ModuleMemberDeclaration([], fableValue, info)] + [Fable.ModuleMemberDeclaration([], fableValue, info, set ctx.UseNamesInDeclarationScope)] let private moduleMemberDeclarationInfo name isValue isPublic (memb: FSharpMemberOrFunctionOrValue): Fable.ModuleMemberInfo = Fable.ModuleMemberInfo(name, @@ -936,15 +931,14 @@ let private transformMemberFunction (com: IFableCompiler) ctx isPublic name (mem if memb.CompiledName = ".cctor" then let fn = Fable.Function(Fable.Delegate args, body, Some name) let apply = makeCall None Fable.Unit (makeSimpleCallInfo None [] []) fn - [Fable.ActionDeclaration apply] + [Fable.ActionDeclaration(apply, set ctx.UseNamesInDeclarationScope)] else let info = moduleMemberDeclarationInfo name false isPublic memb - [Fable.ModuleMemberDeclaration(args, body, info)] + [Fable.ModuleMemberDeclaration(args, body, info, set ctx.UseNamesInDeclarationScope)] let private transformMemberFunctionOrValue (com: IFableCompiler) ctx (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = let isPublic = isPublicMember memb let name, _ = getMemberDeclarationName com memb - com.AddUsedVarName(name) match memb.Attributes with | ImportAtt(selector, path) -> let selector = @@ -952,11 +946,7 @@ let private transformMemberFunctionOrValue (com: IFableCompiler) ctx (memb: FSha else selector let typ = makeType com Map.empty memb.FullType transformImport com None typ memb.IsMutable isPublic name (makeStrConst selector) (makeStrConst path) - | EmitDeclarationAtt macro -> - let typ = makeType com Map.empty memb.FullType - let info = moduleMemberDeclarationInfo name true isPublic memb - [Fable.ModuleMemberDeclaration([], Fable.Operation(Fable.Emit(macro, None), typ, None), info)] - | NoAtt -> + | _ -> if isModuleValueForDeclarations memb then transformMemberValue com ctx isPublic name memb body else transformMemberFunction com ctx isPublic name memb args body @@ -968,11 +958,12 @@ let private transformAttachedMember (com: FableCompiler) (ctx: Context) let body = transformExpr com bodyCtx body |> run let r = makeRange memb.DeclarationLocation |> Some let info = getAttachedMemberInfo com ctx r com.NonMangledAttachedMemberConflicts (Some declaringEntity) signature - [Fable.AttachedMemberDeclaration(args, body, info, declaringEntity)] + [Fable.AttachedMemberDeclaration(args, body, info, declaringEntity, set ctx.UseNamesInDeclarationScope)] let private transformMemberDecl (com: FableCompiler) (ctx: Context) (memb: FSharpMemberOrFunctionOrValue) (args: FSharpMemberOrFunctionOrValue list list) (body: FSharpExpr) = - let ctx = { ctx with EnclosingMember = Some memb } + let ctx = { ctx with EnclosingMember = Some memb + UseNamesInDeclarationScope = HashSet() } if isIgnoredNonAttachedMember memb then if memb.IsMutable && isPublicMember memb && hasAttribute Atts.global_ memb.Attributes then "Global members cannot be mutable and public, please make it private: " + memb.DisplayName @@ -1008,55 +999,55 @@ let private transformMemberDecl (com: FableCompiler) (ctx: Context) (memb: FShar | None -> [] else transformMemberFunctionOrValue com ctx memb args body -// In case this is a recursive module, do a first pass to add -// all entity and member names as used var names -let rec checkMemberNames (com: FableCompiler) decls = - for decl in decls do +let private addUsedRootName com (usedRootNames: Set) name = + if Set.contains name usedRootNames then + "Cannot have two module members with same name: " + name + |> addError com [] None + Set.add name usedRootNames + +// In case this is a recursive module, do a first pass to get all entity and member names +let rec private getUsedRootNames com (usedNames: Set) decls = + (usedNames, decls) ||> List.fold (fun usedNames decl -> match decl with | FSharpImplementationFileDeclaration.Entity(ent, sub) -> - match sub with - | [] when ent.IsFSharpAbbreviation -> () - | [] -> com.AddUsedVarName(getEntityDeclarationName com ent, isRoot=true) - | sub -> checkMemberNames com sub + if isErasedOrStringEnumEntity ent then usedNames + elif ent.IsFSharpUnion || isRecordLike ent then + getEntityDeclarationName com ent + |> addUsedRootName com usedNames + else + getUsedRootNames com usedNames sub | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb,_,_) -> - if not(memb.IsOverrideOrExplicitInterfaceImplementation || isIgnoredNonAttachedMember memb) then + if memb.IsOverrideOrExplicitInterfaceImplementation then usedNames + else let memberName, _ = getMemberDeclarationName com memb - com.AddUsedVarName(memberName, isRoot=true) - | FSharpImplementationFileDeclaration.InitAction _ -> () - -let private transformDeclarations (com: FableCompiler) ctx rootDecls = - let rec transformDeclarationsInner (com: FableCompiler) (ctx: Context) fsDecls = - fsDecls |> List.collect (fun fsDecl -> - match fsDecl with - | FSharpImplementationFileDeclaration.Entity(ent, sub) -> - match ent.Attributes with - | ImportAtt(selector, path) -> - let selector = - if selector = Naming.placeholder then ent.DisplayName - else selector - let name = getEntityDeclarationName com ent - com.AddUsedVarName(name) - (makeStrConst selector, makeStrConst path) - ||> transformImport com None Fable.Any false (not ent.Accessibility.IsPrivate) name - | _ when isErasedOrStringEnumOrGlobalOrImportedEntity ent -> - [] - | _ when ent.IsFSharpUnion || isRecordLike ent -> + let usedNames = addUsedRootName com usedNames memberName + match memb.DeclaringEntity with + | Some ent when memb.IsImplicitConstructor -> let entityName = getEntityDeclarationName com ent - com.AddUsedVarName(entityName) - // TODO: Check Equality/Comparison attributes - let r = getEntityLocation ent |> makeRange - Fable.ConstructorInfo(ent, entityName, isPublicEntity ent, ent.IsFSharpUnion, r) - |> Fable.CompilerGeneratedConstructorDeclaration - |> List.singleton - | _ -> - transformDeclarationsInner com { ctx with EnclosingEntity = Some ent } sub - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(meth, args, body) -> - transformMemberDecl com ctx meth args body - | FSharpImplementationFileDeclaration.InitAction fe -> - [transformExpr com ctx fe |> run |> Fable.ActionDeclaration]) + addUsedRootName com usedNames entityName + | _ -> usedNames + | FSharpImplementationFileDeclaration.InitAction _ -> usedNames) - checkMemberNames com rootDecls - transformDeclarationsInner com ctx rootDecls +let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = + fsDecls |> List.collect (fun fsDecl -> + match fsDecl with + | FSharpImplementationFileDeclaration.Entity(ent, sub) -> + if isErasedOrStringEnumEntity ent then [] + elif ent.IsFSharpUnion || isRecordLike ent then + let entityName = getEntityDeclarationName com ent + // TODO: Check Equality/Comparison attributes + let r = getEntityLocation ent |> makeRange + Fable.ConstructorInfo(ent, entityName, isPublicEntity ent, ent.IsFSharpUnion, r) + |> Fable.CompilerGeneratedConstructorDeclaration + |> List.singleton + else + transformDeclarations com { ctx with EnclosingEntity = Some ent } sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(meth, args, body) -> + transformMemberDecl com ctx meth args body + | FSharpImplementationFileDeclaration.InitAction fe -> + let ctx = { ctx with UseNamesInDeclarationScope = HashSet() } + let e = transformExpr com ctx fe |> run + [Fable.ActionDeclaration(e, set ctx.UseNamesInDeclarationScope)]) let private getRootModuleAndDecls decls = let rec getRootModuleAndDeclsInner outerEnt decls = @@ -1087,18 +1078,10 @@ let private tryGetMemberArgsAndBody com (implFiles: IDictionary None type FableCompiler(com: ICompiler, implFiles: IDictionary) = - member val UsedVarNames = HashSet() member val InlineDependencies = HashSet() member val NonMangledAttachedMemberNames = Dictionary>() member __.Options = com.Options - member this.AddUsedVarName(varName, ?isRoot) = - let isRoot = defaultArg isRoot false - let success = this.UsedVarNames.Add(varName) - if not success && isRoot then - sprintf "Cannot have two module members with same name: %s" varName - |> addError com [] None - member __.AddInlineExpr(memb, inlineExpr: InlineExpr) = let fullName = getMemberUniqueName com memb com.GetOrAddInlineExpr(fullName, fun () -> inlineExpr) |> ignore @@ -1145,12 +1128,6 @@ type FableCompiler(com: ICompiler, implFiles: IDictionary Some f | false, _ -> None - member this.AddUsedVarName(varName, ?isRoot) = - this.AddUsedVarName(varName, ?isRoot=isRoot) - - member this.IsUsedVarName(varName) = - this.UsedVarNames.Contains(varName) - member this.AddInlineDependency(fileName) = this.InlineDependencies.Add(fileName) |> ignore @@ -1158,8 +1135,6 @@ type FableCompiler(com: ICompiler, implFiles: IDictionary "" let transformFile (com: ICompiler) (implFiles: IDictionary) = - try - let file = - match implFiles.TryGetValue(com.CurrentFile) with - | true, file -> file - | false, _ -> - let projFiles = implFiles |> Seq.map (fun kv -> kv.Key) |> String.concat "\n" - failwithf "File %s cannot be found in source list:\n%s" com.CurrentFile projFiles - let rootEnt, rootDecls = getRootModuleAndDecls file.Declarations - let fcom = FableCompiler(com, implFiles) - let ctx = Context.Create(rootEnt) - let rootDecls = transformDeclarations fcom ctx rootDecls - Fable.File(com.CurrentFile, rootDecls, set fcom.UsedVarNames, set fcom.InlineDependencies) - with - | ex -> exn (sprintf "%s (%s)" ex.Message com.CurrentFile, ex) |> raise + let file = + match implFiles.TryGetValue(com.CurrentFile) with + | true, file -> file + | false, _ -> + let projFiles = implFiles |> Seq.map (fun kv -> kv.Key) |> String.concat "\n" + failwithf "File %s cannot be found in source list:\n%s" com.CurrentFile projFiles + let rootEnt, rootDecls = getRootModuleAndDecls file.Declarations + let fcom = FableCompiler(com, implFiles) + let usedRootNames = getUsedRootNames com Set.empty rootDecls + let ctx = Context.Create(rootEnt, usedRootNames) + let rootDecls = transformDeclarations fcom ctx rootDecls + Fable.File(com.CurrentFile, rootDecls, usedRootNames, set fcom.InlineDependencies) diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index a42db1be9..4d94d680f 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -23,8 +23,14 @@ type ITailCallOpportunity = abstract Args: string list abstract IsRecursiveRef: Fable.Expr -> bool +type UsedNames = + { RootScope: HashSet + DeclarationScopes: HashSet[] + CurrentDeclarationScope: HashSet } + type Context = { File: Fable.File + UsedNames: UsedNames DecisionTargets: (Fable.Ident list * Fable.Expr) list HoistVars: Fable.Ident list -> bool TailCallOpportunity: ITailCallOpportunity option @@ -58,13 +64,28 @@ module Util = match args with | [] -> [] | [unitArg] when unitArg.Type = Fable.Unit -> [] - | [thisArg; unitArg] when thisArg.IsThisArgDeclaration && unitArg.Type = Fable.Unit -> [thisArg] + | [thisArg; unitArg] when thisArg.IsThisArgIdent && unitArg.Type = Fable.Unit -> [thisArg] | args -> args - type NamedTailCallOpportunity(com: ICompiler, name, args: Fable.Ident list) = + let getUniqueNameInRootScope (ctx: Context) name = + let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> + ctx.UsedNames.RootScope.Contains(name) + || ctx.UsedNames.DeclarationScopes |> Array.exists (fun s -> s.Contains(name))) + ctx.UsedNames.RootScope.Add(name) |> ignore + name + + let getUniqueNameInDeclarationScope (ctx: Context) name = + let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> + ctx.UsedNames.RootScope.Contains(name) || ctx.UsedNames.CurrentDeclarationScope.Contains(name)) + ctx.UsedNames.CurrentDeclarationScope.Add(name) |> ignore + name + + type NamedTailCallOpportunity(com: ICompiler, ctx, name, args: Fable.Ident list) = // Capture the current argument values to prevent delayed references from getting corrupted, // for that we use block-scoped ES2015 variable declarations. See #681, #1859 - let argIds = discardUnitArg args |> List.map (fun arg -> com.GetUniqueVar(arg.Name)) + // TODO: Local unique ident names + let argIds = discardUnitArg args |> List.map (fun arg -> + getUniqueNameInDeclarationScope ctx (arg.Name + "_mut")) interface ITailCallOpportunity with member __.Label = name member __.Args = argIds @@ -247,7 +268,7 @@ module Util = RestElement(toPattern var, ?typeAnnotation=var.TypeAnnotation) :> PatternNode |> U2.Case1 let callSuperConstructor r (args: Expression list) = - CallExpression(Super(?loc=r), List.toArray args, ?loc=r) :> Expression + CallExpression(Super(), List.toArray args, ?loc=r) :> Expression let callFunction r funcExpr (args: Expression list) = CallExpression(funcExpr, List.toArray args, ?loc=r) :> Expression @@ -483,33 +504,18 @@ module Util = args', body', None, None type MemberKind = - | ClassConstructor of thisArg: Fable.Ident + | ClassConstructor | NonAttached of funcName: string | Attached let getMemberArgsAndBody (com: IBabelCompiler) ctx kind hasSpread (args: Fable.Ident list) (body: Fable.Expr) = - // Bind `this` keyword to prevent problems with function closures and object expressions - let bindThisKeyword (thisArg: Fable.Ident) args body = - let genTypeParams = Set.difference (getGenericTypeParams [thisArg.Type]) ctx.ScopedTypeParams - let mutable foundClosures = false // Including object expressions - let body = - body |> FableTransforms.visitFromOutsideInWithContinueFlag (function - | Fable.IdentExpr id when id.Name = thisArg.Name -> - false, { id with Name="this" } |> Fable.IdentExpr |> Some - | Fable.Function _ - | Fable.ObjectExpr _ -> - foundClosures <- true - false, None - | _ -> true, None) - if foundClosures then - let boundThisExpr = { thisArg with Name = "this" } |> Fable.IdentExpr - None, genTypeParams, args, Fable.Let([thisArg, boundThisExpr], body) - else None, genTypeParams, args, body - let funcName, genTypeParams, args, body = match kind, args with - | Attached, (thisArg::args) -> bindThisKeyword thisArg args body - | ClassConstructor thisArg, _ -> bindThisKeyword thisArg args body + | Attached, (thisArg::args) -> + let genTypeParams = Set.difference (getGenericTypeParams [thisArg.Type]) ctx.ScopedTypeParams + let body = Fable.Let([thisArg, Fable.IdentExpr { thisArg with Name = "this" }], body) + None, genTypeParams, args, body + | ClassConstructor, _ -> None, ctx.ScopedTypeParams, args, body | NonAttached funcName, _ -> Some funcName, Set.empty, args, body | _ -> None, Set.empty, args, body @@ -574,14 +580,15 @@ module Util = | Fable.IdentExpr i -> argId = i.Name | _ -> false)) let tempVars = - if found - then Map.add argId (com.GetUniqueVar(argId)) tempVars + if found then + let tempVarName = getUniqueNameInDeclarationScope ctx (argId + "_tmp") + Map.add argId tempVarName tempVars else tempVars checkCrossRefs tempVars allArgs rest ctx.OptimizeTailCall() let zippedArgs = List.zip tc.Args args let tempVars = checkCrossRefs Map.empty args zippedArgs - let tempVarReplacements = tempVars |> Map.map (fun _ v -> makeIdentExprNonMangled v) + let tempVarReplacements = tempVars |> Map.map (fun _ v -> makeIdentExpr v) [| // First declare temp variables for (KeyValue(argId, tempVar)) in tempVars do @@ -763,7 +770,8 @@ module Util = let generics = generics |> List.map (transformTypeInfo com ctx r genMap) |> List.toArray /// Check if the entity is actually declared in JS code if ent.IsInterface - || FSharp2Fable.Util.isErasedOrStringEnumOrGlobalOrImportedEntity ent + || FSharp2Fable.Util.isErasedOrStringEnumEntity ent + || FSharp2Fable.Util.isGlobalOrImportedEntity ent // TODO: Get reflection info from types in precompiled libs || FSharp2Fable.Util.isReplacementCandidate ent then genericEntity ent generics @@ -792,6 +800,9 @@ module Util = let transformValue (com: IBabelCompiler) (ctx: Context) r value: Expression = match value with + | Fable.BaseValue(None,_) -> upcast Super() + | Fable.BaseValue(Some boundIdent,_) -> identAsExpr boundIdent + | Fable.ThisValue _ -> upcast ThisExpression() | Fable.TypeInfo t -> transformTypeInfo com ctx r Map.empty t | Fable.Null _t -> // if com.Options.typescript @@ -938,15 +949,6 @@ module Util = | Fable.Call(callee, callInfo) -> let args = transformCallArgs com ctx callInfo.HasSpread callInfo.Args match callee, callInfo.ThisArg with - // When calling a virtual method with default implementation from base class, - // compile it as: `BaseClass.prototype.Foo.call(this, ...args)` (see #701) - | Fable.Get(Fable.IdentExpr(IdentType(Fable.DeclaredType(baseEntity, _)) as baseIdent), - Fable.ExprGet membExpr,_,_), _ when baseIdent.IsBaseValue -> - let baseClassExpr = jsConstructor com ctx baseEntity - let baseProtoMember = - com.TransformAsExpr(ctx, membExpr) - |> getExpr None (get None baseClassExpr "prototype") - callFunctionWithThisContext range baseProtoMember args | TransformExpr com ctx callee, None when callInfo.IsJsConstructor -> upcast NewExpression(callee, List.toArray args, ?loc=range) | TransformExpr com ctx callee, Some(TransformExpr com ctx thisArg) -> @@ -1012,22 +1014,18 @@ module Util = | statements -> IfStatement(guardExpr, thenStmnt, BlockStatement statements, ?loc=r) let transformGet (com: IBabelCompiler) ctx range typ fableExpr (getKind: Fable.GetKind) = + let fableExpr = + match fableExpr with + // If we're accessing a virtual member with default implementation (see #701) + // from base class, we can use `super` in JS so we don't need the bound this arg + | Fable.Value(Fable.BaseValue(_,t), r) -> Fable.Value(Fable.BaseValue(None, t), r) + | _ -> fableExpr let expr = com.TransformAsExpr(ctx, fableExpr) match getKind with | Fable.ExprGet(TransformExpr com ctx prop) -> getExpr range expr prop | Fable.ListHead -> get range expr "head" | Fable.ListTail -> get range expr "tail" - | Fable.FieldGet(fieldName,_,_) -> - let expr = - match fableExpr with - // When calling a virtual property with default implementation from base class, - // compile it as: `BaseClass.prototype.Foo` (see #701) - | Fable.IdentExpr(IdentType(Fable.DeclaredType(baseEntity, _)) as thisIdent) - when thisIdent.IsBaseValue -> - let baseClassExpr = jsConstructor com ctx baseEntity - get None baseClassExpr "prototype" - | _ -> expr - get range expr fieldName + | Fable.FieldGet(fieldName,_,_) -> get range expr fieldName | Fable.TupleGet index -> getExpr range expr (ofInt index) | Fable.OptionValue -> if mustWrapOption typ || com.Options.typescript @@ -1307,8 +1305,8 @@ module Util = /// and another to execute the actual target let transformDecisionTreeWithTwoSwitches (com: IBabelCompiler) ctx returnStrategy (targets: (Fable.Ident list * Fable.Expr) list) treeExpr = - // Declare $target and bound idents - let targetId = makeIdentUnique com "target" + // Declare target and bound idents + let targetId = getUniqueNameInDeclarationScope ctx "pattern_matching_result" |> makeIdent let multiVarDecl = let boundIdents = targets |> List.collect (fun (idents,_) -> idents |> List.map (fun id -> typedIdent com ctx id, None)) @@ -1556,7 +1554,7 @@ module Util = let transformFunction com ctx name (args: Fable.Ident list) (body: Fable.Expr) = let tailcallChance = Option.map (fun name -> - NamedTailCallOpportunity(com, name, args) :> ITailCallOpportunity) name + NamedTailCallOpportunity(com, ctx, name, args) :> ITailCallOpportunity) name let args = discardUnitArg args |> List.map (typedIdent com ctx) let declaredVars = ResizeArray() let mutable isTailCallOptimized = false @@ -1815,10 +1813,6 @@ module Util = InterfaceDeclaration(id, body, ?extends_=extends, ?typeParameters=typeParamDecl, ?loc=r) let declareObjectType (com: IBabelCompiler) ctx r isPublic (ent: FSharpEntity) name (consArgs: Pattern[]) (consBody: BlockStatement) (baseExpr: Expression option) = - let displayName = - ent.TryGetFullDisplayName() - |> Option.map (Naming.unsafeReplaceIdentForbiddenChars '_') - |> Option.defaultValue name let consArgs, returnType, typeParamDecl = if com.Options.typescript then let genParams = getEntityGenParams ent @@ -1830,7 +1824,7 @@ module Util = consArgs, returnType, typeParamDecl else consArgs, None, None - let consFunction = makeFunctionExpression (Some displayName) (consArgs, U2.Case1 consBody, returnType, typeParamDecl) + let consFunction = makeFunctionExpression None (consArgs, U2.Case1 consBody, returnType, typeParamDecl) match baseExpr with | Some e -> [|consFunction; e|] | None -> [|consFunction|] @@ -1870,7 +1864,7 @@ module Util = then declareClassType com ctx r isPublic ent name consArgs consBody baseExpr else declareObjectType com ctx r isPublic ent name consArgs consBody baseExpr let reflectionDeclaration = - let genArgs = Array.init ent.GenericParameters.Count (fun _ -> makeIdentUnique com "gen" |> typedIdent com ctx) + let genArgs = Array.init ent.GenericParameters.Count (fun i -> "gen" + string i |> makeIdent |> typedIdent com ctx) let body = transformReflectionInfo com ctx r ent (Array.map (fun x -> x :> _) genArgs) let returnType = if com.Options.typescript then @@ -1879,7 +1873,7 @@ module Util = else None let args = genArgs |> Array.map toPattern makeFunctionExpression None (args, U2.Case2 body, returnType, None) - |> declareModuleMember None isPublic (Naming.appendSuffix name Naming.reflectionSuffix) false + |> declareModuleMember None isPublic (name + Naming.reflectionSuffix) false if com.Options.typescript then // && not (com.Options.classTypes && (ent.IsFSharpUnion || ent.IsFSharpRecord)) then let interfaceDecl = makeInterfaceDecl com ctx r ent name baseExpr let interfaceDeclaration = ExportNamedDeclaration(interfaceDecl) :> ModuleDeclaration |> U2.Case2 @@ -2016,7 +2010,7 @@ module Util = let transformImplicitConstructor (com: IBabelCompiler) ctx (info: Fable.ClassImplicitConstructorInfo) = let consIdent = Identifier(info.EntityName) :> Expression let args, body, returnType, typeParamDecl = - getMemberArgsAndBody com ctx (ClassConstructor info.BoundThis) info.HasSpread info.Arguments info.Body + getMemberArgsAndBody com ctx ClassConstructor info.HasSpread info.Arguments info.Body let returnType, typeParamDecl = // change constructor's return type from void to entity type @@ -2077,11 +2071,15 @@ module Util = yield declareModuleMember info.Range info.IsConstructorPublic info.ConstructorName false exposedCons ] - let rec transformDeclaration (com: IBabelCompiler) ctx = function - | Fable.ActionDeclaration e -> + let rec transformDeclaration (com: IBabelCompiler) ctx i decl = + let usedNames = { ctx.UsedNames with CurrentDeclarationScope = ctx.UsedNames.DeclarationScopes.[i] } + let ctx = { ctx with UsedNames = usedNames } + + match decl with + | Fable.ActionDeclaration(e,_) -> transformAction com ctx e - | Fable.ModuleMemberDeclaration(args, body, info) -> + | Fable.ModuleMemberDeclaration(args, body, info, _) -> if info.IsValue then let isPublic, isMutable, value = // Mutable public values must be compiled as functions (see #986) @@ -2093,14 +2091,14 @@ module Util = else [transformModuleFunction com ctx info args body] - | Fable.ClassImplicitConstructorDeclaration info -> + | Fable.ClassImplicitConstructorDeclaration(info, _) -> transformImplicitConstructor com ctx info | Fable.CompilerGeneratedConstructorDeclaration info -> if info.IsUnion then transformUnionConstructor com ctx info else transformCompilerGeneratedConstructor com ctx info - | Fable.AttachedMemberDeclaration(args, body, info, e) -> + | Fable.AttachedMemberDeclaration(args, body, info, e, _) -> if info.IsGetter || info.IsSetter then transformAttachedProperty com ctx info e args body else @@ -2145,17 +2143,14 @@ module Util = :> ModuleDeclaration |> U2.Case2 |> Some)) |> Seq.toList - let getLocalIdent (ctx: Context) (imports: Dictionary) (path: string) (selector: string) = - match selector with - | "" -> None - | "*" | "default" -> - let x = path.TrimEnd('/') - x.Substring(x.LastIndexOf '/' + 1) |> Some - | selector -> Some selector - |> Option.map (fun selector -> - (selector, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun s -> - ctx.File.UsedVarNames.Contains s - || (imports.Values |> Seq.exists (fun i -> i.LocalIdent = Some s)))) + let getIdentForImport (ctx: Context) (path: string) (selector: string) = + if System.String.IsNullOrEmpty selector then None + else + match selector with + | "*" | "default" -> Path.GetFileNameWithoutExtension(path) + | _ -> selector + |> getUniqueNameInRootScope ctx + |> Some module Compiler = open Util @@ -2177,7 +2172,7 @@ module Compiler = | Some localIdent -> upcast Identifier(localIdent) | None -> upcast NullLiteral () | false, _ -> - let localId = getLocalIdent ctx imports path selector + let localId = getIdentForImport ctx path selector let i = { Selector = if selector = Naming.placeholder @@ -2200,7 +2195,6 @@ module Compiler = member __.Options = com.Options member __.LibraryDir = com.LibraryDir member __.CurrentFile = com.CurrentFile - member __.GetUniqueVar(name) = com.GetUniqueVar(?name=name) member __.GetRootModule(fileName) = com.GetRootModule(fileName) member __.GetOrAddInlineExpr(fullName, generate) = com.GetOrAddInlineExpr(fullName, generate) member __.AddLog(msg, severity, ?range, ?fileName:string, ?tag: string) = @@ -2219,22 +2213,25 @@ module Compiler = Program(facadeFile, decls, sourceFiles_ = sourceFiles) let transformFile (com: ICompiler) (file: Fable.File) = - try - // let t = PerfTimer("Fable > Babel") - let com = makeCompiler com :> IBabelCompiler - let ctx = - { File = file - DecisionTargets = [] - HoistVars = fun _ -> false - TailCallOpportunity = None - OptimizeTailCall = fun () -> () - ScopedTypeParams = Set.empty } - let rootDecls = List.collect (transformDeclaration com ctx) file.Declarations - let importDecls = com.GetAllImports() |> transformImports - let body = importDecls @ rootDecls |> List.toArray - // We don't add imports as dependencies because those will be handled by Webpack - // TODO: Do it for other clients, like fable-splitter? - let dependencies = Array.ofSeq file.InlineDependencies - Program(file.SourcePath, body, dependencies_ = dependencies) - with - | ex -> exn (sprintf "%s (%s)" ex.Message file.SourcePath, ex) |> raise + let com = makeCompiler com :> IBabelCompiler + // Because we will need unique names for imports which can appear in any member, + // just collect all used names in the file to check for name conflicts + let usedGlobalNames = (file.UseNamesInRootScope, file.Declarations) + ||> List.fold (fun acc decl -> Set.union acc decl.UsedNames) + let ctx = + { File = file + UsedNames = { RootScope = HashSet file.UseNamesInRootScope + DeclarationScopes = file.Declarations |> List.mapToArray (fun d -> HashSet d.UsedNames) + CurrentDeclarationScope = Unchecked.defaultof<_> } + DecisionTargets = [] + HoistVars = fun _ -> false + TailCallOpportunity = None + OptimizeTailCall = fun () -> () + ScopedTypeParams = Set.empty } + let rootDecls = List.collecti (transformDeclaration com ctx) file.Declarations + let importDecls = com.GetAllImports() |> transformImports + let body = importDecls @ rootDecls |> List.toArray + // We don't add imports as dependencies because those will be handled by Webpack + // TODO: Do it for other clients, like fable-splitter? + let dependencies = Array.ofSeq file.InlineDependencies + Program(file.SourcePath, body, dependencies_ = dependencies) diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 039a6055b..dedba48d2 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -12,6 +12,7 @@ let visit f e = | Import(e1, e2, kind, t, r) -> Import(f e1, f e2, kind, t, r) | Value(kind, r) -> match kind with + | ThisValue _ | BaseValue _ | TypeInfo _ | Null _ | UnitConstant | BoolConstant _ | CharConstant _ | StringConstant _ | NumberConstant _ | RegexConstant _ -> e @@ -94,18 +95,13 @@ let rec visitFromOutsideIn (f: Expr->Expr option) e = | Some e -> e | None -> visit (visitFromOutsideIn f) e -let rec visitFromOutsideInWithContinueFlag f e = - match f e with - | _, Some e -> e - | true, None -> visit (visitFromOutsideInWithContinueFlag f) e - | false, None -> e - let getSubExpressions = function | IdentExpr _ | Debugger _ -> [] | TypeCast(e,_) -> [e] | Import(e1,e2,_,_,_) -> [e1;e2] | Value(kind,_) -> match kind with + | ThisValue _ | BaseValue _ | TypeInfo _ | Null _ | UnitConstant | BoolConstant _ | CharConstant _ | StringConstant _ | NumberConstant _ | RegexConstant _ -> [] @@ -531,20 +527,20 @@ let optimizations = let transformExpr (com: ICompiler) e = List.fold (fun e f -> f com e) e optimizations -let rec transformDeclaration (com: ICompiler) = function - | ActionDeclaration expr -> - ActionDeclaration(transformExpr com expr) - | ModuleMemberDeclaration(args, body, info) -> +let transformDeclaration (com: ICompiler) = function + | ActionDeclaration(expr, usedNames) -> + ActionDeclaration(transformExpr com expr, usedNames) + | ModuleMemberDeclaration(args, body, info, usedNames) -> let body = if info.IsValue then body else uncurryIdentsAndReplaceInBody args body - ModuleMemberDeclaration(args, transformExpr com body, info) - | AttachedMemberDeclaration(args, body, info, e) -> + ModuleMemberDeclaration(args, transformExpr com body, info, usedNames) + | AttachedMemberDeclaration(args, body, info, e, usedNames) -> let body = if info.IsMethod then uncurryIdentsAndReplaceInBody args body else body - AttachedMemberDeclaration(args, transformExpr com body, info, e) - | ClassImplicitConstructorDeclaration info -> + AttachedMemberDeclaration(args, transformExpr com body, info, e, usedNames) + | ClassImplicitConstructorDeclaration(info, usedNames) -> let baseCall, body = match info.BaseCall with | Some baseCall -> @@ -558,10 +554,9 @@ let rec transformDeclaration (com: ICompiler) = function | body -> None, body // Unexpected, raise error? | None -> None, uncurryIdentsAndReplaceInBody info.Arguments info.Body |> transformExpr com - info.WithBodyAndBaseCall(body, baseCall) - |> ClassImplicitConstructorDeclaration + ClassImplicitConstructorDeclaration(info.WithBodyAndBaseCall(body, baseCall), usedNames) | CompilerGeneratedConstructorDeclaration _ as d -> d let transformFile (com: ICompiler) (file: File) = let newDecls = List.map (transformDeclaration com) file.Declarations - File(file.SourcePath, newDecls, usedVarNames=file.UsedVarNames, inlineDependencies=file.InlineDependencies) + File(file.SourcePath, newDecls, usedRootNames=file.UseNamesInRootScope, inlineDependencies=file.InlineDependencies) diff --git a/src/Fable.Transforms/Global/Compiler.fs b/src/Fable.Transforms/Global/Compiler.fs index bfad2cb51..d24c00c5c 100644 --- a/src/Fable.Transforms/Global/Compiler.fs +++ b/src/Fable.Transforms/Global/Compiler.fs @@ -37,7 +37,6 @@ type ICompiler = abstract LibraryDir: string abstract CurrentFile: string abstract Options: CompilerOptions - abstract GetUniqueVar: ?name: string -> string abstract GetRootModule: string -> string abstract GetOrAddInlineExpr: string * (unit->InlineExpr) -> InlineExpr abstract AddLog: msg:string * severity: Severity * ?range:SourceLocation diff --git a/src/Fable.Transforms/Global/Prelude.fs b/src/Fable.Transforms/Global/Prelude.fs index f81375b96..6b8da97c8 100644 --- a/src/Fable.Transforms/Global/Prelude.fs +++ b/src/Fable.Transforms/Global/Prelude.fs @@ -78,6 +78,10 @@ module List = xs.[xs.Length - 1 ] <- f xs.[xs.Length - 1 ] List.ofArray xs + let collecti (f: int -> 'a -> 'b list) (xs: 'a list) = + let mutable i = -1 + xs |> List.collect (fun x -> i <- i + 1; f i x) + let mapToArray (f: 'a -> 'b) (xs: 'a list) = let ar: 'b[] = List.length xs |> Array.zeroCreate xs |> List.iteri (fun i x -> ar.[i] <- f x) @@ -128,20 +132,19 @@ module Naming = let umdModules = set ["commonjs"; "amd"; "umd"] - // Dollar sign is reserved by Fable as a special character - // to encode other characters, unique var names and as a separator let isIdentChar index (c: char) = let code = int c - c = '_' + c = '_' || c = '$' || (65 <= code && code <= 90) // a-z || (97 <= code && code <= 122) // A-Z // Digits are not allowed in first position, see #1397 || (index > 0 && 48 <= code && code <= 57) // 0-9 let hasIdentForbiddenChars (ident: string) = - let mutable i = 0 - while i < ident.Length && (isIdentChar i ident.[i]) do i <- i + 1 - i < ident.Length + let mutable found = false + for i = 0 to ident.Length - 1 do + found <- found || not(isIdentChar i ident.[i]) + found let sanitizeIdentForbiddenChars (ident: string) = if hasIdentForbiddenChars ident then @@ -154,10 +157,6 @@ module Naming = }) else ident - /// Does not guarantee unique names, only used to clean function constructor names - let unsafeReplaceIdentForbiddenChars (replacement: char) (ident: string): string = - ident.ToCharArray() |> Array.mapi (fun i c -> if isIdentChar i c then c else replacement) |> System.String - let removeGetSetPrefix (s: string) = if s.StartsWith("get_") || s.StartsWith("set_") then s.Substring(4) @@ -192,58 +191,221 @@ module Naming = let jsKeywords = System.Collections.Generic.HashSet [ - // See https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Lexical_grammar#Keywords - "abstract"; "await"; "boolean"; "break"; "byte"; "case"; "catch"; "char"; "class"; "const"; "continue"; "debugger"; "default"; "delete"; "do"; "double"; - "else"; "enum"; "export"; "extends"; "false"; "final"; "finally"; "float"; "for"; "function"; "goto"; "if"; "implements"; "import"; "in"; "instanceof"; "int"; "interface"; - "let"; "long"; "native"; "new"; "null"; "package"; "private"; "protected"; "public"; "return"; "self"; "short"; "static"; "super"; "switch"; "synchronized"; - "this"; "throw"; "throws"; "transient"; "true"; "try"; "typeof"; "undefined"; "var"; "void"; "volatile"; "while"; "with"; "yield"; - // Standard built-in objects (https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Global_Objects) - "Object"; "Function"; "Boolean"; "Symbol"; "Map"; "Set"; "NaN"; "Number"; "Math"; "Date"; "String"; "RegExp"; "JSON"; "Promise"; - "Array"; "Int8Array"; "Uint8Array"; "Uint8ClampedArray"; "Int16Array"; "Uint16Array"; "Int32Array"; "Uint32Array"; "Float32Array"; "Float64Array"; - // DOM interfaces (https://developer.mozilla.org/en-US/docs/Web/API/Document_Object_Model) - "Attr"; "CharacterData"; "Comment"; "CustomEvent"; "Document"; "DocumentFragment"; "DocumentType"; "DOMError"; "DOMException"; "DOMImplementation"; - "DOMString"; "DOMTimeStamp"; "DOMSettableTokenList"; "DOMStringList"; "DOMTokenList"; "Element"; "Event"; "EventTarget"; "Error"; "HTMLCollection"; "MutationObserver"; - "MutationRecord"; "Node"; "NodeFilter"; "NodeIterator"; "NodeList"; "ProcessingInstruction"; "Range"; "Text"; "TreeWalker"; "URL"; "Window"; "Worker"; "XMLDocument"; - // Other JS global and special objects/functions - // See #258, #1358 - // See https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API - // See https://twitter.com/FableCompiler/status/930725972629913600 - "arguments"; "fetch"; "eval"; "window"; "console"; "global"; "document" + // Keywords: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Lexical_grammar#Keywords + "break" + "case" + "catch" + "class" + "const" + "continue" + "debugger" + "default" + "delete" + "do" + "else" + "export" + "extends" + "finally" + "for" + "function" + "if" + "import" + "in" + "instanceof" + "new" + "return" + "super" + "switch" + "this" + "throw" + "try" + "typeof" + "var" + "void" + "while" + "with" + "yield" + + "enum" + + "implements" + "interface" + "let" + "package" + "private" + "protected" + "public" + "static" + + "await" + + "null" + "true" + "false" + "arguments" + "get" + "set" + + // Standard built-in objects: https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Global_Objects + "Infinity" + "NaN" + "undefined" + "globalThis" + + "eval" + "uneval" + "isFinite" + "isNaN" + "parseFloat" + "parseInt" + "decodeURI" + "decodeURIComponent" + "encodeURI" + "encodeURIComponent" + + "Object" + "Function" + "Boolean" + "Symbol" + + "Error" + "AggregateError" + "EvalError" + "InternalError" + "RangeError" + "ReferenceError" + "SyntaxError" + "TypeError" + "URIError" + + "Number" + "BigInt" + "Math" + "Date" + + "String" + "RegExp" + + "Array" + "Int8Array" + "Uint8Array" + "Uint8ClampedArray" + "Int16Array" + "Uint16Array" + "Int32Array" + "Uint32Array" + "Float32Array" + "Float64Array" + "BigInt64Array" + "BigUint64Array" + + "Map" + "Set" + "WeakMap" + "WeakSet" + + "ArrayBuffer" + "SharedArrayBuffer" + "Atomics" + "DataView" + "JSON" + + "Promise" + "Generator" + "GeneratorFunction" + "AsyncFunction" + + "Reflect" + "Proxy" + + "Intl" + "WebAssembly" + + // DOM interfaces (omitting SVG): https://developer.mozilla.org/en-US/docs/Web/API/Document_Object_Model + "Attr" + "CDATASection" + "CharacterData" + "ChildNode" + "Comment" + "CustomEvent" + "Document" + "DocumentFragment" + "DocumentType" + "DOMError" + "DOMException" + "DOMImplementation" + "DOMString" + "DOMTimeStamp" + "DOMStringList" + "DOMTokenList" + "Element" + "Event" + "EventTarget" + "HTMLCollection" + "MutationObserver" + "MutationRecord" + "NamedNodeMap" + "Node" + "NodeFilter" + "NodeIterator" + "NodeList" + "NonDocumentTypeChildNode" + "ParentNode" + "ProcessingInstruction" + "Selection" + "Range" + "Text" + "TextDecoder" + "TextEncoder" + "TimeRanges" + "TreeWalker" + "URL" + "Window" + "Worker" + "XMLDocument" + + // Other JS global and special objects/functions. See #258, #1358 + "console" + "window" + "document" + "global" + "fetch" ] - // A dollar sign is used to prefix chars encoded in hexadecimal - // so use two as separator to prevent conflicts - // (see also `getUniqueName` and `buildName` below) - let preventConflicts conflicts name = - let rec check n = - let name = if n > 0 then name + "$$" + (string n) else name - if not (conflicts name) then name else check (n+1) - check 0 + let preventConflicts conflicts originalName = + let rec check originalName n = + let name = if n > 0 then originalName + "_" + (string n) else originalName + if not (conflicts name) then name else check originalName (n+1) + check originalName 0 + // TODO: Move this to FSharp2Fable.Util type MemberPart = | InstanceMemberPart of string * overloadSuffix: string | StaticMemberPart of string * overloadSuffix: string | NoMemberPart + member this.Replace(f: string -> string) = + match this with + | InstanceMemberPart(s, o) -> InstanceMemberPart(f s, o) + | StaticMemberPart(s, o) -> StaticMemberPart(f s, o) + | NoMemberPart -> this - let getUniqueName baseName (index: int) = - "$" + baseName + "$$" + string index - - let appendSuffix baseName suffix = - if suffix = "" - then baseName - else baseName + "$" + suffix + member this.OverloadSuffix = + match this with + | InstanceMemberPart(_,o) + | StaticMemberPart(_,o) -> o + | NoMemberPart -> "" - let reflectionSuffix = "reflection" + let reflectionSuffix = "$reflection" let private printPart sanitize separator part overloadSuffix = (if part = "" then "" else separator + (sanitize part)) + - (if overloadSuffix = "" then "" else "$$" + overloadSuffix) + (if overloadSuffix = "" then "" else "_" + overloadSuffix) let private buildName sanitize name part = (sanitize name) + (match part with - | InstanceMemberPart(s, i) -> printPart sanitize "$$" s i - | StaticMemberPart(s, i) -> printPart sanitize "$$$" s i + | InstanceMemberPart(s, i) -> printPart sanitize "__" s i + | StaticMemberPart(s, i) -> printPart sanitize "_" s i | NoMemberPart -> "") let buildNameWithoutSanitation name part = diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index da11eaa0a..834b9de76 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -51,8 +51,8 @@ type Helper = ?memb: string, ?isJsConstructor: bool, ?loc: SourceLocation) = let callee = match memb with - | Some memb -> getSimple (makeIdentExprNonMangled ident) memb - | None -> makeIdentExprNonMangled ident + | Some memb -> getSimple (makeIdentExpr ident) memb + | None -> makeIdentExpr ident let argTypes = defaultArg argTypes [] let info = makeSimpleCallInfo None args argTypes let info = @@ -62,7 +62,7 @@ type Helper = Operation(Call(callee, info), returnType, loc) static member GlobalIdent(ident: string, memb: string, typ: Type, ?loc: SourceLocation) = - get loc typ (makeIdentExprNonMangled ident) memb + get loc typ (makeIdentExpr ident) memb module Helpers = let inline makeType com t = @@ -105,7 +105,7 @@ module Helpers = Operation(BinaryOperation(BinaryEqual, expr, Value(Null Any, None)), Boolean, None) let error msg = - Helper.JsConstructorCall(makeIdentExprNonMangled "Error", Any, [msg]) + Helper.JsConstructorCall(makeIdentExpr "Error", Any, [msg]) let s txt = Value(StringConstant txt, None) @@ -591,8 +591,8 @@ let round (args: Expr list) = let arrayCons (com: ICompiler) genArg = match genArg with | Number numberKind when com.Options.typedArrays -> - getTypedArrayName com numberKind |> makeIdentExprNonMangled - | _ -> makeIdentExprNonMangled "Array" + getTypedArrayName com numberKind |> makeIdentExpr + | _ -> makeIdentExpr "Array" let toList returnType expr = Helper.CoreCall("List", "ofSeq", returnType, [expr]) @@ -806,8 +806,8 @@ and compareIf (com: ICompiler) r (left: Expr) (right: Expr) op = makeEqOp r comparison (makeIntConst 0) op and makeComparerFunction (com: ICompiler) typArg = - let x = makeTypedIdentUnique com typArg "x" - let y = makeTypedIdentUnique com typArg "y" + let x = makeTypedIdent typArg "x" + let y = makeTypedIdent typArg "y" let body = compare com None (IdentExpr x) (IdentExpr y) Function(Delegate [x; y], body, None) @@ -815,8 +815,8 @@ and makeComparer (com: ICompiler) typArg = objExpr ["Compare", makeComparerFunction com typArg] let makeEqualityComparer (com: ICompiler) typArg = - let x = makeTypedIdentUnique com typArg "x" - let y = makeTypedIdentUnique com typArg "y" + let x = makeTypedIdent typArg "x" + let y = makeTypedIdent typArg "y" let body = equals com None true (IdentExpr x) (IdentExpr y) let f = Function(Delegate [x; y], body, None) objExpr ["Equals", f @@ -887,8 +887,8 @@ let getOne (com: ICompiler) ctx (t: Type) = | _ -> makeIntConst 1 let makeAddFunction (com: ICompiler) ctx t = - let x = makeTypedIdentUnique com t "x" - let y = makeTypedIdentUnique com t "y" + let x = makeTypedIdent t "x" + let y = makeTypedIdent t "y" let body = applyOp com ctx None t Operators.addition [IdentExpr x; IdentExpr y] [t; t] [] Function(Delegate [x; y], body, None) @@ -900,8 +900,8 @@ let makeGenericAdder (com: ICompiler) ctx t = let makeGenericAverager (com: ICompiler) ctx t = let divideFn = - let x = makeTypedIdentUnique com t "x" - let i = makeTypedIdentUnique com (Number Int32) "i" + let x = makeTypedIdent t "x" + let i = makeTypedIdent (Number Int32) "i" let body = applyOp com ctx None t Operators.divideByInt [IdentExpr x; IdentExpr i] [t; Number Int32] [] Function(Delegate [x; i], body, None) objExpr [ @@ -957,7 +957,7 @@ let injectArg com (ctx: Context) r moduleName methName (genArgs: (string * Type) let tryEntityRef (com: Fable.ICompiler) (ent: FSharpEntity) = match ent.TryFullName with | Some(BuiltinDefinition BclDateTime) - | Some(BuiltinDefinition BclDateTimeOffset) -> makeIdentExprNonMangled "Date" |> Some + | Some(BuiltinDefinition BclDateTimeOffset) -> makeIdentExpr "Date" |> Some | Some(BuiltinDefinition BclTimer) -> makeCoreRef Any "default" "Timer" |> Some | Some(BuiltinDefinition BclInt64) | Some(BuiltinDefinition BclUInt64) -> makeCoreRef Any "default" "Long" |> Some @@ -974,7 +974,7 @@ let tryEntityRef (com: Fable.ICompiler) (ent: FSharpEntity) = // | Some(BuiltinDefinition FSharpSet _) -> fail "Set" // TODO: // | Some(BuiltinDefinition FSharpMap _) -> fail "Map" // TODO: | Some Types.matchFail -> makeCoreRef Any "MatchFailureException" "Types" |> Some - | Some Types.exception_ -> makeIdentExprNonMangled "Error" |> Some + | Some Types.exception_ -> makeIdentExpr "Error" |> Some | Some entFullName -> com.Options.precompiledLib |> Option.bind (fun tryLib -> tryLib entFullName) @@ -1084,7 +1084,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | Value(StringConstant "*",_) -> import | selector -> let selector = - let m = makeIdentNonMangled "m" + let m = makeIdent "m" Function(Delegate [m], Get(IdentExpr m, ExprGet selector, Any, None), None) Helper.InstanceCall(import, "then", t, [selector]) let arg = @@ -1177,7 +1177,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | "jsOptions", [arg] -> makePojoFromLambda arg |> Some | "jsThis", _ -> - makeTypedIdentNonMangled t "this" |> IdentExpr |> Some + makeTypedIdent t "this" |> IdentExpr |> Some | "jsConstructor", _ -> match (genArg com ctx r 0 i.GenericArgs) with | DeclaredType(ent, _) -> jsConstructor com ent |> Some @@ -1280,7 +1280,7 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o match t with | FunctionType(LambdaType argType, retType) -> argType, retType | _ -> Any, Any - let tempVar = makeTypedIdentUnique com argType "arg" + let tempVar = makeTypedIdent argType "arg" let tempVarExpr = match argType with // Erase unit references, because the arg may be erased @@ -1624,8 +1624,8 @@ let seqs (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp let info = makeSimpleCallInfo None [IdentExpr ident] [] Operation(Call(projection, info), genArg, None) | None -> IdentExpr ident - let x = makeTypedIdentUnique com genArg "x" - let y = makeTypedIdentUnique com genArg "y" + let x = makeTypedIdent genArg "x" + let y = makeTypedIdent genArg "y" let comparison = let comparison = compare com None (identExpr x) (identExpr y) if descending @@ -2282,7 +2282,7 @@ let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let exceptions (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg with - | ".ctor", _ -> Helper.JsConstructorCall(makeIdentExprNonMangled "Error", t, args, ?loc=r) |> Some + | ".ctor", _ -> Helper.JsConstructorCall(makeIdentExpr "Error", t, args, ?loc=r) |> Some | "get_Message", Some e -> get r t e "message" |> Some | "get_StackTrace", Some e -> get r t e "stack" |> Some | _ -> None diff --git a/src/Fable.Transforms/State.fs b/src/Fable.Transforms/State.fs index eaa2fba98..f56dabca0 100644 --- a/src/Fable.Transforms/State.fs +++ b/src/Fable.Transforms/State.fs @@ -48,7 +48,6 @@ type Log = /// Type with utilities for compiling F# files to JS /// Not thread-safe, an instance must be created per file type Compiler(currentFile, project: Project, options, fableLibraryDir: string) = - let mutable id = 0 let logs = ResizeArray() let fableLibraryDir = fableLibraryDir.TrimEnd('/') member __.GetLogs() = @@ -94,7 +93,3 @@ type Compiler(currentFile, project: Project, options, fableLibraryDir: string) = Range = range FileName = fileName } |> logs.Add - // TODO: If name includes `$$2` at the end, remove it - member __.GetUniqueVar(name) = - id <- id + 1 - Naming.getUniqueName (defaultArg name "var") id diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index 09aa7c905..5f02a3623 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -9,17 +9,16 @@ module Atts = let [] entryPoint = "Microsoft.FSharp.Core.EntryPointAttribute" // typeof.FullName let [] sealed_ = "Microsoft.FSharp.Core.SealedAttribute" // typeof.FullName let [] mangle = "Fable.Core.MangleAttribute" // typeof.FullName - let [] import = "Fable.Core.ImportAttribute" // typeof.FullName + let [] import = "Fable.Core.Import" let [] importAll = "Fable.Core.ImportAllAttribute" // typeof.FullName let [] importDefault = "Fable.Core.ImportDefaultAttribute" // typeof.FullName let [] importMember = "Fable.Core.ImportMemberAttribute" // typeof.FullName let [] global_ = "Fable.Core.GlobalAttribute" // typeof.FullName - let [] emit = "Fable.Core.EmitAttribute" // typeof.FullName - let [] emitMethod = "Fable.Core.EmitMethodAttribute" // typeof.FullName + let [] emit = "Fable.Core.Emit" + let [] emitMethod = "Fable.Core.EmitMethodAttribute" // typeof.FullName let [] emitConstructor = "Fable.Core.EmitConstructorAttribute" // typeof.FullName - let [] emitIndexer = "Fable.Core.EmitIndexerAttribute" // typeof.FullName - let [] emitProperty = "Fable.Core.EmitPropertyAttribute" // typeof.FullName - let [] emitDeclaration = "Fable.Core.EmitDeclarationAttribute" // typeof.FullName + let [] emitIndexer = "Fable.Core.EmitIndexerAttribute" // typeof.FullName + let [] emitProperty = "Fable.Core.EmitPropertyAttribute" // typeof.FullName let [] erase = "Fable.Core.EraseAttribute" // typeof.FullName let [] stringEnum = "Fable.Core.StringEnumAttribute" // typeof.FullName let [] paramList = "Fable.Core.ParamListAttribute" // typeof.FullName @@ -321,33 +320,25 @@ module AST = | Any | Unit | GenericParam _ | Option _ -> true | _ -> false - /// ATTENTION: Make sure the ident name will be unique within the file - let makeIdentNonMangled name = + /// ATTENTION: Make sure the ident name is unique + let makeIdent name = { Name = name Type = Any Kind = CompilerGenerated IsMutable = false Range = None } - /// Mangles ident name to prevent conflicts in the file - let makeIdentUnique (com: ICompiler) name = - com.GetUniqueVar(name) |> makeIdentNonMangled - - /// ATTENTION: Make sure the ident name will be unique within the file - let makeTypedIdentNonMangled typ name = + /// ATTENTION: Make sure the ident name is unique + let makeTypedIdent typ name = { Name = name Type = typ Kind = CompilerGenerated IsMutable = false Range = None } - /// Mangles ident name to prevent conflicts in the file - let makeTypedIdentUnique (com: ICompiler) typ name = - com.GetUniqueVar(name) |> makeTypedIdentNonMangled typ - - /// ATTENTION: Make sure the ident name will be unique within the file - let makeIdentExprNonMangled name = - makeIdentNonMangled name |> IdentExpr + /// ATTENTION: Make sure the ident name is unique + let makeIdentExpr name = + makeIdent name |> IdentExpr let makeLoop range loopKind = Loop (loopKind, range) diff --git a/src/quicktest/QuickTest.fs b/src/quicktest/QuickTest.fs index 23d8dfbdd..c92b734bd 100644 --- a/src/quicktest/QuickTest.fs +++ b/src/quicktest/QuickTest.fs @@ -58,3 +58,34 @@ let testCaseAsync msg f = // to Fable.Tests project. For example: // testCase "Addition works" <| fun () -> // 2 + 2 |> equal 4 + +let rec test x f = + match x with + | [] -> f x + | h::t -> test t (f << id) + +// base can be used in a constructor +// Can call a virtual member with default implementation in +// this can be used in a function in a constructor + + +[] +type A() = + abstract Value: int + default _.Value = 5 + +type B() = + inherit A() + let y = base.Value + override _.Value = y + 3 + + +type C() = + member _.Value = 4 + +type D() = + inherit C() + member _.Value = base.Value + 8 + +B().Value |> printfn "%i" +D().Value |> printfn "%i" \ No newline at end of file From bd55be4141540354988262670e435383ffe95a75 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Tue, 21 Jul 2020 14:18:02 +0900 Subject: [PATCH 3/8] Make Fable AST independent of FCS --- src/Fable.Core/Fable.Core.JsInterop.fs | 9 +- src/Fable.Core/Fable.Core.Types.fs | 12 +- src/Fable.Transforms/AST/AST.Fable.fs | 342 ++--- src/Fable.Transforms/FSharp2Fable.Util.fs | 614 ++++---- src/Fable.Transforms/FSharp2Fable.fs | 477 +++--- src/Fable.Transforms/Fable2Babel.fs | 1703 +++++++++++---------- src/Fable.Transforms/FableTransforms.fs | 285 ++-- src/Fable.Transforms/Global/Prelude.fs | 10 +- src/Fable.Transforms/Inject.fs | 14 +- src/Fable.Transforms/Replacements.fs | 1157 +++++++------- src/Fable.Transforms/Transforms.Util.fs | 128 +- 11 files changed, 2438 insertions(+), 2313 deletions(-) diff --git a/src/Fable.Core/Fable.Core.JsInterop.fs b/src/Fable.Core/Fable.Core.JsInterop.fs index c05e20edb..000318024 100644 --- a/src/Fable.Core/Fable.Core.JsInterop.fs +++ b/src/Fable.Core/Fable.Core.JsInterop.fs @@ -34,8 +34,13 @@ let (==>) (key: string) (v: obj): string*obj = jsNative let createNew (o: obj) (args: obj): obj = jsNative /// Destructure a tuple of arguments and applies to literal JS code as with EmitAttribute. -/// E.g. `emitJs "$0 + $1" (arg1, arg2)` in JS becomes `arg1 + arg2` -let emitJs (jsCode: string) (args: obj): 'T = jsNative +/// E.g. `emitJsExpr (arg1, arg2) "$0 + $1"` in JS becomes `arg1 + arg2` +let emitJsExpr (args: obj) (jsCode: string): 'T = jsNative + +/// Same as emitJsExpr but intended for JS code that must appear in a statement position +/// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements +/// E.g. `emitJsExpr aValue "while($0 < 5) doSomething()"` +let emitJsStatement (args: obj) (jsCode: string): 'T = jsNative /// Create a literal JS object from a collection of key-value tuples. /// E.g. `createObj [ "a" ==> 5 ]` in JS becomes `{ a: 5 }` diff --git a/src/Fable.Core/Fable.Core.Types.fs b/src/Fable.Core/Fable.Core.Types.fs index 11d35caeb..38978b64c 100644 --- a/src/Fable.Core/Fable.Core.Types.fs +++ b/src/Fable.Core/Fable.Core.Types.fs @@ -49,13 +49,16 @@ type ImportAllAttribute(from: string) = /// Function calls will be replaced by inlined JS code. /// More info: http://fable.io/docs/interacting.html#emit-attribute -type EmitAttribute(macro: string) = +type EmitAttribute(macro: string, ?isStatement: bool) = inherit Attribute() /// Same as `Emit("$0.methodName($1...)")` type EmitMethodAttribute(methodName: string) = inherit Attribute() +type TestAttribute(r: System.Text.RegularExpressions.Regex) = + inherit Attribute() + /// Same as `Emit("new $0($1...)")` type EmitConstructorAttribute() = inherit Attribute() @@ -75,13 +78,6 @@ type StringEnumAttribute() = inherit Attribute() new (caseRules: CaseRules) = StringEnumAttribute() -/// Used to spread the last argument. Mainly intended for `React.createElement` binding, not for general use. -[] -type ParamSeqAttribute() = - inherit Attribute() - -type ParamListAttribute = ParamSeqAttribute - /// Experimental: Currently only intended for some specific libraries [] type InjectAttribute() = diff --git a/src/Fable.Transforms/AST/AST.Fable.fs b/src/Fable.Transforms/AST/AST.Fable.fs index 892711114..f05aecce2 100644 --- a/src/Fable.Transforms/AST/AST.Fable.fs +++ b/src/Fable.Transforms/AST/AST.Fable.fs @@ -2,12 +2,11 @@ namespace rec Fable.AST.Fable open Fable open Fable.AST -open FSharp.Compiler.SourceCodeServices open System -type FunctionTypeKind = - | LambdaType of Type - | DelegateType of Type list +type DeclaredType = + abstract Definition: Entity + abstract GenericArgs: Type list type Type = | MetaType @@ -18,14 +17,15 @@ type Type = | String | Regex | Number of NumberKind - | Enum of FSharpEntity + | Enum of Entity | Option of genericArg: Type | Tuple of genericArgs: Type list | Array of genericArg: Type | List of genericArg: Type - | FunctionType of FunctionTypeKind * returnType: Type + | LambdaType of Type * returnType: Type + | DelegateType of Type list * returnType: Type | GenericParam of name: string - | DeclaredType of FSharpEntity * genericArgs: Type list + | DeclaredType of Entity * genericArgs: Type list | AnonymousRecordType of fieldNames: string [] * genericArgs: Type list member this.Generics = @@ -33,143 +33,114 @@ type Type = | Option gen | Array gen | List gen -> [ gen ] - | FunctionType (LambdaType argType, returnType) -> [ argType; returnType ] - | FunctionType (DelegateType argTypes, returnType) -> argTypes @ [ returnType ] + | LambdaType(argType, returnType) -> [ argType; returnType ] + | DelegateType(argTypes, returnType) -> argTypes @ [ returnType ] | Tuple gen -> gen | DeclaredType (_, gen) -> gen + | AnonymousRecordType (_, gen) -> gen | _ -> [] - member this.ReplaceGenerics(newGen: Type list) = - match this with - | Option _ -> Option newGen.Head - | Array _ -> Array newGen.Head - | List _ -> List newGen.Head - | FunctionType (LambdaType _, _) -> - let argTypes, returnType = List.splitLast newGen - FunctionType(LambdaType argTypes.Head, returnType) - | FunctionType (DelegateType _, _) -> - let argTypes, returnType = List.splitLast newGen - FunctionType(DelegateType argTypes, returnType) - | Tuple _ -> Tuple newGen - | DeclaredType (ent, _) -> DeclaredType(ent, newGen) - | t -> t - -type MemberInfo(name, ?declaringEntity, ?hasSpread, ?isValue, ?range) = - member _.Name: string = name - member _.IsValue = defaultArg isValue false - member _.HasSpread = defaultArg hasSpread false - member _.DeclaringEntity: FSharpEntity option = declaringEntity - member _.Range: SourceLocation option = range - -type ModuleMemberInfo(name, ?declaringEntity, ?hasSpread, ?isValue, ?isPublic, - ?isInstance, ?isMutable, ?isEntryPoint, ?range) = - inherit MemberInfo(name, ?declaringEntity=declaringEntity, ?hasSpread=hasSpread, ?isValue=isValue, ?range=range) - - member _.IsPublic = defaultArg isPublic false - member _.IsInstance = defaultArg isInstance false - member _.IsMutable = defaultArg isMutable false - member _.IsEntryPoint = defaultArg isEntryPoint false - -type AttachedMemberInfo(name, declaringEntity, ?hasSpread, ?isValue, - ?isGetter, ?isSetter, ?isEnumerator, ?range) = - inherit MemberInfo(name, ?declaringEntity=declaringEntity, ?hasSpread=hasSpread, ?isValue=isValue, ?range=range) - - member _.IsGetter = defaultArg isGetter false - member _.IsSetter = defaultArg isSetter false - member _.IsEnumerator = defaultArg isEnumerator false - - member this.IsMethod = - not this.IsValue && not this.IsGetter && not this.IsSetter && not this.IsEnumerator - -type ConstructorInfo(entity, entityName, ?isEntityPublic, ?isUnion, ?range) = - member _.Entity: FSharpEntity = entity - member _.EntityName: string = entityName - member _.IsEntityPublic = defaultArg isEntityPublic false - member _.IsUnion = defaultArg isUnion false - member _.Range: SourceLocation option = range - -type ClassImplicitConstructorInfo(entity, constructorName, entityName, - arguments, body, baseCall, ?hasSpread, - ?isConstructorPublic, ?isEntityPublic, ?range) = - inherit ConstructorInfo(entity, entityName, ?isEntityPublic=isEntityPublic, ?range=range) - - member _.ConstructorName: string = constructorName - member _.Arguments: Ident list = arguments - member _.Body: Expr = body - member _.BaseCall: Expr option = baseCall - member _.IsConstructorPublic = defaultArg isConstructorPublic false - member _.HasSpread = defaultArg hasSpread false - - member _.WithBodyAndBaseCall(body, baseCall) = - ClassImplicitConstructorInfo(entity, constructorName, entityName, arguments, - body, baseCall, ?hasSpread=hasSpread, ?isConstructorPublic=isConstructorPublic, - ?isEntityPublic=isEntityPublic, ?range=range) - -type UsedNames = Set +type Attribute = + abstract FullName: string + abstract ConstructorArguments: obj list + +type Field = + abstract Name: string + abstract FieldType: Type + abstract IsMutable: bool + abstract IsStatic: bool + abstract LiteralValue: obj option + +type UnionCase = + abstract Name: string + abstract CompiledName: string option + abstract UnionCaseFields: Field list + +type GenericParam = + abstract Name: string + +type Parameter = + abstract Name: string option + abstract Type: Type + +type MemberFunctionOrValue = + abstract DisplayName: string + abstract CompiledName: string + abstract FullName: string + abstract CurriedParameterGroups: Parameter list list + abstract ReturnParameter: Parameter + abstract IsExplicitInterfaceImplementation: bool + abstract ApparentEnclosingEntity: Entity + +type Entity = + abstract DisplayName: string + abstract FullName: string + abstract SourcePath: string + abstract AssemblyPath: string option + abstract Attributes: Attribute seq + abstract BaseDeclaration: DeclaredType option + abstract AllInterfaces: DeclaredType seq + abstract GenericParameters: GenericParam list + abstract MembersFunctionsAndValues: MemberFunctionOrValue seq + abstract FSharpFields: Field list + abstract UnionCases: UnionCase list + abstract IsPublic: bool + abstract IsFSharpUnion: bool + abstract IsFSharpRecord: bool + abstract IsValueType: bool + abstract IsFSharpExceptionDeclaration: bool + abstract IsInterface: bool + +type MemberDeclInfo = + abstract Attributes: Attribute seq + abstract HasSpread: bool + abstract IsPublic: bool + abstract IsInstance: bool + abstract IsValue: bool + abstract IsMutable: bool + abstract IsGetter: bool + abstract IsSetter: bool + abstract IsEnumerator: bool + abstract IsMangled: bool + +type MemberDecl = { + Ident: Ident + Args: Ident list + Body: Expr + UsedNames: Set + Info: MemberDeclInfo +} type Declaration = - | ActionDeclaration of Expr * UsedNames - /// Note: Non-attached type members become module members - | ModuleMemberDeclaration of args: Ident list * body: Expr * ModuleMemberInfo * UsedNames - /// Interface and abstract class implementations - | AttachedMemberDeclaration of args: Ident list * body: Expr * AttachedMemberInfo * declaringEntity: FSharpEntity * UsedNames - /// For unions, records and structs - | CompilerGeneratedConstructorDeclaration of ConstructorInfo - | ClassImplicitConstructorDeclaration of ClassImplicitConstructorInfo * UsedNames - + | ActionDeclaration of Expr * usedNames: Set + | MemberDeclaration of MemberDecl + | ClassDeclaration of Entity * Ident * constructor: MemberDecl option * baseCall: Expr option * attachedMembers: MemberDecl list member this.UsedNames = match this with - | ActionDeclaration(_,u) - | ModuleMemberDeclaration(_,_,_,u) - | AttachedMemberDeclaration(_,_,_,_,u) - | ClassImplicitConstructorDeclaration(_,u) -> u - | CompilerGeneratedConstructorDeclaration _ -> Set.empty + | ActionDeclaration(_, usedNames) -> usedNames + | MemberDeclaration m -> m.UsedNames + | ClassDeclaration(_,_,cons,_,attachedMembers) -> + let usedNames = match cons with Some c -> c.UsedNames | None -> Set.empty + (usedNames, attachedMembers) ||> List.fold (fun acc m -> Set.union acc m.UsedNames) type File(sourcePath, decls, ?usedRootNames, ?inlineDependencies) = member __.SourcePath: string = sourcePath member __.Declarations: Declaration list = decls - member __.UseNamesInRootScope: UsedNames = defaultArg usedRootNames Set.empty + member __.UsedNamesInRootScope: Set = defaultArg usedRootNames Set.empty member __.InlineDependencies: Set = defaultArg inlineDependencies Set.empty -type IdentKind = - | UserDeclared - | CompilerGenerated - | ThisArgIdent - type Ident = { Name: string Type: Type - Kind: IdentKind IsMutable: bool + IsThisArgument: bool + IsCompilerGenerated: bool Range: SourceLocation option } - member x.IsCompilerGenerated = - match x.Kind with - | CompilerGenerated -> true - | _ -> false - - member x.IsThisArgIdent = - match x.Kind with - | ThisArgIdent -> true - | _ -> false - member x.DisplayName = x.Range |> Option.bind (fun r -> r.identifierName) |> Option.defaultValue x.Name -type ImportKind = - | Internal - | Library - | CustomImport - -type NewArrayKind = - | ArrayValues of Expr list - | ArrayAlloc of Expr - -type NewRecordKind = - | DeclaredRecord of FSharpEntity - | AnonymousRecord of fieldNames: string [] - type ValueKind = // The AST from F# compiler is a bit inconsistent with ThisValue and BaseValue. // ThisValue only appears in constructors and not in instance members (where `this` is passed as first argument) @@ -184,13 +155,15 @@ type ValueKind = | StringConstant of string | NumberConstant of float * NumberKind | RegexConstant of source: string * flags: RegexFlag list - | EnumConstant of Expr * FSharpEntity + | EnumConstant of Expr * Entity | NewOption of value: Expr option * Type - | NewArray of NewArrayKind * Type + | NewArray of Expr list * Type + | NewArrayAlloc of Expr * Type | NewList of headAndTail: (Expr * Expr) option * Type | NewTuple of Expr list - | NewRecord of Expr list * NewRecordKind * genArgs: Type list - | NewUnion of Expr list * FSharpUnionCase * FSharpEntity * genArgs: Type list + | NewRecord of Expr list * Entity * genArgs: Type list + | NewAnonymousRecord of Expr list * fieldNames: string [] * genArgs: Type list + | NewUnion of Expr list * tag: int * Entity * genArgs: Type list member this.Type = match this with | ThisValue t @@ -206,22 +179,13 @@ type ValueKind = | EnumConstant (_, ent) -> Enum ent | NewOption (_, t) -> Option t | NewArray (_, t) -> Array t + | NewArrayAlloc (_, t) -> Array t | NewList (_, t) -> List t | NewTuple exprs -> exprs |> List.map (fun e -> e.Type) |> Tuple - | NewRecord (_, kind, genArgs) -> - match kind with - | DeclaredRecord ent -> DeclaredType(ent, genArgs) - | AnonymousRecord fieldNames -> AnonymousRecordType(fieldNames, genArgs) + | NewRecord (_, ent, genArgs) -> DeclaredType(ent, genArgs) + | NewAnonymousRecord (_, fieldNames, genArgs) -> AnonymousRecordType(fieldNames, genArgs) | NewUnion (_, _, ent, genArgs) -> DeclaredType(ent, genArgs) -type LoopKind = - | While of guard: Expr * body: Expr - | For of ident: Ident * start: Expr * limit: Expr * body: Expr * isUp: bool - -type FunctionKind = - | Lambda of arg: Ident - | Delegate of args: Ident list - type CallInfo = { ThisArg: Expr option Args: Expr list @@ -229,8 +193,6 @@ type CallInfo = /// E.g.: signature accepts 'a->'b->'c (2-arity) but we pass int->int->int->int (3-arity) SignatureArgTypes: Type list HasSpread: bool - AutoUncurrying: bool - /// Must apply `new` keyword when converted to JS IsJsConstructor: bool } type ReplaceCallInfo = @@ -244,61 +206,74 @@ type ReplaceCallInfo = DeclaringEntityFullName: string GenericArgs: (string * Type) list } +type EmitInfo = + { Macro: string + Args: Expr list + IsJsStatement: bool } + type OperationKind = - | Call of callee: Expr * info: CallInfo - | CurriedApply of applied: Expr * args: Expr list - | Emit of macro: string * args: CallInfo option - | UnaryOperation of UnaryOperator * Expr - | BinaryOperation of BinaryOperator * left: Expr * right: Expr - | LogicalOperation of LogicalOperator * left: Expr * right: Expr + | Unary of UnaryOperator * Expr + | Binary of BinaryOperator * left: Expr * right: Expr + | Logical of LogicalOperator * left: Expr * right: Expr + +type KeyKind = + | FieldKey of Field + | ExprKey of Expr type GetKind = - | ExprGet of Expr - | TupleGet of int - | FieldGet of string * isFieldMutable: bool * fieldType: Type - | UnionField of FSharpField * FSharpUnionCase * fieldType: Type + | ByKey of KeyKind + | TupleIndex of int + | UnionField of index: int * fieldType: Type | UnionTag | ListHead | ListTail | OptionValue -type SetKind = - | VarSet - | ExprSet of Expr - | FieldSet of string * Type - type TestKind = | TypeTest of Type - | ErasedUnionTest of Type | OptionTest of isSome: bool | ListTest of isCons: bool - | UnionCaseTest of FSharpUnionCase * FSharpEntity + | UnionCaseTest of tag: int type Expr = + // Values and Idents | Value of ValueKind * SourceLocation option | IdentExpr of Ident - | TypeCast of Expr * Type - | Curry of Expr * arity: int * Type * SourceLocation option - | Import of selector: Expr * path: Expr * ImportKind * Type * SourceLocation option - | Function of FunctionKind * body: Expr * name: string option - | ObjectExpr of (Ident list * Expr * AttachedMemberInfo) list * Type * baseCall: Expr option + // Closures + /// Lambdas are curried, they always have a single argument (which can be unit) + | Lambda of arg: Ident * body: Expr * name: string option + /// Delegates are uncurried functions, can have none or multiple arguments + | Delegate of args: Ident list * body: Expr * name: string option + | ObjectExpr of MemberDecl list * Type * baseCall: Expr option + // Type cast and tests + | TypeCast of Expr * Type | Test of Expr * TestKind * range: SourceLocation option + + // Operations + | Call of callee: Expr * info: CallInfo * typ: Type * range: SourceLocation option + | CurriedApply of applied: Expr * args: Expr list * typ: Type * range: SourceLocation option + | Curry of Expr * arity: int * Type * SourceLocation option | Operation of OperationKind * typ: Type * range: SourceLocation option - | Get of Expr * GetKind * typ: Type * range: SourceLocation option - | Debugger of range: SourceLocation option - | Throw of Expr * typ: Type * range: SourceLocation option + // JS related: imports and statements + | Import of selector: Expr * path: Expr * Type * SourceLocation option + | Emit of EmitInfo * typ: Type * range: SourceLocation option + // Pattern matching | DecisionTree of Expr * targets: (Ident list * Expr) list | DecisionTreeSuccess of targetIndex: int * boundValues: Expr list * Type - | Sequential of Expr list + // Getters, setters and bindings | Let of bindings: (Ident * Expr) list * body: Expr - | Set of Expr * SetKind * value: Expr * range: SourceLocation option - // TODO: Check if we actually need range for loops - | Loop of LoopKind * range: SourceLocation option + | Get of Expr * GetKind * typ: Type * range: SourceLocation option + | Set of Expr * key: KeyKind option * value: Expr * range: SourceLocation option + + // Flow control + | Sequential of Expr list + | WhileLoop of guard: Expr * body: Expr * range: SourceLocation option + | ForLoop of ident: Ident * start: Expr * limit: Expr * body: Expr * isUp: bool * range: SourceLocation option | TryCatch of body: Expr * catch: (Ident * Expr) option * finalizer: Expr option * range: SourceLocation option | IfThenElse of guardExpr: Expr * thenExpr: Expr * elseExpr: Expr * range: SourceLocation option @@ -307,26 +282,26 @@ type Expr = | Test _ -> Boolean | Value (kind, _) -> kind.Type | IdentExpr id -> id.Type + | Call(_,_,t,_) + | CurriedApply(_,_,t,_) | TypeCast (_, t) - | Import (_, _, _, t, _) + | Import (_, _, t, _) | Curry (_, _, t, _) | ObjectExpr (_, t, _) | Operation (_, t, _) | Get (_, _, t, _) - | Throw (_, t, _) + | Emit (_,t,_) | DecisionTreeSuccess (_, _, t) -> t - | Debugger _ | Set _ - | Loop _ -> Unit - | Sequential exprs -> (List.last exprs).Type + | WhileLoop _ + | ForLoop _-> Unit + | Sequential exprs -> List.tryLast exprs |> Option.map (fun e -> e.Type) |> Option.defaultValue Unit | Let (_, expr) | TryCatch (expr, _, _, _) | IfThenElse (_, expr, _, _) | DecisionTree (expr, _) -> expr.Type - | Function (kind, body, _) -> - match kind with - | Lambda arg -> FunctionType(LambdaType arg.Type, body.Type) - | Delegate args -> FunctionType(DelegateType(args |> List.map (fun a -> a.Type)), body.Type) + | Lambda(arg, body, _) -> LambdaType(arg.Type, body.Type) + | Delegate(args, body, _) -> DelegateType(args |> List.map (fun a -> a.Type), body.Type) member this.Range: SourceLocation option = match this with @@ -335,20 +310,21 @@ type Expr = | Let _ | DecisionTree _ | DecisionTreeSuccess _ -> None - - | Function (_, e, _) + | Lambda (_, e, _) + | Delegate (_, e, _) | TypeCast (e, _) -> e.Range | IdentExpr id -> id.Range - - | Import(_,_,_,_,r) + | Call(_,_,_,r) + | CurriedApply(_,_,_,r) + | Emit (_,_,r) + | Import(_,_,_,r) | Curry(_,_,_,r) | Value (_, r) | IfThenElse (_, _, _, r) | TryCatch (_, _, _, r) - | Debugger r | Test (_, _, r) | Operation (_, _, r) | Get (_, _, _, r) - | Throw (_, _, r) | Set (_, _, _, r) - | Loop (_, r) -> r + | ForLoop (_,_,_,_,_,r) + | WhileLoop (_,_,r) -> r diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 5e4f93a02..80b38b887 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -1,4 +1,4 @@ -namespace Fable.Transforms.FSharp2Fable +namespace rec Fable.Transforms.FSharp2Fable open System open System.Collections.Generic @@ -9,14 +9,170 @@ open Fable.Core open Fable.AST open Fable.Transforms +type FsField(name, typ: Lazy, ?isMutable, ?isStatic, ?literalValue) = + new (fi: FSharpField) = + let getFSharpFieldName (fi: FSharpField) = + let rec countConflictingCases acc (ent: FSharpEntity) (name: string) = + match TypeHelpers.getBaseClass ent with + | None -> acc + | Some (baseClass: FSharpEntity) -> + let conflicts = + baseClass.FSharpFields + |> Seq.exists (fun fi -> fi.Name = name) + let acc = if conflicts then acc + 1 else acc + countConflictingCases acc baseClass name + + let name = fi.Name + match fi.DeclaringEntity with + | None -> name + | Some ent when ent.IsFSharpRecord || ent.IsFSharpUnion -> name + | Some ent -> + match countConflictingCases 0 ent name with + | 0 -> name + | n -> name + "_" + (string n) + + let typ = lazy TypeHelpers.makeType Map.empty fi.FieldType + FsField(getFSharpFieldName fi, typ, isMutable=fi.IsMutable, isStatic=fi.IsStatic, ?literalValue=fi.LiteralValue) + interface Fable.Field with + member _.Name = name + member _.FieldType = typ.Value + member _.LiteralValue = literalValue + member _.IsStatic = defaultArg isStatic false + member _.IsMutable = defaultArg isMutable false + +type FsUnionCase(uci: FSharpUnionCase) = + /// FSharpUnionCase.CompiledName doesn't give the value of CompiledNameAttribute + /// We must check the attributes explicitly + static member CompiledName (uci: FSharpUnionCase) = + uci.Attributes + |> Helpers.tryFindAtt Atts.compiledName + |> Option.map (fun (att: FSharpAttribute) -> att.ConstructorArguments.[0] |> snd |> string) + + interface Fable.UnionCase with + member _.Name = uci.Name + member _.CompiledName = FsUnionCase.CompiledName uci + member _.UnionCaseFields = uci.UnionCaseFields |> Seq.mapToList (fun x -> upcast FsField(x)) + +type FsAtt(att: FSharpAttribute) = + interface Fable.Attribute with + member _.FullName = defaultArg att.AttributeType.TryFullName "" + member _.ConstructorArguments = [] + +type FsGenParam(gen: FSharpGenericParameter) = + interface Fable.GenericParam with + member _.Name = TypeHelpers.genParamName gen + +type FsDeclaredType(ent: FSharpEntity, genArgs: IList) = + interface Fable.DeclaredType with + member _.Definition = FsEnt ent :> _ + member _.GenericArgs = genArgs |> Seq.mapToList (TypeHelpers.makeType Map.empty) + +type FsMemberFunctionOrValue(m: FSharpMemberOrFunctionOrValue) = + static member SourcePath (memb: FSharpMemberOrFunctionOrValue) = + memb.DeclarationLocation.FileName + |> Path.normalizePathAndEnsureFsExtension + + interface Fable.MemberFunctionOrValue with + member _.DisplayName = Naming.removeGetSetPrefix m.DisplayName + member _.CompiledName = m.CompiledName + member _.FullName = m.FullName + member _.CurriedParameterGroups = [] + member _.ReturnParameter = failwith "todo" + member _.IsExplicitInterfaceImplementation = m.IsExplicitInterfaceImplementation + member _.ApparentEnclosingEntity = FsEnt m.ApparentEnclosingEntity :> _ + +type FsEnt(ent: FSharpEntity) = + member _.FSharpEntity = ent + + static member IsPublic (ent: FSharpEntity) = + not ent.Accessibility.IsPrivate + + static member SourcePath (ent: FSharpEntity) = + ent.DeclarationLocation.FileName + |> Path.normalizePathAndEnsureFsExtension + + interface Fable.Entity with + member _.DisplayName = ent.DisplayName + + member _.FullName = + match ent.TryFullName with + | Some n -> n + | None -> ent.CompiledName + + member _.SourcePath = FsEnt.SourcePath ent + + member _.AssemblyPath = ent.Assembly.FileName + + member _.BaseDeclaration = + match ent.BaseType with + | Some baseType -> + match Helpers.tryDefinition baseType with + | Some(baseEntity, fullName) when fullName <> Some Types.object -> + Some(upcast FsDeclaredType(baseEntity, baseType.GenericArguments)) + | _ -> None + | None -> None + + member _.Attributes = + ent.Attributes |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) + + member _.MembersFunctionsAndValues = + ent.TryGetMembersFunctionsAndValues |> Seq.map (fun x -> + FsMemberFunctionOrValue(x) :> Fable.MemberFunctionOrValue) + + member _.AllInterfaces = + ent.AllInterfaces |> Seq.choose (fun ifc -> + if ifc.HasTypeDefinition then + Some(upcast FsDeclaredType(ifc.TypeDefinition, ifc.GenericArguments)) + else None) + + member _.GenericParameters = + ent.GenericParameters |> Seq.mapToList (fun x -> FsGenParam(x) :> Fable.GenericParam) + + member _.FSharpFields = + ent.FSharpFields |> Seq.mapToList (fun x -> FsField(x) :> Fable.Field) + + member _.UnionCases = + ent.UnionCases |> Seq.mapToList (fun x -> FsUnionCase(x) :> Fable.UnionCase) + + member _.IsPublic = FsEnt.IsPublic ent + member _.IsFSharpUnion = ent.IsFSharpUnion + member _.IsFSharpRecord = ent.IsFSharpRecord + member _.IsFSharpExceptionDeclaration = ent.IsFSharpExceptionDeclaration + member _.IsValueType = ent.IsValueType + member _.IsInterface = ent.IsInterface + +type MemberDeclInfo(?attributes: FSharpAttribute seq, + ?hasSpread: bool, + ?isPublic: bool, + ?isInstance: bool, + ?isValue: bool, + ?isMutable: bool, + ?isGetter: bool, + ?isSetter: bool, + ?isEnumerator: bool, + ?isMangled: bool) = + interface Fable.MemberDeclInfo with + member _.Attributes = + match attributes with + | Some atts -> atts |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) + | None -> upcast [] + member _.HasSpread = defaultArg hasSpread false + member _.IsPublic = defaultArg isPublic true + member _.IsInstance = defaultArg isInstance true + member _.IsValue = defaultArg isValue false + member _.IsMutable = defaultArg isMutable false + member _.IsGetter = defaultArg isGetter false + member _.IsSetter = defaultArg isSetter false + member _.IsEnumerator = defaultArg isEnumerator false + member _.IsMangled = defaultArg isMangled false + type Context = { Scope: (FSharpMemberOrFunctionOrValue * Fable.Ident * Fable.Expr option) list ScopeInlineValues: (FSharpMemberOrFunctionOrValue * FSharpExpr) list - UseNamesInRootScope: Set + UsedNamesInRootScope: Set UseNamesInDeclarationScope: HashSet GenericArgs: Map EnclosingMember: FSharpMemberOrFunctionOrValue option - EnclosingEntity: FSharpEntity option InlinedFunction: FSharpMemberOrFunctionOrValue option CaughtException: Fable.Ident option BoundConstructorThis: Fable.Ident option @@ -27,11 +183,10 @@ type Context = static member Create(enclosingEntity, usedRootNames) = { Scope = [] ScopeInlineValues = [] - UseNamesInRootScope = usedRootNames + UsedNamesInRootScope = usedRootNames UseNamesInDeclarationScope = Unchecked.defaultof<_> GenericArgs = Map.empty EnclosingMember = None - EnclosingEntity = enclosingEntity InlinedFunction = None CaughtException = None BoundConstructorThis = None @@ -69,9 +224,14 @@ module Helpers = // TODO: Report bug in FCS repo, when ent.IsNamespace, FullName doesn't work. let getEntityFullName (ent: FSharpEntity) = - if ent.IsNamespace - then match ent.Namespace with Some ns -> ns + "." + ent.CompiledName | None -> ent.CompiledName - else defaultArg ent.TryFullName ent.CompiledName + if ent.IsNamespace then + match ent.Namespace with + | Some ns -> ns + "." + ent.CompiledName + | None -> ent.CompiledName + else + match ent.TryFullName with + | Some n -> n + | None -> ent.CompiledName let getGenericArguments (t: FSharpType) = // Accessing .GenericArguments for a generic parameter will fail @@ -79,35 +239,20 @@ module Helpers = then [||] :> IList<_> else (nonAbbreviatedType t).GenericArguments - let inline getEntityLocation (ent: FSharpEntity) = - ent.DeclarationLocation - // As we're using a hash for the overload suffix, we shouldn't care - // whether the location belongs to the implementation or the signature - // match ent.ImplementationLocation with - // | Some loc -> loc - // | None -> ent.DeclarationLocation - - let inline getMemberLocation (memb: FSharpMemberOrFunctionOrValue) = - memb.DeclarationLocation - // match memb.ImplementationLocation with - // | Some loc -> loc - // | None -> memb.DeclarationLocation - - let private getEntityMangledName (com: ICompiler) trimRootModule (ent: FSharpEntity) = - match ent.TryFullName with - | Some fullName when not trimRootModule -> fullName - | Some fullName -> - let loc = getEntityLocation ent - let rootMod = com.GetRootModule(loc.FileName) + + let private getEntityMangledName (com: ICompiler) trimRootModule (ent: Fable.Entity) = + match ent.FullName with + | fullName when not trimRootModule -> fullName + | fullName -> + let rootMod = com.GetRootModule(ent.SourcePath) if fullName.StartsWith(rootMod) then fullName.Substring(rootMod.Length).TrimStart('.') else fullName - | None -> ent.CompiledName let cleanNameAsJsIdentifier (name: string) = - name.Replace('.','_').Replace('`','_') + name.Replace('.','_').Replace('`','$') - let getEntityDeclarationName (com: ICompiler) (ent: FSharpEntity) = + let getEntityDeclarationName (com: ICompiler) (ent: Fable.Entity) = let entityName = getEntityMangledName com true ent |> cleanNameAsJsIdentifier (entityName, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun _ -> false) @@ -115,17 +260,17 @@ module Helpers = let private getMemberMangledName (com: ICompiler) trimRootModule (memb: FSharpMemberOrFunctionOrValue) = if memb.IsExtensionMember then let overloadSuffix = OverloadSuffix.getExtensionHash memb - let entName = getEntityMangledName com false memb.ApparentEnclosingEntity + let entName = getEntityMangledName com false (FsEnt memb.ApparentEnclosingEntity) entName, Naming.InstanceMemberPart(memb.CompiledName, overloadSuffix) else match memb.DeclaringEntity with | Some ent when ent.IsFSharpModule -> - match getEntityMangledName com trimRootModule ent with + match getEntityMangledName com trimRootModule (FsEnt ent) with | "" -> memb.CompiledName, Naming.NoMemberPart | moduleName -> moduleName, Naming.StaticMemberPart(memb.CompiledName, "") | Some ent -> let overloadSuffix = OverloadSuffix.getHash ent memb - let entName = getEntityMangledName com trimRootModule ent + let entName = getEntityMangledName com trimRootModule (FsEnt ent) if memb.IsInstanceMember then entName, Naming.InstanceMemberPart(memb.CompiledName, overloadSuffix) else entName, Naming.StaticMemberPart(memb.CompiledName, overloadSuffix) @@ -144,18 +289,11 @@ module Helpers = getMemberMangledName com false memb ||> Naming.buildNameWithoutSanitation - let getMemberFullName (memb: FSharpMemberOrFunctionOrValue) = - if memb.IsExplicitInterfaceImplementation then - true, memb.CompiledName.Replace("-",".") - else - let ent = memb.ApparentEnclosingEntity - ent.IsInterface, memb.FullName - let getMemberDisplayName (memb: FSharpMemberOrFunctionOrValue) = Naming.removeGetSetPrefix memb.DisplayName let isUsedName (ctx: Context) name = - ctx.UseNamesInRootScope.Contains name || ctx.UseNamesInDeclarationScope.Contains name + ctx.UsedNamesInRootScope.Contains name || ctx.UseNamesInDeclarationScope.Contains name let getIdentUniqueName (ctx: Context) name = let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (isUsedName ctx) @@ -168,20 +306,30 @@ module Helpers = typ.TypeDefinition.TryFullName = Some Types.unit else false - let tryFindAtt fullName (atts: #seq) = + let tryFindAtt fullName (atts: FSharpAttribute seq) = atts |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with | Some fullName' -> if fullName = fullName' then Some att else None | None -> None) - let hasAttribute attFullName (attributes: #seq) = + let hasAttribute attFullName (attributes: FSharpAttribute seq) = let mutable found = false let attFullName = Some attFullName for att in attributes do found <- found || att.AttributeType.TryFullName = attFullName found + let tryAttributeConsArg (att: FSharpAttribute) index (defValue: 'T) (f: obj -> 'T option) = + let consArgs = att.ConstructorArguments + if consArgs.Count <= index then defValue + else + consArgs.[index] |> snd |> f + |> Option.defaultValue defValue + + let tryBoolean: obj -> bool option = function (:? bool as x) -> Some x | _ -> None + let tryString: obj -> string option = function (:? string as x) -> Some x | _ -> None + let tryDefinition (typ: FSharpType) = let typ = nonAbbreviatedType typ if typ.HasTypeDefinition then @@ -194,15 +342,6 @@ module Helpers = | Some(_, Some fullName) -> fullName | _ -> Naming.unknown - let tryEntityBase (ent: FSharpEntity) = - match ent.BaseType with - | Some baseType -> - match tryDefinition baseType with - | Some(baseEntity, fullName) when fullName <> Some Types.object -> - Some(baseEntity, baseType.GenericArguments) - | _ -> None - | None -> None - let isInline (memb: FSharpMemberOrFunctionOrValue) = match memb.InlineAnnotation with | FSharpInlineAnnotation.NeverInline @@ -212,9 +351,6 @@ module Helpers = | FSharpInlineAnnotation.AlwaysInline | FSharpInlineAnnotation.AggressiveInline -> true - let isPublicEntity (ent: FSharpEntity) = - not ent.Accessibility.IsPrivate - let isPublicMember (memb: FSharpMemberOrFunctionOrValue) = if memb.IsCompilerGenerated then false @@ -228,6 +364,16 @@ module Helpers = let makeRangeFrom (fsExpr: FSharpExpr) = Some (makeRange fsExpr.Range) + let makeRangedIdent (r: Range.range) (displayName: string) (compiledName: string): Fable.Ident = + { Name = compiledName + Type = Fable.Any + IsCompilerGenerated = false + IsThisArgument = false + IsMutable = false + Range = Some { start = { line = r.StartLine; column = r.StartColumn } + ``end``= { line = r.StartLine; column = r.StartColumn + displayName.Length } + identifierName = Some displayName } } + // let hasCaseWithFields (ent: FSharpEntity) = // ent.UnionCases |> Seq.exists (fun uci -> uci.UnionCaseFields.Count > 0) @@ -237,16 +383,9 @@ module Helpers = with _ -> failwithf "Cannot find case %s in %s" unionCase.Name (getEntityFullName ent) - /// FSharpUnionCase.CompiledName doesn't give the value of CompiledNameAttribute - /// We must check the attributes explicitly - let unionCaseCompiledName (unionCase: FSharpUnionCase) = - unionCase.Attributes - |> tryFindAtt Atts.compiledName - |> Option.map (fun att -> att.ConstructorArguments.[0] |> snd |> string) - /// Apply case rules to case name if there's no explicit compiled name let transformStringEnum (rule: CaseRules) (unionCase: FSharpUnionCase) = - match unionCaseCompiledName unionCase with + match FsUnionCase.CompiledName unionCase with | Some name -> name | None -> Naming.applyCaseRule rule unionCase.Name |> makeStrConst @@ -276,9 +415,6 @@ module Helpers = | None -> () } - let rec isInterfaceEmpty (ent: FSharpEntity) = - getAllInterfaceMembers ent |> Seq.isEmpty - /// Test if the name corresponds to this interface or anyone in its hierarchy let rec testInterfaceHierarcy interfaceFullname interfaceType = match tryDefinition interfaceType with @@ -289,19 +425,10 @@ module Helpers = |> Seq.exists (testInterfaceHierarcy interfaceFullname) | _ -> false - let hasSeqSpread (memb: FSharpMemberOrFunctionOrValue) = - let hasParamArray (memb: FSharpMemberOrFunctionOrValue) = - if memb.CurriedParameterGroups.Count <> 1 then false else - let args = memb.CurriedParameterGroups.[0] - args.Count > 0 && args.[args.Count - 1].IsParamArrayArg - - let hasParamSeq (memb: FSharpMemberOrFunctionOrValue) = - Seq.tryLast memb.CurriedParameterGroups - |> Option.bind Seq.tryLast - |> Option.map (fun lastParam -> hasAttribute Atts.paramList lastParam.Attributes) - |> Option.defaultValue false - - hasParamArray memb || hasParamSeq memb + let hasParamArray (memb: FSharpMemberOrFunctionOrValue) = + if memb.CurriedParameterGroups.Count <> 1 then false else + let args = memb.CurriedParameterGroups.[0] + args.Count > 0 && args.[args.Count - 1].IsParamArrayArg module Patterns = open BasicPatterns @@ -341,14 +468,6 @@ module Patterns = let (|MemberFullName|) (memb: FSharpMemberOrFunctionOrValue) = memb.FullName - let (|AttFullName|_|) (att: FSharpAttribute) = - match att.AttributeType.TryFullName with - | Some fullName -> Some(fullName, att) - | None -> None - - let (|AttArguments|) (att: FSharpAttribute) = - att.ConstructorArguments |> Seq.map snd |> Seq.toList - let (|RefType|_|) = function | TypeDefinition tdef as t when tdef.TryFullName = Some Types.reference -> Some t | _ -> None @@ -561,14 +680,14 @@ module TypeHelpers = | None -> Fable.GenericParam name | Some typ -> typ - let rec makeGenArgs (com: ICompiler) ctxTypeArgs (genArgs: IList) = + let makeGenArgs ctxTypeArgs (genArgs: IList) = genArgs |> Seq.map (fun genArg -> if genArg.IsGenericParameter then resolveGenParam ctxTypeArgs genArg.GenericParameter - else makeType com ctxTypeArgs genArg) + else makeType ctxTypeArgs genArg) |> Seq.toList - and makeTypeFromDelegate com ctxTypeArgs (genArgs: IList) (tdef: FSharpEntity) = + let makeTypeFromDelegate ctxTypeArgs (genArgs: IList) (tdef: FSharpEntity) = let argTypes, returnType = try tdef.FSharpDelegateSignature.DelegateArguments |> Seq.map snd, @@ -582,17 +701,17 @@ module TypeHelpers = let genArgs = Seq.zip (tdef.GenericParameters |> Seq.map genParamName) genArgs |> Map let resolveType (t: FSharpType) = if t.IsGenericParameter then Map.find (genParamName t.GenericParameter) genArgs else t - let argTypes = argTypes |> Seq.map (resolveType >> makeType com ctxTypeArgs) |> Seq.toList - let returnType = returnType |> resolveType |> makeType com ctxTypeArgs - Fable.FunctionType(Fable.DelegateType argTypes, returnType) + let argTypes = argTypes |> Seq.map (resolveType >> makeType ctxTypeArgs) |> Seq.toList + let returnType = returnType |> resolveType |> makeType ctxTypeArgs + Fable.DelegateType(argTypes, returnType) - and makeTypeFromDef (com: ICompiler) ctxTypeArgs (genArgs: IList) (tdef: FSharpEntity) = + let makeTypeFromDef ctxTypeArgs (genArgs: IList) (tdef: FSharpEntity) = if tdef.IsArrayType then - makeGenArgs com ctxTypeArgs genArgs |> List.head |> Fable.Array + makeGenArgs ctxTypeArgs genArgs |> List.head |> Fable.Array elif tdef.IsDelegate then - makeTypeFromDelegate com ctxTypeArgs genArgs tdef + makeTypeFromDelegate ctxTypeArgs genArgs tdef elif tdef.IsEnum then - Fable.Enum tdef + Fable.Enum(FsEnt tdef) else match getEntityFullName tdef with // Fable "primitives" @@ -603,30 +722,30 @@ module TypeHelpers = | Types.string -> Fable.String | Types.regex -> Fable.Regex | Types.valueOption - | Types.option -> makeGenArgs com ctxTypeArgs genArgs |> List.head |> Fable.Option - | Types.resizeArray -> makeGenArgs com ctxTypeArgs genArgs |> List.head |> Fable.Array - | Types.list -> makeGenArgs com ctxTypeArgs genArgs |> List.head |> Fable.List + | Types.option -> makeGenArgs ctxTypeArgs genArgs |> List.head |> Fable.Option + | Types.resizeArray -> makeGenArgs ctxTypeArgs genArgs |> List.head |> Fable.Array + | Types.list -> makeGenArgs ctxTypeArgs genArgs |> List.head |> Fable.List | NumberKind kind -> Fable.Number kind // Special attributes | _ when hasAttribute Atts.stringEnum tdef.Attributes -> Fable.String | _ when hasAttribute Atts.erase tdef.Attributes -> Fable.Any // Rest of declared types - | _ -> Fable.DeclaredType(tdef, makeGenArgs com ctxTypeArgs genArgs) + | _ -> Fable.DeclaredType(FsEnt tdef, makeGenArgs ctxTypeArgs genArgs) - and makeType (com: ICompiler) (ctxTypeArgs: Map) (NonAbbreviatedType t) = + let rec makeType (ctxTypeArgs: Map) (NonAbbreviatedType t) = // Generic parameter (try to resolve for inline functions) if t.IsGenericParameter then resolveGenParam ctxTypeArgs t.GenericParameter // Tuple elif t.IsTupleType then - makeGenArgs com ctxTypeArgs t.GenericArguments |> Fable.Tuple + makeGenArgs ctxTypeArgs t.GenericArguments |> Fable.Tuple // Function elif t.IsFunctionType then - let argType = makeType com ctxTypeArgs t.GenericArguments.[0] - let returnType = makeType com ctxTypeArgs t.GenericArguments.[1] - Fable.FunctionType(Fable.LambdaType argType, returnType) + let argType = makeType ctxTypeArgs t.GenericArguments.[0] + let returnType = makeType ctxTypeArgs t.GenericArguments.[1] + Fable.LambdaType(argType, returnType) elif t.IsAnonRecordType then - let genArgs = makeGenArgs com ctxTypeArgs t.GenericArguments + let genArgs = makeGenArgs ctxTypeArgs t.GenericArguments Fable.AnonymousRecordType(t.AnonRecordTypeDetails.SortedFieldNames, genArgs) elif t.HasTypeDefinition then // No support for provided types when compiling FCS+Fable to JS @@ -635,43 +754,15 @@ module TypeHelpers = if t.TypeDefinition.IsProvidedAndErased then Fable.Any else #endif - makeTypeFromDef com ctxTypeArgs t.GenericArguments t.TypeDefinition + makeTypeFromDef ctxTypeArgs t.GenericArguments t.TypeDefinition else Fable.Any // failwithf "Unexpected non-declared F# type: %A" t - // TODO: This is intended to wrap JS expressions with `| 0`, check enum as well? - let isSignedIntType (NonAbbreviatedType t) = - if t.HasTypeDefinition then - match t.TypeDefinition.TryFullName with - | Some(Types.int8 | Types.int16 | Types.int32) -> true - | _ -> false - else false - let getBaseClass (tdef: FSharpEntity) = match tdef.BaseType with | Some(TypeDefinition tdef) when tdef.TryFullName <> Some Types.object -> Some tdef | _ -> None - let getFSharpFieldName (fi: FSharpField) = - let rec countConflictingCases acc (ent: FSharpEntity) (name: string) = - match getBaseClass ent with - | None -> acc - | Some baseClass -> - let conflicts = - baseClass.FSharpFields - |> Seq.exists (fun fi -> fi.Name = name) - let acc = if conflicts then acc + 1 else acc - countConflictingCases acc baseClass name - - let name = fi.Name - match fi.DeclaringEntity with - | None -> name - | Some ent when ent.IsFSharpRecord -> name - | Some ent -> - match countConflictingCases 0 ent name with - | 0 -> name - | n -> name + "_" + (string n) - let rec getOwnAndInheritedFsharpMembers (tdef: FSharpEntity) = seq { yield! tdef.TryGetMembersFunctionsAndValues match tdef.BaseType with @@ -684,7 +775,7 @@ module TypeHelpers = // FSharpParameters don't contain the `this` arg Seq.concat memb.CurriedParameterGroups // The F# compiler "untuples" the args in methods - |> Seq.map (fun x -> makeType com Map.empty x.Type) + |> Seq.map (fun x -> makeType Map.empty x.Type) |> Seq.toList let isAbstract (ent: FSharpEntity) = @@ -704,23 +795,60 @@ module TypeHelpers = if t.HasTypeDefinition then Some t.TypeDefinition else None else None - let tryFindMember com (entity: FSharpEntity) genArgs compiledName isInstance (argTypes: Fable.Type list) = + let tryFindMember com (entity: Fable.Entity) genArgs compiledName isInstance (argTypes: Fable.Type list) = let argsEqual (args1: Fable.Type list) args1Length (args2: IList>) = let args2Length = args2 |> Seq.sumBy (fun g -> g.Count) if args1Length = args2Length then let args2 = args2 |> Seq.collect (fun g -> - g |> Seq.map (fun p -> makeType com genArgs p.Type) |> Seq.toList) + g |> Seq.map (fun p -> makeType genArgs p.Type) |> Seq.toList) listEquals (typeEquals false) args1 (Seq.toList args2) else false - let argTypesLength = List.length argTypes - getOwnAndInheritedFsharpMembers entity |> Seq.tryFind (fun m2 -> - if m2.IsInstanceMember = isInstance && m2.CompiledName = compiledName - then argsEqual argTypes argTypesLength m2.CurriedParameterGroups - else false) - let inline (|FableType|) com (ctx: Context) t = makeType com ctx.GenericArgs t + match entity with + | :? FsEnt as entity -> + let argTypesLength = List.length argTypes + getOwnAndInheritedFsharpMembers entity.FSharpEntity |> Seq.tryFind (fun m2 -> + if m2.IsInstanceMember = isInstance && m2.CompiledName = compiledName + then argsEqual argTypes argTypesLength m2.CurriedParameterGroups + else false) + | _ -> None + + let fitsAnonRecordInInterface com (argExprs: Fable.Expr list) fieldNames (interface_: Fable.Entity) = + match interface_ with + | :? FsEnt as fsEnt -> + let interface_ = fsEnt.FSharpEntity + // TODO: Check also if there are extra fields in the record not present in the interface? + (Ok (), getAllInterfaceMembers interface_ |> Seq.filter (fun memb -> memb.IsPropertyGetterMethod)) + ||> Seq.fold (fun res memb -> + match res with + | Error _ -> res + | Ok _ -> + let expectedType = memb.ReturnParameter.Type |> makeType Map.empty + Array.tryFindIndex ((=) memb.DisplayName) fieldNames + |> function + | None -> + match expectedType with + | Fable.Option _ -> Ok () // Optional fields can be missing + | _ -> sprintf "Object doesn't contain field '%s'" memb.DisplayName |> Error + | Some i -> + let e = List.item i argExprs + match expectedType, e.Type with + | Fable.Any, _ -> true + | Fable.Option t1, Fable.Option t2 + | Fable.Option t1, t2 + | t1, t2 -> typeEquals false t1 t2 + |> function + | true -> Ok () + | false -> + let typeName = getTypeFullName true expectedType + sprintf "Expecting type '%s' for field '%s'" typeName memb.DisplayName |> Error) + | _ -> Ok () // TODO: Error instead if we cannot check the interface? + + + + let inline (|FableType|) com (ctx: Context) t = makeType ctx.GenericArgs t module Identifiers = open Helpers @@ -734,8 +862,9 @@ module Identifiers = ||> Naming.sanitizeIdent (isUsedName ctx) ctx.UseNamesInDeclarationScope.Add(sanitizedName) |> ignore { Name = sanitizedName - Type = makeType com ctx.GenericArgs fsRef.FullType - Kind = if fsRef.IsCompilerGenerated then Fable.CompilerGenerated else Fable.UserDeclared + Type = makeType ctx.GenericArgs fsRef.FullType + IsThisArgument = false + IsCompilerGenerated = fsRef.IsCompilerGenerated IsMutable = fsRef.IsMutable Range = { makeRange fsRef.DeclarationLocation with identifierName = Some fsRef.DisplayName } |> Some } @@ -791,7 +920,7 @@ module Util = match args with | (firstArg::restArgs1)::restArgs2 when firstArg.IsMemberThisValue -> let ctx, thisArg = putArgInScope com ctx firstArg - let thisArg = { thisArg with Kind = Fable.ThisArgIdent } + let thisArg = { thisArg with IsThisArgument = true } let ctx = { ctx with BoundMemberThis = Some thisArg } ctx, [thisArg], restArgs1::restArgs2 | _ -> ctx, [], args @@ -816,10 +945,11 @@ module Util = | None -> None Fable.TryCatch(body, catchClause, finalizer, r) - let matchGenericParams (genArgs: Fable.Type seq) (genParams: FSharpGenericParameter seq) = - Seq.zip (genParams |> Seq.map genParamName) genArgs let matchGenericParamsFrom (memb: FSharpMemberOrFunctionOrValue) (genArgs: Fable.Type seq) = + let matchGenericParams (genArgs: Fable.Type seq) (genParams: FSharpGenericParameter seq) = + Seq.zip (genParams |> Seq.map genParamName) genArgs + let genArgsLen = Seq.length genArgs match memb.DeclaringEntity with // It seems that for F# types memb.GenericParameters contains all generics @@ -848,9 +978,9 @@ module Util = // When importing a relative path from a different path where the member, // entity... is declared, we need to resolve the path - let fixImportedRelativePath (com: ICompiler) (path: string) (loc: Lazy) = + let fixImportedRelativePath (com: ICompiler) (path: string) normalizedSourcePath = if Path.isRelativePath path then - let file = Path.normalizePathAndEnsureFsExtension loc.Value.FileName + let file = Path.normalizePathAndEnsureFsExtension normalizedSourcePath if file = com.CurrentFile then path else @@ -858,7 +988,10 @@ module Util = |> Path.getRelativePath com.CurrentFile else path - let (|GlobalAtt|ImportAtt|NoGlobalNorImport|) (atts: #seq) = + let (|GlobalAtt|ImportAtt|NoGlobalNorImport|) (atts: Fable.Attribute seq) = + let (|AttFullName|) (att: Fable.Attribute) = att.FullName, att + let (|AttArguments|) (att: Fable.Attribute) = att.ConstructorArguments + atts |> Seq.tryPick (function | AttFullName(Atts.global_, att) -> match att with @@ -882,10 +1015,9 @@ module Util = /// Function used to check if calls must be replaced by global idents or direct imports let tryGlobalOrImportedMember com typ (memb: FSharpMemberOrFunctionOrValue) = - let getImportPath path = - lazy getMemberLocation memb - |> fixImportedRelativePath com path - match memb.Attributes with + memb.Attributes + |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) + |> function | GlobalAtt(Some customName) -> makeTypedIdent typ customName |> Fable.IdentExpr |> Some | GlobalAtt None -> @@ -895,12 +1027,12 @@ module Util = if selector = Naming.placeholder then getMemberDisplayName memb else selector let path = - lazy getMemberLocation memb + FsMemberFunctionOrValue.SourcePath memb |> fixImportedRelativePath com path makeCustomImport typ selector path |> Some | _ -> None - let tryGlobalOrImportedEntity (com: ICompiler) (ent: FSharpEntity) = + let tryGlobalOrImportedEntity (com: ICompiler) (ent: Fable.Entity) = match ent.Attributes with | GlobalAtt(Some customName) -> makeTypedIdent Fable.Any customName |> Fable.IdentExpr |> Some @@ -910,57 +1042,60 @@ module Util = let selector = if selector = Naming.placeholder then ent.DisplayName else selector - let path = - lazy getEntityLocation ent - |> fixImportedRelativePath com path - makeCustomImport Fable.Any selector path |> Some + fixImportedRelativePath com ent.SourcePath path + |> makeCustomImport Fable.Any selector |> Some | _ -> None - let isErasedOrStringEnumEntity (ent: FSharpEntity) = + let isErasedOrStringEnumEntity (ent: Fable.Entity) = ent.Attributes |> Seq.exists (fun att -> - match att.AttributeType.TryFullName with - | Some(Atts.erase | Atts.stringEnum) -> true + match att.FullName with + | Atts.erase | Atts.stringEnum -> true | _ -> false) - let isGlobalOrImportedEntity (ent: FSharpEntity) = + let isGlobalOrImportedEntity (ent: Fable.Entity) = ent.Attributes |> Seq.exists (fun att -> - match att.AttributeType.TryFullName with - | Some(Atts.global_ | Naming.StartsWith Atts.import _) -> true + match att.FullName with + | Atts.global_ | Naming.StartsWith Atts.import _ -> true | _ -> false) /// Entities coming from assemblies (we don't have access to source code) are candidates for replacement - let isReplacementCandidate (ent: FSharpEntity) = - match ent.Assembly.FileName, ent.TryFullName with - | Some asmPath, _ -> not(System.String.IsNullOrEmpty(asmPath)) - // When compiling Fable itself, Fable.Core entities will be part of the code base, - // but still need to be replaced - | None, Some entityFullName -> entityFullName.StartsWith("Fable.Core.") - | None, None -> false + /// TODO: If we start precompiling libraries, we'll have to use System. and FSharp.Core namespaces instead + /// We can also just remove this and fail only when we cannot reference a class. + let isReplacementCandidate (ent: Fable.Entity) = + match ent.AssemblyPath with + | Some asmPath -> not(String.IsNullOrEmpty(asmPath)) // Do we still need the IsNullOrEmpty check? + | None -> +#if FABLE_COMPILER + // When compiling Fable itself, Fable.Core entities will be part of the code base, + // but still need to be replaced + ent.FullName.StartsWith("Fable.Core.") +#else + false +#endif /// We can add a suffix to the entity name for special methods, like reflection declaration - let entityRefWithSuffix (com: ICompiler) (ent: FSharpEntity) suffix = + let entityRefWithSuffix (com: ICompiler) (ent: Fable.Entity) suffix = let error msg = - defaultArg ent.TryFullName ent.CompiledName + ent.FullName |> sprintf "%s: %s" msg |> addErrorAndReturnNull com [] None if ent.IsInterface then error "Cannot reference an interface" else - let entLoc = getEntityLocation ent - let file = Path.normalizePathAndEnsureFsExtension entLoc.FileName + let file = ent.SourcePath let entityName = getEntityDeclarationName com ent + suffix if file = com.CurrentFile then makeIdentExpr entityName - elif isPublicEntity ent then + elif ent.IsPublic then makeInternalImport com Fable.Any entityName file else error "Cannot inline functions that reference private entities" - let entityRef (com: ICompiler) (ent: FSharpEntity) = + let entityRef (com: ICompiler) (ent: Fable.Entity) = entityRefWithSuffix com ent "" /// First checks if the entity is global or imported - let entityRefMaybeGlobalOrImported (com: ICompiler) (ent: FSharpEntity) = + let entityRefMaybeGlobalOrImported (com: ICompiler) (ent: Fable.Entity) = match tryGlobalOrImportedEntity com ent with | Some importedEntity -> importedEntity | None -> entityRef com ent @@ -970,9 +1105,7 @@ module Util = let memberName, hasOverloadSuffix = getMemberDeclarationName com memb let file = match memb.DeclaringEntity with - | Some ent -> - let entLoc = getEntityLocation ent - Path.normalizePathAndEnsureFsExtension entLoc.FileName + | Some ent -> FsEnt.SourcePath ent // Cases when .DeclaringEntity returns None are rare (see #237) // We assume the member belongs to the current file | None -> com.CurrentFile @@ -1024,7 +1157,7 @@ module Util = // Don't mangle interfaces by default (for better JS interop) unless they have Mangle attribute | _ when ent.IsInterface -> hasAttribute Atts.mangle ent.Attributes // Mangle members from abstract classes unless they are global/imported - | _ -> not(isGlobalOrImportedEntity ent) + | _ -> not(isGlobalOrImportedEntity(FsEnt ent)) let getMangledAbstractMemberName (ent: FSharpEntity) memberName overloadHash = // TODO: Error if entity doesn't have fullname? @@ -1053,20 +1186,22 @@ module Util = if indexedProp then memb.CompiledName, false, false else getMemberDisplayName memb, isGetter, isSetter if isGetter then - let t = memb.ReturnParameter.Type |> makeType com Map.empty - let kind = Fable.FieldGet(name, true, t) - Fable.Get(callee, kind, typ, r) + let t = memb.ReturnParameter.Type |> makeType Map.empty + // Set the field as mutable to prevent beta reduction + let key = makeFieldKey name true t + Fable.Get(callee, Fable.ByKey key, typ, r) elif isSetter then - let t = memb.CurriedParameterGroups.[0].[0].Type |> makeType com Map.empty + let t = memb.CurriedParameterGroups.[0].[0].Type |> makeType Map.empty let arg = callInfo.Args |> List.tryHead |> Option.defaultWith makeNull - Fable.Set(callee, Fable.FieldSet(name, t), arg, r) + let key = makeFieldKey name true t + Fable.Set(callee, Some key, arg, r) else getSimple callee name |> makeCall r typ callInfo let (|Replaced|_|) (com: IFableCompiler) ctx r typ (genArgs: Lazy<_>) (callInfo: Fable.CallInfo) (memb: FSharpMemberOrFunctionOrValue, entity: FSharpEntity option) = match entity with - | Some ent when isReplacementCandidate ent -> + | Some ent when isReplacementCandidate(FsEnt ent) -> let info: Fable.ReplaceCallInfo = { SignatureArgTypes = callInfo.SignatureArgTypes DeclaringEntityFullName = ent.FullName @@ -1085,20 +1220,18 @@ module Util = |> addErrorAndReturnNull com ctx.InlinePath r |> Some | _ -> None - let (|Emitted|_|) com r typ callInfo (memb: FSharpMemberOrFunctionOrValue) = + let (|Emitted|_|) com r typ thisArg args (memb: FSharpMemberOrFunctionOrValue) = memb.Attributes |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with | Some(Naming.StartsWith Atts.emit _ as attFullName) -> - let callInfo = + let args = (Option.toList thisArg) @ args + let args = // Allow combination of Import and Emit attributes - match callInfo, tryGlobalOrImportedMember com Fable.Any memb with - | Some callInfo, Some importExpr -> - Some { callInfo with Fable.ThisArg = Some importExpr } - | _ -> callInfo - let macro = - match Seq.tryHead att.ConstructorArguments with - | Some(_, (:? string as macro)) -> macro - | _ -> "" + match tryGlobalOrImportedMember com Fable.Any memb with + | Some importExpr -> importExpr::args + | None -> args + let isStatement = tryAttributeConsArg att 1 false tryBoolean + let macro = tryAttributeConsArg att 0 "" tryString let macro = match attFullName with | Atts.emitMethod -> "$0." + macro + "($1...)" @@ -1106,7 +1239,12 @@ module Util = | Atts.emitIndexer -> "$0[$1]{{=$2}}" | Atts.emitProperty -> "$0." + macro + "{{=$1}}" | _ -> macro - Fable.Operation(Fable.Emit(macro, callInfo), typ, r) |> Some + let i: Fable.EmitInfo = { + Macro = macro + Args = args + IsJsStatement = isStatement + } + Fable.Emit(i, typ, r) |> Some | _ -> None) let (|Imported|_|) com r typ callInfo (memb: FSharpMemberOrFunctionOrValue, entity: FSharpEntity option) = @@ -1126,20 +1264,20 @@ module Util = // The value/method is not imported, check if the declaring entity is | None, Some callInfo, Some e -> - match tryGlobalOrImportedEntity com e, callInfo.ThisArg with + match tryGlobalOrImportedEntity com (FsEnt e), callInfo.ThisArg with | Some _, Some _thisArg -> callInstanceMember com r typ callInfo e memb |> Some | Some classExpr, None when memb.IsConstructor -> - Fable.Operation(Fable.Call(classExpr, { callInfo with IsJsConstructor = true }), typ, r) |> Some + emitJsExpr r typ (classExpr::callInfo.Args) "new $0($1...)" |> Some | Some moduleOrClassExpr, None -> // Set the field as mutable just in case, so it's not displaced by beta reduction - let fieldGet = Fable.FieldGet(getMemberDisplayName memb, true, Fable.Any) + let fieldGet = makeFieldKey (getMemberDisplayName memb) true Fable.Any if isModuleValueForCalls e memb then - Fable.Get(moduleOrClassExpr, fieldGet, typ, r) |> Some + Fable.Get(moduleOrClassExpr, Fable.ByKey fieldGet, typ, r) |> Some else - Fable.Get(moduleOrClassExpr, fieldGet, Fable.Any, None) + Fable.Get(moduleOrClassExpr, Fable.ByKey fieldGet, Fable.Any, None) |> makeCall r typ callInfo |> Some | None, _ -> None @@ -1150,7 +1288,7 @@ module Util = | argIdent::restArgIdents, argExpr::restArgExprs -> foldArgs ((argIdent, argExpr)::acc) (restArgIdents, restArgExprs) | (argIdent: FSharpMemberOrFunctionOrValue)::restArgIdents, [] -> - let t = makeType com ctx.GenericArgs argIdent.FullType + let t = makeType ctx.GenericArgs argIdent.FullType foldArgs ((argIdent, Fable.Value(Fable.NewOption(None, t), None))::acc) (restArgIdents, []) | [], _ -> List.rev acc @@ -1173,7 +1311,7 @@ module Util = // tries to inline it in DEBUG mode (some patterns depend on this) let ident = { makeIdentFrom com ctx argId with Type = arg.Type - Kind = Fable.CompilerGenerated } + IsCompilerGenerated = true } let ctx = putIdentInScope ctx argId ident (Some arg) ctx, (ident, arg)::bindings) @@ -1218,47 +1356,12 @@ module Util = | _ -> "none", arg::acc) |> snd - let hasInterface interfaceFullname (ent: FSharpEntity) = - let mutable found = false - let interfaceFullname = Some interfaceFullname - for t in ent.AllInterfaces do - found <- found || t.HasTypeDefinition && t.TypeDefinition.TryFullName = interfaceFullname - found - - let hasImplicitConstructor (ent: FSharpEntity) = - let mutable found = false - for m in ent.MembersFunctionsAndValues do - found <- found || m.IsImplicitConstructor - found - - let isImplicitConstructor (com: IFableCompiler) (ent: FSharpEntity) (cons: FSharpMemberOrFunctionOrValue) = - let rec tryGetImplicitConstructor (entityFullName: string) = function - | FSharpImplementationFileDeclaration.Entity (e, decls) -> - let entityFullName2 = getEntityFullName e - if entityFullName.StartsWith(entityFullName2) then - decls |> List.tryPick (tryGetImplicitConstructor entityFullName) - else None - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(m,_,_) -> - match m.IsImplicitConstructor, m.DeclaringEntity with - | true, Some e when getEntityFullName e = entityFullName -> Some m - | _ -> None - | FSharpImplementationFileDeclaration.InitAction _ -> None - - match ent.SignatureLocation with - // If the entity is in a signature file .IsImplicitConstructor won't work - | Some loc when loc.FileName.EndsWith(".fsi") -> - com.TryGetImplementationFile(loc.FileName) - |> Option.bind (fun file -> - let entityFullName = getEntityFullName ent - file.Declarations |> List.tryPick (tryGetImplicitConstructor entityFullName)) - |> Option.map (fun cons2 -> cons2.IsEffectivelySameAs(cons)) - |> Option.defaultValue false - | _ -> - cons.IsImplicitConstructor + let hasInterface interfaceFullname (ent: Fable.Entity) = + ent.AllInterfaces |> Seq.exists (fun ifc -> ifc.Definition.FullName = interfaceFullname) - let makeCallWithArgInfo com ctx r typ genArgs callee (memb: FSharpMemberOrFunctionOrValue) callInfo = + let makeCallWithArgInfo com ctx r typ genArgs callee (memb: FSharpMemberOrFunctionOrValue) (callInfo: Fable.CallInfo) = match memb, memb.DeclaringEntity with - | Emitted com r typ (Some callInfo) emitted, _ -> emitted + | Emitted com r typ callInfo.ThisArg callInfo.Args emitted, _ -> emitted | Imported com r typ (Some callInfo) imported -> imported | Replaced com ctx r typ genArgs callInfo replaced -> replaced | Inlined com ctx r genArgs callee callInfo.Args expr, _ -> expr @@ -1274,7 +1377,7 @@ module Util = callInstanceMember com r typ callInfo entity memb | _, Some entity when isModuleValueForCalls entity memb -> - let typ = makeType com ctx.GenericArgs memb.FullType + let typ = makeType ctx.GenericArgs memb.FullType memberRefTyped com ctx r typ memb | _ -> @@ -1285,8 +1388,7 @@ module Util = ThisArg = callee Args = transformOptionalArguments com ctx r memb genArgs args SignatureArgTypes = getArgTypes com memb - HasSpread = hasSeqSpread memb - AutoUncurrying = false + HasSpread = hasParamArray memb IsJsConstructor = false } @@ -1296,14 +1398,14 @@ module Util = |> makeCallWithArgInfo com ctx r typ genArgs callee memb let makeValueFrom (com: IFableCompiler) (ctx: Context) r (v: FSharpMemberOrFunctionOrValue) = - let typ = makeType com ctx.GenericArgs v.FullType + let typ = makeType ctx.GenericArgs v.FullType match v, v.DeclaringEntity with | _ when typ = Fable.Unit -> if com.Options.verbosity = Verbosity.Verbose && not v.IsCompilerGenerated then // See #1516 sprintf "Value %s is replaced with unit constant" v.DisplayName |> addWarning com ctx.InlinePath r Fable.Value(Fable.UnitConstant, r) - | Emitted com r typ None emitted, _ -> emitted + | Emitted com r typ None [] emitted, _ -> emitted | Imported com r typ None imported -> imported | Try (tryGetIdentFromScope ctx r) expr, _ -> expr | _ -> memberRefTyped com ctx r typ v diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index c85ffca71..98f18b579 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -27,28 +27,29 @@ let private checkArgumentsPassedByRef com ctx (args: FSharpExpr list) = |> addWarning com ctx.InlinePath (makeRangeFrom arg) | _ -> () -let private transformBaseConsCall com ctx r baseEnt (baseCons: FSharpMemberOrFunctionOrValue) genArgs baseArgs = +let private transformBaseConsCall com ctx r (baseEnt: FSharpEntity) (baseCons: FSharpMemberOrFunctionOrValue) genArgs baseArgs = + let baseEnt = FsEnt baseEnt + let argTypes = lazy getArgTypes com baseCons let baseArgs = transformExprList com ctx baseArgs |> run - let genArgs = genArgs |> Seq.map (makeType com ctx.GenericArgs) - match Replacements.tryBaseConstructor com baseEnt baseCons genArgs baseArgs with + let genArgs = genArgs |> Seq.map (makeType ctx.GenericArgs) + match Replacements.tryBaseConstructor com baseEnt argTypes genArgs baseArgs with | Some(baseRef, args) -> let callInfo: Fable.CallInfo = { ThisArg = None Args = args SignatureArgTypes = getArgTypes com baseCons HasSpread = false - AutoUncurrying = false IsJsConstructor = false } makeCall r Fable.Unit callInfo baseRef | None -> - if not(isImplicitConstructor com baseEnt baseCons) then + if not baseCons.IsImplicitConstructor then "Only inheriting from primary constructors is supported" - |> addErrorAndReturnNull com [] r + |> addWarningAndReturnNull com [] r else match makeCallFrom com ctx r Fable.Unit genArgs None baseArgs baseCons with - | Fable.Operation(Fable.Call(_, info), t, r) -> + | Fable.Call(_, info, t, r) -> let baseExpr = entityRef com baseEnt - Fable.Operation(Fable.Call(baseExpr, info), t, r) + Fable.Call(baseExpr, info, t, r) | e -> e // Unexpected, throw error? let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (argExprs: Fable.Expr list) = @@ -67,7 +68,7 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg | _ -> sprintf "StringEnum types cannot have fields: %O" tdef.TryFullName |> addErrorAndReturnNull com ctx.InlinePath r | OptionUnion typ -> - let typ = makeType com ctx.GenericArgs typ + let typ = makeType ctx.GenericArgs typ let expr = match argExprs with | [] -> None @@ -75,7 +76,7 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg | _ -> failwith "Unexpected args for Option constructor" Fable.NewOption(expr, typ) |> makeValue r | ListUnion typ -> - let typ = makeType com ctx.GenericArgs typ + let typ = makeType ctx.GenericArgs typ let headAndTail = match argExprs with | [] -> None @@ -83,8 +84,9 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg | _ -> failwith "Unexpected args for List constructor" Fable.NewList(headAndTail, typ) |> makeValue r | DiscriminatedUnion(tdef, genArgs) -> - let genArgs = makeGenArgs com ctx.GenericArgs genArgs - Fable.NewUnion(argExprs, unionCase, tdef, genArgs) |> makeValue r + let genArgs = makeGenArgs ctx.GenericArgs genArgs + let tag = unionCaseTag tdef unionCase + Fable.NewUnion(argExprs, tag, FsEnt tdef, genArgs) |> makeValue r let private transformTraitCall com (ctx: Context) r typ (sourceTypes: FSharpType list) traitName (flags: MemberFlags) (argTypes: FSharpType list) (argExprs: FSharpExpr list) = let makeCallInfo traitName entityFullName argTypes genArgs: Fable.ReplaceCallInfo = @@ -105,13 +107,14 @@ let private transformTraitCall com (ctx: Context) r typ (sourceTypes: FSharpType | genArgs -> genArgs |> List.mapi (fun i genArg -> "T" + string i, genArg) } - let resolveMemberCall (entity: FSharpEntity) genArgs membCompiledName isInstance argTypes thisArg args = - let genArgs = matchGenericParams genArgs entity.GenericParameters + let resolveMemberCall (entity: Fable.Entity) genArgs membCompiledName isInstance argTypes thisArg args = + let genParamNames = entity.GenericParameters |> List.map (fun x -> x.Name) + let genArgs = List.zip genParamNames genArgs tryFindMember com entity (Map genArgs) membCompiledName isInstance argTypes |> Option.map (fun memb -> makeCallFrom com ctx r typ [] thisArg args memb) let isInstance = flags.IsInstance - let argTypes = List.map (makeType com ctx.GenericArgs) argTypes + let argTypes = List.map (makeType ctx.GenericArgs) argTypes let argExprs = List.map (fun e -> com.Transform(ctx, e)) argExprs let thisArg, args, argTypes = match argExprs, argTypes with @@ -119,7 +122,7 @@ let private transformTraitCall com (ctx: Context) r typ (sourceTypes: FSharpType | args, argTypes -> None, args, argTypes sourceTypes |> Seq.tryPick (fun sourceType -> - let t = makeType com ctx.GenericArgs sourceType + let t = makeType ctx.GenericArgs sourceType match t with // Types with specific entry in Fable.AST // TODO: Check other types like booleans or numbers? @@ -145,7 +148,7 @@ let private transformTraitCall com (ctx: Context) r typ (sourceTypes: FSharpType let fieldName = Naming.removeGetSetPrefix traitName entity.FSharpFields |> Seq.tryPick (fun fi -> if fi.Name = fieldName then - let kind = Fable.FieldGet(fi.Name, fi.IsMutable, makeType com Map.empty fi.FieldType) + let kind = Fable.FieldKey(fi) |> Fable.ByKey Fable.Get(thisArg.Value, kind, typ, r) |> Some else None) |> Option.orElseWith (fun () -> @@ -157,7 +160,10 @@ let private transformTraitCall com (ctx: Context) r typ (sourceTypes: FSharpType Seq.zip sortedFieldNames genArgs |> Seq.tryPick (fun (fi, fiType) -> if fi = fieldName then - let kind = Fable.FieldGet(fi, false, fiType) + let kind = + FsField(fi, lazy fiType) :> Fable.Field + |> Fable.FieldKey + |> Fable.ByKey Fable.Get(thisArg.Value, kind, typ, r) |> Some else None) | _ -> None @@ -165,16 +171,13 @@ let private transformTraitCall com (ctx: Context) r typ (sourceTypes: FSharpType "Cannot resolve trait call " + traitName |> addErrorAndReturnNull com ctx.InlinePath r) let private getAttachedMemberInfo com ctx r nonMangledNameConflicts - (declaringEntity: FSharpEntity option) (sign: FSharpAbstractSignature): Fable.AttachedMemberInfo = - let entityName = - match declaringEntity with - | Some e -> getEntityDeclarationName com e - | None -> "" + (declaringEntityName: string option) (sign: FSharpAbstractSignature) attributes = + let declaringEntityName = defaultArg declaringEntityName "" let isGetter = sign.Name.StartsWith("get_") let isSetter = not isGetter && sign.Name.StartsWith("set_") let indexedProp = (isGetter && countNonCurriedParamsForSignature sign > 0) || (isSetter && countNonCurriedParamsForSignature sign > 1) - let name, isGetter, isSetter, isEnumerator, hasSpread = + let name, isMangled, isGetter, isSetter, isEnumerator, hasSpread = // Don't use the type from the arguments as the override may come // from another type, like ToString() match tryDefinition sign.DeclaringType with @@ -189,9 +192,10 @@ let private getAttachedMemberInfo com ctx r nonMangledNameConflicts // information about ParamArray, we need to check the source method. ent.TryGetMembersFunctionsAndValues |> Seq.tryFind (fun x -> x.CompiledName = sign.Name) - |> function Some m -> hasSeqSpread m | None -> false + |> function Some m -> hasParamArray m | None -> false + let isMangled = isMangledAbstractEntity ent let name, isGetter, isSetter = - if isMangledAbstractEntity ent then + if isMangled then let overloadHash = if (isGetter || isSetter) && not indexedProp then "" else OverloadSuffix.getAbstractSignatureHash ent sign @@ -202,14 +206,19 @@ let private getAttachedMemberInfo com ctx r nonMangledNameConflicts if indexedProp then sign.Name, false, false else Naming.removeGetSetPrefix sign.Name, isGetter, isSetter // Setters can have same name as getters, assume there will always be a getter - if not isSetter && nonMangledNameConflicts entityName name then + if not isSetter && nonMangledNameConflicts declaringEntityName name then sprintf "Member %s is duplicated, use Mangle attribute to prevent conflicts with interfaces" name |> addError com ctx.InlinePath r name, isGetter, isSetter - name, isGetter, isSetter, isEnumerator, hasSpread + name, isMangled, isGetter, isSetter, isEnumerator, hasSpread | None -> - Naming.removeGetSetPrefix sign.Name, isGetter, isSetter, false, false - Fable.AttachedMemberInfo(name, declaringEntity, hasSpread, false, isGetter, isSetter, isEnumerator, ?range=r) + Naming.removeGetSetPrefix sign.Name, false, isGetter, isSetter, false, false + name, MemberDeclInfo(attributes=attributes, + hasSpread=hasSpread, + isGetter=isGetter, + isSetter=isSetter, + isEnumerator=isEnumerator, + isMangled=isMangled) let private transformObjExpr (com: IFableCompiler) (ctx: Context) (objType: FSharpType) baseCallExpr (overrides: FSharpObjectExprOverride list) otherOverrides = @@ -218,12 +227,17 @@ let private transformObjExpr (com: IFableCompiler) (ctx: Context) (objType: FSha let nonMangledNameConflicts _ name = nonMangledMemberNames.Add(name) |> not - let mapOverride (over: FSharpObjectExprOverride) = + let mapOverride (over: FSharpObjectExprOverride): Thunk = trampoline { let ctx, args = bindMemberArgs com ctx over.CurriedParameterGroups let! body = transformExpr com ctx over.Body - let info = getAttachedMemberInfo com ctx body.Range nonMangledNameConflicts None over.Signature - return args, body, info + let name, info = getAttachedMemberInfo com ctx body.Range nonMangledNameConflicts None over.Signature [] + return { Ident = makeIdent name + Args = args + Body = body + // UsedNames are not used for obj expr members + UsedNames = Set.empty + Info = info } } trampoline { @@ -235,9 +249,9 @@ let private transformObjExpr (com: IFableCompiler) (ctx: Context) (objType: FSha | BasicPatterns.Call(None,baseCall,genArgs1,genArgs2,baseArgs) -> match baseCall.DeclaringEntity with | Some baseType when baseType.TryFullName <> Some Types.object -> - let typ = makeType com ctx.GenericArgs baseCallExpr.Type + let typ = makeType ctx.GenericArgs baseCallExpr.Type let! baseArgs = transformExprList com ctx baseArgs - let genArgs = genArgs1 @ genArgs2 |> Seq.map (makeType com ctx.GenericArgs) + let genArgs = genArgs1 @ genArgs2 |> Seq.map (makeType ctx.GenericArgs) return makeCallFrom com ctx None typ genArgs None baseArgs baseCall |> Some | _ -> return None | _ -> return None @@ -248,18 +262,18 @@ let private transformObjExpr (com: IFableCompiler) (ctx: Context) (objType: FSha |> trampolineListMap (fun (_typ, overrides) -> overrides |> trampolineListMap mapOverride) - return Fable.ObjectExpr(members |> List.concat, makeType com ctx.GenericArgs objType, baseCall) + return Fable.ObjectExpr(members |> List.concat, makeType ctx.GenericArgs objType, baseCall) } let private transformDelegate com ctx delegateType expr = trampoline { let! expr = transformExpr com ctx expr - match makeType com ctx.GenericArgs delegateType with - | Fable.FunctionType(Fable.DelegateType argTypes, _) -> + match makeType ctx.GenericArgs delegateType with + | Fable.DelegateType(argTypes, _) -> let arity = List.length argTypes |> max 1 match expr with | LambdaUncurriedAtCompileTime (Some arity) lambda -> return lambda - | _ -> return Replacements.uncurryExprAtRuntime arity expr + | _ -> return Replacements.uncurryExprAtRuntime com arity expr | _ -> return expr } @@ -281,7 +295,7 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r |> Seq.findIndex (fun arg -> arg.Name = name) genArgs.[index] else fi.FieldType - let kind = makeType com ctx.GenericArgs typ |> Fable.TypeTest + let kind = makeType ctx.GenericArgs typ |> Fable.TypeTest return Fable.Test(unionExpr, kind, r) | _ -> return "Erased unions with multiple cases cannot have more than one field: " + (getFsTypeFullName fsType) @@ -295,8 +309,8 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r | StringEnum(_, rule) -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqualStrict | DiscriminatedUnion(tdef,_) -> - let kind = Fable.UnionCaseTest(unionCase, tdef) - return Fable.Test(unionExpr, kind, r) + let tag = unionCaseTag tdef unionCase + return Fable.Test(unionExpr, Fable.UnionCaseTest(tag), r) } let rec private transformDecisionTargets (com: IFableCompiler) (ctx: Context) acc @@ -317,21 +331,21 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = trampoline { match fsExpr with | OptimizedOperator(memb, comp, opName, argTypes, argExprs) -> - let r, typ = makeRangeFrom fsExpr, makeType com ctx.GenericArgs fsExpr.Type - let argTypes = argTypes |> List.map (makeType com ctx.GenericArgs) + let r, typ = makeRangeFrom fsExpr, makeType ctx.GenericArgs fsExpr.Type + let argTypes = argTypes |> List.map (makeType ctx.GenericArgs) let! args = transformExprList com ctx argExprs - let entity = + let entity: Fable.Entity = match comp with - | Some comp -> comp.DeclaringEntity.Value - | None -> memb.DeclaringEntity.Value + | Some comp -> upcast FsEnt comp.DeclaringEntity.Value + | None -> upcast FsEnt memb.DeclaringEntity.Value let membOpt = tryFindMember com entity ctx.GenericArgs opName false argTypes return (match membOpt with | Some memb -> makeCallFrom com ctx r typ argTypes None args memb - | None -> failwithf "Cannot find member %A.%A" (entity.FullName) opName) + | None -> failwithf "Cannot find member %s.%s" (entity.FullName) opName) | BasicPatterns.Coerce(targetType, inpExpr) -> let! (inpExpr: Fable.Expr) = transformExpr com ctx inpExpr - let t = makeType com ctx.GenericArgs targetType + let t = makeType ctx.GenericArgs targetType match tryDefinition targetType with | Some(_, Some fullName) -> match fullName with @@ -349,22 +363,22 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = | ByrefArgToTuple (callee, memb, ownerGenArgs, membGenArgs, membArgs) -> let! callee = transformExprOpt com ctx callee let! args = transformExprList com ctx membArgs - let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs) - let typ = makeType com ctx.GenericArgs fsExpr.Type + let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + let typ = makeType ctx.GenericArgs fsExpr.Type return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs callee args memb | ByrefArgToTupleOptimizedIf (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr) -> let ctx, ident = putArgInScope com ctx outArg let! callee = transformExprOpt com ctx callee let! args = transformExprList com ctx membArgs - let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs) - let byrefType = makeType com ctx.GenericArgs (List.last membArgs).Type + let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent let tupleIdentExpr = Fable.IdentExpr tupleIdent let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb - let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleGet 1, tupleType, None) - let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleGet 0, tupleType, None) + let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None) + let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) let! thenExpr = transformExpr com ctx thenExpr let! elseExpr = transformExpr com ctx elseExpr let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None) @@ -374,12 +388,12 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let ctx, ident = putArgInScope com ctx outArg let! callee = transformExprOpt com ctx callee let! args = transformExprList com ctx membArgs - let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs) - let byrefType = makeType com ctx.GenericArgs (List.last membArgs).Type + let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple let tupleIdentExpr = Fable.IdentExpr ident let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb - let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleGet 0, tupleType, None) + let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) let! thenExpr = transformExpr com ctx thenExpr let! elseExpr = transformExpr com ctx elseExpr let! targetsExpr = transformDecisionTargets com ctx [] targetsExpr @@ -391,14 +405,14 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let ctx, ident2 = putArgInScope com ctx id2 let! callee = transformExprOpt com ctx callee let! args = transformExprList com ctx membArgs - let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs) - let byrefType = makeType com ctx.GenericArgs (List.last membArgs).Type + let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent let tupleIdentExpr = Fable.IdentExpr tupleIdent let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb - let id1Expr = Fable.Get(tupleIdentExpr, Fable.TupleGet 0, tupleType, None) - let id2Expr = Fable.Get(tupleIdentExpr, Fable.TupleGet 1, tupleType, None) + let id1Expr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) + let id2Expr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None) let! restExpr = transformExpr com ctx restExpr let body = Fable.Let([ident1, id1Expr], Fable.Let([ident2, id2Expr], restExpr)) return Fable.Let([tupleIdent, tupleExpr], body) @@ -407,8 +421,8 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let! callee = transformExpr com ctx callee let! args = transformExprList com ctx membArgs let callee = get None Fable.Any callee eventName - let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs) - let typ = makeType com ctx.GenericArgs fsExpr.Type + let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + let typ = makeType ctx.GenericArgs fsExpr.Type return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs (Some callee) args memb | BindCreateEvent (var, value, eventName, body) -> @@ -422,7 +436,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = | ForOf (PutArgInScope com ctx (newContext, ident), value, body) -> let! value = transformExpr com ctx value let! body = transformExpr com newContext body - return Replacements.iterate (makeRangeFrom fsExpr) ident body value + return Replacements.iterate com (makeRangeFrom fsExpr) ident body value // Flow control | BasicPatterns.FastIntegerForLoop(start, limit, body, isUp) -> @@ -432,24 +446,22 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let! start = transformExpr com ctx start let! limit = transformExpr com ctx limit let! body = transformExpr com newContext body - return Fable.For (ident, start, limit, body, isUp) - |> makeLoop r + return makeForLoop r isUp ident start limit body | _ -> return failwithf "Unexpected loop %O: %A" r fsExpr | BasicPatterns.WhileLoop(guardExpr, bodyExpr) -> let! guardExpr = transformExpr com ctx guardExpr let! bodyExpr = transformExpr com ctx bodyExpr - return Fable.While (guardExpr, bodyExpr) - |> makeLoop (makeRangeFrom fsExpr) + return (guardExpr, bodyExpr) ||> makeWhileLoop (makeRangeFrom fsExpr) // Values | BasicPatterns.Const(value, typ) -> - let typ = makeType com ctx.GenericArgs typ - return Replacements.makeTypeConst (makeRangeFrom fsExpr) typ value + let typ = makeType ctx.GenericArgs typ + return Replacements.makeTypeConst com (makeRangeFrom fsExpr) typ value | BasicPatterns.BaseValue typ -> let r = makeRangeFrom fsExpr - let typ = makeType com Map.empty typ + let typ = makeType Map.empty typ return Fable.Value(Fable.BaseValue(ctx.BoundMemberThis, typ), r) // F# compiler doesn't represent `this` in non-constructors as BasicPatterns.ThisValue (but BasicPatterns.Value) @@ -464,7 +476,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = |> addErrorAndReturnNull com ctx.InlinePath r) // Check if `this` has been bound previously to avoid conflicts with an object expression | _, Some i -> identWithRange r i |> Fable.IdentExpr - | _, None -> Fable.Value(makeType com Map.empty typ |> Fable.ThisValue, r) + | _, None -> Fable.Value(makeType Map.empty typ |> Fable.ThisValue, r) | BasicPatterns.Value var -> let r = makeRangeFrom fsExpr @@ -483,7 +495,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = // Capture variable generic type mapping | BasicPatterns.Let((var, value), (BasicPatterns.Application(_body, genArgs, _args) as expr)) -> - let genArgs = Seq.map (makeType com ctx.GenericArgs) genArgs + let genArgs = Seq.map (makeType ctx.GenericArgs) genArgs let ctx = { ctx with GenericArgs = matchGenericParamsFrom var genArgs |> Map } let! value = transformExpr com ctx value let ctx, ident = putBindingInScope com ctx var value @@ -519,7 +531,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = // `argTypes2` is always empty | BasicPatterns.TraitCall(sourceTypes, traitName, flags, argTypes, _argTypes2, argExprs) -> - let typ = makeType com ctx.GenericArgs fsExpr.Type + let typ = makeType ctx.GenericArgs fsExpr.Type return transformTraitCall com ctx (makeRangeFrom fsExpr) typ sourceTypes traitName flags argTypes argExprs | BasicPatterns.Call(callee, memb, ownerGenArgs, membGenArgs, args) -> @@ -527,8 +539,8 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let! callee = transformExprOpt com ctx callee let! args = transformExprList com ctx args // TODO: Check answer to #868 in FSC repo - let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs) - let typ = makeType com ctx.GenericArgs fsExpr.Type + let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + let typ = makeType ctx.GenericArgs fsExpr.Type return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs callee args memb | BasicPatterns.Application(applied, _genArgs, []) -> @@ -541,15 +553,15 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let r = makeRangeFrom fsExpr match ctx.ScopeInlineValues |> List.tryFind (fun (v,_) -> obj.Equals(v, var)) with | Some (_,fsExpr) -> - let genArgs = Seq.map (makeType com ctx.GenericArgs) genArgs + let genArgs = Seq.map (makeType ctx.GenericArgs) genArgs let resolvedCtx = { ctx with GenericArgs = matchGenericParamsFrom var genArgs |> Map } let! callee = transformExpr com resolvedCtx fsExpr match args with | [] -> return callee | args -> - let typ = makeType com ctx.GenericArgs fsExpr.Type + let typ = makeType ctx.GenericArgs fsExpr.Type let! args = transformExprList com ctx args - return Fable.Operation(Fable.CurriedApply(callee, args), typ, r) + return Fable.CurriedApply(callee, args, typ, r) | None -> return "Cannot resolve locally inlined value: " + var.DisplayName |> addErrorAndReturnNull com ctx.InlinePath r @@ -560,12 +572,16 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = when m.FullName = "Fable.Core.JsInterop.( ? )" -> let! e1 = transformExpr com ctx e1 let! e2 = transformExpr com ctx e2 - let e = Fable.Get(e1, Fable.ExprGet e2, Fable.Any, e1.Range) + let e = Fable.Get(e1, Fable.ByKey(Fable.ExprKey e2), Fable.Any, e1.Range) let! args = transformExprList com ctx args let args = destructureTupleArgs args - let typ = makeType com ctx.GenericArgs fsExpr.Type - let callInfo = { makeSimpleCallInfo None args [] with AutoUncurrying = true } - return Fable.Operation(Fable.Call(e, callInfo), typ, makeRangeFrom fsExpr) + let typ = makeType ctx.GenericArgs fsExpr.Type + // Convert this to emit so auto-uncurrying is applied + let emitInfo: Fable.EmitInfo = + { Macro = "$0($1...)" + Args = e::args + IsJsStatement = false } + return Fable.Emit(emitInfo, typ, makeRangeFrom fsExpr) // Some instance members such as Option.get_IsSome are compiled as static members, and the F# compiler // wraps calls with an application. But in Fable they will be replaced so the application is not needed @@ -576,8 +592,8 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = | BasicPatterns.Application(applied, _genArgs, args) -> let! applied = transformExpr com ctx applied let! args = transformExprList com ctx args - let typ = makeType com ctx.GenericArgs fsExpr.Type - return Fable.Operation(Fable.CurriedApply(applied, args), typ, makeRangeFrom fsExpr) + let typ = makeType ctx.GenericArgs fsExpr.Type + return Fable.CurriedApply(applied, args, typ, makeRangeFrom fsExpr) | BasicPatterns.IfThenElse (guardExpr, thenExpr, elseExpr) -> let! guardExpr = transformExpr com ctx guardExpr @@ -590,7 +606,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let errorMessage = "The match cases were incomplete" let rangeOfElseExpr = makeRangeFrom elseExpr let errorExpr = Replacements.Helpers.error (Fable.Value(Fable.StringConstant errorMessage, None)) - Fable.Throw(errorExpr, Fable.Any, rangeOfElseExpr) + makeThrow rangeOfElseExpr errorExpr | _ -> fableElseExpr @@ -615,31 +631,31 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = match args with | [arg] -> let! body = transformExpr com ctx body - return Fable.Function(Fable.Lambda arg, body, None) + return Fable.Lambda(arg, body, None) | _ -> return failwith "makeFunctionArgs returns args with different length" // Getters and Setters | BasicPatterns.AnonRecordGet(callee, calleeType, fieldIndex) -> let! callee = transformExpr com ctx callee let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex] - let typ = makeType com ctx.GenericArgs fsExpr.Type - let kind = Fable.FieldGet(fieldName, false, typ) - return Fable.Get(callee, kind, typ, makeRangeFrom fsExpr) + let typ = makeType ctx.GenericArgs fsExpr.Type + let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey + return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr) | BasicPatterns.FSharpFieldGet(callee, calleeType, field) -> let! callee = transformExprOpt com ctx callee let callee = match callee with | Some callee -> callee - | None -> entityRef com calleeType.TypeDefinition - let kind = Fable.FieldGet(getFSharpFieldName field, field.IsMutable, makeType com Map.empty field.FieldType) - let typ = makeType com ctx.GenericArgs fsExpr.Type - return Fable.Get(callee, kind, typ, makeRangeFrom fsExpr) + | None -> entityRef com (FsEnt calleeType.TypeDefinition) + let key = FsField field :> Fable.Field |> Fable.FieldKey + let typ = makeType ctx.GenericArgs fsExpr.Type + return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr) | BasicPatterns.TupleGet(_tupleType, tupleElemIndex, tupleExpr) -> let! tupleExpr = transformExpr com ctx tupleExpr - let typ = makeType com ctx.GenericArgs fsExpr.Type - return Fable.Get(tupleExpr, Fable.TupleGet tupleElemIndex, typ, makeRangeFrom fsExpr) + let typ = makeType ctx.GenericArgs fsExpr.Type + return Fable.Get(tupleExpr, Fable.TupleIndex tupleElemIndex, typ, makeRangeFrom fsExpr) | BasicPatterns.UnionCaseGet (unionExpr, fsType, unionCase, field) -> let r = makeRangeFrom fsExpr @@ -649,23 +665,26 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = if unionCase.UnionCaseFields.Count = 1 then return unionExpr else let index = unionCase.UnionCaseFields |> Seq.findIndex (fun x -> x.Name = field.Name) - return Fable.Get(unionExpr, Fable.TupleGet index, makeType com ctx.GenericArgs fsType, r) + return Fable.Get(unionExpr, Fable.TupleIndex index, makeType ctx.GenericArgs fsType, r) | StringEnum _ -> return "StringEnum types cannot have fields" |> addErrorAndReturnNull com ctx.InlinePath r | OptionUnion t -> - return Fable.Get(unionExpr, Fable.OptionValue, makeType com ctx.GenericArgs t, r) + return Fable.Get(unionExpr, Fable.OptionValue, makeType ctx.GenericArgs t, r) | ListUnion t -> - let t = makeType com ctx.GenericArgs t + let t = makeType ctx.GenericArgs t let kind, t = if field.Name = "Head" then Fable.ListHead, t else Fable.ListTail, Fable.List t return Fable.Get(unionExpr, kind, t, r) | DiscriminatedUnion _ -> - let t = makeType com Map.empty field.FieldType - let kind = Fable.UnionField(field, unionCase, t) - let typ = makeType com ctx.GenericArgs fsExpr.Type + let t = makeType Map.empty field.FieldType + let index = + unionCase.UnionCaseFields + |> Seq.findIndex (fun fi -> fi.Name = field.Name) + let kind = Fable.UnionField(index, t) + let typ = makeType ctx.GenericArgs fsExpr.Type return Fable.Get(unionExpr, kind, typ, r) | BasicPatterns.FSharpFieldSet(callee, calleeType, field, value) -> @@ -674,8 +693,9 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let callee = match callee with | Some callee -> callee - | None -> entityRef com calleeType.TypeDefinition - return Fable.Set(callee, Fable.FieldSet(getFSharpFieldName field, makeType com Map.empty field.FieldType), value, makeRangeFrom fsExpr) + | None -> entityRef com (FsEnt calleeType.TypeDefinition) + let field = FsField field :> Fable.Field |> Fable.FieldKey |> Some + return Fable.Set(callee, field, value, makeRangeFrom fsExpr) | BasicPatterns.UnionCaseTag(unionExpr, _unionType) -> let! unionExpr = transformExpr com ctx unionExpr @@ -692,10 +712,10 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = // Mutable and public module values are compiled as functions, because // values imported from ES2015 modules cannot be modified (see #986) let valToSet = makeValueFrom com ctx r valToSet - return Fable.Operation(Fable.CurriedApply(valToSet, [valueExpr]), Fable.Unit, r) + return Fable.CurriedApply(valToSet, [valueExpr], Fable.Unit, r) | _ -> let valToSet = makeValueFrom com ctx r valToSet - return Fable.Set(valToSet, Fable.VarSet, valueExpr, r) + return Fable.Set(valToSet, None, valueExpr, r) // Instantiation | BasicPatterns.NewArray(FableType com ctx elTyp, argExprs) -> @@ -721,8 +741,8 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = | BasicPatterns.NewObject(memb, genArgs, args) -> // TODO: Check arguments passed byref here too? let! args = transformExprList com ctx args - let genArgs = Seq.map (makeType com ctx.GenericArgs) genArgs - let typ = makeType com ctx.GenericArgs fsExpr.Type + let genArgs = Seq.map (makeType ctx.GenericArgs) genArgs + let typ = makeType ctx.GenericArgs fsExpr.Type return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb // work-around for optimized "for x in list" (erases this sequential) @@ -742,14 +762,14 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = | BasicPatterns.NewRecord(fsType, argExprs) -> let! argExprs = transformExprList com ctx argExprs - let genArgs = makeGenArgs com ctx.GenericArgs (getGenericArguments fsType) - return Fable.NewRecord(argExprs, Fable.DeclaredRecord fsType.TypeDefinition, genArgs) |> makeValue (makeRangeFrom fsExpr) + let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType) + return Fable.NewRecord(argExprs, FsEnt fsType.TypeDefinition, genArgs) |> makeValue (makeRangeFrom fsExpr) | BasicPatterns.NewAnonRecord(fsType, argExprs) -> let! argExprs = transformExprList com ctx argExprs let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames - let genArgs = makeGenArgs com ctx.GenericArgs (getGenericArguments fsType) - return Fable.NewRecord(argExprs, Fable.AnonymousRecord fieldNames, genArgs) |> makeValue (makeRangeFrom fsExpr) + let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType) + return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue (makeRangeFrom fsExpr) | BasicPatterns.NewUnionCase(fsType, unionCase, argExprs) -> let! argExprs = transformExprList com ctx argExprs @@ -782,7 +802,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = fileNameWhereErrorOccurs let errorExpr = Replacements.Helpers.error (Fable.Value(Fable.StringConstant errorMessage, None)) // Creates a "throw Error({errorMessage})" expression - let throwExpr = Fable.Throw(errorExpr, Fable.Any, rangeOfLastDecisionTarget) + let throwExpr = makeThrow rangeOfLastDecisionTarget errorExpr fableDecisionTargets |> List.replaceLast (fun _lastExpr -> [], throwExpr) @@ -797,13 +817,13 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = | BasicPatterns.DecisionTreeSuccess(targetIndex, boundValues) -> let! boundValues = transformExprList com ctx boundValues - let typ = makeType com ctx.GenericArgs fsExpr.Type + let typ = makeType ctx.GenericArgs fsExpr.Type return Fable.DecisionTreeSuccess(targetIndex, boundValues, typ) | BasicPatterns.ILFieldGet(None, ownerTyp, fieldName) -> - let ownerTyp = makeType com ctx.GenericArgs ownerTyp - let typ = makeType com ctx.GenericArgs fsExpr.Type - match Replacements.tryField typ ownerTyp fieldName with + let ownerTyp = makeType ctx.GenericArgs ownerTyp + let typ = makeType ctx.GenericArgs fsExpr.Type + match Replacements.tryField com typ ownerTyp fieldName with | Some expr -> return expr | None -> return sprintf "Cannot compile ILFieldGet(%A, %s)" ownerTyp fieldName @@ -833,42 +853,41 @@ let private isIgnoredNonAttachedMember (meth: FSharpMemberOrFunctionOrValue) = | Some(Atts.global_ | Naming.StartsWith Atts.import _ | Naming.StartsWith Atts.emit _) -> true | _ -> false) || (match meth.DeclaringEntity with - | Some ent -> isGlobalOrImportedEntity ent + | Some ent -> isGlobalOrImportedEntity (FsEnt ent) | None -> false) -let private isRecordLike (ent: FSharpEntity) = - ent.IsFSharpRecord - || ent.IsFSharpExceptionDeclaration - || ((ent.IsClass || ent.IsValueType) && not ent.IsMeasure - && not ent.IsEnum - && not (hasImplicitConstructor ent)) - -let private transformImplicitConstructor com (ctx: Context) +let private transformImplicitConstructor (com: FableCompiler) (ctx: Context) (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = match memb.DeclaringEntity with | None -> "Unexpected constructor without declaring entity: " + memb.FullName |> addError com ctx.InlinePath None; [] | Some ent -> - let mutable baseRefAndConsCall = None + let mutable baseCall = None let captureBaseCall = ent.BaseType |> Option.bind (fun (NonAbbreviatedType baseType) -> if baseType.HasTypeDefinition then let ent = baseType.TypeDefinition match ent.TryFullName with | Some name when name <> Types.object -> - Some(ent, fun c -> baseRefAndConsCall <- Some c) + Some(ent, fun c -> baseCall <- Some c) | _ -> None else None) let bodyCtx, args = bindMemberArgs com ctx args let bodyCtx = { bodyCtx with CaptureBaseConsCall = captureBaseCall } let body = transformExpr com bodyCtx body |> run let consName, _ = getMemberDeclarationName com memb - let entityName = getEntityDeclarationName com ent - let r = getEntityLocation ent |> makeRange - let info = Fable.ClassImplicitConstructorInfo(ent, consName, entityName, - args, body, baseRefAndConsCall, hasSeqSpread memb, - isPublicMember memb, isPublicEntity ent, r) - [Fable.ClassImplicitConstructorDeclaration(info, set ctx.UseNamesInDeclarationScope)] + let info = MemberDeclInfo(memb.Attributes, + hasSpread=hasParamArray memb, + isPublic=isPublicMember memb, + isInstance=false) + let cons: Fable.MemberDecl = + { Ident = makeIdent consName + Args = args + Body = body + UsedNames = set ctx.UseNamesInDeclarationScope + Info = info } + com.AddConstructor(ent.FullName, cons, baseCall) + [] /// When using `importMember`, uses the member display name as selector let private importExprSelector (memb: FSharpMemberOrFunctionOrValue) selector = @@ -881,17 +900,23 @@ let private transformImport com r typ isMutable isPublic name selector path = if isMutable && isPublic then // See #1314 "Imported members cannot be mutable and public, please make it private: " + name |> addError com [] None - let info = Fable.ModuleMemberInfo(name, isValue=true, isPublic=isPublic, isMutable=isMutable) - let fableValue = Fable.Import(selector, path, Fable.CustomImport, typ, r) - [Fable.ModuleMemberDeclaration([], fableValue, info, Set.empty)] + let info = MemberDeclInfo(isValue=true, isPublic=isPublic, isMutable=isMutable) + let ident = { makeIdent name with Range = r + IsCompilerGenerated = false } + [Fable.MemberDeclaration + { Ident = ident + Args = [] + Body = Fable.Import(selector, path, typ, r) + UsedNames = Set.empty + Info = info }] let private transformMemberValue (com: IFableCompiler) ctx isPublic name (memb: FSharpMemberOrFunctionOrValue) (value: FSharpExpr) = let value = transformExpr com ctx value |> run match value with // Accept import expressions, e.g. let foo = import "foo" "myLib" - | Fable.Import(selector, path, Fable.CustomImport, typ, r) -> + | Fable.Import(selector, path, typ, r) -> match typ with - | Fable.FunctionType(Fable.LambdaType _, Fable.FunctionType(Fable.LambdaType _, _)) -> + | Fable.LambdaType(_, Fable.LambdaType(_, _)) -> "Change declaration of member: " + name + "\n" + "Importing JS functions with multiple arguments as `let add: int->int->int` won't uncurry parameters." + "\n" + "Use following syntax: `let add (x:int) (y:int): int = import ...`" @@ -900,51 +925,56 @@ let private transformMemberValue (com: IFableCompiler) ctx isPublic name (memb: let selector = importExprSelector memb selector transformImport com r typ memb.IsMutable isPublic name selector path | fableValue -> - let r = makeRange memb.DeclarationLocation - let info = Fable.ModuleMemberInfo(name, ?declaringEntity=memb.DeclaringEntity, - isValue=true, isPublic=isPublic, isMutable=memb.IsMutable, range=r) - [Fable.ModuleMemberDeclaration([], fableValue, info, set ctx.UseNamesInDeclarationScope)] - -let private moduleMemberDeclarationInfo name isValue isPublic (memb: FSharpMemberOrFunctionOrValue): Fable.ModuleMemberInfo = - Fable.ModuleMemberInfo(name, - ?declaringEntity=memb.DeclaringEntity, - hasSpread=hasSeqSpread memb, - isValue=isValue, - isPublic=isPublic, - isInstance=memb.IsInstanceMember, - isMutable=memb.IsMutable, - isEntryPoint=hasAttribute Atts.entryPoint memb.Attributes, - range=makeRange memb.DeclarationLocation) + let info = MemberDeclInfo(memb.Attributes, isValue=true, isPublic=isPublic, isMutable=memb.IsMutable) + [Fable.MemberDeclaration + { Ident = makeRangedIdent memb.DeclarationLocation memb.DisplayName name + Args = [] + Body = fableValue + UsedNames = set ctx.UseNamesInDeclarationScope + Info = info }] + +let private moduleMemberDeclarationInfo isPublic (memb: FSharpMemberOrFunctionOrValue): Fable.MemberDeclInfo = + MemberDeclInfo(memb.Attributes, + hasSpread=hasParamArray memb, + isPublic=isPublic, + isInstance=memb.IsInstanceMember, + isMutable=memb.IsMutable) :> _ let private transformMemberFunction (com: IFableCompiler) ctx isPublic name (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = let bodyCtx, args = bindMemberArgs com ctx args let body = transformExpr com bodyCtx body |> run match body with // Accept import expressions, e.g. let foo x y = import "foo" "myLib" - | Fable.Import(selector, path, Fable.CustomImport, _, r) -> + | Fable.Import(selector, path, _, r) -> // Use the full function type - let typ = makeType com Map.empty memb.FullType + let typ = makeType Map.empty memb.FullType let selector = importExprSelector memb selector transformImport com r typ false isPublic name selector path | body -> // If this is a static constructor, call it immediately if memb.CompiledName = ".cctor" then - let fn = Fable.Function(Fable.Delegate args, body, Some name) - let apply = makeCall None Fable.Unit (makeSimpleCallInfo None [] []) fn + let fn = Fable.Delegate(args, body, Some name) + let apply = makeCall None Fable.Unit (makeCallInfo None [] []) fn [Fable.ActionDeclaration(apply, set ctx.UseNamesInDeclarationScope)] else - let info = moduleMemberDeclarationInfo name false isPublic memb - [Fable.ModuleMemberDeclaration(args, body, info, set ctx.UseNamesInDeclarationScope)] + [Fable.MemberDeclaration + { Ident = makeRangedIdent memb.DeclarationLocation memb.DisplayName name + Args = args + Body = body + UsedNames = set ctx.UseNamesInDeclarationScope + Info = moduleMemberDeclarationInfo isPublic memb }] let private transformMemberFunctionOrValue (com: IFableCompiler) ctx (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = let isPublic = isPublicMember memb let name, _ = getMemberDeclarationName com memb - match memb.Attributes with + memb.Attributes + |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) + |> function | ImportAtt(selector, path) -> let selector = if selector = Naming.placeholder then getMemberDisplayName memb else selector - let typ = makeType com Map.empty memb.FullType + let typ = makeType Map.empty memb.FullType transformImport com None typ memb.IsMutable isPublic name (makeStrConst selector) (makeStrConst path) | _ -> if isModuleValueForDeclarations memb @@ -952,13 +982,18 @@ let private transformMemberFunctionOrValue (com: IFableCompiler) ctx (memb: FSha else transformMemberFunction com ctx isPublic name memb args body let private transformAttachedMember (com: FableCompiler) (ctx: Context) - (declaringEntity: FSharpEntity) (signature: FSharpAbstractSignature) + (declaringEntity: Fable.Entity) (signature: FSharpAbstractSignature) (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = let bodyCtx, args = bindMemberArgs com ctx args let body = transformExpr com bodyCtx body |> run - let r = makeRange memb.DeclarationLocation |> Some - let info = getAttachedMemberInfo com ctx r com.NonMangledAttachedMemberConflicts (Some declaringEntity) signature - [Fable.AttachedMemberDeclaration(args, body, info, declaringEntity, set ctx.UseNamesInDeclarationScope)] + let entFullName = declaringEntity.FullName + let name, info = getAttachedMemberInfo com ctx body.Range com.NonMangledAttachedMemberConflicts (Some entFullName) signature memb.Attributes + com.AddAttachedMember(entFullName, + { Ident = makeRangedIdent memb.DeclarationLocation signature.Name name + Args = args + Body = body + UsedNames = set ctx.UseNamesInDeclarationScope + Info = info }) let private transformMemberDecl (com: FableCompiler) (ctx: Context) (memb: FSharpMemberOrFunctionOrValue) (args: FSharpMemberOrFunctionOrValue list list) (body: FSharpExpr) = @@ -981,22 +1016,22 @@ let private transformMemberDecl (com: FableCompiler) (ctx: Context) (memb: FShar transformImplicitConstructor com ctx memb args body elif memb.IsOverrideOrExplicitInterfaceImplementation then // Ignore attached members generated by the F# compiler (for comparison and equality) - if memb.IsCompilerGenerated then [] - else + if not memb.IsCompilerGenerated then match memb.DeclaringEntity with | Some declaringEntity -> - if isGlobalOrImportedEntity declaringEntity then [] + let declaringEntity = FsEnt declaringEntity :> Fable.Entity + if isGlobalOrImportedEntity declaringEntity then () elif isErasedOrStringEnumEntity declaringEntity then let r = makeRange memb.DeclarationLocation |> Some "Erased types cannot implement abstract members" |> addError com ctx.InlinePath r - [] else // Not sure when it's possible that a member implements multiple abstract signatures - memb.ImplementedAbstractSignatures |> Seq.tryHead - |> Option.map (fun s -> transformAttachedMember com ctx declaringEntity s memb args body) - |> Option.defaultValue [] - | None -> [] + memb.ImplementedAbstractSignatures + |> Seq.tryHead + |> Option.iter (fun s -> transformAttachedMember com ctx declaringEntity s memb args body) + | None -> () + [] else transformMemberFunctionOrValue com ctx memb args body let private addUsedRootName com (usedRootNames: Set) name = @@ -1009,39 +1044,33 @@ let private addUsedRootName com (usedRootNames: Set) name = let rec private getUsedRootNames com (usedNames: Set) decls = (usedNames, decls) ||> List.fold (fun usedNames decl -> match decl with - | FSharpImplementationFileDeclaration.Entity(ent, sub) -> + | FSharpImplementationFileDeclaration.Entity(ent, []) -> + let ent = FsEnt(ent) :> Fable.Entity if isErasedOrStringEnumEntity ent then usedNames - elif ent.IsFSharpUnion || isRecordLike ent then + else getEntityDeclarationName com ent |> addUsedRootName com usedNames - else - getUsedRootNames com usedNames sub + | FSharpImplementationFileDeclaration.Entity(ent, sub) -> + getUsedRootNames com usedNames sub | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb,_,_) -> if memb.IsOverrideOrExplicitInterfaceImplementation then usedNames else let memberName, _ = getMemberDeclarationName com memb - let usedNames = addUsedRootName com usedNames memberName - match memb.DeclaringEntity with - | Some ent when memb.IsImplicitConstructor -> - let entityName = getEntityDeclarationName com ent - addUsedRootName com usedNames entityName - | _ -> usedNames + addUsedRootName com usedNames memberName | FSharpImplementationFileDeclaration.InitAction _ -> usedNames) let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = fsDecls |> List.collect (fun fsDecl -> match fsDecl with - | FSharpImplementationFileDeclaration.Entity(ent, sub) -> - if isErasedOrStringEnumEntity ent then [] - elif ent.IsFSharpUnion || isRecordLike ent then - let entityName = getEntityDeclarationName com ent - // TODO: Check Equality/Comparison attributes - let r = getEntityLocation ent |> makeRange - Fable.ConstructorInfo(ent, entityName, isPublicEntity ent, ent.IsFSharpUnion, r) - |> Fable.CompilerGeneratedConstructorDeclaration - |> List.singleton + | FSharpImplementationFileDeclaration.Entity(ent, []) -> + let fableEnt = FsEnt(ent) :> Fable.Entity + if isErasedOrStringEnumEntity fableEnt then [] else - transformDeclarations com { ctx with EnclosingEntity = Some ent } sub + let entityName = getEntityDeclarationName com fableEnt + let ident = makeRangedIdent ent.DeclarationLocation ent.DisplayName entityName + [Fable.ClassDeclaration(fableEnt, ident, None, None, [])] + | FSharpImplementationFileDeclaration.Entity(ent, sub) -> + transformDeclarations com ctx sub | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(meth, args, body) -> transformMemberDecl com ctx meth args body | FSharpImplementationFileDeclaration.InitAction fe -> @@ -1078,18 +1107,46 @@ let private tryGetMemberArgsAndBody com (implFiles: IDictionary None type FableCompiler(com: ICompiler, implFiles: IDictionary) = + let attachedMembers = Dictionary() + member val InlineDependencies = HashSet() - member val NonMangledAttachedMemberNames = Dictionary>() member __.Options = com.Options - member __.AddInlineExpr(memb, inlineExpr: InlineExpr) = + member _.AddInlineExpr(memb, inlineExpr: InlineExpr) = let fullName = getMemberUniqueName com memb com.GetOrAddInlineExpr(fullName, fun () -> inlineExpr) |> ignore - member this.NonMangledAttachedMemberConflicts declaringEntityName memberName = - match this.NonMangledAttachedMemberNames.TryGetValue(declaringEntityName) with - | true, memberNames -> memberNames.Add(memberName) |> not - | false, _ -> this.NonMangledAttachedMemberNames.Add(declaringEntityName, HashSet [|memberName|]); false + member _.ReplaceAttachedMembers(entityFullName, f) = + if attachedMembers.ContainsKey(entityFullName) then + attachedMembers.[entityFullName] <- f attachedMembers.[entityFullName] + else + let members = {| NonMangledNames = HashSet() + Members = ResizeArray() + Cons = None + BaseCall = None |} + attachedMembers.Add(entityFullName, f members) + + member _.TryGetAttachedMembers(entityFullName) = + match attachedMembers.TryGetValue(entityFullName) with + | true, members -> Some members + | false, _ -> None + + member this.AddConstructor(entityFullName, cons: Fable.MemberDecl, baseCall: Fable.Expr option) = + this.ReplaceAttachedMembers(entityFullName, fun members -> + {| members with Cons = Some cons + BaseCall = baseCall |}) + + member this.AddAttachedMember(entityFullName, memb: Fable.MemberDecl) = + this.ReplaceAttachedMembers(entityFullName, fun members -> + if not memb.Info.IsMangled then + members.NonMangledNames.Add(memb.Ident.Name) |> ignore + members.Members.Add(memb) + members) + + member this.NonMangledAttachedMemberConflicts entityFullName memberName = + this.TryGetAttachedMembers(entityFullName) + |> Option.map (fun members -> members.NonMangledNames.Contains(memberName)) + |> Option.defaultValue false interface IFableCompiler with member this.Transform(ctx, fsExpr) = @@ -1109,9 +1166,7 @@ type FableCompiler(com: ICompiler, implFiles: IDictionary Path.normalizePathAndEnsureFsExtension + let fileName = FsMemberFunctionOrValue.SourcePath memb if fileName <> com.CurrentFile then (this :> IFableCompiler).AddInlineDependency(fileName) com.GetOrAddInlineExpr(membUniqueName, fun () -> @@ -1122,7 +1177,7 @@ type FableCompiler(com: ICompiler, implFiles: IDictionary failwith ("Cannot find inline member. Please report: " + membUniqueName)) - member this.TryGetImplementationFile (fileName) = + member _.TryGetImplementationFile (fileName) = let fileName = Path.normalizePathAndEnsureFsExtension fileName match implFiles.TryGetValue(fileName) with | true, f -> Some f @@ -1155,9 +1210,17 @@ let transformFile (com: ICompiler) (implFiles: IDictionary let projFiles = implFiles |> Seq.map (fun kv -> kv.Key) |> String.concat "\n" failwithf "File %s cannot be found in source list:\n%s" com.CurrentFile projFiles - let rootEnt, rootDecls = getRootModuleAndDecls file.Declarations let fcom = FableCompiler(com, implFiles) + let rootEnt, rootDecls = getRootModuleAndDecls file.Declarations let usedRootNames = getUsedRootNames com Set.empty rootDecls let ctx = Context.Create(rootEnt, usedRootNames) - let rootDecls = transformDeclarations fcom ctx rootDecls + let rootDecls = + transformDeclarations fcom ctx rootDecls + |> List.map (function + | Fable.ClassDeclaration(ent, ident, _, _, _) as decl -> + fcom.TryGetAttachedMembers(ent.FullName) + |> Option.map (fun members -> + Fable.ClassDeclaration(ent, ident, members.Cons, members.BaseCall, members.Members.ToArray() |> List.ofArray)) + |> Option.defaultValue decl + | decl -> decl) Fable.File(com.CurrentFile, rootDecls, usedRootNames, set fcom.InlineDependencies) diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 4d94d680f..3bd75c888 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -1,11 +1,10 @@ -module Fable.Transforms.Fable2Babel +module rec Fable.Transforms.Fable2Babel open Fable open Fable.Core open Fable.AST open Fable.AST.Babel open System.Collections.Generic -open FSharp.Compiler.SourceCodeServices type ReturnStrategy = | Return @@ -25,7 +24,7 @@ type ITailCallOpportunity = type UsedNames = { RootScope: HashSet - DeclarationScopes: HashSet[] + DeclarationScopes: HashSet CurrentDeclarationScope: HashSet } type Context = @@ -37,159 +36,27 @@ type Context = OptimizeTailCall: unit -> unit ScopedTypeParams: Set } -type AttachedMember = Fable.Ident list * Fable.Expr * Fable.AttachedMemberInfo - type IBabelCompiler = inherit ICompiler abstract GetAllImports: unit -> seq - abstract GetImportExpr: Context * selector: string * path: string * Fable.ImportKind -> Expression + abstract GetImportExpr: Context * selector: string * path: string -> Expression abstract TransformAsExpr: Context * Fable.Expr -> Expression abstract TransformAsStatements: Context * ReturnStrategy option * Fable.Expr -> Statement array - abstract TransformImport: Context * selector:string * path:string * Fable.ImportKind -> Expression + abstract TransformImport: Context * selector:string * path:string -> Expression abstract TransformFunction: Context * string option * Fable.Ident list * Fable.Expr -> (Pattern array) * U2 -module Util = - let (|TransformExpr|) (com: IBabelCompiler) ctx e = - com.TransformAsExpr(ctx, e) - - let (|EntityFullName|_|) (e: FSharpEntity) = - e.TryFullName - - let (|FunctionArgs|) = function - | Fable.Lambda arg -> [arg] - | Fable.Delegate args -> args - - let discardUnitArg (args: Fable.Ident list) = - match args with - | [] -> [] - | [unitArg] when unitArg.Type = Fable.Unit -> [] - | [thisArg; unitArg] when thisArg.IsThisArgIdent && unitArg.Type = Fable.Unit -> [thisArg] - | args -> args - - let getUniqueNameInRootScope (ctx: Context) name = - let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> - ctx.UsedNames.RootScope.Contains(name) - || ctx.UsedNames.DeclarationScopes |> Array.exists (fun s -> s.Contains(name))) - ctx.UsedNames.RootScope.Add(name) |> ignore - name - - let getUniqueNameInDeclarationScope (ctx: Context) name = - let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> - ctx.UsedNames.RootScope.Contains(name) || ctx.UsedNames.CurrentDeclarationScope.Contains(name)) - ctx.UsedNames.CurrentDeclarationScope.Add(name) |> ignore - name - - type NamedTailCallOpportunity(com: ICompiler, ctx, name, args: Fable.Ident list) = - // Capture the current argument values to prevent delayed references from getting corrupted, - // for that we use block-scoped ES2015 variable declarations. See #681, #1859 - // TODO: Local unique ident names - let argIds = discardUnitArg args |> List.map (fun arg -> - getUniqueNameInDeclarationScope ctx (arg.Name + "_mut")) - interface ITailCallOpportunity with - member __.Label = name - member __.Args = argIds - member __.IsRecursiveRef(e) = - match e with Fable.IdentExpr id -> name = id.Name | _ -> false - - let getDecisionTarget (ctx: Context) targetIndex = - match List.tryItem targetIndex ctx.DecisionTargets with - | None -> failwithf "Cannot find DecisionTree target %i" targetIndex - | Some(idents, target) -> idents, target - - let rec isJsStatement ctx preferStatement (expr: Fable.Expr) = - match expr with - | Fable.Value _ | Fable.Import _ | Fable.Curry _ | Fable.Test _ | Fable.IdentExpr _ | Fable.Function _ - | Fable.ObjectExpr _ | Fable.Operation _ | Fable.Get _ | Fable.TypeCast _ -> false - - | Fable.TryCatch _ | Fable.Debugger _ - | Fable.Sequential _ | Fable.Let _ | Fable.Set _ - | Fable.Loop _ | Fable.Throw _ -> true - - | Fable.DecisionTreeSuccess(targetIndex,_, _) -> - getDecisionTarget ctx targetIndex - |> snd |> isJsStatement ctx preferStatement - - // Make it also statement if we have more than, say, 3 targets? - // That would increase the chances to convert it into a switch - | Fable.DecisionTree(_,targets) -> - preferStatement - || List.exists (snd >> (isJsStatement ctx false)) targets - - | Fable.IfThenElse(_,thenExpr,elseExpr,_) -> - preferStatement || isJsStatement ctx false thenExpr || isJsStatement ctx false elseExpr - - let addErrorAndReturnNull (com: ICompiler) (range: SourceLocation option) (error: string) = - addError com [] range error - NullLiteral () :> Expression - - let toPattern (e: PatternExpression): Pattern = - U2.Case2 e - - let ident (id: Fable.Ident) = - Identifier(id.Name, ?loc=id.Range) - - let identAsPattern (id: Fable.Ident) = - ident id |> toPattern - - let identAsExpr (id: Fable.Ident) = - (ident id) :> Expression +// TODO: All things that depend on the library should be moved to Replacements +// to become independent of the specific implementation +module Lib = + let libCall (com: IBabelCompiler) ctx r moduleName memberName args = + CallExpression(com.TransformImport(ctx, memberName, getLibPath com moduleName), args, ?loc=r) :> Expression - let thisExpr = - ThisExpression() :> Expression - - let ofInt i = - NumericLiteral(float i) :> Expression + let libConsCall (com: IBabelCompiler) ctx moduleName memberName args = + NewExpression(com.TransformImport(ctx, memberName, getLibPath com moduleName), args) :> Expression - let ofString s = - StringLiteral s :> Expression - - let memberFromName (memberName: string): Expression * bool = - if memberName.StartsWith("Symbol.") then - upcast MemberExpression(Identifier "Symbol", Identifier memberName.[7..], false), true - elif Naming.hasIdentForbiddenChars memberName then - upcast StringLiteral(memberName), true - else - upcast Identifier(memberName), false - - let memberFromExpr (com: IBabelCompiler) ctx memberExpr: Expression * bool = - match memberExpr with - | Fable.Value(Fable.StringConstant name, _) -> memberFromName name - | e -> com.TransformAsExpr(ctx, e), true - - let get r left memberName = - let expr, computed = memberFromName memberName - MemberExpression(left, expr, computed, ?loc=r) :> Expression - - let getExpr r (object: Expression) (expr: Expression) = - let expr, computed = - match expr with - | :? StringLiteral as e -> memberFromName e.Value - | e -> e, true - MemberExpression(object, expr, computed, ?loc=r) :> Expression - - let rec getParts (parts: string list) (expr: Expression) = - match parts with - | [] -> expr - | m::ms -> get None expr m |> getParts ms - - let jsObject methodName args = - CallExpression(get None (Identifier "Object") methodName, args) :> Expression - - let coreUtil (com: IBabelCompiler) ctx memberName args = - CallExpression(com.TransformImport(ctx, memberName, "Util", Fable.Library), args) :> Expression - - let coreLibCall (com: IBabelCompiler) ctx r moduleName memberName args = - CallExpression(com.TransformImport(ctx, memberName, moduleName, Fable.Library), args, ?loc=r) :> Expression - - let coreLibConstructorCall (com: IBabelCompiler) ctx moduleName memberName args = - NewExpression(com.TransformImport(ctx, memberName, moduleName, Fable.Library), args) :> Expression - - let coreValue (com: IBabelCompiler) ctx moduleName memberName = - com.TransformImport(ctx, memberName, moduleName, Fable.Library) - - let coreReflectionCall (com: IBabelCompiler) ctx r memberName args = - coreLibCall com ctx r "Reflection" (memberName + "_type") args + let libValue (com: IBabelCompiler) ctx moduleName memberName = + com.TransformImport(ctx, memberName, getLibPath com moduleName) let tryJsConstructor (com: IBabelCompiler) ctx ent = match Replacements.tryJsConstructor com ent with @@ -200,95 +67,248 @@ module Util = let entRef = Replacements.jsConstructor com ent com.TransformAsExpr(ctx, entRef) - let makeList com ctx headAndTail = - match headAndTail with - | None -> [||] - | Some(TransformExpr com ctx head, TransformExpr com ctx tail) -> [|head; tail|] - |> coreLibConstructorCall com ctx "Types" "List" - - let arrayExpr babelExprs = - ArrayExpression(List.toArray babelExprs) :> Expression - - let makeArray (com: IBabelCompiler) ctx exprs = - List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) exprs - |> ArrayExpression :> Expression - - let makeTypedArray (com: IBabelCompiler) ctx typ (arrayKind: Fable.NewArrayKind) = - match typ, arrayKind with - | Fable.Number kind, _ when com.Options.typedArrays -> - let jsName = getTypedArrayName com kind - let args = - match arrayKind with - | Fable.ArrayValues args -> - [| List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) args - |> ArrayExpression :> Expression |] - | Fable.ArrayAlloc(TransformExpr com ctx size) -> [|size|] - NewExpression(Identifier jsName, args) :> Expression - | _, Fable.ArrayAlloc(TransformExpr com ctx size) -> - upcast NewExpression(Identifier "Array", [|size|]) - | _, Fable.ArrayValues exprs -> - makeArray com ctx exprs +// TODO: This is too implementation-dependent, ideally move it to Replacements +module Reflection = + open Lib - let makeStringArray strings = - strings - |> List.mapToArray (fun x -> StringLiteral x :> Expression) - |> ArrayExpression :> Expression + let private libReflectionCall (com: IBabelCompiler) ctx r memberName args = + libCall com ctx r "Reflection" (memberName + "_type") args - let makeJsObject pairs = - pairs |> Seq.map (fun (name, value) -> - let prop, computed = memberFromName name - ObjectProperty(prop, value, computed_=computed) |> U3.Case1) - |> Seq.toArray - |> ObjectExpression :> Expression - - let assign range left right = - AssignmentExpression(AssignEqual, left, right, ?loc=range) - :> Expression + let private asFSharpEntity (ent: Fable.Entity) = + match ent with + | :? FSharp2Fable.FsEnt as ent -> Some ent + | _ -> None - /// Immediately Invoked Function Expression - let iife (com: IBabelCompiler) ctx (expr: Fable.Expr) = - let _, body = com.TransformFunction(ctx, None, [], expr) - // Use an arrow function in case we need to capture `this` - CallExpression(ArrowFunctionExpression([||], body), [||]) + let private transformRecordReflectionInfo com ctx r (ent: Fable.Entity) generics = + // TODO: Refactor these three bindings to reuse in transformUnionReflectionInfo + let fullname = ent.FullName + let fullnameExpr = StringLiteral fullname :> Expression + let genMap = + let genParamNames = ent.GenericParameters |> List.mapToArray (fun x -> x.Name) |> Seq.toArray + Array.zip genParamNames generics |> Map + let fields = + ent.FSharpFields |> Seq.map (fun fi -> + let typeInfo = transformTypeInfo com ctx r genMap fi.FieldType + (ArrayExpression [|StringLiteral fi.Name; typeInfo|] :> Expression)) + |> Seq.toArray + let fields = ArrowFunctionExpression([||], ArrayExpression fields :> Expression |> U2.Case2) :> Expression + [|fullnameExpr; upcast ArrayExpression generics; jsConstructor com ctx ent; fields|] + |> libReflectionCall com ctx None "record" - let multiVarDeclaration kind (variables: (Identifier * Expression option) list) = - let varDeclarators = - // TODO: Log error if there're duplicated non-empty var declarations - variables - |> List.distinctBy (fun (id, value) -> id.Name) - |> List.mapToArray (fun (id, value) -> - VariableDeclarator(id |> toPattern, ?init=value)) - VariableDeclaration(kind, varDeclarators) :> Statement + let private transformUnionReflectionInfo com ctx r (ent: Fable.Entity) generics = + let fullname = ent.FullName + let fullnameExpr = StringLiteral fullname :> Expression + let genMap = + let genParamNames = ent.GenericParameters |> List.map (fun x -> x.Name) |> Seq.toArray + Array.zip genParamNames generics |> Map + let cases = + ent.UnionCases |> Seq.map (fun uci -> + uci.UnionCaseFields |> List.mapToArray (fun fi -> + ArrayExpression [| + fi.Name |> StringLiteral :> Expression + transformTypeInfo com ctx r genMap fi.FieldType + |] :> Expression) + |> ArrayExpression :> Expression + ) |> Seq.toArray + let cases = ArrowFunctionExpression([||], ArrayExpression cases :> Expression |> U2.Case2) :> Expression + [|fullnameExpr; upcast ArrayExpression generics; jsConstructor com ctx ent; cases|] + |> libReflectionCall com ctx None "union" - let varDeclaration (var: Identifier) (isMutable: bool) value = - let kind = if isMutable then Let else Const - VariableDeclaration(toPattern var, value, kind, ?loc=addRanges[var.Loc; value.Loc]) + let transformTypeInfo (com: IBabelCompiler) ctx r (genMap: Map) t: Expression = + let primitiveTypeInfo name = + libValue com ctx "Reflection" (name + "_type") + let numberInfo kind = + getNumberKindName kind + |> primitiveTypeInfo + let nonGenericTypeInfo fullname = + [| StringLiteral fullname :> Expression |] + |> libReflectionCall com ctx None "class" + let resolveGenerics generics: Expression[] = + generics |> Array.map (transformTypeInfo com ctx r genMap) + let genericTypeInfo name genArgs = + let resolved = resolveGenerics genArgs + libReflectionCall com ctx None name resolved + let genericEntity (ent: Fable.Entity) generics = + let fullname = ent.FullName + let fullnameExpr = StringLiteral fullname :> Expression + let args = if Array.isEmpty generics then [|fullnameExpr|] else [|fullnameExpr; ArrayExpression generics :> Expression|] + libReflectionCall com ctx None "class" args + match t with + | Fable.Any -> primitiveTypeInfo "obj" + | Fable.GenericParam name -> + match Map.tryFind name genMap with + | Some t -> t + | None -> + Replacements.genericTypeInfoError name |> addError com [] r + NullLiteral () :> Expression + | Fable.Unit -> primitiveTypeInfo "unit" + | Fable.Boolean -> primitiveTypeInfo "bool" + | Fable.Char -> primitiveTypeInfo "char" + | Fable.String -> primitiveTypeInfo "string" + | Fable.Enum ent -> + let fullName = ent.FullName + let mutable numberKind = Int32 + let cases = + ent.FSharpFields |> Seq.choose (fun fi -> + // F# seems to include a field with this name in the underlying type + match fi.Name with + | "value__" -> + match fi.FieldType with + | Fable.Number kind -> numberKind <- kind + | _ -> () + None + | name -> + let value = match fi.LiteralValue with Some v -> System.Convert.ToDouble v | None -> 0. + ArrayExpression [|StringLiteral name; NumericLiteral value|] :> Expression |> Some) + |> Seq.toArray + |> ArrayExpression + [|StringLiteral fullName :> Expression; numberInfo numberKind; cases :> _|] + |> libReflectionCall com ctx None "enum" + | Fable.Number kind -> + numberInfo kind + | Fable.LambdaType(argType, returnType) -> + genericTypeInfo "lambda" [|argType; returnType|] + | Fable.DelegateType(argTypes, returnType) -> + genericTypeInfo "delegate" ([|yield! argTypes; yield returnType|]) + | Fable.Tuple genArgs -> genericTypeInfo "tuple" (List.toArray genArgs) + | Fable.Option genArg -> genericTypeInfo "option" [|genArg|] + | Fable.Array genArg -> genericTypeInfo "array" [|genArg|] + | Fable.List genArg -> genericTypeInfo "list" [|genArg|] + | Fable.Regex -> nonGenericTypeInfo Types.regex + | Fable.MetaType -> nonGenericTypeInfo Types.type_ + | Fable.AnonymousRecordType(fieldNames, genArgs) -> + let genArgs = resolveGenerics (List.toArray genArgs) + Array.zip fieldNames genArgs + |> Array.map (fun (k, t) -> ArrayExpression [|StringLiteral k; t|] :> Expression) + |> libReflectionCall com ctx None "anonRecord" + | Fable.DeclaredType(ent, generics) -> + match ent, generics with + | Replacements.BuiltinEntity kind -> + match kind with + | Replacements.BclGuid + | Replacements.BclTimeSpan + | Replacements.BclDateTime + | Replacements.BclDateTimeOffset + | Replacements.BclTimer + | Replacements.BclInt64 + | Replacements.BclUInt64 + | Replacements.BclDecimal + | Replacements.BclBigInt -> genericEntity ent [||] + | Replacements.BclHashSet gen + | Replacements.FSharpSet gen -> + genericEntity ent [|transformTypeInfo com ctx r genMap gen|] + | Replacements.BclDictionary(key, value) + | Replacements.BclKeyValuePair(key, value) + | Replacements.FSharpMap(key, value) -> + genericEntity ent [| + transformTypeInfo com ctx r genMap key + transformTypeInfo com ctx r genMap value + |] + | Replacements.FSharpResult(ok, err) -> + transformUnionReflectionInfo com ctx r ent [| + transformTypeInfo com ctx r genMap ok + transformTypeInfo com ctx r genMap err + |] + | Replacements.FSharpChoice gen -> + let gen = List.map (transformTypeInfo com ctx r genMap) gen + List.toArray gen |> transformUnionReflectionInfo com ctx r ent + | Replacements.FSharpReference gen -> + transformRecordReflectionInfo com ctx r ent [|transformTypeInfo com ctx r genMap gen|] + | _ -> + let generics = generics |> List.map (transformTypeInfo com ctx r genMap) |> List.toArray + /// Check if the entity is actually declared in JS code + if ent.IsInterface + || FSharp2Fable.Util.isErasedOrStringEnumEntity ent + || FSharp2Fable.Util.isGlobalOrImportedEntity ent + // TODO: Get reflection info from types in precompiled libs + || FSharp2Fable.Util.isReplacementCandidate ent then + genericEntity ent generics + else + let reflectionMethodExpr = FSharp2Fable.Util.entityRefWithSuffix com ent Naming.reflectionSuffix + let callee = com.TransformAsExpr(ctx, reflectionMethodExpr) + CallExpression(callee, generics) :> Expression - let restElement (var: Identifier) = - RestElement(toPattern var, ?typeAnnotation=var.TypeAnnotation) :> PatternNode |> U2.Case1 + let transformReflectionInfo com ctx r (ent: Fable.Entity) generics = + if ent.IsFSharpRecord then + transformRecordReflectionInfo com ctx r ent generics + elif ent.IsFSharpUnion then + transformUnionReflectionInfo com ctx r ent generics + else + let fullname = ent.FullName + [| + yield StringLiteral fullname :> Expression + match generics with + | [||] -> yield Undefined() :> Expression + | generics -> yield ArrayExpression generics :> _ + match tryJsConstructor com ctx ent with + | Some cons -> yield cons + | None -> () + |] + |> libReflectionCall com ctx None "class" - let callSuperConstructor r (args: Expression list) = - CallExpression(Super(), List.toArray args, ?loc=r) :> Expression + let private ofString s = StringLiteral s :> Expression + let private ofArray babelExprs = ArrayExpression(List.toArray babelExprs) :> Expression - let callFunction r funcExpr (args: Expression list) = - CallExpression(funcExpr, List.toArray args, ?loc=r) :> Expression + let rec private toTypeTester com ctx r = function + | Fable.Regex -> Identifier "RegExp" :> Expression + | Fable.MetaType -> libValue com ctx "Reflection" "TypeInfo" + | Fable.LambdaType _ | Fable.DelegateType _ -> ofString "function" + | Fable.AnonymousRecordType _ -> ofString "unknown" // Recognize shape? (it's possible in F#) + | Fable.Any -> ofString "any" + | Fable.Unit -> ofString "undefined" + | Fable.Boolean -> ofString "boolean" + | Fable.Char + | Fable.String -> ofString "string" + | Fable.Number _ -> ofString "number" + | Fable.Enum _ -> ofString "number" + | Fable.Option t -> ofArray [ofString "option"; toTypeTester com ctx r t] + | Fable.Array t -> ofArray [ofString "array"; toTypeTester com ctx r t] + | Fable.List t -> ofArray [ofString "list"; toTypeTester com ctx r t] + | Fable.Tuple genArgs -> + let genArgs = List.map (toTypeTester com ctx r) genArgs + ofArray [ofString "tuple"; ofArray genArgs] + | Fable.GenericParam name -> + sprintf "Cannot resolve generic param %s for type testing, evals to true" name |> addWarning com [] r + ofString "any" + | Fable.DeclaredType(ent, _) when ent.IsInterface -> + "Cannot type test interfaces, evals to false" |> addWarning com [] r + ofString "unknown" + | Fable.DeclaredType(ent, genArgs) -> + match tryJsConstructor com ctx ent with + | Some cons -> + if not(List.isEmpty genArgs) then + "Generic args are ignored in type testing" |> addWarning com [] r + cons + | None -> + sprintf "Cannot type test %s, evals to false" ent.FullName |> addWarning com [] r + ofString "unknown" - let callFunctionWithThisContext r funcExpr (args: Expression list) = - let args = (Identifier "this" :> Expression)::args |> List.toArray - CallExpression(get None funcExpr "call", args, ?loc=r) :> Expression + let transformTypeTest (com: IBabelCompiler) ctx range (expr': Fable.Expr) (typ: Fable.Type): Expression = + let (|EntityFullName|) (e: Fable.Entity) = e.FullName - let macroExpression range (txt: string) args = - MacroExpression(txt, List.toArray args, ?loc=range) :> Expression + let expr = com.TransformAsExpr(ctx, expr') + match typ with + // Special cases + | Fable.DeclaredType(EntityFullName Types.idisposable, _) -> + match expr' with + | MaybeCasted(ExprType(Fable.DeclaredType(ent2, _))) when FSharp2Fable.Util.hasInterface Types.idisposable ent2 -> + upcast BooleanLiteral true + | _ -> libCall com ctx None "Util" "isDisposable" [|expr|] + | Fable.DeclaredType(EntityFullName Types.ienumerable, _) -> + libCall com ctx None "Util" "isIterable" [|expr|] + | Fable.DeclaredType(EntityFullName Types.array, _) -> // Untyped array + libCall com ctx None "Util" "isArrayLike" [|expr|] + | Fable.DeclaredType(EntityFullName Types.exception_, _) -> + libCall com ctx None "Types" "isException" [|expr|] + | _ -> + let typeTester = toTypeTester com ctx range typ + libCall com ctx range "Reflection" "typeTest" [|expr; typeTester|] - let getGenericTypeParams (types: Fable.Type list) = - let rec getGenParams = function - | Fable.GenericParam name -> [name] - | t -> t.Generics |> List.collect getGenParams - types - |> List.collect getGenParams - |> Set.ofList - let getEntityGenParams (ent: FSharpEntity) = +// TODO: I'm trying to tell apart the code to generate annotations, but it's not a very clear distinction +// as there are many dependencies from/to the Util module below +module Annotation = + let getEntityGenParams (ent: Fable.Entity) = ent.GenericParameters |> Seq.map (fun x -> x.Name) |> Set.ofSeq @@ -324,14 +344,44 @@ module Util = | None, Some _ -> decl2 | None, None -> None - let uncurryLambdaType t = - let rec uncurryLambdaArgs acc = function - | Fable.FunctionType(Fable.LambdaType paramType, returnType) -> - uncurryLambdaArgs (paramType::acc) returnType - | t -> List.rev acc, t - uncurryLambdaArgs [] t + let getGenericTypeAnnotation com ctx id genParams = + let typeParamInst = makeTypeParamInst genParams + GenericTypeAnnotation(Util.ident id, ?typeParameters=typeParamInst) :> TypeAnnotationInfo + |> TypeAnnotation |> Some + + let makeInterfaceDecl (com: IBabelCompiler) ctx (ent: Fable.Entity) (ident: Fable.Ident) (baseExpr: Expression option) = + let genTypeParams = getEntityGenParams ent + let newTypeParams = Set.difference genTypeParams ctx.ScopedTypeParams + let ctx = { ctx with ScopedTypeParams = Set.union ctx.ScopedTypeParams newTypeParams } + let fields = + if not (com.Options.classTypes) + then Util.getEntityFieldsAsProps com ctx ent + else Array.empty + let attached = Util.getEntityExplicitInterfaceMembers com ctx ent + let baseExt = + match baseExpr with + | Some expr when not (com.Options.classTypes) -> + match expr with + | :? Identifier as id -> + let typeParamInst = + ent.BaseDeclaration |> Option.bind (fun x -> + getEntityGenParams x.Definition |> makeTypeParamInst) + InterfaceExtends(id, ?typeParameters=typeParamInst) |> Seq.singleton + | _ -> Seq.empty + | _ -> Seq.empty + let interfaceExt = Util.getInterfaceExtends com ctx ent + let combinedExt = Seq.append baseExt interfaceExt |> Seq.toArray + let extends = if Array.isEmpty combinedExt then None else Some combinedExt + // Type declaration merging only works well with class declarations, not class expressions, + // but Babel does not allow duplicate declarations (interface and class with the same name) + // so we're adding a prefix to the interface name, which will be removed after transpiling. + let prefix = if com.Options.classTypes then "$INTERFACE_DECL_PREFIX$_" else "" + let id = Identifier(prefix + ident.Name) + let body = ObjectTypeAnnotation([| yield! fields; yield! attached |]) + let typeParamDecl = genTypeParams |> makeTypeParamDecl + InterfaceDeclaration(id, body, ?extends_=extends, ?typeParameters=typeParamDecl) - let rec typeAnnotation com ctx typ: TypeAnnotationInfo = + let typeAnnotation com ctx typ: TypeAnnotationInfo = match typ with | Fable.MetaType -> upcast AnyTypeAnnotation() | Fable.Any -> upcast AnyTypeAnnotation() @@ -347,56 +397,56 @@ module Util = | Fable.Array genArg -> makeArrayTypeAnnotation com ctx genArg | Fable.List genArg -> makeListTypeAnnotation com ctx genArg | Replacements.Builtin kind -> makeBuiltinTypeAnnotation com ctx kind - | Fable.FunctionType(kind, returnType) -> - makeFunctionTypeAnnotation com ctx typ kind returnType + | Fable.LambdaType _ -> Util.uncurryLambdaType typ ||> makeFunctionTypeAnnotation com ctx typ + | Fable.DelegateType(argTypes, returnType) -> makeFunctionTypeAnnotation com ctx typ argTypes returnType | Fable.GenericParam name -> makeSimpleTypeAnnotation com ctx name | Fable.DeclaredType(ent, genArgs) -> makeEntityTypeAnnotation com ctx ent genArgs | Fable.AnonymousRecordType(fieldNames, genArgs) -> makeAnonymousRecordTypeAnnotation com ctx fieldNames genArgs - and makeSimpleTypeAnnotation _com _ctx name = + let makeSimpleTypeAnnotation _com _ctx name = GenericTypeAnnotation(Identifier(name)) :> TypeAnnotationInfo - and makeGenTypeParamInst com ctx genArgs = + let makeGenTypeParamInst com ctx genArgs = match genArgs with | [] -> None | xs -> genArgs |> List.map (typeAnnotation com ctx) |> List.toArray |> TypeParameterInstantiation |> Some - and makeGenericTypeAnnotation com ctx genArgs id = + let makeGenericTypeAnnotation com ctx genArgs id = let typeParamInst = makeGenTypeParamInst com ctx genArgs GenericTypeAnnotation(id, ?typeParameters=typeParamInst) :> TypeAnnotationInfo - and makeNativeTypeAnnotation com ctx genArgs typeName = + let makeNativeTypeAnnotation com ctx genArgs typeName = Identifier(typeName) |> makeGenericTypeAnnotation com ctx genArgs - and makeImportTypeId (com: IBabelCompiler) ctx moduleName typeName = - let expr = com.GetImportExpr(ctx, typeName, moduleName, Fable.Library) + let makeImportTypeId (com: IBabelCompiler) ctx moduleName typeName = + let expr = com.GetImportExpr(ctx, typeName, getLibPath com moduleName) match expr with | :? Identifier as id -> id | _ -> Identifier(typeName) - and makeImportTypeAnnotation com ctx genArgs moduleName typeName = + let makeImportTypeAnnotation com ctx genArgs moduleName typeName = let id = makeImportTypeId com ctx moduleName typeName makeGenericTypeAnnotation com ctx genArgs id - and makeNumericTypeAnnotation com ctx kind = + let makeNumericTypeAnnotation com ctx kind = let typeName = getNumberKindName kind makeImportTypeAnnotation com ctx [] "Int32" typeName - and makeOptionTypeAnnotation com ctx genArg = + let makeOptionTypeAnnotation com ctx genArg = makeImportTypeAnnotation com ctx [genArg] "Option" "Option" - and makeTupleTypeAnnotation com ctx genArgs = + let makeTupleTypeAnnotation com ctx genArgs = List.map (typeAnnotation com ctx) genArgs |> List.toArray |> TupleTypeAnnotation :> TypeAnnotationInfo - and makeArrayTypeAnnotation com ctx genArg = + let makeArrayTypeAnnotation com ctx genArg = match genArg with | Fable.Number kind when com.Options.typedArrays -> let name = getTypedArrayName com kind @@ -404,15 +454,15 @@ module Util = | _ -> makeNativeTypeAnnotation com ctx [genArg] "Array" - and makeListTypeAnnotation com ctx genArg = + let makeListTypeAnnotation com ctx genArg = makeImportTypeAnnotation com ctx [genArg] "Types" "List" - and makeUnionTypeAnnotation com ctx genArgs = + let makeUnionTypeAnnotation com ctx genArgs = List.map (typeAnnotation com ctx) genArgs |> List.toArray |> UnionTypeAnnotation :> TypeAnnotationInfo - and makeBuiltinTypeAnnotation com ctx kind = + let makeBuiltinTypeAnnotation com ctx kind = match kind with | Replacements.BclGuid -> upcast StringTypeAnnotation() | Replacements.BclTimeSpan -> upcast NumberTypeAnnotation() @@ -432,11 +482,7 @@ module Util = | Replacements.FSharpChoice genArgs -> makeImportTypeAnnotation com ctx genArgs "Option" "Choice" | Replacements.FSharpReference genArg -> makeImportTypeAnnotation com ctx [genArg] "Types" "FSharpRef" - and makeFunctionTypeAnnotation com ctx typ kind returnType = - let argTypes, returnType = - match kind with - | Fable.LambdaType _argType -> uncurryLambdaType typ - | Fable.DelegateType argTypes -> argTypes, returnType + let makeFunctionTypeAnnotation com ctx typ argTypes returnType = let funcTypeParams = argTypes |> List.mapi (fun i argType -> @@ -444,7 +490,7 @@ module Util = Identifier("arg" + (string i)), typeAnnotation com ctx argType)) |> List.toArray - let genTypeParams = getGenericTypeParams (argTypes @ [returnType]) + let genTypeParams = Util.getGenericTypeParams (argTypes @ [returnType]) let newTypeParams = Set.difference genTypeParams ctx.ScopedTypeParams let ctx = { ctx with ScopedTypeParams = Set.union ctx.ScopedTypeParams newTypeParams } let returnType = typeAnnotation com ctx returnType @@ -452,18 +498,18 @@ module Util = FunctionTypeAnnotation(funcTypeParams, returnType, ?typeParameters=typeParamDecl) :> TypeAnnotationInfo - and makeEntityTypeAnnotation com ctx ent genArgs = - match ent.TryFullName with - | Some Types.ienumerableGeneric -> + let makeEntityTypeAnnotation com ctx ent genArgs = + match ent.FullName with + | Types.ienumerableGeneric -> makeNativeTypeAnnotation com ctx genArgs "Iterable" - | Some Types.result -> + | Types.result -> makeUnionTypeAnnotation com ctx genArgs - | Some entName when entName.StartsWith(Types.choiceNonGeneric) -> + | entName when entName.StartsWith(Types.choiceNonGeneric) -> makeUnionTypeAnnotation com ctx genArgs | _ when ent.IsInterface -> upcast AnyTypeAnnotation() // TODO: | _ -> - match tryJsConstructor com ctx ent with + match Lib.tryJsConstructor com ctx ent with | Some entRef -> match entRef with | :? StringLiteral as str -> @@ -478,7 +524,7 @@ module Util = | _ -> upcast AnyTypeAnnotation() | None -> upcast AnyTypeAnnotation() - and makeAnonymousRecordTypeAnnotation com ctx fieldNames genArgs = + let makeAnonymousRecordTypeAnnotation com ctx fieldNames genArgs = upcast AnyTypeAnnotation() // TODO: let typedIdent (com: IBabelCompiler) ctx (id: Fable.Ident) = @@ -492,7 +538,7 @@ module Util = let transformFunctionWithAnnotations (com: IBabelCompiler) ctx name (args: Fable.Ident list) (body: Fable.Expr) = if com.Options.typescript then let argTypes = args |> List.map (fun id -> id.Type) - let genTypeParams = getGenericTypeParams (argTypes @ [body.Type]) + let genTypeParams = Util.getGenericTypeParams (argTypes @ [body.Type]) let newTypeParams = Set.difference genTypeParams ctx.ScopedTypeParams let ctx = { ctx with ScopedTypeParams = Set.union ctx.ScopedTypeParams newTypeParams } let args', body' = com.TransformFunction(ctx, name, args, body) @@ -503,6 +549,233 @@ module Util = let args', body' = com.TransformFunction(ctx, name, args, body) args', body', None, None + +module Util = + open Lib + open Reflection + open Annotation + + let (|TransformExpr|) (com: IBabelCompiler) ctx e = + com.TransformAsExpr(ctx, e) + + let (|Function|_|) = function + | Fable.Lambda(arg, body, _) -> Some([arg], body) + | Fable.Delegate(args, body, _) -> Some(args, body) + | _ -> None + + let discardUnitArg (args: Fable.Ident list) = + match args with + | [] -> [] + | [unitArg] when unitArg.Type = Fable.Unit -> [] + | [thisArg; unitArg] when thisArg.IsThisArgument && unitArg.Type = Fable.Unit -> [thisArg] + | args -> args + + let getUniqueNameInRootScope (ctx: Context) name = + let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> + ctx.UsedNames.RootScope.Contains(name) + || ctx.UsedNames.DeclarationScopes.Contains(name)) + ctx.UsedNames.RootScope.Add(name) |> ignore + name + + let getUniqueNameInDeclarationScope (ctx: Context) name = + let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> + ctx.UsedNames.RootScope.Contains(name) || ctx.UsedNames.CurrentDeclarationScope.Contains(name)) + ctx.UsedNames.CurrentDeclarationScope.Add(name) |> ignore + name + + type NamedTailCallOpportunity(com: ICompiler, ctx, name, args: Fable.Ident list) = + // Capture the current argument values to prevent delayed references from getting corrupted, + // for that we use block-scoped ES2015 variable declarations. See #681, #1859 + // TODO: Local unique ident names + let argIds = discardUnitArg args |> List.map (fun arg -> + getUniqueNameInDeclarationScope ctx (arg.Name + "_mut")) + interface ITailCallOpportunity with + member __.Label = name + member __.Args = argIds + member __.IsRecursiveRef(e) = + match e with Fable.IdentExpr id -> name = id.Name | _ -> false + + let getDecisionTarget (ctx: Context) targetIndex = + match List.tryItem targetIndex ctx.DecisionTargets with + | None -> failwithf "Cannot find DecisionTree target %i" targetIndex + | Some(idents, target) -> idents, target + + let rec isJsStatement ctx preferStatement (expr: Fable.Expr) = + match expr with + | Fable.Value _ | Fable.Import _ | Fable.IdentExpr _ + | Fable.Lambda _ | Fable.Delegate _ | Fable.ObjectExpr _ + | Fable.Call _ | Fable.CurriedApply _ | Fable.Curry _ | Fable.Operation _ + | Fable.Get _ | Fable.Test _ | Fable.TypeCast _ -> false + + | Fable.TryCatch _ + | Fable.Sequential _ | Fable.Let _ | Fable.Set _ + | Fable.ForLoop _ | Fable.WhileLoop _ -> true + + | Fable.Emit(info,_,_) -> info.IsJsStatement + + | Fable.DecisionTreeSuccess(targetIndex,_, _) -> + getDecisionTarget ctx targetIndex + |> snd |> isJsStatement ctx preferStatement + + // Make it also statement if we have more than, say, 3 targets? + // That would increase the chances to convert it into a switch + | Fable.DecisionTree(_,targets) -> + preferStatement + || List.exists (snd >> (isJsStatement ctx false)) targets + + | Fable.IfThenElse(_,thenExpr,elseExpr,_) -> + preferStatement || isJsStatement ctx false thenExpr || isJsStatement ctx false elseExpr + + let addErrorAndReturnNull (com: ICompiler) (range: SourceLocation option) (error: string) = + addError com [] range error + NullLiteral () :> Expression + + let toPattern (e: PatternExpression): Pattern = + U2.Case2 e + + let ident (id: Fable.Ident) = + Identifier(id.Name, ?loc=id.Range) + + let identAsPattern (id: Fable.Ident) = + ident id |> toPattern + + let identAsExpr (id: Fable.Ident) = + (ident id) :> Expression + + let thisExpr = + ThisExpression() :> Expression + + let ofInt i = + NumericLiteral(float i) :> Expression + + let memberFromName (memberName: string): Expression * bool = + if memberName.StartsWith("Symbol.") then + upcast MemberExpression(Identifier "Symbol", Identifier memberName.[7..], false), true + elif Naming.hasIdentForbiddenChars memberName then + upcast StringLiteral(memberName), true + else + upcast Identifier(memberName), false + + let memberFromExpr (com: IBabelCompiler) ctx memberExpr: Expression * bool = + match memberExpr with + | Fable.Value(Fable.StringConstant name, _) -> memberFromName name + | e -> com.TransformAsExpr(ctx, e), true + + let get r left memberName = + let expr, computed = memberFromName memberName + MemberExpression(left, expr, computed, ?loc=r) :> Expression + + let getExpr r (object: Expression) (expr: Expression) = + let expr, computed = + match expr with + | :? StringLiteral as e -> memberFromName e.Value + | e -> e, true + MemberExpression(object, expr, computed, ?loc=r) :> Expression + + let rec getParts (parts: string list) (expr: Expression) = + match parts with + | [] -> expr + | m::ms -> get None expr m |> getParts ms + + let jsObject methodName args = + CallExpression(get None (Identifier "Object") methodName, args) :> Expression + + let makeList com ctx headAndTail = + match headAndTail with + | None -> [||] + | Some(TransformExpr com ctx head, TransformExpr com ctx tail) -> [|head; tail|] + |> libConsCall com ctx "Types" "List" + + let makeArray (com: IBabelCompiler) ctx exprs = + List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) exprs + |> ArrayExpression :> Expression + + let makeTypedArray (com: IBabelCompiler) ctx typ (args: Fable.Expr list) = + match typ with + | Fable.Number kind when com.Options.typedArrays -> + let jsName = getTypedArrayName com kind + let args = + [| List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) args + |> ArrayExpression :> Expression |] + NewExpression(Identifier jsName, args) :> Expression + | _ -> + makeArray com ctx args + + let makeTypedAllochedArray (com: IBabelCompiler) ctx typ (TransformExpr com ctx size) = + match typ with + | Fable.Number kind when com.Options.typedArrays -> + let jsName = getTypedArrayName com kind + let args = [|size|] + NewExpression(Identifier jsName, [|size|]) :> Expression + | _ -> + upcast NewExpression(Identifier "Array", [|size|]) + + let makeStringArray strings = + strings + |> List.mapToArray (fun x -> StringLiteral x :> Expression) + |> ArrayExpression :> Expression + + let makeJsObject pairs = + pairs |> Seq.map (fun (name, value) -> + let prop, computed = memberFromName name + ObjectProperty(prop, value, computed_=computed) |> U3.Case1) + |> Seq.toArray + |> ObjectExpression :> Expression + + let assign range left right = + AssignmentExpression(AssignEqual, left, right, ?loc=range) + :> Expression + + /// Immediately Invoked Function Expression + let iife (com: IBabelCompiler) ctx (expr: Fable.Expr) = + let _, body = com.TransformFunction(ctx, None, [], expr) + // Use an arrow function in case we need to capture `this` + CallExpression(ArrowFunctionExpression([||], body), [||]) + + let multiVarDeclaration kind (variables: (Identifier * Expression option) list) = + let varDeclarators = + // TODO: Log error if there're duplicated non-empty var declarations + variables + |> List.distinctBy (fun (id, value) -> id.Name) + |> List.mapToArray (fun (id, value) -> + VariableDeclarator(id |> toPattern, ?init=value)) + VariableDeclaration(kind, varDeclarators) :> Statement + + let varDeclaration (var: Identifier) (isMutable: bool) value = + let kind = if isMutable then Let else Const + VariableDeclaration(toPattern var, value, kind, ?loc=addRanges[var.Loc; value.Loc]) + + let restElement (var: Identifier) = + RestElement(toPattern var, ?typeAnnotation=var.TypeAnnotation) :> PatternNode |> U2.Case1 + + let callSuperConstructor r (args: Expression list) = + CallExpression(Super(), List.toArray args, ?loc=r) :> Expression + + let callFunction r funcExpr (args: Expression list) = + CallExpression(funcExpr, List.toArray args, ?loc=r) :> Expression + + let callFunctionWithThisContext r funcExpr (args: Expression list) = + let args = (Identifier "this" :> Expression)::args |> List.toArray + CallExpression(get None funcExpr "call", args, ?loc=r) :> Expression + + let macroExpression range (txt: string) args = + MacroExpression(txt, List.toArray args, ?loc=range) :> Expression + + let getGenericTypeParams (types: Fable.Type list) = + let rec getGenParams = function + | Fable.GenericParam name -> [name] + | t -> t.Generics |> List.collect getGenParams + types + |> List.collect getGenParams + |> Set.ofList + + let uncurryLambdaType t = + let rec uncurryLambdaArgs acc = function + | Fable.LambdaType(paramType, returnType) -> + uncurryLambdaArgs (paramType::acc) returnType + | t -> List.rev acc, t + uncurryLambdaArgs [] t + type MemberKind = | ClassConstructor | NonAttached of funcName: string @@ -541,15 +814,11 @@ module Util = args, body, returnType, typeParamDecl - let getUnionCaseName uci = - FSharp2Fable.Helpers.unionCaseCompiledName uci - |> Option.defaultValue uci.Name + let getUnionCaseName (uci: Fable.UnionCase) = + match uci.CompiledName with Some cname -> cname | None -> uci.Name let getUnionExprTag r expr = - getExpr r expr (ofString "tag") - - let getUnionExprField r expr fieldIndex = - getExpr r (getExpr None expr (ofString "fields")) (ofInt fieldIndex) + getExpr r expr (StringLiteral "tag") /// Wrap int expressions with `| 0` to help optimization of JS VMs let wrapIntExpression typ (e: Expression) = @@ -602,13 +871,13 @@ module Util = yield upcast ContinueStatement(Identifier tc.Label, ?loc=range) |] - let transformImport (com: IBabelCompiler) ctx r (selector: Fable.Expr) (path: Fable.Expr) kind = + let transformImport (com: IBabelCompiler) ctx r (selector: Fable.Expr) (path: Fable.Expr) = match selector, path with | Fable.Value(Fable.StringConstant selector,_), Fable.Value(Fable.StringConstant path,_) -> let selector, parts = let parts = Array.toList(selector.Split('.')) parts.Head, parts.Tail - com.GetImportExpr(ctx, selector, path, kind) + com.GetImportExpr(ctx, selector, path) |> getParts parts | _ -> "Import expressions only accept string literals" |> addErrorAndReturnNull com r @@ -618,185 +887,14 @@ module Util = // Done at the very end of the compile pipeline to get more opportunities // of matching cast and literal expressions after resolving pipes, inlining... | Fable.DeclaredType(ent,[_]) -> - match ent.TryFullName, e with - | Some Types.ienumerableGeneric, Replacements.ArrayOrListLiteral(exprs, _) -> + match ent.FullName, e with + | Types.ienumerableGeneric, Replacements.ArrayOrListLiteral(exprs, _) -> makeArray com ctx exprs | _ -> com.TransformAsExpr(ctx, e) | _ -> com.TransformAsExpr(ctx, e) let transformCurry (com: IBabelCompiler) (ctx: Context) r expr arity: Expression = - com.TransformAsExpr(ctx, Replacements.curryExprAtRuntime arity expr) - - let rec transformRecordReflectionInfo com ctx r (ent: FSharpEntity) generics = - // TODO: Refactor these three bindings to reuse in transformUnionReflectionInfo - let fullname = defaultArg ent.TryFullName Naming.unknown - let fullnameExpr = StringLiteral fullname :> Expression - let genMap = - let genParamNames = ent.GenericParameters |> Seq.map (fun x -> x.Name) |> Seq.toArray - Array.zip genParamNames generics |> Map - let fields = - ent.FSharpFields |> Seq.map (fun fi -> - let typeInfo = - FSharp2Fable.TypeHelpers.makeType com Map.empty fi.FieldType - |> transformTypeInfo com ctx r genMap - (ArrayExpression [|StringLiteral fi.Name; typeInfo|] :> Expression)) - |> Seq.toArray - let fields = ArrowFunctionExpression([||], ArrayExpression fields :> Expression |> U2.Case2) :> Expression - [|fullnameExpr; upcast ArrayExpression generics; jsConstructor com ctx ent; fields|] - |> coreReflectionCall com ctx None "record" - - and transformUnionReflectionInfo com ctx r (ent: FSharpEntity) generics = - let fullname = defaultArg ent.TryFullName Naming.unknown - let fullnameExpr = StringLiteral fullname :> Expression - let genMap = - let genParamNames = ent.GenericParameters |> Seq.map (fun x -> x.Name) |> Seq.toArray - Array.zip genParamNames generics |> Map - let cases = - ent.UnionCases |> Seq.map (fun uci -> - uci.UnionCaseFields |> Seq.map (fun fi -> - ArrayExpression [| - fi.Name |> StringLiteral :> Expression - FSharp2Fable.TypeHelpers.makeType com Map.empty fi.FieldType - |> transformTypeInfo com ctx r genMap - |] :> Expression) - |> Seq.toArray - |> ArrayExpression :> Expression - ) |> Seq.toArray - let cases = ArrowFunctionExpression([||], ArrayExpression cases :> Expression |> U2.Case2) :> Expression - [|fullnameExpr; upcast ArrayExpression generics; jsConstructor com ctx ent; cases|] - |> coreReflectionCall com ctx None "union" - - and transformTypeInfo (com: IBabelCompiler) ctx r (genMap: Map) t: Expression = - let primitiveTypeInfo name = - coreValue com ctx "Reflection" (name + "_type") - let numberInfo kind = - getNumberKindName kind - |> primitiveTypeInfo - let nonGenericTypeInfo fullname = - [| StringLiteral fullname :> Expression |] - |> coreReflectionCall com ctx None "class" - let resolveGenerics generics: Expression[] = - generics |> Array.map (transformTypeInfo com ctx r genMap) - let genericTypeInfo name genArgs = - let resolved = resolveGenerics genArgs - coreReflectionCall com ctx None name resolved - let genericEntity (ent: FSharpEntity) generics = - let fullname = defaultArg ent.TryFullName Naming.unknown - let fullnameExpr = StringLiteral fullname :> Expression - let args = if Array.isEmpty generics then [|fullnameExpr|] else [|fullnameExpr; ArrayExpression generics :> Expression|] - coreReflectionCall com ctx None "class" args - match t with - | Fable.Any -> primitiveTypeInfo "obj" - | Fable.GenericParam name -> - match Map.tryFind name genMap with - | Some t -> t - | None -> - Replacements.genericTypeInfoError name |> addError com [] r - NullLiteral () :> Expression - | Fable.Unit -> primitiveTypeInfo "unit" - | Fable.Boolean -> primitiveTypeInfo "bool" - | Fable.Char -> primitiveTypeInfo "char" - | Fable.String -> primitiveTypeInfo "string" - | Fable.Enum ent -> - let fullName = defaultArg ent.TryFullName Naming.unknown - let mutable numberKind = Int32 - let cases = - ent.FSharpFields |> Seq.choose (fun fi -> - // F# seems to include a field with this name with the underlying type - match fi.Name with - | "value__" -> - match FSharp2Fable.TypeHelpers.makeType com Map.empty fi.FieldType with - | Fable.Number kind -> numberKind <- kind - | _ -> () - None - | name -> - let value = match fi.LiteralValue with Some v -> System.Convert.ToDouble v | None -> 0. - ArrayExpression [|StringLiteral name; NumericLiteral value|] :> Expression |> Some) - |> Seq.toArray - |> ArrayExpression - [|StringLiteral fullName :> Expression; numberInfo numberKind; cases :> _|] - |> coreReflectionCall com ctx None "enum" - | Fable.Number kind -> - numberInfo kind - | Fable.FunctionType(Fable.LambdaType argType, returnType) -> - genericTypeInfo "lambda" [|argType; returnType|] - | Fable.FunctionType(Fable.DelegateType argTypes, returnType) -> - genericTypeInfo "delegate" ([|yield! argTypes; yield returnType|]) - | Fable.Tuple genArgs -> genericTypeInfo "tuple" (List.toArray genArgs) - | Fable.Option genArg -> genericTypeInfo "option" [|genArg|] - | Fable.Array genArg -> genericTypeInfo "array" [|genArg|] - | Fable.List genArg -> genericTypeInfo "list" [|genArg|] - | Fable.Regex -> nonGenericTypeInfo Types.regex - | Fable.MetaType -> nonGenericTypeInfo Types.type_ - | Fable.AnonymousRecordType(fieldNames, genArgs) -> - let genArgs = resolveGenerics (List.toArray genArgs) - Array.zip fieldNames genArgs - |> Array.map (fun (k, t) -> ArrayExpression [|StringLiteral k; t|] :> Expression) - |> coreReflectionCall com ctx None "anonRecord" - | Fable.DeclaredType(ent, generics) -> - match ent, generics with - | Replacements.BuiltinEntity kind -> - match kind with - | Replacements.BclGuid - | Replacements.BclTimeSpan - | Replacements.BclDateTime - | Replacements.BclDateTimeOffset - | Replacements.BclTimer - | Replacements.BclInt64 - | Replacements.BclUInt64 - | Replacements.BclDecimal - | Replacements.BclBigInt -> genericEntity ent [||] - | Replacements.BclHashSet gen - | Replacements.FSharpSet gen -> - genericEntity ent [|transformTypeInfo com ctx r genMap gen|] - | Replacements.BclDictionary(key, value) - | Replacements.BclKeyValuePair(key, value) - | Replacements.FSharpMap(key, value) -> - genericEntity ent [| - transformTypeInfo com ctx r genMap key - transformTypeInfo com ctx r genMap value - |] - | Replacements.FSharpResult(ok, err) -> - transformUnionReflectionInfo com ctx r ent [| - transformTypeInfo com ctx r genMap ok - transformTypeInfo com ctx r genMap err - |] - | Replacements.FSharpChoice gen -> - let gen = List.map (transformTypeInfo com ctx r genMap) gen - List.toArray gen |> transformUnionReflectionInfo com ctx r ent - | Replacements.FSharpReference gen -> - transformRecordReflectionInfo com ctx r ent [|transformTypeInfo com ctx r genMap gen|] - | _ -> - let generics = generics |> List.map (transformTypeInfo com ctx r genMap) |> List.toArray - /// Check if the entity is actually declared in JS code - if ent.IsInterface - || FSharp2Fable.Util.isErasedOrStringEnumEntity ent - || FSharp2Fable.Util.isGlobalOrImportedEntity ent - // TODO: Get reflection info from types in precompiled libs - || FSharp2Fable.Util.isReplacementCandidate ent then - genericEntity ent generics - else - let reflectionMethodExpr = FSharp2Fable.Util.entityRefWithSuffix com ent Naming.reflectionSuffix - let callee = com.TransformAsExpr(ctx, reflectionMethodExpr) - CallExpression(callee, generics) :> Expression - - let transformReflectionInfo com ctx r (ent: FSharpEntity) generics = - if ent.IsFSharpRecord then - transformRecordReflectionInfo com ctx r ent generics - elif ent.IsFSharpUnion then - transformUnionReflectionInfo com ctx r ent generics - else - let fullname = defaultArg ent.TryFullName Naming.unknown - [| - yield StringLiteral fullname :> Expression - match generics with - | [||] -> yield Undefined() :> Expression - | generics -> yield ArrayExpression generics :> _ - match tryJsConstructor com ctx ent with - | Some cons -> yield cons - | None -> () - |] - |> coreReflectionCall com ctx None "class" + com.TransformAsExpr(ctx, Replacements.curryExprAtRuntime com arity expr) let transformValue (com: IBabelCompiler) (ctx: Context) r value: Expression = match value with @@ -820,87 +918,83 @@ module Util = then upcast UnaryExpression(UnaryMinus, NumericLiteral(x * -1.), ?loc=r) else upcast NumericLiteral(x, ?loc=r) | Fable.RegexConstant (source, flags) -> upcast RegExpLiteral(source, flags, ?loc=r) - | Fable.NewArray (arrayKind, typ) -> makeTypedArray com ctx typ arrayKind + | Fable.NewArray (values, typ) -> makeTypedArray com ctx typ values + | Fable.NewArrayAlloc (size, typ) -> makeTypedAllochedArray com ctx typ size | Fable.NewTuple vals -> makeArray com ctx vals // Optimization for bundle size: compile list literals as List.ofArray | Replacements.ListLiteral(exprs, t) -> match exprs with | [] -> makeList com ctx None | [expr] -> Some(expr, Fable.Value(Fable.NewList (None,t), None)) |> makeList com ctx - | exprs -> [|makeArray com ctx exprs|] |> coreLibCall com ctx r "List" "ofArray" + | exprs -> [|makeArray com ctx exprs|] |> libCall com ctx r "List" "ofArray" | Fable.NewList (headAndTail, _) -> makeList com ctx headAndTail | Fable.NewOption (value, t) -> match value with | Some (TransformExpr com ctx e) -> if mustWrapOption t - then coreLibCall com ctx r "Option" "some" [|e|] + then libCall com ctx r "Option" "some" [|e|] else e | None -> upcast Undefined(?loc=r) | Fable.EnumConstant(x,_) -> com.TransformAsExpr(ctx, x) - | Fable.NewRecord(values, kind, genArgs) -> + | Fable.NewRecord(values, ent, genArgs) -> let values = List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values - match kind with - | Fable.DeclaredRecord ent -> - let consRef = jsConstructor com ctx ent - let typeParamInst = - if com.Options.typescript && (com.Options.classTypes || ent.TryFullName = Some Types.reference) - then makeGenTypeParamInst com ctx genArgs - else None - upcast NewExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r) - | Fable.AnonymousRecord fieldNames -> - Array.zip fieldNames values - |> makeJsObject - |> Array.singleton - |> coreLibCall com ctx r "Types" "anonRecord" - | Fable.NewUnion(values, uci, ent, genArgs) -> - // Union cases with EraseAttribute are used for `Custom`-like cases in unions meant for `keyValueList` - if FSharp2Fable.Helpers.hasAttribute Atts.erase uci.Attributes then - makeArray com ctx values - else - let consRef = jsConstructor com ctx ent - let tag = FSharp2Fable.Helpers.unionCaseTag ent uci - let values = List.map (fun x -> com.TransformAsExpr(ctx, x)) values - let typeParamInst = - if com.Options.typescript && com.Options.classTypes - then makeGenTypeParamInst com ctx genArgs - else None - let values = (ofInt tag)::values |> List.toArray - upcast NewExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r) + let consRef = jsConstructor com ctx ent + let typeParamInst = + if com.Options.typescript && (com.Options.classTypes || ent.FullName = Types.reference) + then makeGenTypeParamInst com ctx genArgs + else None + upcast NewExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r) + | Fable.NewAnonymousRecord(values, fieldNames, genArgs) -> + let values = List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values + Array.zip fieldNames values + |> makeJsObject + |> Array.singleton + |> libCall com ctx r "Types" "anonRecord" + | Fable.NewUnion(values, tag, ent, genArgs) -> + let consRef = jsConstructor com ctx ent + let values = List.map (fun x -> com.TransformAsExpr(ctx, x)) values + let typeParamInst = + if com.Options.typescript && com.Options.classTypes + then makeGenTypeParamInst com ctx genArgs + else None + let values = (ofInt tag)::values |> List.toArray + upcast NewExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r) let enumerator2iterator com ctx = let enumerator = CallExpression(get None (Identifier "this") "GetEnumerator", [||]) :> Expression - BlockStatement [|ReturnStatement(coreLibCall com ctx None "Seq" "toIterator" [|enumerator|])|] + BlockStatement [|ReturnStatement(libCall com ctx None "Seq" "toIterator" [|enumerator|])|] - let transformObjectExpr (com: IBabelCompiler) ctx (members: AttachedMember list) baseCall: Expression = + let transformObjectExpr (com: IBabelCompiler) ctx (members: Fable.MemberDecl list) baseCall: Expression = let makeObjMethod kind prop computed hasSpread args body = let args, body, returnType, typeParamDecl = getMemberArgsAndBody com ctx Attached hasSpread args body ObjectMethod(kind, prop, args, body, computed_=computed, ?returnType=returnType, ?typeParameters=typeParamDecl) |> U3.Case2 let pojo = - members |> List.collect (fun (args, body, info) -> - let prop, computed = memberFromName info.Name + members |> List.collect (fun memb -> + let info = memb.Info + let prop, computed = memberFromName memb.Ident.Name if info.IsValue then - [ObjectProperty(prop, com.TransformAsExpr(ctx, body), computed_=computed) |> U3.Case1] + [ObjectProperty(prop, com.TransformAsExpr(ctx, memb.Body), computed_=computed) |> U3.Case1] elif info.IsGetter then - [makeObjMethod ObjectGetter prop computed false args body] + [makeObjMethod ObjectGetter prop computed false memb.Args memb.Body] elif info.IsSetter then - [makeObjMethod ObjectSetter prop computed false args body] + [makeObjMethod ObjectSetter prop computed false memb.Args memb.Body] elif info.IsEnumerator then - let method = makeObjMethod ObjectMeth prop computed info.HasSpread args body + let method = makeObjMethod ObjectMeth prop computed info.HasSpread memb.Args memb.Body let iterator = let prop, computed = memberFromName "Symbol.iterator" let body = enumerator2iterator com ctx ObjectMethod(ObjectMeth, prop, [||], body, computed_=computed) |> U3.Case2 [method; iterator] else - [makeObjMethod ObjectMeth prop computed info.HasSpread args body] + [makeObjMethod ObjectMeth prop computed info.HasSpread memb.Args memb.Body] ) |> List.toArray |> ObjectExpression match baseCall with | Some(TransformExpr com ctx baseCall) -> - coreUtil com ctx "extend" [|baseCall; pojo|] + libCall com ctx None "Util" "extend" [|baseCall; pojo|] | None -> pojo :> Expression let transformCallArgs (com: IBabelCompiler) ctx hasSpread args = @@ -926,60 +1020,59 @@ module Util = | Some(Assign left) -> upcast ExpressionStatement(assign None left babelExpr, ?loc=babelExpr.Loc) | Some(Target left) -> upcast ExpressionStatement(assign None left babelExpr, ?loc=babelExpr.Loc) - let transformOperation com ctx range t opKind: Expression = + let transformOperation com ctx range opKind: Expression = match opKind with - | Fable.UnaryOperation(op, TransformExpr com ctx expr) -> + | Fable.Unary(op, TransformExpr com ctx expr) -> upcast UnaryExpression (op, expr, ?loc=range) - | Fable.BinaryOperation(op, TransformExpr com ctx left, TransformExpr com ctx right) -> + | Fable.Binary(op, TransformExpr com ctx left, TransformExpr com ctx right) -> upcast BinaryExpression (op, left, right, ?loc=range) - | Fable.LogicalOperation(op, TransformExpr com ctx left, TransformExpr com ctx right) -> + | Fable.Logical(op, TransformExpr com ctx left, TransformExpr com ctx right) -> upcast LogicalExpression (op, left, right, ?loc=range) - | Fable.Emit(emit, callInfo) -> - match callInfo with - | Some callInfo -> - let args = transformCallArgs com ctx callInfo.HasSpread callInfo.Args - match callInfo.ThisArg with - | Some(TransformExpr com ctx thisArg) -> macroExpression range emit (thisArg::args) - | None -> macroExpression range emit args - | None -> macroExpression range emit [] - - | Fable.Call(callee, callInfo) -> - let args = transformCallArgs com ctx callInfo.HasSpread callInfo.Args - match callee, callInfo.ThisArg with - | TransformExpr com ctx callee, None when callInfo.IsJsConstructor -> - upcast NewExpression(callee, List.toArray args, ?loc=range) - | TransformExpr com ctx callee, Some(TransformExpr com ctx thisArg) -> - callFunction range callee (thisArg::args) - | TransformExpr com ctx callee, None -> - callFunction range callee args - - | Fable.CurriedApply(TransformExpr com ctx applied, args) -> - match transformCallArgs com ctx false args with - | [] -> callFunction range applied [] - | args -> (applied, args) ||> List.fold (fun e arg -> callFunction range e [arg]) - - let transformOperationAsStatements com ctx range t returnStrategy opKind = + let transformEmit com ctx range (info: Fable.EmitInfo) = + transformCallArgs com ctx false info.Args + |> macroExpression range info.Macro + + let transformCall com ctx range callee (callInfo: Fable.CallInfo) = + let args = transformCallArgs com ctx callInfo.HasSpread callInfo.Args + match callee, callInfo.ThisArg with + | TransformExpr com ctx callee, None when callInfo.IsJsConstructor -> + NewExpression(callee, List.toArray args, ?loc=range) :> Expression + | TransformExpr com ctx callee, Some(TransformExpr com ctx thisArg) -> + callFunction range callee (thisArg::args) + | TransformExpr com ctx callee, None -> + callFunction range callee args + + let transformCurriedApply com ctx range (TransformExpr com ctx applied) args = + match transformCallArgs com ctx false args with + | [] -> callFunction range applied [] + | args -> (applied, args) ||> List.fold (fun e arg -> callFunction range e [arg]) + + let transformCallAsStatements com ctx range t returnStrategy callee callInfo = let argsLen (i: Fable.CallInfo) = List.length i.Args + (if Option.isSome i.ThisArg then 1 else 0) // Warn when there's a recursive call that couldn't be optimized? - match returnStrategy, ctx.TailCallOpportunity, opKind with - | Some(Return|ReturnUnit), Some tc, Fable.Call(callee, callInfo) - when tc.IsRecursiveRef(callee) - && argsLen callInfo = List.length tc.Args -> + match returnStrategy, ctx.TailCallOpportunity with + | Some(Return|ReturnUnit), Some tc when tc.IsRecursiveRef(callee) + && argsLen callInfo = List.length tc.Args -> let args = match callInfo.ThisArg with | Some thisArg -> thisArg::callInfo.Args | None -> callInfo.Args optimizeTailCall com ctx range tc args - | Some(Return|ReturnUnit), Some tc, Fable.CurriedApply(callee, args) - when tc.IsRecursiveRef(callee) - && List.sameLength args tc.Args -> + | _ -> + [|transformCall com ctx range callee callInfo |> resolveExpr t returnStrategy|] + + let transformCurriedApplyAsStatements com ctx range t returnStrategy callee args = + // Warn when there's a recursive call that couldn't be optimized? + match returnStrategy, ctx.TailCallOpportunity with + | Some(Return|ReturnUnit), Some tc when tc.IsRecursiveRef(callee) + && List.sameLength args tc.Args -> optimizeTailCall com ctx range tc args | _ -> - [|transformOperation com ctx range t opKind |> resolveExpr t returnStrategy|] + [|transformCurriedApply com ctx range callee args |> resolveExpr t returnStrategy|] // When expecting a block, it's usually not necessary to wrap it // in a lambda to isolate its variable context @@ -1022,49 +1115,37 @@ module Util = | _ -> fableExpr let expr = com.TransformAsExpr(ctx, fableExpr) match getKind with - | Fable.ExprGet(TransformExpr com ctx prop) -> getExpr range expr prop + | Fable.ByKey(Fable.ExprKey(TransformExpr com ctx prop)) -> getExpr range expr prop + | Fable.ByKey(Fable.FieldKey field) -> get range expr field.Name | Fable.ListHead -> get range expr "head" | Fable.ListTail -> get range expr "tail" - | Fable.FieldGet(fieldName,_,_) -> get range expr fieldName - | Fable.TupleGet index -> getExpr range expr (ofInt index) + | Fable.TupleIndex index -> getExpr range expr (ofInt index) | Fable.OptionValue -> if mustWrapOption typ || com.Options.typescript - then coreLibCall com ctx None "Option" "value" [|expr|] + then libCall com ctx None "Option" "value" [|expr|] else expr | Fable.UnionTag -> getUnionExprTag range expr - | Fable.UnionField(field, uci, _) -> - let fieldName = field.Name - uci.UnionCaseFields - |> Seq.findIndex (fun fi -> fi.Name = fieldName) - |> getUnionExprField range expr + | Fable.UnionField(idx, _) -> + getExpr range (getExpr None expr (StringLiteral "fields")) (ofInt idx) - let transformSet (com: IBabelCompiler) ctx range var (value: Fable.Expr) (setKind: Fable.SetKind) = + let transformSet (com: IBabelCompiler) ctx range var (value: Fable.Expr) setKind = let var = com.TransformAsExpr(ctx, var) let value = com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type let var = match setKind with - | Fable.VarSet -> var - | Fable.FieldSet(name,_) -> get None var name - | Fable.ExprSet(TransformExpr com ctx e) -> getExpr None var e + | None -> var + | Some(Fable.FieldKey fi) -> get None var fi.Name + | Some(Fable.ExprKey(TransformExpr com ctx e)) -> getExpr None var e assign range var value - let getSetReturnStrategy com ctx (TransformExpr com ctx expr) = function - | Fable.VarSet -> Assign expr - | Fable.ExprSet(TransformExpr com ctx prop) -> getExpr None expr prop |> Assign - | Fable.FieldSet(name,_) -> get None expr name |> Assign - let transformBindingExprBody (com: IBabelCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) = match value with // Check imports with name placeholder - | Fable.Import((Fable.Value(Fable.StringConstant Naming.placeholder,_)), path, kind, _, r) -> - transformImport com ctx r (makeStrConst var.Name) path kind - | Fable.Function(_,Fable.Import((Fable.Value(Fable.StringConstant Naming.placeholder,_)), path, kind, _, r),_) -> - transformImport com ctx r (makeStrConst var.Name) path kind - | Fable.Function(args, body, _) -> - let args = - match args with - | Fable.Lambda arg -> [arg] - | Fable.Delegate args -> args + | Fable.Import((Fable.Value(Fable.StringConstant Naming.placeholder,_)), path, _, r) -> + transformImport com ctx r (makeStrConst var.Name) path + | Function(_,Fable.Import(Fable.Value(Fable.StringConstant Naming.placeholder,_), path, _, r)) -> + transformImport com ctx r (makeStrConst var.Name) path + | Function(args, body) -> let name = Some var.Name transformFunctionWithAnnotations com ctx name args body |> (if com.Options.classTypes || com.Options.typescript @@ -1087,64 +1168,9 @@ module Util = let value = transformBindingExprBody com ctx var value [|varDeclaration (typedIdent com ctx var) var.IsMutable value :> Statement|] - // Maybe we should create a type here that emulates Reflection.ts/TypeTester - let rec toTypeTester com ctx r = function - | Fable.Regex -> Identifier "RegExp" :> Expression - | Fable.MetaType -> coreValue com ctx "Reflection" "TypeInfo" - | Fable.FunctionType _ -> ofString "function" - | Fable.AnonymousRecordType _ -> ofString "unknown" // Recognize shape? (it's possible in F#) - | Fable.Any -> ofString "any" - | Fable.Unit -> ofString "undefined" - | Fable.Boolean -> ofString "boolean" - | Fable.Char - | Fable.String -> ofString "string" - | Fable.Number _ -> ofString "number" - | Fable.Enum _ -> ofString "number" - | Fable.Option t -> arrayExpr [ofString "option"; toTypeTester com ctx r t] - | Fable.Array t -> arrayExpr [ofString "array"; toTypeTester com ctx r t] - | Fable.List t -> arrayExpr [ofString "list"; toTypeTester com ctx r t] - | Fable.Tuple genArgs -> - let genArgs = List.map (toTypeTester com ctx r) genArgs - arrayExpr [ofString "tuple"; arrayExpr genArgs] - | Fable.GenericParam name -> - sprintf "Cannot resolve generic param %s for type testing, evals to true" name |> addWarning com [] r - ofString "any" - | Fable.DeclaredType(ent, _) when ent.IsInterface -> - "Cannot type test interfaces, evals to false" |> addWarning com [] r - ofString "unknown" - | Fable.DeclaredType(ent, genArgs) -> - match tryJsConstructor com ctx ent with - | Some cons -> - if not(List.isEmpty genArgs) then - "Generic args are ignored in type testing" |> addWarning com [] r - cons - | None -> - sprintf "Cannot type test %s, evals to false" ent.DisplayName |> addWarning com [] r - ofString "unknown" - - let transformTypeTest (com: IBabelCompiler) ctx range (expr': Fable.Expr) (typ: Fable.Type): Expression = - let expr = com.TransformAsExpr(ctx, expr') - match typ with - // Special cases - | Fable.DeclaredType(EntityFullName Types.idisposable, _) -> - match expr' with - | MaybeCasted(ExprType(Fable.DeclaredType(ent2, _))) when FSharp2Fable.Util.hasInterface Types.idisposable ent2 -> - upcast BooleanLiteral true - | _ -> coreLibCall com ctx None "Util" "isDisposable" [|expr|] - | Fable.DeclaredType(EntityFullName Types.ienumerable, _) -> - coreLibCall com ctx None "Util" "isIterable" [|expr|] - | Fable.DeclaredType(EntityFullName Types.array, _) -> // Untyped array - coreLibCall com ctx None "Util" "isArrayLike" [|expr|] - | Fable.DeclaredType(EntityFullName Types.exception_, _) -> - coreLibCall com ctx None "Types" "isException" [|expr|] - | _ -> - let typeTester = toTypeTester com ctx range typ - coreLibCall com ctx range "Reflection" "typeTest" [|expr; typeTester|] - let transformTest (com: IBabelCompiler) ctx range kind expr: Expression = match kind with - | Fable.TypeTest t - | Fable.ErasedUnionTest t -> + | Fable.TypeTest t -> transformTypeTest com ctx range expr t | Fable.OptionTest nonEmpty -> let op = if nonEmpty then BinaryUnequal else BinaryEqual @@ -1153,8 +1179,8 @@ module Util = let expr = com.TransformAsExpr(ctx, expr) let op = if nonEmpty then BinaryUnequal else BinaryEqual upcast BinaryExpression(op, get None expr "tail", NullLiteral(), ?loc=range) - | Fable.UnionCaseTest(uci, ent) -> - let expected = FSharp2Fable.Helpers.unionCaseTag ent uci |> ofInt + | Fable.UnionCaseTest tag -> + let expected = ofInt tag let actual = com.TransformAsExpr(ctx, expr) |> getUnionExprTag None upcast BinaryExpression(BinaryEqualStrict, actual, expected, ?loc=range) @@ -1229,11 +1255,11 @@ module Util = let transformDecisionTreeAsSwitch expr = let (|Equals|_|) = function - | Fable.Operation(Fable.BinaryOperation(BinaryEqualStrict, expr, right), _, _) -> + | Fable.Operation(Fable.Binary(BinaryEqualStrict, expr, right), _, _) -> Some(expr, right) - | Fable.Test(expr, Fable.UnionCaseTest(uci, ent), _) -> + | Fable.Test(expr, Fable.UnionCaseTest tag, _) -> let evalExpr = Fable.Get(expr, Fable.UnionTag, Fable.Number Int32, None) - let right = Fable.NumberConstant(FSharp2Fable.Helpers.unionCaseTag ent uci |> float, Int32) |> makeValue None + let right = Fable.NumberConstant(float tag, Int32) |> makeValue None Some(evalExpr, right) | _ -> None let sameEvalExprs evalExpr1 evalExpr2 = @@ -1383,19 +1409,19 @@ module Util = | Fable.IdentExpr id -> upcast ident id - | Fable.Import(selector, path, kind, _, r) -> - transformImport com ctx r selector path kind + | Fable.Import(selector, path, _, r) -> + transformImport com ctx r selector path | Fable.Test(expr, kind, range) -> transformTest com ctx range kind expr - | Fable.Function(Fable.Lambda arg, body, name) -> + | Fable.Lambda(arg, body, name) -> transformFunctionWithAnnotations com ctx name [arg] body |> (if com.Options.classTypes || com.Options.typescript then makeArrowFunctionExpression name else makeFunctionExpression name) - | Fable.Function(Fable.Delegate args, body, name) -> + | Fable.Delegate(args, body, name) -> transformFunctionWithAnnotations com ctx name args body |> (if com.Options.classTypes || com.Options.typescript then makeArrowFunctionExpression name @@ -1404,8 +1430,14 @@ module Util = | Fable.ObjectExpr (members, _, baseCall) -> transformObjectExpr com ctx members baseCall - | Fable.Operation(opKind, typ, range) -> - transformOperation com ctx range typ opKind + | Fable.Call(callee, info, _, range) -> + transformCall com ctx range callee info + + | Fable.CurriedApply(callee, args, _, range) -> + transformCurriedApply com ctx range callee args + + | Fable.Operation(kind, _, range) -> + transformOperation com ctx range kind | Fable.Get(expr, getKind, typ, range) -> transformGet com ctx range typ expr getKind @@ -1435,8 +1467,12 @@ module Util = List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) exprs |> SequenceExpression :> Expression + | Fable.Emit(info, _, range) -> + if info.IsJsStatement then iife com ctx expr :> Expression + else transformEmit com ctx range info + // These cannot appear in expression position in JS, must be wrapped in a lambda - | Fable.Debugger _ | Fable.Throw _ | Fable.Loop _ | Fable.TryCatch _ -> + | Fable.WhileLoop _ | Fable.ForLoop _ | Fable.TryCatch _ -> iife com ctx expr :> Expression let rec transformAsStatements (com: IBabelCompiler) ctx returnStrategy @@ -1454,20 +1490,20 @@ module Util = | Fable.IdentExpr id -> [|identAsExpr id |> resolveExpr id.Type returnStrategy|] - | Fable.Import(selector, path, kind, t, r) -> - [|transformImport com ctx r selector path kind |> resolveExpr t returnStrategy|] + | Fable.Import(selector, path, t, r) -> + [|transformImport com ctx r selector path |> resolveExpr t returnStrategy|] | Fable.Test(expr, kind, range) -> [|transformTest com ctx range kind expr |> resolveExpr Fable.Boolean returnStrategy|] - | Fable.Function(Fable.Lambda arg, body, name) -> + | Fable.Lambda(arg, body, name) -> [|transformFunctionWithAnnotations com ctx name [arg] body |> (if com.Options.classTypes || com.Options.typescript then makeArrowFunctionExpression name else makeFunctionExpression name) |> resolveExpr expr.Type returnStrategy|] - | Fable.Function(Fable.Delegate args, body, name) -> + | Fable.Delegate(args, body, name) -> [|transformFunctionWithAnnotations com ctx name args body |> (if com.Options.classTypes || com.Options.typescript then makeArrowFunctionExpression name @@ -1477,8 +1513,18 @@ module Util = | Fable.ObjectExpr (members, t, baseCall) -> [|transformObjectExpr com ctx members baseCall |> resolveExpr t returnStrategy|] - | Fable.Operation(callKind, t, range) -> - transformOperationAsStatements com ctx range t returnStrategy callKind + | Fable.Call(callee, info, typ, range) -> + transformCallAsStatements com ctx range typ returnStrategy callee info + + | Fable.CurriedApply(callee, args, typ, range) -> + transformCurriedApplyAsStatements com ctx range typ returnStrategy callee args + + // Ignore the return strategy + | Fable.Emit(info, _, range) -> + [|ExpressionStatement(transformEmit com ctx range info)|] + + | Fable.Operation(kind, t, range) -> + [|transformOperation com ctx range kind |> resolveExpr t returnStrategy|] | Fable.Get(expr, getKind, t, range) -> [|transformGet com ctx range t expr getKind |> resolveExpr t returnStrategy|] @@ -1487,16 +1533,14 @@ module Util = let bindings = bindings |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v) |> Seq.toArray Array.append bindings (transformAsStatements com ctx returnStrategy body) - | Fable.Set(expr, setKind, value, _range) -> - let ret = getSetReturnStrategy com ctx expr setKind + | Fable.Set(TransformExpr com ctx expr, kind, value, _range) -> + let ret = + match kind with + | None -> Assign expr + | Some(Fable.ExprKey(TransformExpr com ctx prop)) -> getExpr None expr prop |> Assign + | Some(Fable.FieldKey fi) -> get None expr fi.Name |> Assign com.TransformAsStatements(ctx, Some ret, value) - | Fable.Throw(TransformExpr com ctx ex, _, range) -> - [|ThrowStatement(ex, ?loc=range) :> Statement|] - - | Fable.Debugger range -> - [|DebuggerStatement(?loc=range) :> Statement|] - // Even if IfStatement doesn't enforce it, compile both branches as blocks // to prevent conflicts (e.g. `then` doesn't become a block while `else` does) | Fable.IfThenElse(guardExpr, thenExpr, elseExpr, r) -> @@ -1535,21 +1579,19 @@ module Util = | Fable.DecisionTreeSuccess(idx, boundValues, _) -> transformDecisionTreeSuccessAsStatements com ctx returnStrategy idx boundValues - | Fable.Loop (loopKind, range) -> - match loopKind with - | Fable.While (TransformExpr com ctx guard, body) -> - WhileStatement(guard, transformBlock com ctx None body, ?loc=range) :> Statement - | Fable.For (var, TransformExpr com ctx start, TransformExpr com ctx limit, body, isUp) -> - let op1, op2 = - if isUp - then BinaryOperator.BinaryLessOrEqual, UpdateOperator.UpdatePlus - else BinaryOperator.BinaryGreaterOrEqual, UpdateOperator.UpdateMinus - ForStatement( - transformBlock com ctx None body, - start |> varDeclaration (typedIdent com ctx var) true |> U2.Case1, - BinaryExpression (op1, ident var, limit), - UpdateExpression (op2, false, ident var), ?loc=range) :> Statement - |> Array.singleton + | Fable.WhileLoop(TransformExpr com ctx guard, body, range) -> + [|WhileStatement(guard, transformBlock com ctx None body, ?loc=range) :> Statement|] + + | Fable.ForLoop (var, TransformExpr com ctx start, TransformExpr com ctx limit, body, isUp, range) -> + let op1, op2 = + if isUp + then BinaryOperator.BinaryLessOrEqual, UpdateOperator.UpdatePlus + else BinaryOperator.BinaryGreaterOrEqual, UpdateOperator.UpdateMinus + [|ForStatement( + transformBlock com ctx None body, + start |> varDeclaration (typedIdent com ctx var) true |> U2.Case1, + BinaryExpression (op1, ident var, limit), + UpdateExpression (op2, false, ident var), ?loc=range) :> Statement|] let transformFunction com ctx name (args: Fable.Ident list) (body: Fable.Expr) = let tailcallChance = @@ -1609,39 +1651,37 @@ module Util = // ExpressionStatement(macroExpression funcExpr.loc "process.exit($0)" [main], ?loc=funcExpr.loc) ExpressionStatement(main) :> Statement - let declareModuleMember r isPublic name isMutable (expr: Expression) = - let privateIdent = Identifier name + let declareModuleMember isPublic id isMutable (expr: Expression) = + let id = ident id let decl: Declaration = match expr with | :? ClassExpression as e -> upcast ClassDeclaration( e.Body, - ?id = Some privateIdent, + ?id = Some id, ?superClass = e.SuperClass, ?implements = e.Implements, ?superTypeParameters = e.SuperTypeParameters, - ?typeParameters = e.TypeParameters, - ?loc = r) + ?typeParameters = e.TypeParameters) | :? FunctionExpression as e -> upcast FunctionDeclaration( e.Params, e.Body, - ?id = Some privateIdent, + ?id = Some id, ?returnType = e.ReturnType, - ?typeParameters = e.TypeParameters, - ?loc = r) - | _ -> upcast varDeclaration privateIdent isMutable expr + ?typeParameters = e.TypeParameters) + | _ -> upcast varDeclaration id isMutable expr if not isPublic then U2.Case1 (decl :> Statement) else ExportNamedDeclaration(decl) :> ModuleDeclaration |> U2.Case2 - let makeEntityTypeParamDecl (com: IBabelCompiler) ctx (ent: FSharpEntity) = + let makeEntityTypeParamDecl (com: IBabelCompiler) ctx (ent: Fable.Entity) = if com.Options.typescript then getEntityGenParams ent |> makeTypeParamDecl else None - let getInterfaceExtends com ctx (ent: FSharpEntity) = + let getInterfaceExtends com ctx (ent: Fable.Entity) = let mkNative genArgs typeName = let id = Identifier(typeName) let typeParamInst = makeGenTypeParamInst com ctx genArgs @@ -1654,37 +1694,34 @@ module Util = // let isIEquatable = FSharp2Fable.Util.hasInterface Types.iequatable ent // let isIComparable = FSharp2Fable.Util.hasInterface Types.icomparable ent - ent.AllInterfaces |> Seq.choose (fun typ -> - match FSharp2Fable.TypeHelpers.makeType com Map.empty typ with - | Fable.DeclaredType(ent, genArgs) -> - match ent.TryFullName with - | Some Types.ienumerableGeneric -> - mkImport genArgs "Seq" "IEnumerable" - | Some Types.ienumeratorGeneric -> - mkImport genArgs "Seq" "IEnumerator" - | Some Types.iequatable -> - mkImport [Fable.Any] "Util" "IEquatable" - | Some Types.icomparable -> - mkImport [Fable.Any] "Util" "IComparable" - // | Some Types.iequatableGeneric when not isIEquatable -> - // mkImport genArgs "Util" "IEquatable" - // | Some Types.icomparableGeneric when not isIComparable -> - // mkImport genArgs "Util" "IComparable" - | Some Types.comparer -> - mkImport genArgs "Util" "IComparer" - // this is not needed, as it's already included in every object - // | Some Types.equalityComparer -> - // mkImport genArgs "Util" "IEqualityComparer" - | Some Types.idisposable -> - mkImport [] "Util" "IDisposable" - | Some Types.icollectionGeneric -> - mkImport genArgs "Util" "ICollection" - | Some "Fable.Collections.IMutableSet`1" -> - mkImport genArgs "Util" "IMutableSet" - | Some "Fable.Collections.IMutableMap`2" -> - mkImport genArgs "Util" "IMutableMap" - // TODO: add other interfaces - | _ -> None + ent.AllInterfaces |> Seq.choose (fun ifc -> + match ifc.Definition.FullName with + | Types.ienumerableGeneric -> + mkImport ifc.GenericArgs "Seq" "IEnumerable" + | Types.ienumeratorGeneric -> + mkImport ifc.GenericArgs "Seq" "IEnumerator" + | Types.iequatable -> + mkImport [Fable.Any] "Util" "IEquatable" + | Types.icomparable -> + mkImport [Fable.Any] "Util" "IComparable" + // | Types.iequatableGeneric when not isIEquatable -> + // mkImport ifc.GenericArgs "Util" "IEquatable" + // | Types.icomparableGeneric when not isIComparable -> + // mkImport ifc.GenericArgs "Util" "IComparable" + | Types.comparer -> + mkImport ifc.GenericArgs "Util" "IComparer" + // this is not needed, as it's already included in every object + // | Types.equalityComparer -> + // mkImport ifc.GenericArgs "Util" "IEqualityComparer" + | Types.idisposable -> + mkImport [] "Util" "IDisposable" + | Types.icollectionGeneric -> + mkImport ifc.GenericArgs "Util" "ICollection" + | "Fable.Collections.IMutableSet`1" -> + mkImport ifc.GenericArgs "Util" "IMutableSet" + | "Fable.Collections.IMutableMap`2" -> + mkImport ifc.GenericArgs "Util" "IMutableMap" + // TODO: add other interfaces | _ -> None ) @@ -1705,30 +1742,31 @@ module Util = "Fable.Collections.IMutableMap`2" ] - let isOtherInterfaceMember (memb: FSharpMemberOrFunctionOrValue) = - let isInterface, fullName = FSharp2Fable.Helpers.getMemberFullName memb + let isOtherInterfaceMember (memb: Fable.MemberFunctionOrValue) = + let isInterface, fullName = + if memb.IsExplicitInterfaceImplementation then + true, memb.CompiledName.Replace("-",".") + else + let ent = memb.ApparentEnclosingEntity + ent.IsInterface, memb.FullName let lastDot = fullName.LastIndexOf(".") let entName = if lastDot < 0 then fullName else fullName.Substring(0, lastDot) isInterface && not (alreadyDeclaredInterfaces.Contains entName) - let getEntityExplicitInterfaceMembers com ctx (ent: FSharpEntity) = - let ctxTypeArgs = Map.empty - ent.TryGetMembersFunctionsAndValues + let getEntityExplicitInterfaceMembers com ctx (ent: Fable.Entity) = + ent.MembersFunctionsAndValues |> Seq.filter isOtherInterfaceMember |> Seq.map (fun memb -> let args = - Seq.concat memb.CurriedParameterGroups - |> Seq.mapi (fun i p -> + List.concat memb.CurriedParameterGroups + |> List.mapi (fun i p -> let name = defaultArg p.Name ("arg" + (string i)) |> Naming.sanitizeIdentForbiddenChars |> Naming.checkJsKeywords - let typ = FSharp2Fable.TypeHelpers.makeType com ctxTypeArgs p.Type - name, typ + name, p.Type ) - let argTypes = args |> Seq.map snd |> Seq.toList - let retType = - memb.ReturnParameter.Type - |> FSharp2Fable.TypeHelpers.makeType com ctxTypeArgs + let argTypes = args |> List.map snd + let retType = memb.ReturnParameter.Type let genTypeParams = getGenericTypeParams (argTypes @ [retType]) let newTypeParams = Set.difference genTypeParams ctx.ScopedTypeParams let ctx = { ctx with ScopedTypeParams = Set.union ctx.ScopedTypeParams newTypeParams } @@ -1744,13 +1782,13 @@ module Util = FunctionTypeAnnotation(funcArgs, returnType, ?typeParameters=typeParamDecl) :> TypeAnnotationInfo // TODO!!! This should be the compiled name if the interface is not mangled - let name = FSharp2Fable.Helpers.getMemberDisplayName memb + let name = memb.DisplayName let membId = Identifier(name) |> U2.Case1 ObjectTypeProperty(membId, funcTypeInfo) ) |> Seq.toArray - let getEntityFieldsAsProps (com: IBabelCompiler) ctx (ent: FSharpEntity) = + let getEntityFieldsAsProps (com: IBabelCompiler) ctx (ent: Fable.Entity) = ent.FSharpFields |> Seq.filter (fun field -> com.Options.classTypes || not (field.IsStatic)) |> Seq.map (fun field -> @@ -1759,64 +1797,25 @@ module Util = then StringLiteral(field.Name) |> U2.Case2 else Identifier(field.Name) |> U2.Case1 let ta = - FSharp2Fable.TypeHelpers.makeType com Map.empty field.FieldType - |> typeAnnotation com ctx + typeAnnotation com ctx field.FieldType let isStaticOpt = if field.IsStatic then Some true else None ObjectTypeProperty(id, ta, ?``static``=isStaticOpt)) |> Seq.toArray - let getEntityFieldsAsIdents com (ent: FSharpEntity) = + let getEntityFieldsAsIdents com (ent: Fable.Entity) = ent.FSharpFields |> Seq.map (fun field -> let name = field.Name |> Naming.sanitizeIdentForbiddenChars |> Naming.checkJsKeywords - let typ = FSharp2Fable.TypeHelpers.makeType com Map.empty field.FieldType - let id: Fable.Ident = { Name = name; Type = typ; Kind = Fable.UserDeclared; IsMutable = false; Range = None } + let typ = field.FieldType + let id: Fable.Ident = makeTypedIdent typ name id) |> Seq.toArray - let getGenericTypeAnnotation com ctx name genParams = - let id = Identifier(name) - let typeParamInst = makeTypeParamInst genParams - GenericTypeAnnotation(id, ?typeParameters=typeParamInst) :> TypeAnnotationInfo - |> TypeAnnotation |> Some - - let makeInterfaceDecl (com: IBabelCompiler) ctx r (ent: FSharpEntity) name (baseExpr: Expression option) = - let genTypeParams = getEntityGenParams ent - let newTypeParams = Set.difference genTypeParams ctx.ScopedTypeParams - let ctx = { ctx with ScopedTypeParams = Set.union ctx.ScopedTypeParams newTypeParams } - let fields = - if not (com.Options.classTypes) - then getEntityFieldsAsProps com ctx ent - else Array.empty - let attached = getEntityExplicitInterfaceMembers com ctx ent - let baseExt = - match baseExpr with - | Some expr when not (com.Options.classTypes) -> - match expr with - | :? Identifier as id -> - let typeParamInst = - FSharp2Fable.Helpers.tryEntityBase ent - |> Option.bind (fst >> getEntityGenParams >> makeTypeParamInst) - InterfaceExtends(id, ?typeParameters=typeParamInst) |> Seq.singleton - | _ -> Seq.empty - | _ -> Seq.empty - let interfaceExt = getInterfaceExtends com ctx ent - let combinedExt = Seq.append baseExt interfaceExt |> Seq.toArray - let extends = if Array.isEmpty combinedExt then None else Some combinedExt - // Type declaration merging only works well with class declarations, not class expressions, - // but Babel does not allow duplicate declarations (interface and class with the same name) - // so we're adding a prefix to the interface name, which will be removed after transpiling. - let prefix = if com.Options.classTypes then "$INTERFACE_DECL_PREFIX$_" else "" - let id = Identifier(prefix + name) - let body = ObjectTypeAnnotation([| yield! fields; yield! attached |]) - let typeParamDecl = genTypeParams |> makeTypeParamDecl - InterfaceDeclaration(id, body, ?extends_=extends, ?typeParameters=typeParamDecl, ?loc=r) - - let declareObjectType (com: IBabelCompiler) ctx r isPublic (ent: FSharpEntity) name (consArgs: Pattern[]) (consBody: BlockStatement) (baseExpr: Expression option) = + let declareObjectType (com: IBabelCompiler) ctx (ent: Fable.Entity) ident (consArgs: Pattern[]) (consBody: BlockStatement) (baseExpr: Expression option) = let consArgs, returnType, typeParamDecl = if com.Options.typescript then let genParams = getEntityGenParams ent - let ta = getGenericTypeAnnotation com ctx name genParams + let ta = getGenericTypeAnnotation com ctx ident genParams let thisArg = Identifier("this", ?typeAnnotation=ta) |> toPattern let consArgs = Array.append [| thisArg |] consArgs let returnType = None @@ -1828,10 +1827,10 @@ module Util = match baseExpr with | Some e -> [|consFunction; e|] | None -> [|consFunction|] - |> coreLibCall com ctx None "Types" "declare" - |> declareModuleMember r isPublic name false + |> libCall com ctx None "Types" "declare" + |> declareModuleMember ent.IsPublic ident false - let declareClassType (com: IBabelCompiler) ctx r isPublic (ent: FSharpEntity) name (consArgs: Pattern[]) (consBody: BlockStatement) (baseExpr: Expression option) = + let declareClassType (com: IBabelCompiler) ctx (ent: Fable.Entity) ident (consArgs: Pattern[]) (consBody: BlockStatement) (baseExpr: Expression option) = let consId = Identifier "constructor" let typeParamDecl = makeEntityTypeParamDecl com ctx ent let baseRef = @@ -1844,7 +1843,7 @@ module Util = let super = callSuperConstructor None [] |> ExpressionStatement :> Statement BlockStatement (Array.append [|super|] consBody.Body) else consBody - let classCons = ClassMethod(Babel.ClassImplicitConstructor, consId, consArgs, consBody, ?loc=r) + let classCons = ClassMethod(Babel.ClassImplicitConstructor, consId, consArgs, consBody) let classFields = if com.Options.typescript then getEntityFieldsAsProps com ctx ent @@ -1855,40 +1854,42 @@ module Util = // no need for constructor in unions let classMethods = if ent.IsFSharpUnion then [||] else [| U2.Case1 classCons |] let classBody = ClassBody([| yield! classFields; yield! classMethods |]) - let classExpr = ClassExpression(classBody, ?superClass=Some baseRef, ?typeParameters=typeParamDecl, ?loc=r) - classExpr |> declareModuleMember r isPublic name false + let classExpr = ClassExpression(classBody, ?superClass=Some baseRef, ?typeParameters=typeParamDecl) + classExpr |> declareModuleMember ent.IsPublic ident false - let declareType (com: IBabelCompiler) ctx r isPublic (ent: FSharpEntity) name (consArgs: Pattern[]) (consBody: BlockStatement) baseExpr: U2 list = + let declareType (com: IBabelCompiler) ctx (ent: Fable.Entity) ident (consArgs: Pattern[]) (consBody: BlockStatement) baseExpr: U2 list = let typeDeclaration = if com.Options.classTypes - then declareClassType com ctx r isPublic ent name consArgs consBody baseExpr - else declareObjectType com ctx r isPublic ent name consArgs consBody baseExpr + then declareClassType com ctx ent ident consArgs consBody baseExpr + else declareObjectType com ctx ent ident consArgs consBody baseExpr let reflectionDeclaration = - let genArgs = Array.init ent.GenericParameters.Count (fun i -> "gen" + string i |> makeIdent |> typedIdent com ctx) - let body = transformReflectionInfo com ctx r ent (Array.map (fun x -> x :> _) genArgs) + let genArgs = Array.init (ent.GenericParameters.Length) (fun i -> "gen" + string i |> makeIdent |> typedIdent com ctx) + let body = transformReflectionInfo com ctx ident.Range ent (Array.map (fun x -> x :> _) genArgs) let returnType = if com.Options.typescript then makeImportTypeAnnotation com ctx [] "Reflection" "TypeInfo" |> TypeAnnotation |> Some else None let args = genArgs |> Array.map toPattern + let ident = makeIdent (ident.Name + Naming.reflectionSuffix) makeFunctionExpression None (args, U2.Case2 body, returnType, None) - |> declareModuleMember None isPublic (name + Naming.reflectionSuffix) false - if com.Options.typescript then // && not (com.Options.classTypes && (ent.IsFSharpUnion || ent.IsFSharpRecord)) then - let interfaceDecl = makeInterfaceDecl com ctx r ent name baseExpr + |> declareModuleMember ent.IsPublic ident false + if com.Options.typescript then // && not (com.Options.classTypes && (ent.IsUnion || ent.IsFSharpRecord)) then + let interfaceDecl = makeInterfaceDecl com ctx ent ident baseExpr let interfaceDeclaration = ExportNamedDeclaration(interfaceDecl) :> ModuleDeclaration |> U2.Case2 [interfaceDeclaration; typeDeclaration; reflectionDeclaration] else [typeDeclaration; reflectionDeclaration] - let transformModuleFunction (com: IBabelCompiler) ctx (info: Fable.ModuleMemberInfo) args body = + let transformModuleFunction (com: IBabelCompiler) ctx (info: Fable.MemberDeclInfo) (ident: Fable.Ident) args body = let args, body, returnType, typeParamDecl = - getMemberArgsAndBody com ctx (NonAttached info.Name) info.HasSpread args body + getMemberArgsAndBody com ctx (NonAttached ident.Name) info.HasSpread args body let expr = FunctionExpression(args, body, ?returnType=returnType, ?typeParameters=typeParamDecl) :> Expression - if info.IsEntryPoint then - declareEntryPoint com ctx expr |> U2.Case1 - else - declareModuleMember info.Range info.IsPublic info.Name false expr + info.Attributes + |> Seq.exists (fun att -> att.FullName = Atts.entryPoint) + |> function + | true -> declareEntryPoint com ctx expr |> U2.Case1 + | false -> declareModuleMember info.IsPublic ident false expr let transformAction (com: IBabelCompiler) ctx expr = let statements = transformAsStatements com ctx None expr @@ -1901,7 +1902,7 @@ module Util = |> ExpressionStatement :> Statement |> U2.Case1 ] else Array.map U2.Case1 statements |> Array.toList - let transformAttachedProperty (com: IBabelCompiler) ctx (info: Fable.AttachedMemberInfo) entity args body = + let transformAttachedProperty (com: IBabelCompiler) ctx entity (ident: Fable.Ident) (info: Fable.MemberDeclInfo) args body = let key = if info.IsGetter then "get" else "set" let args, body, returnType, typeParamDecl = getMemberArgsAndBody com ctx Attached false args body @@ -1911,7 +1912,7 @@ module Util = |> transformAsExpr com ctx jsObject "defineProperty" [| get None funcCons "prototype" - StringLiteral info.Name + StringLiteral ident.Name ObjectExpression [| ObjectProperty(StringLiteral "configurable", BooleanLiteral true) |> U3.Case1 ObjectProperty(StringLiteral key, funcExpr) |> U3.Case1 @@ -1930,7 +1931,7 @@ module Util = let prototype = get None funcCons "prototype" attachTo prototype (StringLiteral memberName) expr - let transformAttachedMethod (com: IBabelCompiler) ctx (info: Fable.AttachedMemberInfo) entity args body = + let transformAttachedMethod (com: IBabelCompiler) ctx entity (ident: Fable.Ident) (info: Fable.MemberDeclInfo) args body = let funcCons = FSharp2Fable.Util.entityRef com entity |> transformAsExpr com ctx @@ -1938,7 +1939,7 @@ module Util = getMemberArgsAndBody com ctx Attached info.HasSpread args body let method = makeFunctionExpression None (args, U2.Case1 body, returnType, typeParamDecl) - |> attachToPrototype funcCons info.Name + |> attachToPrototype funcCons ident.Name if info.IsEnumerator then let iterator = FunctionExpression([||], enumerator2iterator com ctx) :> Expression @@ -1947,11 +1948,10 @@ module Util = else [method] - let transformUnionConstructor (com: IBabelCompiler) ctx (info: Fable.ConstructorInfo) = - let baseRef = coreValue com ctx "Types" "Union" - let argId: Fable.Ident = { Name = ""; Type = Fable.Any; Kind = Fable.UserDeclared; IsMutable = false; Range = None } - let tagId = { argId with Name = "tag"; Type = Fable.Number Int32 } - let fieldsId = { argId with Name = "fields"; Type = Fable.Array Fable.Any } + let transformUnionConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (id: Fable.Ident) = + let baseRef = libValue com ctx "Types" "Union" + let tagId = makeTypedIdent (Fable.Number Int32) "tag" + let fieldsId = makeTypedIdent (Fable.Array Fable.Any) "fields" let args = [| typedIdent com ctx tagId |> toPattern typedIdent com ctx fieldsId |> restElement |] @@ -1973,50 +1973,46 @@ module Util = assign None left right |> ExpressionStatement :> Statement) |> BlockStatement [ - yield! declareType com ctx info.Range info.IsEntityPublic info.Entity info.EntityName args body (Some baseRef) + yield! declareType com ctx ent id args body (Some baseRef) yield - info.Entity.UnionCases + ent.UnionCases |> Seq.map (getUnionCaseName >> makeStrConst) |> Seq.toList |> makeArray com ctx |> fun cases -> makeFunctionExpression None ([||], U2.Case2 cases, None, None) - |> attachToPrototype (Identifier info.EntityName) "cases" + |> attachToPrototype (ident id) "cases" ] - let transformCompilerGeneratedConstructor (com: IBabelCompiler) ctx (info: Fable.ConstructorInfo) = - let fieldIds = getEntityFieldsAsIdents com info.Entity + let transformCompilerGeneratedConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (id: Fable.Ident) = + let fieldIds = getEntityFieldsAsIdents com ent let args = fieldIds |> Array.map ident let body = - info.Entity.FSharpFields + ent.FSharpFields |> Seq.mapi (fun i field -> let left = get None thisExpr field.Name - let right = - /// Shortcut instead of using wrapIntExpression - if FSharp2Fable.TypeHelpers.isSignedIntType field.FieldType - then BinaryExpression(BinaryOrBitwise, args.[i], NumericLiteral(0.)) :> Expression - else args.[i] :> _ + let right = wrapIntExpression field.FieldType args.[i] assign None left right |> ExpressionStatement :> Statement) |> Seq.toArray |> BlockStatement let baseExpr = - if info.Entity.IsFSharpExceptionDeclaration - then coreValue com ctx "Types" "FSharpException" |> Some - elif info.Entity.IsFSharpRecord || info.Entity.IsValueType - then coreValue com ctx "Types" "Record" |> Some + if ent.IsFSharpExceptionDeclaration + then libValue com ctx "Types" "FSharpException" |> Some + elif ent.IsFSharpRecord || ent.IsValueType + then libValue com ctx "Types" "Record" |> Some else None let typedPattern = typedIdent com ctx >> toPattern let args = fieldIds |> Array.map typedPattern - declareType com ctx info.Range info.IsEntityPublic info.Entity info.EntityName args body baseExpr + declareType com ctx ent id args body baseExpr - let transformImplicitConstructor (com: IBabelCompiler) ctx (info: Fable.ClassImplicitConstructorInfo) = - let consIdent = Identifier(info.EntityName) :> Expression - let args, body, returnType, typeParamDecl = - getMemberArgsAndBody com ctx ClassConstructor info.HasSpread info.Arguments info.Body + let transformImplicitConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (id: Fable.Ident) (info: Fable.MemberDeclInfo) args body baseCall = + let consIdent = Identifier(id.Name) :> Expression + let babelArgs, body, returnType, typeParamDecl = + getMemberArgsAndBody com ctx ClassConstructor info.HasSpread args body let returnType, typeParamDecl = // change constructor's return type from void to entity type if com.Options.typescript then - let genParams = getEntityGenParams info.Entity - let returnType = getGenericTypeAnnotation com ctx info.EntityName genParams + let genParams = getEntityGenParams ent + let returnType = getGenericTypeAnnotation com ctx id genParams let typeParamDecl = makeTypeParamDecl genParams |> mergeTypeParamDecls typeParamDecl returnType, typeParamDecl else @@ -2024,7 +2020,7 @@ module Util = let typedPattern = typedIdent com ctx >> toPattern let argIdents, argExprs: Pattern list * Expression list = - match info.Arguments with + match args with | [] -> [], [] | [unitArg] when unitArg.Type = Fable.Unit -> [], [] | args when info.HasSpread -> @@ -2050,10 +2046,10 @@ module Util = makeFunctionExpression None (consArgs, exposedConsBody, returnType, typeParamDecl) let baseExpr, body = - match info.BaseCall with + match baseCall with | Some baseCall -> match baseCall with - | Fable.Operation(Fable.Call(TransformExpr com ctx baseRef, info),_,_) -> + | Fable.Call(TransformExpr com ctx baseRef, info,_,_) -> let args = transformCallArgs com ctx info.HasSpread info.Args let baseCall = if com.Options.classTypes then callSuperConstructor baseCall.Range args @@ -2063,46 +2059,57 @@ module Util = |> BlockStatement | _ -> None, body // Unexpected // Structs have same properties as records - | None when info.Entity.IsValueType -> Some(coreValue com ctx "Types" "Record"), body + | None when ent.IsValueType -> Some(libValue com ctx "Types" "Record"), body | None -> None, body [ - yield! declareType com ctx info.Range info.IsEntityPublic info.Entity info.EntityName args body baseExpr - yield declareModuleMember info.Range info.IsConstructorPublic info.ConstructorName false exposedCons + yield! declareType com ctx ent id babelArgs body baseExpr + yield declareModuleMember info.IsPublic id false exposedCons ] - let rec transformDeclaration (com: IBabelCompiler) ctx i decl = - let usedNames = { ctx.UsedNames with CurrentDeclarationScope = ctx.UsedNames.DeclarationScopes.[i] } - let ctx = { ctx with UsedNames = usedNames } + let rec transformDeclaration (com: IBabelCompiler) ctx decl = + let withCurrentScope ctx (usedNames: Set) f = + let ctx = { ctx with UsedNames = { ctx.UsedNames with CurrentDeclarationScope = HashSet usedNames } } + let result = f ctx + ctx.UsedNames.DeclarationScopes.UnionWith(ctx.UsedNames.CurrentDeclarationScope) + result match decl with - | Fable.ActionDeclaration(e,_) -> - transformAction com ctx e - - | Fable.ModuleMemberDeclaration(args, body, info, _) -> - if info.IsValue then - let isPublic, isMutable, value = - // Mutable public values must be compiled as functions (see #986) - // because values imported from ES2015 modules cannot be modified - match info.IsPublic, info.IsMutable with - | true, true -> true, false, Replacements.createAtom body |> transformAsExpr com ctx - | isPublic, isMutable -> isPublic, isMutable, transformAsExpr com ctx body - [declareModuleMember info.Range isPublic info.Name isMutable value] - else - [transformModuleFunction com ctx info args body] - - | Fable.ClassImplicitConstructorDeclaration(info, _) -> - transformImplicitConstructor com ctx info - - | Fable.CompilerGeneratedConstructorDeclaration info -> - if info.IsUnion then transformUnionConstructor com ctx info - else transformCompilerGeneratedConstructor com ctx info - - | Fable.AttachedMemberDeclaration(args, body, info, e, _) -> - if info.IsGetter || info.IsSetter then - transformAttachedProperty com ctx info e args body - else - transformAttachedMethod com ctx info e args body + | Fable.ActionDeclaration(e, usedNames) -> + withCurrentScope ctx usedNames <| fun ctx -> + transformAction com ctx e + + | Fable.MemberDeclaration memb -> + withCurrentScope ctx memb.UsedNames <| fun ctx -> + if memb.Info.IsValue then + let isPublic, isMutable, value = + // Mutable public values must be compiled as functions (see #986) + // because values imported from ES2015 modules cannot be modified + match memb.Info.IsPublic, memb.Info.IsMutable with + | true, true -> true, false, Replacements.createAtom com memb.Body |> transformAsExpr com ctx + | isPublic, isMutable -> isPublic, isMutable, transformAsExpr com ctx memb.Body + [declareModuleMember isPublic memb.Ident isMutable value] + else + [transformModuleFunction com ctx memb.Info memb.Ident memb.Args memb.Body] + + | Fable.ClassDeclaration(ent, ident, cons, baseCall, attachedMembers) -> + let cons = + match cons with + | Some memb -> + withCurrentScope ctx memb.UsedNames <| fun ctx -> + transformImplicitConstructor com ctx ent ident memb.Info memb.Args memb.Body baseCall + | None when ent.IsFSharpUnion -> transformUnionConstructor com ctx ent ident + | None -> transformCompilerGeneratedConstructor com ctx ent ident + + let attachedMembers = + attachedMembers |> List.collect (fun memb -> + withCurrentScope ctx memb.UsedNames <| fun ctx -> + if memb.Info.IsGetter || memb.Info.IsSetter then + transformAttachedProperty com ctx ent memb.Ident memb.Info memb.Args memb.Body + else + transformAttachedMethod com ctx ent memb.Ident memb.Info memb.Args memb.Body) + + cons @ attachedMembers let transformImports (imports: Import seq): U2 list = imports |> Seq.map (fun import -> @@ -2159,13 +2166,9 @@ module Compiler = let imports = Dictionary() interface IBabelCompiler with - member __.GetImportExpr(ctx, selector, path, kind) = + member __.GetImportExpr(ctx, selector, path) = let ext = if com.Options.typescript then "" else Naming.targetFileExtension - let sanitizedPath = - match kind with - | Fable.CustomImport | Fable.Internal -> path - | Fable.Library -> com.LibraryDir + "/" + path + ext - let cachedName = sanitizedPath + "::" + selector + let cachedName = path + "::" + selector match imports.TryGetValue(cachedName) with | true, i -> match i.LocalIdent with @@ -2180,7 +2183,7 @@ module Compiler = |> addError com [] None; selector else selector LocalIdent = localId - Path = sanitizedPath } + Path = path } imports.Add(cachedName, i) match localId with | Some localId -> upcast Identifier(localId) @@ -2189,7 +2192,7 @@ module Compiler = member bcom.TransformAsExpr(ctx, e) = transformAsExpr bcom ctx e member bcom.TransformAsStatements(ctx, ret, e) = transformAsStatements bcom ctx ret e member bcom.TransformFunction(ctx, name, args, body) = transformFunction bcom ctx name args body - member bcom.TransformImport(ctx, selector, path, kind) = transformImport bcom ctx None (makeStrConst selector) (makeStrConst path) kind + member bcom.TransformImport(ctx, selector, path) = transformImport bcom ctx None (makeStrConst selector) (makeStrConst path) interface ICompiler with member __.Options = com.Options @@ -2214,21 +2217,23 @@ module Compiler = let transformFile (com: ICompiler) (file: Fable.File) = let com = makeCompiler com :> IBabelCompiler - // Because we will need unique names for imports which can appear in any member, - // just collect all used names in the file to check for name conflicts - let usedGlobalNames = (file.UseNamesInRootScope, file.Declarations) - ||> List.fold (fun acc decl -> Set.union acc decl.UsedNames) + let declScopes = + let hs = HashSet() + for decl in file.Declarations do + hs.UnionWith(decl.UsedNames) + hs + let ctx = { File = file - UsedNames = { RootScope = HashSet file.UseNamesInRootScope - DeclarationScopes = file.Declarations |> List.mapToArray (fun d -> HashSet d.UsedNames) + UsedNames = { RootScope = HashSet file.UsedNamesInRootScope + DeclarationScopes = declScopes CurrentDeclarationScope = Unchecked.defaultof<_> } DecisionTargets = [] HoistVars = fun _ -> false TailCallOpportunity = None OptimizeTailCall = fun () -> () ScopedTypeParams = Set.empty } - let rootDecls = List.collecti (transformDeclaration com ctx) file.Declarations + let rootDecls = List.collect (transformDeclaration com ctx) file.Declarations let importDecls = com.GetAllImports() |> transformImports let body = importDecls @ rootDecls |> List.toArray // We don't add imports as dependencies because those will be handled by Webpack diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index dedba48d2..3a6dc4996 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -7,9 +7,9 @@ open FSharp.Compiler.SourceCodeServices // TODO: Use trampoline here? let visit f e = match e with - | IdentExpr _ | Debugger _ -> e + | IdentExpr _ -> e | TypeCast(e, t) -> TypeCast(f e, t) - | Import(e1, e2, kind, t, r) -> Import(f e1, f e2, kind, t, r) + | Import(e1, e2, t, r) -> Import(f e1, f e2, t, r) | Value(kind, r) -> match kind with | ThisValue _ | BaseValue _ @@ -19,49 +19,46 @@ let visit f e = | EnumConstant(exp, ent) -> EnumConstant(f exp, ent) |> makeValue r | NewOption(e, t) -> NewOption(Option.map f e, t) |> makeValue r | NewTuple exprs -> NewTuple(List.map f exprs) |> makeValue r - | NewArray(kind, t) -> - match kind with - | ArrayValues exprs -> NewArray(ArrayValues(List.map f exprs), t) |> makeValue r - | ArrayAlloc e -> NewArray(ArrayAlloc(f e), t) |> makeValue r + | NewArray(exprs, t) -> NewArray(List.map f exprs, t) |> makeValue r + | NewArrayAlloc(e, t) -> NewArrayAlloc(f e, t) |> makeValue r | NewList(ht, t) -> let ht = ht |> Option.map (fun (h,t) -> f h, f t) NewList(ht, t) |> makeValue r | NewRecord(exprs, ent, genArgs) -> NewRecord(List.map f exprs, ent, genArgs) |> makeValue r + | NewAnonymousRecord(exprs, ent, genArgs) -> + NewAnonymousRecord(List.map f exprs, ent, genArgs) |> makeValue r | NewUnion(exprs, uci, ent, genArgs) -> NewUnion(List.map f exprs, uci, ent, genArgs) |> makeValue r | Test(e, kind, r) -> Test(f e, kind, r) | Curry(e, arity, t, r) -> Curry(f e, arity, t, r) - | Function(kind, body, name) -> Function(kind, f body, name) + | Lambda(arg, body, name) -> Lambda(arg, f body, name) + | Delegate(args, body, name) -> Delegate(args, f body, name) | ObjectExpr(members, t, baseCall) -> let baseCall = Option.map f baseCall - let members = members |> List.map (fun (args, v, info) -> args, f v, info) + let members = members |> List.map (fun m -> { m with Body = f m.Body }) ObjectExpr(members, t, baseCall) + | CurriedApply(callee, args, t, r) -> + CurriedApply(f callee, List.map f args, t, r) + | Call(callee, info, t, r) -> + let info = { info with ThisArg = Option.map f info.ThisArg + Args = List.map f info.Args } + Call(f callee, info, t, r) + | Emit(info, t, r) -> + Emit({ info with Args = List.map f info.Args }, t, r) | Operation(kind, t, r) -> match kind with - | CurriedApply(callee, args) -> - Operation(CurriedApply(f callee, List.map f args), t, r) - | Call(callee, info) -> - let info = { info with ThisArg = Option.map f info.ThisArg - Args = List.map f info.Args } - Operation(Call(f callee, info), t, r) - | Emit(macro, info) -> - let info = info |> Option.map (fun info -> - { info with ThisArg = Option.map f info.ThisArg - Args = List.map f info.Args }) - Operation(Emit(macro, info), t, r) - | UnaryOperation(operator, operand) -> - Operation(UnaryOperation(operator, f operand), t, r) - | BinaryOperation(op, left, right) -> - Operation(BinaryOperation(op, f left, f right), t, r) - | LogicalOperation(op, left, right) -> - Operation(LogicalOperation(op, f left, f right), t, r) + | Unary(operator, operand) -> + Operation(Unary(operator, f operand), t, r) + | Binary(op, left, right) -> + Operation(Binary(op, f left, f right), t, r) + | Logical(op, left, right) -> + Operation(Logical(op, f left, f right), t, r) | Get(e, kind, t, r) -> match kind with - | ListHead | ListTail | OptionValue | TupleGet _ | UnionTag - | UnionField _ | FieldGet _ -> Get(f e, kind, t, r) - | ExprGet e2 -> Get(f e, ExprGet (f e2), t, r) - | Throw(e, typ, r) -> Throw(f e, typ, r) + | ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag + | UnionField _ | ByKey(FieldKey _) -> Get(f e, kind, t, r) + | ByKey(ExprKey e2) -> Get(f e, ByKey(ExprKey(f e2)), t, r) | Sequential exprs -> Sequential(List.map f exprs) | Let(bs, body) -> let bs = bs |> List.map (fun (i,e) -> i, f e) @@ -70,13 +67,11 @@ let visit f e = IfThenElse(f cond, f thenExpr, f elseExpr, r) | Set(e, kind, v, r) -> match kind with - | VarSet | FieldSet _ -> - Set(f e, kind, f v, r) - | ExprSet e2 -> Set(f e, ExprSet (f e2), f v, r) - | Loop (kind, r) -> - match kind with - | While(e1, e2) -> Loop(While(f e1, f e2), r) - | For(i, e1, e2, e3, up) -> Loop(For(i, f e1, f e2, f e3, up), r) + | Some(ExprKey e2) -> + Set(f e, Some(ExprKey(f e2)), f v, r) + | Some(FieldKey _) | None -> Set(f e, kind, f v, r) + | WhileLoop(e1, e2, r) -> WhileLoop(f e1, f e2, r) + | ForLoop(i, e1, e2, e3, up, r) -> ForLoop(i, f e1, f e2, f e3, up, r) | TryCatch(body, catch, finalizer, r) -> TryCatch(f body, Option.map (fun (i, e) -> i, f e) catch, @@ -96,9 +91,9 @@ let rec visitFromOutsideIn (f: Expr->Expr option) e = | None -> visit (visitFromOutsideIn f) e let getSubExpressions = function - | IdentExpr _ | Debugger _ -> [] + | IdentExpr _ -> [] | TypeCast(e,_) -> [e] - | Import(e1,e2,_,_,_) -> [e1;e2] + | Import(e1,e2,_,_) -> [e1;e2] | Value(kind,_) -> match kind with | ThisValue _ | BaseValue _ @@ -108,47 +103,42 @@ let getSubExpressions = function | EnumConstant(e, _) -> [e] | NewOption(e, _) -> Option.toList e | NewTuple exprs -> exprs - | NewArray(kind, _) -> - match kind with - | ArrayValues exprs -> exprs - | ArrayAlloc e -> [e] + | NewArray(exprs, _) -> exprs + | NewArrayAlloc(e, _) -> [e] | NewList(ht, _) -> match ht with Some(h,t) -> [h;t] | None -> [] | NewRecord(exprs, _, _) -> exprs + | NewAnonymousRecord(exprs, _, _) -> exprs | NewUnion(exprs, _, _, _) -> exprs | Test(e, _, _) -> [e] | Curry(e, _, _, _) -> [e] - | Function(_, body, _) -> [body] + | Lambda(_, body, _) -> [body] + | Delegate(_, body, _) -> [body] | ObjectExpr(members, _, baseCall) -> - let members = members |> List.collect (fun (_,v,_) -> [v]) + let members = members |> List.map (fun m -> m.Body) match baseCall with Some b -> b::members | None -> members + | CurriedApply(callee, args, _, _) -> callee::args + | Call(e1, info, _, _) -> e1 :: (Option.toList info.ThisArg) @ info.Args + | Emit(info, _, _) -> info.Args | Operation(kind, _, _) -> match kind with - | CurriedApply(callee, args) -> callee::args - | Call(e1, info) -> - e1 :: (Option.toList info.ThisArg) @ info.Args - | Emit(_, info) -> - match info with Some info -> (Option.toList info.ThisArg) @ info.Args | None -> [] - | UnaryOperation(_, operand) -> [operand] - | BinaryOperation(_, left, right) -> [left; right] - | LogicalOperation(_, left, right) -> [left; right] + | Unary(_, operand) -> [operand] + | Binary(_, left, right) -> [left; right] + | Logical(_, left, right) -> [left; right] | Get(e, kind, _, _) -> match kind with - | ListHead | ListTail | OptionValue | TupleGet _ | UnionTag - | UnionField _ | FieldGet _ -> [e] - | ExprGet e2 -> [e; e2] - | Throw(e, _, _) -> [e] + | ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag + | UnionField _ | ByKey(FieldKey _) -> [e] + | ByKey(ExprKey e2) -> [e; e2] | Sequential exprs -> exprs | Let(bs, body) -> (List.map snd bs) @ [body] | IfThenElse(cond, thenExpr, elseExpr, _) -> [cond; thenExpr; elseExpr] | Set(e, kind, v, _) -> match kind with - | VarSet | FieldSet _ -> [e; v] - | ExprSet e2 -> [e; e2; v] - | Loop (kind, _) -> - match kind with - | While(e1, e2) -> [e1; e2] - | For(_, e1, e2, e3, _) -> [e1; e2; e3] + | Some(ExprKey e2) -> [e; e2; v] + | Some(FieldKey _) | None -> [e; v] + | WhileLoop(e1, e2, _) -> [e1; e2] + | ForLoop(_, e1, e2, e3, _, _) -> [e1; e2; e3] | TryCatch(body, catch, finalizer, _) -> match catch with | Some(_,c) -> body::c::(Option.toList finalizer) @@ -200,21 +190,23 @@ let countReferences limit identName body = let canInlineArg identName value body = match value with - | Function _ -> countReferences 1 identName body <= 1 + | Lambda _ | Delegate _ -> countReferences 1 identName body <= 1 | value -> canHaveSideEffects value |> not module private Transforms = let (|LambdaOrDelegate|_|) = function - | Function(Lambda arg, body, name) -> Some([arg], body, name) - | Function(Delegate args, body, name) -> Some(args, body, name) + | Lambda(arg, body, name) -> Some([arg], body, name) + | Delegate(args, body, name) -> Some(args, body, name) | _ -> None + let (|FieldType|) (fi: Field) = fi.FieldType + let lambdaBetaReduction (com: ICompiler) e = // Sometimes the F# compiler creates a lot of binding closures, as with printfn let (|NestedLetsAndLambdas|_|) expr = let rec inner accBindings accArgs body name = match body with - | Function(Lambda arg, body, None) -> + | Lambda(arg, body, None) -> inner accBindings (arg::accArgs) body name | Let(bindings, body) -> inner (accBindings @ bindings) accArgs body name @@ -224,7 +216,7 @@ module private Transforms = match expr with | Let(bindings, body) -> inner bindings [] body None - | Function(Lambda arg, body, name) -> + | Lambda(arg, body, name) -> inner [] [arg] body name | _ -> None let applyArgs (args: Ident list) argExprs body = @@ -239,7 +231,7 @@ module private Transforms = | bindings -> Let(List.rev bindings, replaceValues replacements body) match e with // TODO: Other binary operations and numeric types, also recursive? - | Operation(BinaryOperation(AST.BinaryPlus, Value(StringConstant str1, r1), Value(StringConstant str2, r2)),_,_) -> + | Operation(Binary(AST.BinaryPlus, Value(StringConstant str1, r1), Value(StringConstant str2, r2)),_,_) -> Value(StringConstant(str1 + str2), addRanges [r1; r2]) | NestedApply(NestedLetsAndLambdas(lambdaArgs, body, _) as lambda, argExprs,_,_) -> if List.sameLength lambdaArgs argExprs then @@ -247,13 +239,13 @@ module private Transforms = else // Partial apply match List.length argExprs, lambda with - | 1, Function(Lambda arg, body, _) -> + | 1, Lambda(arg, body, _) -> applyArgs [arg] argExprs body - | 2, Function(Lambda arg1, Function(Lambda arg2, body,_),_) -> + | 2, Lambda(arg1, Lambda(arg2, body,_),_) -> applyArgs [arg1; arg2] argExprs body - | 3, Function(Lambda arg1, Function(Lambda arg2, Function(Lambda arg3, body,_),_),_) -> + | 3, Lambda(arg1, Lambda(arg2, Lambda(arg3, body,_),_),_) -> applyArgs [arg1; arg2; arg3] argExprs body - | 4, Function(Lambda arg1, Function(Lambda arg2, Function(Lambda arg3, Function(Lambda arg4, body,_),_),_),_) -> + | 4, Lambda(arg1, Lambda(arg2, Lambda(arg3, Lambda(arg4, body,_),_),_),_) -> applyArgs [arg1; arg2; arg3; arg4] argExprs body | _ -> e | e -> e @@ -261,7 +253,7 @@ module private Transforms = /// Tuples created when pattern matching multiple elements can usually be erased /// after the binding and lambda beta reduction let tupleBetaReduction (_: ICompiler) = function - | Get(Value(NewTuple exprs, _), TupleGet index, _, _) -> List.item index exprs + | Get(Value(NewTuple exprs, _), TupleIndex index, _, _) -> List.item index exprs | e -> e let bindingBetaReduction (com: ICompiler) e = @@ -284,7 +276,8 @@ module private Transforms = let value = match value with // Ident becomes the name of the function (mainly used for tail call optimizations) - | Function(args, funBody, _) -> Function(args, funBody, Some ident.Name) + | Lambda(arg, funBody, _) -> Lambda(arg, funBody, Some ident.Name) + | Delegate(args, funBody, _) -> Delegate(args, funBody, Some ident.Name) | value -> value replaceValues (Map [ident.Name, value]) letBody else e @@ -293,12 +286,12 @@ module private Transforms = /// Returns arity of lambda (or lambda option) types let getLambdaTypeArity t = let rec getLambdaTypeArity acc = function - | FunctionType(LambdaType _, returnType) -> + | LambdaType(_, returnType) -> getLambdaTypeArity (acc + 1) returnType | _ -> acc match t with - | FunctionType(LambdaType _, returnType) - | Option(FunctionType(LambdaType _, returnType)) -> + | LambdaType(_, returnType) + | Option(LambdaType(_, returnType)) -> getLambdaTypeArity 1 returnType | _ -> 0 @@ -321,7 +314,7 @@ module private Transforms = then body else curryIdentsInBody replacements body - let uncurryExpr arity expr = + let uncurryExpr com arity expr = let matches arity arity2 = match arity with // TODO: check cases where arity <> arity2 @@ -338,7 +331,7 @@ module private Transforms = when matches arity arity2 -> Value(NewOption(Some(innerExpr),r1),r2) | _ -> match arity with - | Some arity -> Replacements.uncurryExprAtRuntime arity expr + | Some arity -> Replacements.uncurryExprAtRuntime com arity expr | None -> expr // For function arguments check if the arity of their own function arguments is expected or not @@ -369,7 +362,7 @@ module private Transforms = NewTuple [makeIntConst expectedArity; makeIntConst actualArity] |> makeValue None | None -> makeIntConst 0) |> makeArray Any - Replacements.Helper.CoreCall("Util", "mapCurriedArgs", expectedType, [expr; mappings]) + Replacements.Helper.LibCall(com, "Util", "mapCurriedArgs", expectedType, [expr; mappings]) | _ -> expr let uncurryArgs com autoUncurrying argTypes args = @@ -383,14 +376,14 @@ module private Transforms = | _, [] -> List.rev acc mapArgsInner f [] argTypes args match argTypes with - | _ when autoUncurrying -> List.map (uncurryExpr None) args + | _ when autoUncurrying -> List.map (uncurryExpr com None) args | [] -> args // Do nothing | argTypes -> (argTypes, args) ||> mapArgs (fun expectedType arg -> let arg = checkSubArguments com expectedType arg let arity = getLambdaTypeArity expectedType if arity > 1 - then uncurryExpr (Some arity) arg + then uncurryExpr com (Some arity) arg else arg) let uncurryInnerFunctions (_: ICompiler) e = @@ -400,13 +393,13 @@ module private Transforms = | Let([ident, NestedLambdaWithSameArity(args, fnBody, _)], letBody) when List.isMultiple args -> let fnBody = curryIdentInBody ident.Name args fnBody let letBody = curryIdentInBody ident.Name args letBody - Let([ident, Function(Delegate args, fnBody, None)], letBody) + Let([ident, Delegate(args, fnBody, None)], letBody) // Anonymous lambda immediately applied - | Operation(CurriedApply((NestedLambdaWithSameArity(args, fnBody, Some name)), argExprs), t, r) + | CurriedApply(NestedLambdaWithSameArity(args, fnBody, Some name), argExprs, t, r) when List.isMultiple args && List.sameLength args argExprs -> let fnBody = curryIdentInBody name args fnBody - let info = makeSimpleCallInfo None argExprs (args |> List.map (fun a -> a.Type)) - Function(Delegate args, fnBody, Some name) + let info = makeCallInfo None argExprs (args |> List.map (fun a -> a.Type)) + Delegate(args, fnBody, Some name) |> makeCall r t info | e -> e @@ -427,73 +420,73 @@ module private Transforms = else Let(identsAndValues, curryIdentsInBody replacements body) | e -> e + let uncurryMemberArgs (m: MemberDecl) = + if m.Info.IsValue then m + else { m with Body = uncurryIdentsAndReplaceInBody m.Args m.Body } + let uncurryReceivedArgs (_: ICompiler) e = match e with - | Function(Lambda arg, body, name) -> + | Lambda(arg, body, name) -> let body = uncurryIdentsAndReplaceInBody [arg] body - Function(Lambda arg, body, name) - | Function(Delegate args, body, name) -> + Lambda(arg, body, name) + | Delegate(args, body, name) -> let body = uncurryIdentsAndReplaceInBody args body - Function(Delegate args, body, name) + Delegate(args, body, name) // Uncurry also values received from getters - | Get(_, (FieldGet(_,_,fieldType) | UnionField(_,_,fieldType)), t, r) -> + | Get(_, (ByKey(FieldKey(FieldType fieldType)) | UnionField(_,fieldType)), t, r) -> let arity = getLambdaTypeArity fieldType if arity > 1 then Curry(e, arity, t, r) else e | ObjectExpr(members, t, baseCall) -> - let members = - members |> List.map (fun (args, body, info) -> - let body = if info.IsMethod then uncurryIdentsAndReplaceInBody args body - else body - args, body, info) - ObjectExpr(members, t, baseCall) + ObjectExpr(List.map uncurryMemberArgs members, t, baseCall) | e -> e let uncurrySendingArgs (com: ICompiler) e = - let uncurryConsArgs args (fields: seq) = + let uncurryConsArgs args (fields: seq) = let argTypes = fields - |> Seq.map (fun fi -> FSharp2Fable.TypeHelpers.makeType com Map.empty fi.FieldType) + |> Seq.map (fun fi -> fi.FieldType) |> Seq.toList uncurryArgs com false argTypes args match e with - | Operation(Call(callee, info), t, r) -> - let args = uncurryArgs com info.AutoUncurrying info.SignatureArgTypes info.Args + | Call(callee, info, t, r) -> + let args = uncurryArgs com false info.SignatureArgTypes info.Args let info = { info with Args = args } - Operation(Call(callee, info), t, r) - | Operation(CurriedApply(callee, args), t, r) -> + Call(callee, info, t, r) + | CurriedApply(callee, args, t, r) -> match callee.Type with | NestedLambdaType(argTypes, _) -> - Operation(CurriedApply(callee, uncurryArgs com false argTypes args), t, r) + CurriedApply(callee, uncurryArgs com false argTypes args, t, r) | _ -> e - | Operation(Emit(macro, Some info), t, r) -> - let args = uncurryArgs com info.AutoUncurrying info.SignatureArgTypes info.Args - let info = { info with Args = args } - Operation(Emit(macro, Some info), t, r) + | Emit(info, t, r) -> + Emit({ info with Args = uncurryArgs com true [] info.Args }, t, r) // Uncurry also values in setters or new record/union/tuple - | Value(NewRecord(args, kind, genArgs), r) -> - let args = - match kind with - | DeclaredRecord ent -> uncurryConsArgs args ent.FSharpFields - | AnonymousRecord _ -> uncurryArgs com true [] args - Value(NewRecord(args, kind, genArgs), r) - | Value(NewUnion(args, uci, ent, genArgs), r) -> + | Value(NewRecord(args, ent, genArgs), r) -> + let args = uncurryConsArgs args ent.FSharpFields + Value(NewRecord(args, ent, genArgs), r) + | Value(NewAnonymousRecord(args, fieldNames, genArgs), r) -> + let args = uncurryArgs com true [] args + Value(NewAnonymousRecord(args, fieldNames, genArgs), r) + | Value(NewUnion(args, tag, ent, genArgs), r) -> + let uci = ent.UnionCases.[tag] let args = uncurryConsArgs args uci.UnionCaseFields - Value(NewUnion(args, uci, ent, genArgs), r) - | Set(e, FieldSet(fieldName, fieldType), value, r) -> - let value = uncurryArgs com false [fieldType] [value] - Set(e, FieldSet(fieldName, fieldType), List.head value, r) + Value(NewUnion(args, tag, ent, genArgs), r) + | Set(e, Some(FieldKey fi), value, r) -> + let value = uncurryArgs com false [fi.FieldType] [value] + Set(e, Some(FieldKey fi), List.head value, r) | e -> e let rec uncurryApplications (com: ICompiler) e = let uncurryApply r t applied args uncurriedArity = let argsLen = List.length args if uncurriedArity = argsLen then - let info = { makeSimpleCallInfo None args [] with AutoUncurrying = true } + // This is already uncurried we don't need the signature arg types anymore, + // just make a normal call + let info = makeCallInfo None args [] makeCall r t info applied |> Some else - Replacements.partialApplyAtRuntime t (uncurriedArity - argsLen) applied args |> Some + Replacements.partialApplyAtRuntime com t (uncurriedArity - argsLen) applied args |> Some match e with | NestedApply(applied, args, t, r) -> let applied = visitFromOutsideIn (uncurryApplications com) applied @@ -503,7 +496,7 @@ module private Transforms = uncurryApply r t applied args uncurriedArity | Get(Curry(applied, uncurriedArity,_,_), OptionValue, t2, r2) -> uncurryApply r t (Get(applied, OptionValue, t2, r2)) args uncurriedArity - | _ -> Operation(CurriedApply(applied, args), t, r) |> Some + | _ -> CurriedApply(applied, args, t, r) |> Some | _ -> None open Transforms @@ -527,36 +520,38 @@ let optimizations = let transformExpr (com: ICompiler) e = List.fold (fun e f -> f com e) e optimizations +let transformMemberBody com (m: MemberDecl) = + { m with Body = transformExpr com m.Body } + let transformDeclaration (com: ICompiler) = function | ActionDeclaration(expr, usedNames) -> ActionDeclaration(transformExpr com expr, usedNames) - | ModuleMemberDeclaration(args, body, info, usedNames) -> - let body = - if info.IsValue then body - else uncurryIdentsAndReplaceInBody args body - ModuleMemberDeclaration(args, transformExpr com body, info, usedNames) - | AttachedMemberDeclaration(args, body, info, e, usedNames) -> - let body = - if info.IsMethod then uncurryIdentsAndReplaceInBody args body - else body - AttachedMemberDeclaration(args, transformExpr com body, info, e, usedNames) - | ClassImplicitConstructorDeclaration(info, usedNames) -> - let baseCall, body = - match info.BaseCall with - | Some baseCall -> + + | MemberDeclaration m -> + uncurryMemberArgs m |> transformMemberBody com |> MemberDeclaration + + | ClassDeclaration(ent, ident, cons, baseCall, attachedMembers) -> + let attachedMembers = + attachedMembers + |> List.map (uncurryMemberArgs >> transformMemberBody com) + + let cons, baseCall = + match cons, baseCall with + | None, _ -> cons, baseCall + | Some cons, None -> + uncurryMemberArgs cons |> transformMemberBody com |> Some, None + | Some cons, Some baseCall -> // In order to uncurry correctly the baseCall arguments, // we need to include it in the constructor body - Sequential [baseCall; info.Body] - |> uncurryIdentsAndReplaceInBody info.Arguments + Sequential [baseCall; cons.Body] + |> uncurryIdentsAndReplaceInBody cons.Args |> transformExpr com |> function - | Sequential [baseCall; body] -> Some baseCall, body - | body -> None, body // Unexpected, raise error? - | None -> - None, uncurryIdentsAndReplaceInBody info.Arguments info.Body |> transformExpr com - ClassImplicitConstructorDeclaration(info.WithBodyAndBaseCall(body, baseCall), usedNames) - | CompilerGeneratedConstructorDeclaration _ as d -> d + | Sequential [baseCall; body] -> Some { cons with Body = body }, Some baseCall + | body -> Some { cons with Body = body }, None // Unexpected, raise error? + + ClassDeclaration(ent, ident, cons, baseCall, attachedMembers) let transformFile (com: ICompiler) (file: File) = let newDecls = List.map (transformDeclaration com) file.Declarations - File(file.SourcePath, newDecls, usedRootNames=file.UseNamesInRootScope, inlineDependencies=file.InlineDependencies) + File(file.SourcePath, newDecls, usedRootNames=file.UsedNamesInRootScope, inlineDependencies=file.InlineDependencies) diff --git a/src/Fable.Transforms/Global/Prelude.fs b/src/Fable.Transforms/Global/Prelude.fs index 6b8da97c8..1435470e0 100644 --- a/src/Fable.Transforms/Global/Prelude.fs +++ b/src/Fable.Transforms/Global/Prelude.fs @@ -6,8 +6,9 @@ type Position = static member Empty = { line = 1; column = 0 } type SourceLocation = - { start: Position; - ``end``: Position; + { start: Position + ``end``: Position + /// We added the display name here because it seemed to be used by Babel source map generation identifierName: string option } static member (+)(r1, r2) = { start = r1.start @@ -32,6 +33,11 @@ module Tuple3 = let item2 (_,y,_) = y let item3 (_,_,z) = z +[] +module Seq = + let mapToList (f: 'a -> 'b) (xs: 'a seq) = + ([], xs) ||> Seq.fold (fun li x -> (f x)::li) |> List.rev + [] module Array = let mapToList (f: 'a -> 'b) (xs: 'a array) = diff --git a/src/Fable.Transforms/Inject.fs b/src/Fable.Transforms/Inject.fs index 92f725ed5..76b36a54c 100644 --- a/src/Fable.Transforms/Inject.fs +++ b/src/Fable.Transforms/Inject.fs @@ -27,17 +27,17 @@ let (|GeneratedInterface|_|) com ctx r t = match t with | Fable.DeclaredType(typDef,[t]) -> // TODO: Unify with Replacements.injectArg? - match typDef.TryFullName with - | Some Types.typeResolver -> + match typDef.FullName with + | Types.typeResolver -> let fn = Fable.Value(Fable.TypeInfo t, r) |> makeDelegate [] Replacements.Helpers.objExpr ["ResolveType", fn] |> Some - | Some Types.comparer -> + | Types.comparer -> Replacements.makeComparer com t |> Some - | Some Types.equalityComparer -> + | Types.equalityComparer -> Replacements.makeEqualityComparer com t |> Some - | Some Types.adder -> + | Types.adder -> Replacements.makeGenericAdder com ctx t |> Some - | Some Types.averager -> + | Types.averager -> Replacements.makeGenericAverager com ctx t |> Some | _ -> None | _ -> None @@ -47,7 +47,7 @@ let injectArg com ctx r (genArgs: (string * Fable.Type) list) (par: FSharpParame let typ = // The type of the parameter must be an option if parType.HasTypeDefinition && parType.TypeDefinition.TryFullName = Some Types.option - then makeType com (Map genArgs) parType.GenericArguments.[0] |> Some + then makeType (Map genArgs) parType.GenericArguments.[0] |> Some else None match typ with | Some(GeneratedInterface com ctx r e) -> e diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index 834b9de76..84bfabf8b 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -3,49 +3,38 @@ module Fable.Transforms.Replacements #nowarn "1182" -open FSharp.Compiler.SourceCodeServices open Fable open Fable.AST open Fable.AST.Fable -open Fable.Core type Context = FSharp2Fable.Context type ICompiler = FSharp2Fable.IFableCompiler type CallInfo = Fable.ReplaceCallInfo type Helper = - static member JsConstructorCall(consExpr: Expr, returnType: Type, args: Expr list, - ?argTypes: Type list, ?loc: SourceLocation) = - let argTypes = defaultArg argTypes [] - let info = { makeSimpleCallInfo None args argTypes with IsJsConstructor = true } - Operation(Call(consExpr, info), returnType, loc) + static member JsConstructorCall(consExpr: Expr, returnType: Type, args: Expr list, ?loc: SourceLocation) = + emitJsExpr loc returnType (consExpr::args) "new $0($1...)" static member InstanceCall(callee: Expr, memb: string, returnType: Type, args: Expr list, ?argTypes: Type list, ?loc: SourceLocation) = let callee = getSimple callee memb - let info = defaultArg argTypes [] |> makeSimpleCallInfo None args - Operation(Call(callee, info), returnType, loc) + let info = defaultArg argTypes [] |> makeCallInfo None args + Call(callee, info, returnType, loc) static member Application(callee: Expr, returnType: Type, args: Expr list, ?argTypes: Type list, ?loc: SourceLocation) = - let info = defaultArg argTypes [] |> makeSimpleCallInfo None args - Operation(Call(callee, info), returnType, loc) - - static member CoreValue(coreModule: string, coreMember: string, returnType: Type) = - makeCoreRef returnType coreMember coreModule - - static member CoreCall(coreModule: string, coreMember: string, returnType: Type, args: Expr list, - ?argTypes: Type list, ?thisArg: Expr, ?isJsConstructor: bool, - ?hasSpread: bool, ?loc: SourceLocation) = - let callee = makeCoreRef Any coreMember coreModule - let info = - { ThisArg = thisArg - Args = args - SignatureArgTypes = defaultArg argTypes [] - HasSpread = defaultArg hasSpread false - AutoUncurrying = false - IsJsConstructor = defaultArg isJsConstructor false } - Operation(Call(callee, info), returnType, loc) + let info = defaultArg argTypes [] |> makeCallInfo None args + Call(callee, info, returnType, loc) + + static member LibValue(com, coreModule: string, coreMember: string, returnType: Type) = + makeLibRef com returnType coreMember coreModule + + static member LibCall(com, coreModule: string, coreMember: string, returnType: Type, args: Expr list, + ?argTypes: Type list, ?thisArg: Expr, ?hasSpread: bool, ?isJsConstructor: bool, ?loc: SourceLocation) = + let callee = makeLibRef com Any coreMember coreModule + let info = makeCallInfo thisArg args (defaultArg argTypes []) + Call(callee, { info with HasSpread = defaultArg hasSpread false + IsJsConstructor = defaultArg isJsConstructor false }, returnType, loc) static member GlobalCall(ident: string, returnType: Type, args: Expr list, ?argTypes: Type list, ?memb: string, ?isJsConstructor: bool, ?loc: SourceLocation) = @@ -53,21 +42,13 @@ type Helper = match memb with | Some memb -> getSimple (makeIdentExpr ident) memb | None -> makeIdentExpr ident - let argTypes = defaultArg argTypes [] - let info = makeSimpleCallInfo None args argTypes - let info = - match isJsConstructor with - | Some true -> { info with IsJsConstructor = true } - | Some false | None -> info - Operation(Call(callee, info), returnType, loc) + let info = makeCallInfo None args (defaultArg argTypes []) + Call(callee, { info with IsJsConstructor = defaultArg isJsConstructor false }, returnType, loc) static member GlobalIdent(ident: string, memb: string, typ: Type, ?loc: SourceLocation) = get loc typ (makeIdentExpr ident) memb module Helpers = - let inline makeType com t = - FSharp2Fable.TypeHelpers.makeType com Map.empty t - let resolveArgTypes argTypes (genArgs: (string * Type) list) = argTypes |> List.map (function | GenericParam name as t -> @@ -76,12 +57,14 @@ module Helpers = |> Option.defaultValue t | t -> t) - let emitJs r t args macro = - let info = { makeSimpleCallInfo None args [] with AutoUncurrying = true } - Operation(Emit(macro, Some info), t, r) - - let objValue (k, v) = - [], v, Fable.AttachedMemberInfo(k, None, isValue=true) + let objValue (k, v): Fable.MemberDecl = + { + Ident = makeIdent k + Args = [] + Body = v + UsedNames = Set.empty + Info = FSharp2Fable.MemberDeclInfo(isValue=true) + } let typedObjExpr t kvs = ObjectExpr(List.map objValue kvs, t, None) @@ -90,19 +73,19 @@ module Helpers = typedObjExpr Fable.Any kvs let add left right = - Operation(BinaryOperation(BinaryPlus, left, right), left.Type, None) + Operation(Binary(BinaryPlus, left, right), left.Type, None) let sub left right = - Operation(BinaryOperation(BinaryMinus, left, right), left.Type, None) + Operation(Binary(BinaryMinus, left, right), left.Type, None) let eq left right = - Operation(BinaryOperation(BinaryEqualStrict, left, right), Boolean, None) + Operation(Binary(BinaryEqualStrict, left, right), Boolean, None) let neq left right = - Operation(BinaryOperation(BinaryUnequalStrict, left, right), Boolean, None) + Operation(Binary(BinaryUnequalStrict, left, right), Boolean, None) let isNull expr = - Operation(BinaryOperation(BinaryEqual, expr, Value(Null Any, None)), Boolean, None) + Operation(Binary(BinaryEqual, expr, Value(Null Any, None)), Boolean, None) let error msg = Helper.JsConstructorCall(makeIdentExpr "Error", Any, [msg]) @@ -117,11 +100,6 @@ module Helpers = |> addError com ctx.InlinePath r Any) - /// Records, unions and F# exceptions (value types are assimilated into records) will have a base - /// implementing basic methods: toString, toJSON, GetHashCode, Equals, CompareTo. See fable-library/Types - let hasBaseImplementingBasicMethods (ent: FSharpEntity) = - ent.IsFSharpRecord || ent.IsFSharpUnion || ent.IsFSharpExceptionDeclaration || ent.IsValueType - open Helpers type BuiltinType = @@ -165,21 +143,18 @@ let (|BuiltinDefinition|_|) = function | (Naming.StartsWith Types.choiceNonGeneric _) -> Some(FSharpChoice []) | _ -> None -let (|BuiltinEntity|_|) (ent: FSharpEntity, genArgs) = - match ent.TryFullName with - | Some entityFullName -> - match entityFullName, genArgs with - | BuiltinDefinition(FSharpSet _), [t] -> Some(FSharpSet(t)) - | BuiltinDefinition(FSharpMap _), [k;v] -> Some(FSharpMap(k,v)) - | BuiltinDefinition(BclHashSet _), [t] -> Some(BclHashSet(t)) - | BuiltinDefinition(BclDictionary _), [k;v] -> Some(BclDictionary(k,v)) - | BuiltinDefinition(BclKeyValuePair _), [k;v] -> Some(BclKeyValuePair(k,v)) - | BuiltinDefinition(FSharpResult _), [k;v] -> Some(FSharpResult(k,v)) - | BuiltinDefinition(FSharpReference _), [v] -> Some(FSharpReference(v)) - | BuiltinDefinition(FSharpChoice _), genArgs -> Some(FSharpChoice genArgs) - | BuiltinDefinition t, _ -> Some t - | _ -> None - | None -> None +let (|BuiltinEntity|_|) (ent: Entity, genArgs) = + match ent.FullName, genArgs with + | BuiltinDefinition(FSharpSet _), [t] -> Some(FSharpSet(t)) + | BuiltinDefinition(FSharpMap _), [k;v] -> Some(FSharpMap(k,v)) + | BuiltinDefinition(BclHashSet _), [t] -> Some(BclHashSet(t)) + | BuiltinDefinition(BclDictionary _), [k;v] -> Some(BclDictionary(k,v)) + | BuiltinDefinition(BclKeyValuePair _), [k;v] -> Some(BclKeyValuePair(k,v)) + | BuiltinDefinition(FSharpResult _), [k;v] -> Some(FSharpResult(k,v)) + | BuiltinDefinition(FSharpReference _), [v] -> Some(FSharpReference(v)) + | BuiltinDefinition(FSharpChoice _), genArgs -> Some(FSharpChoice genArgs) + | BuiltinDefinition t, _ -> Some t + | _ -> None let (|Builtin|_|) = function | DeclaredType(ent, genArgs) -> @@ -234,9 +209,9 @@ let getTypeName com (ctx: Context) r t = let (|Nameof|_|) com ctx = function | IdentExpr ident -> Some ident.DisplayName - | Get(_, ExprGet(Value(StringConstant prop,_)), _, _) -> Some prop - | Get(_, FieldGet(fi,_,_), _, _) -> Some fi - | NestedLambda(args, Operation(Call(IdentExpr ident, info),_,_), None) -> + | Get(_, ByKey(ExprKey(Value(StringConstant prop,_))), _, _) -> Some prop + | Get(_, ByKey(FieldKey fi), _, _) -> Some fi.Name + | NestedLambda(args, Call(IdentExpr ident, info, _, _), None) -> if List.sameLength args info.Args && List.zip args info.Args |> List.forall (fun (a1, a2) -> match a2 with IdentExpr id2 -> a1.Name = id2.Name | _ -> false) then Some ident.DisplayName @@ -270,22 +245,22 @@ let (|ListLiteral|_|) e = | _ -> None let (|ArrayOrListLiteral|_|) = function - | Value((NewArray(ArrayValues vals, t)|ListLiteral(vals, t)),_) -> Some(vals, t) + | Value((NewArray(vals, t)|ListLiteral(vals, t)),_) -> Some(vals, t) | _ -> None let (|IDictionary|IEqualityComparer|Other|) = function | DeclaredType(ent,_) -> - match ent.TryFullName with - | Some Types.idictionary -> IDictionary - | Some Types.equalityComparer -> IEqualityComparer + match ent.FullName with + | Types.idictionary -> IDictionary + | Types.equalityComparer -> IEqualityComparer | _ -> Other | _ -> Other let (|IEnumerable|IEqualityComparer|Other|) = function | DeclaredType(ent,_) -> - match ent.TryFullName with - | Some Types.ienumerableGeneric -> IEnumerable - | Some Types.equalityComparer -> IEqualityComparer + match ent.FullName with + | Types.ienumerableGeneric -> IEnumerable + | Types.equalityComparer -> IEqualityComparer | _ -> Other | _ -> Other @@ -293,7 +268,7 @@ let (|NewAnonymousRecord|_|) e = let rec inner bindings = function // The F# compiler may create some bindings of expression arguments to fix https://github.com/dotnet/fsharp/issues/6487 | Let(newBindings, body) -> inner (bindings @ newBindings) body - | Value(NewRecord(exprs, AnonymousRecord fieldNames, genArgs), r) -> + | Value(NewAnonymousRecord(exprs, fieldNames, genArgs), r) -> Some(List.rev bindings, exprs, fieldNames, genArgs, r) | _ -> None inner [] e @@ -316,30 +291,30 @@ let coreModFor = function | BclDictionary _ -> "MutableMap" | BclKeyValuePair _ -> failwith "Cannot decide core module" -let makeLongInt r t signed (x: uint64) = +let makeLongInt com r t signed (x: uint64) = let lowBits = NumberConstant (float (uint32 x), Float64) let highBits = NumberConstant (float (x >>> 32), Float64) let unsigned = BoolConstant (not signed) let args = [makeValue None lowBits; makeValue None highBits; makeValue None unsigned] - Helper.CoreCall("Long", "fromBits", t, args, ?loc=r) + Helper.LibCall(com, "Long", "fromBits", t, args, ?loc=r) -let makeDecimal r t (x: decimal) = +let makeDecimal com r t (x: decimal) = let str = x.ToString(System.Globalization.CultureInfo.InvariantCulture) - Helper.CoreCall("Decimal", "default", t, [makeStrConst str], isJsConstructor=true, ?loc=r) + Helper.LibCall(com, "Decimal", "default", t, [makeStrConst str], isJsConstructor=true, ?loc=r) -let makeDecimalFromExpr r t (e: Expr) = - Helper.CoreCall("Decimal", "default", t, [e], isJsConstructor=true, ?loc=r) +let makeDecimalFromExpr com r t (e: Expr) = + Helper.LibCall(com, "Decimal", "default", t, [e], isJsConstructor=true, ?loc=r) let makeFloat32 r (x: float32) = Helper.GlobalCall("Math", Number Float32, [NumberConstant (float x, Float32) |> makeValue r], memb="fround") -let makeTypeConst r (typ: Type) (value: obj) = +let makeTypeConst com r (typ: Type) (value: obj) = match typ, value with // Long Integer types - | Builtin BclInt64, (:? int64 as x) -> makeLongInt r typ true (uint64 x) - | Builtin BclUInt64, (:? uint64 as x) -> makeLongInt r typ false x + | Builtin BclInt64, (:? int64 as x) -> makeLongInt com r typ true (uint64 x) + | Builtin BclUInt64, (:? uint64 as x) -> makeLongInt com r typ false x // Decimal type - | Builtin BclDecimal, (:? decimal as x) -> makeDecimal r typ x + | Builtin BclDecimal, (:? decimal as x) -> makeDecimal com r typ x | Boolean, (:? bool as x) -> BoolConstant x |> makeValue r | String, (:? string as x) -> StringConstant x |> makeValue r | Char, (:? char as x) -> CharConstant x |> makeValue r @@ -368,10 +343,10 @@ let makeTypeConst r (typ: Type) (value: obj) = // in F# AST as BasicPatterns.Const | Array (Number kind), (:? (byte[]) as arr) -> let values = arr |> Array.map (fun x -> NumberConstant (float x, kind) |> makeValue None) |> Seq.toList - NewArray (ArrayValues values, Number kind) |> makeValue r + NewArray (values, Number kind) |> makeValue r | Array (Number kind), (:? (uint16[]) as arr) -> let values = arr |> Array.map (fun x -> NumberConstant (float x, kind) |> makeValue None) |> Seq.toList - NewArray (ArrayValues values, Number kind) |> makeValue r + NewArray (values, Number kind) |> makeValue r | _ -> failwithf "Unexpected type %A for literal %O (%s)" typ value (value.GetType().FullName) let makeTypeInfo r t = @@ -392,9 +367,9 @@ let makeTypeDefinitionInfo r t = | t -> t TypeInfo t |> makeValue r -let createAtom (value: Expr) = +let createAtom com (value: Expr) = let typ = value.Type - Helper.CoreCall("Util", "createAtom", typ, [value], [typ]) + Helper.LibCall(com, "Util", "createAtom", typ, [value], [typ]) let toChar (arg: Expr) = match arg.Type with @@ -411,13 +386,10 @@ let toString com (ctx: Context) r (args: Expr list) = | Char | String | Builtin BclGuid -> head | Builtin (BclTimeSpan|BclInt64|BclUInt64 as t) -> - Helper.CoreCall(coreModFor t, "toString", String, args) - | Number Int16 -> Helper.CoreCall("Util", "int16ToString", String, args) - | Number Int32 -> Helper.CoreCall("Util", "int32ToString", String, args) + Helper.LibCall(com, coreModFor t, "toString", String, args) + | Number Int16 -> Helper.LibCall(com, "Util", "int16ToString", String, args) + | Number Int32 -> Helper.LibCall(com, "Util", "int32ToString", String, args) | Number _ -> Helper.InstanceCall(head, "toString", String, tail) - // | DeclaredType(ent,_) when hasBaseImplementingBasicMethods ent -> - // Helper.InstanceCall(head, "toString", String, []) - // | Unit | Boolean | Array _ | Tuple _ | FunctionType _ | EnumType _ | _ -> Helper.GlobalCall("String", String, [head]) let getParseParams (kind: NumberExtKind) = @@ -477,12 +449,12 @@ let needToCast typeFrom typeTo = let toFloat com (ctx: Context) r targetType (args: Expr list): Expr = match args.Head.Type with | Char -> Helper.InstanceCall(args.Head, "charCodeAt", Number Int32, [makeIntConst 0]) - | String -> Helper.CoreCall("Double", "parse", targetType, args) + | String -> Helper.LibCall(com, "Double", "parse", targetType, args) | NumberExt kind -> match kind with - | BigInt -> Helper.CoreCall("BigInt", castBigIntMethod targetType, targetType, args) - | Long _ -> Helper.CoreCall("Long", "toNumber", targetType, args) - | Decimal -> Helper.CoreCall("Decimal", "toNumber", targetType, args) + | BigInt -> Helper.LibCall(com, "BigInt", castBigIntMethod targetType, targetType, args) + | Long _ -> Helper.LibCall(com, "Long", "toNumber", targetType, args) + | Decimal -> Helper.LibCall(com, "Decimal", "toNumber", targetType, args) | JsNumber _ -> TypeCast(args.Head, targetType) | Enum _ -> TypeCast(args.Head, targetType) | _ -> @@ -493,16 +465,16 @@ let toDecimal com (ctx: Context) r targetType (args: Expr list): Expr = match args.Head.Type with | Char -> Helper.InstanceCall(args.Head, "charCodeAt", Number Int32, [makeIntConst 0]) - |> makeDecimalFromExpr r targetType - | String -> makeDecimalFromExpr r targetType args.Head + |> makeDecimalFromExpr com r targetType + | String -> makeDecimalFromExpr com r targetType args.Head | NumberExt kind -> match kind with - | BigInt -> Helper.CoreCall("BigInt", castBigIntMethod targetType, targetType, args) - | Long _ -> Helper.CoreCall("Long", "toNumber", Number Float64, args) - |> makeDecimalFromExpr r targetType + | BigInt -> Helper.LibCall(com, "BigInt", castBigIntMethod targetType, targetType, args) + | Long _ -> Helper.LibCall(com, "Long", "toNumber", Number Float64, args) + |> makeDecimalFromExpr com r targetType | Decimal -> args.Head - | JsNumber _ -> makeDecimalFromExpr r targetType args.Head - | Enum _ -> makeDecimalFromExpr r targetType args.Head + | JsNumber _ -> makeDecimalFromExpr com r targetType args.Head + | Enum _ -> makeDecimalFromExpr com r targetType args.Head | _ -> addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" TypeCast(args.Head, targetType) @@ -520,13 +492,13 @@ let stringToInt com (ctx: Context) r targetType (args: Expr list): Expr = let style = int System.Globalization.NumberStyles.Any let _isFloatOrDecimal, numberModule, unsigned, bitsize = getParseParams kind let parseArgs = [makeIntConst style; makeBoolConst unsigned; makeIntConst bitsize] - Helper.CoreCall(numberModule, "parse", targetType, + Helper.LibCall(com, numberModule, "parse", targetType, [args.Head] @ parseArgs @ args.Tail, ?loc=r) let toLong com (ctx: Context) r (unsigned: bool) targetType (args: Expr list): Expr = let fromInteger kind arg = let kind = makeIntConst (kindIndex (JsNumber kind)) - Helper.CoreCall("Long", "fromInteger", targetType, [arg; makeBoolConst unsigned; kind]) + Helper.LibCall(com, "Long", "fromInteger", targetType, [arg; makeBoolConst unsigned; kind]) let sourceType = args.Head.Type match sourceType with | Char -> @@ -535,13 +507,13 @@ let toLong com (ctx: Context) r (unsigned: bool) targetType (args: Expr list): E | String -> stringToInt com ctx r targetType args | NumberExt kind -> match kind with - | BigInt -> Helper.CoreCall("BigInt", castBigIntMethod targetType, targetType, args) - | Long _ -> Helper.CoreCall("Long", "fromValue", targetType, args @ [makeBoolConst unsigned]) + | BigInt -> Helper.LibCall(com, "BigInt", castBigIntMethod targetType, targetType, args) + | Long _ -> Helper.LibCall(com, "Long", "fromValue", targetType, args @ [makeBoolConst unsigned]) | Decimal -> - let n = Helper.CoreCall("Decimal", "toNumber", Number Float64, args) - Helper.CoreCall("Long", "fromNumber", targetType, [n; makeBoolConst unsigned]) + let n = Helper.LibCall(com, "Decimal", "toNumber", Number Float64, args) + Helper.LibCall(com, "Long", "fromNumber", targetType, [n; makeBoolConst unsigned]) | JsNumber (Integer as kind) -> fromInteger kind args.Head - | JsNumber Float -> Helper.CoreCall("Long", "fromNumber", targetType, args @ [makeBoolConst unsigned]) + | JsNumber Float -> Helper.LibCall(com, "Long", "fromNumber", targetType, args @ [makeBoolConst unsigned]) | Enum _ -> fromInteger Int32 args.Head | _ -> addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" @@ -554,22 +526,22 @@ let toInt com (ctx: Context) r targetType (args: Expr list) = let targetType = transformEnumType targetType let emitCast typeTo arg = match typeTo with - | JsNumber Int8 -> emitJs None (Number Int8) [arg] "($0 + 0x80 & 0xFF) - 0x80" - | JsNumber Int16 -> emitJs None (Number Int16) [arg] "($0 + 0x8000 & 0xFFFF) - 0x8000" + | JsNumber Int8 -> emitJsExpr None (Number Int8) [arg] "($0 + 0x80 & 0xFF) - 0x80" + | JsNumber Int16 -> emitJsExpr None (Number Int16) [arg] "($0 + 0x8000 & 0xFFFF) - 0x8000" | JsNumber Int32 -> fastIntFloor arg - | JsNumber UInt8 -> emitJs None (Number UInt8) [arg] "$0 & 0xFF" - | JsNumber UInt16 -> emitJs None (Number UInt16) [arg] "$0 & 0xFFFF" - | JsNumber UInt32 -> emitJs None (Number UInt32) [arg] "$0 >>> 0" + | JsNumber UInt8 -> emitJsExpr None (Number UInt8) [arg] "$0 & 0xFF" + | JsNumber UInt16 -> emitJsExpr None (Number UInt16) [arg] "$0 & 0xFFFF" + | JsNumber UInt32 -> emitJsExpr None (Number UInt32) [arg] "$0 >>> 0" | _ -> failwithf "Unexpected non-integer type %A" typeTo match sourceType, targetType with | Char, _ -> Helper.InstanceCall(args.Head, "charCodeAt", targetType, [makeIntConst 0]) | String, _ -> stringToInt com ctx r targetType args - | Builtin BclBigInt, _ -> Helper.CoreCall("BigInt", castBigIntMethod targetType, targetType, args) + | Builtin BclBigInt, _ -> Helper.LibCall(com, "BigInt", castBigIntMethod targetType, targetType, args) | NumberExt typeFrom, NumberExt typeTo -> if needToCast typeFrom typeTo then match typeFrom with - | Long _ -> Helper.CoreCall("Long", "toInt", targetType, args) - | Decimal -> Helper.CoreCall("Decimal", "toNumber", targetType, args) + | Long _ -> Helper.LibCall(com, "Long", "toInt", targetType, args) + | Decimal -> Helper.LibCall(com, "Decimal", "toNumber", targetType, args) | _ -> args.Head |> emitCast typeTo else TypeCast(args.Head, targetType) @@ -577,14 +549,14 @@ let toInt com (ctx: Context) r targetType (args: Expr list) = addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" TypeCast(args.Head, targetType) -let round (args: Expr list) = +let round com (args: Expr list) = match args.Head.Type with | Builtin BclDecimal -> - let n = Helper.CoreCall("Decimal", "toNumber", Number Float64, [args.Head]) - let rounded = Helper.CoreCall("Util", "round", Number Float64, [n]) + let n = Helper.LibCall(com, "Decimal", "toNumber", Number Float64, [args.Head]) + let rounded = Helper.LibCall(com, "Util", "round", Number Float64, [n]) rounded::args.Tail | Number Float -> - let rounded = Helper.CoreCall("Util", "round", Number Float64, [args.Head]) + let rounded = Helper.LibCall(com, "Util", "round", Number Float64, [args.Head]) rounded::args.Tail | _ -> args @@ -594,8 +566,8 @@ let arrayCons (com: ICompiler) genArg = getTypedArrayName com numberKind |> makeIdentExpr | _ -> makeIdentExpr "Array" -let toList returnType expr = - Helper.CoreCall("List", "ofSeq", returnType, [expr]) +let toList com returnType expr = + Helper.LibCall(com, "List", "ofSeq", returnType, [expr]) let toArray (com: ICompiler) returnType expr = // match expr, returnType with @@ -611,15 +583,15 @@ let toArray (com: ICompiler) returnType expr = // This is used also by Seq.cache, which returns `'T seq` instead of `'T array` | DeclaredType(_, [genArg]) -> [expr; arrayCons com genArg] | _ -> [expr] - Helper.CoreCall("Array", "ofSeq", returnType, args) + Helper.LibCall(com, "Array", "ofSeq", returnType, args) let listToArray com r t (li: Expr) = match li with | Value(ListLiteral(exprs, t),_) -> - NewArray(ArrayValues exprs, t) |> makeValue r + NewArray(exprs, t) |> makeValue r | _ -> let args = match t with Array genArg -> [li; arrayCons com genArg] | _ -> [li] - Helper.CoreCall("Array", "ofList", t, args, ?loc=r) + Helper.LibCall(com, "Array", "ofList", t, args, ?loc=r) let stringToCharArray t e = Helper.InstanceCall(e, "split", t, [makeStrConst ""]) @@ -630,14 +602,14 @@ let toSeq t (e: Expr) = | String -> stringToCharArray t e | _ -> TypeCast(e, t) -let iterate r ident body (xs: Expr) = - let f = Function(Delegate [ident], body, None) - Helper.CoreCall("Seq", "iterate", Unit, [f; toSeq xs.Type xs], ?loc=r) +let iterate com r ident body (xs: Expr) = + let f = Delegate([ident], body, None) + Helper.LibCall(com, "Seq", "iterate", Unit, [f; toSeq xs.Type xs], ?loc=r) let (|ListSingleton|) x = [x] let (|CustomOp|_|) com ctx opName argTypes sourceTypes = - let tryFindMember com (ctx: Context) (ent: FSharpEntity) opName argTypes = + let tryFindMember com (ctx: Context) (ent: Entity) opName argTypes = FSharp2Fable.TypeHelpers.tryFindMember com ent ctx.GenericArgs opName false argTypes sourceTypes |> List.tryPick (function | DeclaredType(ent,_) -> tryFindMember com ctx ent opName argTypes @@ -645,16 +617,16 @@ let (|CustomOp|_|) com ctx opName argTypes sourceTypes = let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) argTypes genArgs = let unOp operator operand = - Operation(UnaryOperation(operator, operand), t, r) + Operation(Unary(operator, operand), t, r) let binOp op left right = - Operation(BinaryOperation(op, left, right), t, r) + Operation(Binary(op, left, right), t, r) let truncateUnsigned operation = // see #1550 match t with | Number UInt32 -> - Operation(BinaryOperation(BinaryShiftRightZeroFill,operation,makeIntConst 0), t, r) + Operation(Binary(BinaryShiftRightZeroFill,operation,makeIntConst 0), t, r) | _ -> operation let logicOp op left right = - Operation(LogicalOperation(op, left, right), Boolean, r) + Operation(Logical(op, left, right), Boolean, r) let nativeOp opName argTypes args = match opName, args with | Operators.addition, [left; right] -> binOp BinaryPlus left right @@ -679,9 +651,9 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) argType | Operators.logicalNot, [operand] -> unOp UnaryNotBitwise operand |> truncateUnsigned | Operators.unaryNegation, [operand] -> match argTypes with - | Number Int8::_ -> Helper.CoreCall("Int32", "op_UnaryNegation_Int8", t, args, ?loc=r) - | Number Int16::_ -> Helper.CoreCall("Int32", "op_UnaryNegation_Int16", t, args, ?loc=r) - | Number Int32::_ -> Helper.CoreCall("Int32", "op_UnaryNegation_Int32", t, args, ?loc=r) + | Number Int8::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int8", t, args, ?loc=r) + | Number Int16::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int16", t, args, ?loc=r) + | Number Int32::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int32", t, args, ?loc=r) | _ -> unOp UnaryMinus operand | _ -> sprintf "Operator %s not found in %A" opName argTypes |> addErrorAndReturnNull com ctx.InlinePath r @@ -693,13 +665,13 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) argType | BclUInt64, Operators.rightShift -> "op_RightShiftUnsigned" // See #1482 | BclDecimal, Operators.divideByInt -> Operators.division | _ -> opName - Helper.CoreCall(coreModFor bt, opName, t, args, argTypes, ?loc=r) + Helper.LibCall(com, coreModFor bt, opName, t, args, argTypes, ?loc=r) | Builtin(FSharpSet _)::_ -> let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpSet" true opName "" - Helper.CoreCall("Set", mangledName, t, args, argTypes, ?loc=r) + Helper.LibCall(com, "Set", mangledName, t, args, argTypes, ?loc=r) // | Builtin (FSharpMap _)::_ -> // let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpMap" true opName overloadSuffix.Value - // Helper.CoreCall("Map", mangledName, t, args, argTypes, ?loc=r) + // Helper.LibCall(com, "Map", mangledName, t, args, argTypes, ?loc=r) | Builtin BclTimeSpan::_ -> nativeOp opName argTypes args | CustomOp com ctx opName argTypes m -> @@ -717,26 +689,26 @@ let isCompatibleWithJsComparison = function | GenericParam _ -> false | AnonymousRecordType _ -> false | Any | Unit | Boolean | Number _ | String | Char | Regex - | Enum _ | FunctionType _ -> true + | Enum _ | DelegateType _ | LambdaType _ -> true // Overview of hash rules: // * `hash`, `Unchecked.hash` first check if GetHashCode is implemented and then default to structural hash. // * `.GetHashCode` called directly defaults to identity hash (for reference types except string) if not implemented. // * `LanguagePrimitive.PhysicalHash` creates an identity hash no matter whether GetHashCode is implemented or not. -let identityHash r (arg: Expr) = +let identityHash com r (arg: Expr) = match arg.Type with | Boolean | Char | String | Number _ | Enum _ | Option _ | Tuple _ | List _ | Builtin(BclInt64 | BclUInt64 | BclDecimal | BclBigInt) | Builtin(BclGuid | BclTimeSpan | BclDateTime | BclDateTimeOffset) | Builtin(FSharpSet _ | FSharpMap _ | FSharpChoice _ | FSharpResult _) -> - Helper.CoreCall("Util", "structuralHash", Number Int32, [arg], ?loc=r) + Helper.LibCall(com, "Util", "structuralHash", Number Int32, [arg], ?loc=r) | DeclaredType(ent,_) when ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType -> - Helper.CoreCall("Util", "structuralHash", Number Int32, [arg], ?loc=r) + Helper.LibCall(com, "Util", "structuralHash", Number Int32, [arg], ?loc=r) | _ -> - Helper.CoreCall("Util", "identityHash", Number Int32, [arg], ?loc=r) + Helper.LibCall(com, "Util", "identityHash", Number Int32, [arg], ?loc=r) -let structuralHash r (arg: Expr) = - Helper.CoreCall("Util", "structuralHash", Number Int32, [arg], ?loc=r) +let structuralHash com r (arg: Expr) = + Helper.LibCall(com, "Util", "structuralHash", Number Int32, [arg], ?loc=r) let rec equals (com: ICompiler) r equal (left: Expr) (right: Expr) = let is equal expr = @@ -749,51 +721,44 @@ let rec equals (com: ICompiler) r equal (left: Expr) (right: Expr) = let op = if equal then BinaryEqualStrict else BinaryUnequalStrict makeBinOp r Boolean left right op | Builtin(BclDateTime|BclDateTimeOffset) -> - Helper.CoreCall("Date", "equals", Boolean, [left; right], ?loc=r) |> is equal + Helper.LibCall(com, "Date", "equals", Boolean, [left; right], ?loc=r) |> is equal | Builtin(FSharpSet _|FSharpMap _) -> Helper.InstanceCall(left, "Equals", Boolean, [right]) |> is equal | Builtin(BclInt64|BclUInt64|BclDecimal|BclBigInt as bt) -> - Helper.CoreCall(coreModFor bt, "equals", Boolean, [left; right], ?loc=r) |> is equal + Helper.LibCall(com, coreModFor bt, "equals", Boolean, [left; right], ?loc=r) |> is equal | Array t -> let f = makeComparerFunction com t - Helper.CoreCall("Array", "equalsWith", Boolean, [f; left; right], ?loc=r) |> is equal + Helper.LibCall(com, "Array", "equalsWith", Boolean, [f; left; right], ?loc=r) |> is equal | List _ -> - Helper.CoreCall("Util", "equals", Boolean, [left; right], ?loc=r) |> is equal + Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal | MetaType -> - Helper.CoreCall("Reflection", "equals", Boolean, [left; right], ?loc=r) |> is equal + Helper.LibCall(com, "Reflection", "equals", Boolean, [left; right], ?loc=r) |> is equal | Tuple _ -> - Helper.CoreCall("Util", "equalArrays", Boolean, [left; right], ?loc=r) |> is equal - // unsafe optimization, left can sometimes be null - // | DeclaredType(ent,_) when hasBaseImplementingBasicMethods ent -> - // Helper.InstanceCall(left, "Equals", Boolean, [right]) |> is equal + Helper.LibCall(com, "Util", "equalArrays", Boolean, [left; right], ?loc=r) |> is equal | _ -> - Helper.CoreCall("Util", "equals", Boolean, [left; right], ?loc=r) |> is equal + Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal /// Compare function that will call Util.compare or instance `CompareTo` as appropriate and compare (com: ICompiler) r (left: Expr) (right: Expr) = match left.Type with | Builtin(BclGuid|BclTimeSpan) | Boolean | Char | String | Number _ | Enum _ -> - Helper.CoreCall("Util", "comparePrimitives", Number Int32, [left; right], ?loc=r) + Helper.LibCall(com, "Util", "comparePrimitives", Number Int32, [left; right], ?loc=r) | Builtin(BclDateTime|BclDateTimeOffset) -> - Helper.CoreCall("Date", "compare", Number Int32, [left; right], ?loc=r) + Helper.LibCall(com, "Date", "compare", Number Int32, [left; right], ?loc=r) | Builtin(BclInt64|BclUInt64|BclDecimal|BclBigInt as bt) -> - Helper.CoreCall(coreModFor bt, "compare", Number Int32, [left; right], ?loc=r) + Helper.LibCall(com, coreModFor bt, "compare", Number Int32, [left; right], ?loc=r) | Array t -> let f = makeComparerFunction com t - Helper.CoreCall("Array", "compareWith", Number Int32, [f; left; right], ?loc=r) + Helper.LibCall(com, "Array", "compareWith", Number Int32, [f; left; right], ?loc=r) | List _ -> - Helper.CoreCall("Util", "compare", Number Int32, [left; right], ?loc=r) + Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r) | MetaType -> - Helper.CoreCall("Reflection", "compare", Number Int32, [left; right], ?loc=r) + Helper.LibCall(com, "Reflection", "compare", Number Int32, [left; right], ?loc=r) | Tuple _ -> - Helper.CoreCall("Util", "compareArrays", Number Int32, [left; right], ?loc=r) - | DeclaredType(ent,_) when hasBaseImplementingBasicMethods ent -> - Helper.InstanceCall(left, "CompareTo", Number Int32, [right], ?loc=r) - | DeclaredType(ent,_) when FSharp2Fable.Util.hasInterface Types.icomparable ent -> - Helper.InstanceCall(left, "CompareTo", Number Int32, [right], ?loc=r) + Helper.LibCall(com, "Util", "compareArrays", Number Int32, [left; right], ?loc=r) | _ -> - Helper.CoreCall("Util", "compare", Number Int32, [left; right], ?loc=r) + Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r) /// Wraps comparison with the binary operator, like `comparison < 0` and compareIf (com: ICompiler) r (left: Expr) (right: Expr) op = @@ -809,7 +774,7 @@ and makeComparerFunction (com: ICompiler) typArg = let x = makeTypedIdent typArg "x" let y = makeTypedIdent typArg "y" let body = compare com None (IdentExpr x) (IdentExpr y) - Function(Delegate [x; y], body, None) + Delegate([x; y], body, None) and makeComparer (com: ICompiler) typArg = objExpr ["Compare", makeComparerFunction com typArg] @@ -818,45 +783,45 @@ let makeEqualityComparer (com: ICompiler) typArg = let x = makeTypedIdent typArg "x" let y = makeTypedIdent typArg "y" let body = equals com None true (IdentExpr x) (IdentExpr y) - let f = Function(Delegate [x; y], body, None) + let f = Delegate([x; y], body, None) objExpr ["Equals", f - "GetHashCode", makeCoreRef Any "structuralHash" "Util"] + "GetHashCode", makeLibRef com Any "structuralHash" "Util"] // TODO: Try to detect at compile-time if the object already implements `Compare`? let inline makeComparerFromEqualityComparer e = e // leave it as is, if implementation supports it - // Helper.CoreCall("Util", "comparerFromEqualityComparer", Any, [e]) + // Helper.LibCall(com, "Util", "comparerFromEqualityComparer", Any, [e]) /// Adds comparer as last argument for set creator methods let makeSet (com: ICompiler) r t methName args genArg = let args = args @ [makeComparer com genArg] - Helper.CoreCall("Set", Naming.lowerFirst methName, t, args, ?loc=r) + Helper.LibCall(com, "Set", Naming.lowerFirst methName, t, args, ?loc=r) /// Adds comparer as last argument for map creator methods let makeMap (com: ICompiler) r t methName args genArg = let args = args @ [makeComparer com genArg] - Helper.CoreCall("Map", Naming.lowerFirst methName, t, args, ?loc=r) + Helper.LibCall(com, "Map", Naming.lowerFirst methName, t, args, ?loc=r) -let makeDictionaryWithComparer r t sourceSeq comparer = - Helper.CoreCall("Map", "createMutable", t, [sourceSeq; comparer], ?loc=r) +let makeDictionaryWithComparer com r t sourceSeq comparer = + Helper.LibCall(com, "Map", "createMutable", t, [sourceSeq; comparer], ?loc=r) let makeDictionary (com: ICompiler) r t sourceSeq = match t with | DeclaredType(_,[key;_]) when not(isCompatibleWithJsComparison key) -> // makeComparer com key makeEqualityComparer com key - |> makeDictionaryWithComparer r t sourceSeq + |> makeDictionaryWithComparer com r t sourceSeq | _ -> Helper.GlobalCall("Map", t, [sourceSeq], isJsConstructor=true, ?loc=r) -let makeHashSetWithComparer r t sourceSeq comparer = - Helper.CoreCall("Set", "createMutable", t, [sourceSeq; comparer], ?loc=r) +let makeHashSetWithComparer com r t sourceSeq comparer = + Helper.LibCall(com, "Set", "createMutable", t, [sourceSeq; comparer], ?loc=r) let makeHashSet (com: ICompiler) r t sourceSeq = match t with | DeclaredType(_,[key]) when not(isCompatibleWithJsComparison key) -> // makeComparer com key makeEqualityComparer com key - |> makeHashSetWithComparer r t sourceSeq + |> makeHashSetWithComparer com r t sourceSeq | _ -> Helper.GlobalCall("Set", t, [sourceSeq], isJsConstructor=true, ?loc=r) let rec getZero (com: ICompiler) ctx (t: Type) = @@ -865,12 +830,12 @@ let rec getZero (com: ICompiler) ctx (t: Type) = | Number _ -> makeIntConst 0 | Char | String -> makeStrConst "" // TODO: Use null for string? | Builtin BclTimeSpan -> makeIntConst 0 - | Builtin BclDateTime as t -> Helper.CoreCall("Date", "minValue", t, []) - | Builtin BclDateTimeOffset as t -> Helper.CoreCall("DateOffset", "minValue", t, []) + | Builtin BclDateTime as t -> Helper.LibCall(com, "Date", "minValue", t, []) + | Builtin BclDateTimeOffset as t -> Helper.LibCall(com, "DateOffset", "minValue", t, []) | Builtin (FSharpSet genArg) as t -> makeSet com None t "Empty" [] genArg - | Builtin (BclInt64|BclUInt64) as t -> Helper.CoreCall("Long", "fromInt", t, [makeIntConst 0]) - | Builtin BclBigInt as t -> Helper.CoreCall("BigInt", "fromInt32", t, [makeIntConst 0]) - | Builtin BclDecimal as t -> makeIntConst 0 |> makeDecimalFromExpr None t + | Builtin (BclInt64|BclUInt64) as t -> Helper.LibCall(com, "Long", "fromInt", t, [makeIntConst 0]) + | Builtin BclBigInt as t -> Helper.LibCall(com, "BigInt", "fromInt32", t, [makeIntConst 0]) + | Builtin BclDecimal as t -> makeIntConst 0 |> makeDecimalFromExpr com None t | Builtin (BclKeyValuePair(k,v)) -> Value(NewTuple[getZero com ctx k; getZero com ctx v], None) | ListSingleton(CustomOp com ctx "get_Zero" [] m) -> @@ -879,9 +844,9 @@ let rec getZero (com: ICompiler) ctx (t: Type) = let getOne (com: ICompiler) ctx (t: Type) = match t with - | Builtin (BclInt64|BclUInt64) as t -> Helper.CoreCall("Long", "fromInt", t, [makeIntConst 1]) - | Builtin BclBigInt as t -> Helper.CoreCall("BigInt", "fromInt32", t, [makeIntConst 1]) - | Builtin BclDecimal as t -> makeIntConst 1 |> makeDecimalFromExpr None t + | Builtin (BclInt64|BclUInt64) as t -> Helper.LibCall(com, "Long", "fromInt", t, [makeIntConst 1]) + | Builtin BclBigInt as t -> Helper.LibCall(com, "BigInt", "fromInt32", t, [makeIntConst 1]) + | Builtin BclDecimal as t -> makeIntConst 1 |> makeDecimalFromExpr com None t | ListSingleton(CustomOp com ctx "get_One" [] m) -> FSharp2Fable.Util.makeCallFrom com ctx None t [] None [] m | _ -> makeIntConst 1 @@ -890,7 +855,7 @@ let makeAddFunction (com: ICompiler) ctx t = let x = makeTypedIdent t "x" let y = makeTypedIdent t "y" let body = applyOp com ctx None t Operators.addition [IdentExpr x; IdentExpr y] [t; t] [] - Function(Delegate [x; y], body, None) + Delegate([x; y], body, None) let makeGenericAdder (com: ICompiler) ctx t = objExpr [ @@ -903,28 +868,28 @@ let makeGenericAverager (com: ICompiler) ctx t = let x = makeTypedIdent t "x" let i = makeTypedIdent (Number Int32) "i" let body = applyOp com ctx None t Operators.divideByInt [IdentExpr x; IdentExpr i] [t; Number Int32] [] - Function(Delegate [x; i], body, None) + Delegate([x; i], body, None) objExpr [ "GetZero", getZero com ctx t |> makeDelegate [] "Add", makeAddFunction com ctx t "DivideByInt", divideFn ] -let makePojoFromLambda arg = +let makePojoFromLambda com arg = let rec flattenSequential = function | Sequential statements -> List.collect flattenSequential statements | e -> [e] match arg with - | Function(Lambda _, lambdaBody, _) -> + | Lambda(_, lambdaBody, _) -> (flattenSequential lambdaBody, Some []) ||> List.foldBack (fun statement acc -> match acc, statement with - | Some acc, Set(_, FieldSet(fiName, _), value, _) -> - objValue (fiName, value)::acc |> Some + | Some acc, Set(_, Some(FieldKey fi), value, _) -> + objValue (fi.Name, value)::acc |> Some | _ -> None) | _ -> None |> Option.map (fun members -> ObjectExpr(members, Any, None)) - |> Option.defaultWith (fun () -> Helper.CoreCall("Util", "jsOptions", Any, [arg])) + |> Option.defaultWith (fun () -> Helper.LibCall(com, "Util", "jsOptions", Any, [arg])) let injectArg com (ctx: Context) r moduleName methName (genArgs: (string * Type) list) args = let (|GenericArg|_|) genArgs genArgIndex = @@ -954,34 +919,33 @@ let injectArg com (ctx: Context) r moduleName methName (genArgs: (string * Type) | None -> args | Some injections -> args @ injections -let tryEntityRef (com: Fable.ICompiler) (ent: FSharpEntity) = - match ent.TryFullName with - | Some(BuiltinDefinition BclDateTime) - | Some(BuiltinDefinition BclDateTimeOffset) -> makeIdentExpr "Date" |> Some - | Some(BuiltinDefinition BclTimer) -> makeCoreRef Any "default" "Timer" |> Some - | Some(BuiltinDefinition BclInt64) - | Some(BuiltinDefinition BclUInt64) -> makeCoreRef Any "default" "Long" |> Some - | Some(BuiltinDefinition BclDecimal) -> makeCoreRef Any "default" "Decimal" |> Some - | Some(BuiltinDefinition BclBigInt) -> makeCoreRef Any "BigInteger" "BigInt/z" |> Some - | Some(BuiltinDefinition(FSharpReference _)) -> makeCoreRef Any "FSharpRef" "Types" |> Some - | Some(BuiltinDefinition(FSharpResult _)) -> makeCoreRef Any "Result" "Option" |> Some - | Some(BuiltinDefinition(FSharpChoice _)) -> makeCoreRef Any "Choice" "Option" |> Some - // | Some(BuiltinDefinition BclGuid) -> jsTypeof "string" expr - // | Some(BuiltinDefinition BclTimeSpan) -> jsTypeof "number" expr - // | Some(BuiltinDefinition BclHashSet _) -> fail "MutableSet" // TODO: - // | Some(BuiltinDefinition BclDictionary _) -> fail "MutableMap" // TODO: - // | Some(BuiltinDefinition BclKeyValuePair _) -> fail "KeyValuePair" // TODO: - // | Some(BuiltinDefinition FSharpSet _) -> fail "Set" // TODO: - // | Some(BuiltinDefinition FSharpMap _) -> fail "Map" // TODO: - | Some Types.matchFail -> makeCoreRef Any "MatchFailureException" "Types" |> Some - | Some Types.exception_ -> makeIdentExpr "Error" |> Some - | Some entFullName -> +let tryEntityRef (com: Fable.ICompiler) (ent: Entity) = + match ent.FullName with + | BuiltinDefinition BclDateTime + | BuiltinDefinition BclDateTimeOffset -> makeIdentExpr "Date" |> Some + | BuiltinDefinition BclTimer -> makeLibRef com Any "default" "Timer" |> Some + | BuiltinDefinition BclInt64 + | BuiltinDefinition BclUInt64 -> makeLibRef com Any "default" "Long" |> Some + | BuiltinDefinition BclDecimal -> makeLibRef com Any "default" "Decimal" |> Some + | BuiltinDefinition BclBigInt -> makeLibRef com Any "BigInteger" "BigInt/z" |> Some + | BuiltinDefinition(FSharpReference _) -> makeLibRef com Any "FSharpRef" "Types" |> Some + | BuiltinDefinition(FSharpResult _) -> makeLibRef com Any "Result" "Option" |> Some + | BuiltinDefinition(FSharpChoice _) -> makeLibRef com Any "Choice" "Option" |> Some + // | BuiltinDefinition BclGuid -> jsTypeof "string" expr + // | BuiltinDefinition BclTimeSpan -> jsTypeof "number" expr + // | BuiltinDefinition BclHashSet _ -> fail "MutableSet" // TODO: + // | BuiltinDefinition BclDictionary _ -> fail "MutableMap" // TODO: + // | BuiltinDefinition BclKeyValuePair _ -> fail "KeyValuePair" // TODO: + // | BuiltinDefinition FSharpSet _ -> fail "Set" // TODO: + // | BuiltinDefinition FSharpMap _ -> fail "Map" // TODO: + | Types.matchFail -> makeLibRef com Any "MatchFailureException" "Types" |> Some + | Types.exception_ -> makeIdentExpr "Error" |> Some + | entFullName -> com.Options.precompiledLib |> Option.bind (fun tryLib -> tryLib entFullName) |> Option.map (fun (entityName, importPath) -> let entityName = Naming.sanitizeIdentForbiddenChars entityName |> Naming.checkJsKeywords makeCustomImport Any entityName importPath) - | None -> None let tryJsConstructor com ent = if FSharp2Fable.Util.isReplacementCandidate ent then tryEntityRef com ent @@ -991,16 +955,16 @@ let jsConstructor com ent = match tryJsConstructor com ent with | Some e -> e | None -> - defaultArg ent.TryFullName ent.CompiledName + ent.FullName |> sprintf "Cannot find %s constructor" |> addErrorAndReturnNull com [] None -let tryOp r t op args = - Helper.CoreCall("Option", "tryOp", t, op::args, ?loc=r) +let tryOp com r t op args = + Helper.LibCall(com, "Option", "tryOp", t, op::args, ?loc=r) -let tryCoreOp r t coreModule coreMember args = - let op = Helper.CoreValue(coreModule, coreMember, Any) - tryOp r t op args +let tryCoreOp com r t coreModule coreMember args = + let op = Helper.LibValue(com, coreModule, coreMember, Any) + tryOp com r t op args let emptyGuid () = makeStrConst "00000000-0000-0000-0000-000000000000" @@ -1033,7 +997,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp let runtimeMsg = "A function supposed to be replaced by JS native code has been called, please check." |> StringConstant |> makeValue None - Throw(error runtimeMsg, t, r) |> Some + makeThrow r (error runtimeMsg) |> Some | _, ("nameof"|"nameof2" as meth) -> match args with | [Nameof com ctx name as arg] -> @@ -1045,7 +1009,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp makeStrConst Naming.unknown |> Some | _, "nameofLambda" -> match args with - | [Function(_, (Nameof com ctx name), _)] -> Some name + | [Lambda(_, (Nameof com ctx name), _)] -> Some name | [IdentExpr ident] -> let rec findLambda scope identName = match scope with @@ -1053,7 +1017,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | (_,ident2,expr)::prevScope -> if identName = ident2.Name then match expr with - | Some(Function(_, (Nameof com ctx name), _)) -> Some name + | Some(Lambda(_, (Nameof com ctx name), _)) -> Some name | Some(IdentExpr ident) -> findLambda prevScope ident.Name | _ -> None else findLambda prevScope identName @@ -1064,15 +1028,15 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp |> addError com ctx.InlinePath r Naming.unknown) |> makeStrConst |> Some - | _, "Async.AwaitPromise.Static" -> Helper.CoreCall("Async", "awaitPromise", t, args, ?loc=r) |> Some - | _, "Async.StartAsPromise.Static" -> Helper.CoreCall("Async", "startAsPromise", t, args, ?loc=r) |> Some + | _, "Async.AwaitPromise.Static" -> Helper.LibCall(com, "Async", "awaitPromise", t, args, ?loc=r) |> Some + | _, "Async.StartAsPromise.Static" -> Helper.LibCall(com, "Async", "startAsPromise", t, args, ?loc=r) |> Some | "Fable.Core.Testing.Assert", _ -> match i.CompiledName with - | "AreEqual" -> Helper.CoreCall("Util", "assertEqual", t, args, ?loc=r) |> Some - | "NotEqual" -> Helper.CoreCall("Util", "assertNotEqual", t, args, ?loc=r) |> Some + | "AreEqual" -> Helper.LibCall(com, "Util", "assertEqual", t, args, ?loc=r) |> Some + | "NotEqual" -> Helper.LibCall(com, "Util", "assertNotEqual", t, args, ?loc=r) |> Some | _ -> None | "Fable.Core.Reflection", meth -> - Helper.CoreCall("Reflection", meth, t, args, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some | "Fable.Core.JsInterop", _ -> match i.CompiledName, args with | "importDynamic", _ -> @@ -1085,7 +1049,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | selector -> let selector = let m = makeIdent "m" - Function(Delegate [m], Get(IdentExpr m, ExprGet selector, Any, None), None) + Delegate([m], Get(IdentExpr m, ByKey(ExprKey selector), Any, None), None) Helper.InstanceCall(import, "then", t, [selector]) let arg = match arg with @@ -1095,9 +1059,9 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | arg -> arg match arg with // TODO: Check this is not a fable-library import? - | Import(selector,path,_,_,_) -> + | Import(selector,path,_,_) -> dynamicImport selector path |> Some - | NestedLambda(args, Operation(Call(Import(selector,path,_,_,_),info),_,_), None) + | NestedLambda(args, Call(Import(selector,path,_,_),info,_,_), None) when argEquals args info.Args -> dynamicImport selector path |> Some | _ -> @@ -1105,11 +1069,11 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp |> addErrorAndReturnNull com ctx.InlinePath r |> Some | Naming.StartsWith "import" suffix, _ -> match suffix, args with - | "Member", [path] -> Import(makeStrConst Naming.placeholder, path, CustomImport, t, r) |> Some - | "Default", [path] -> Import(makeStrConst "default", path, CustomImport, t, r) |> Some - | "SideEffects", [path] -> Import(makeStrConst "", path, CustomImport, t, r) |> Some - | "All", [path] -> Import(makeStrConst "*", path, CustomImport, t, r) |> Some - | _, [selector; path] -> Import(selector, path, CustomImport, t, r) |> Some + | "Member", [path] -> Import(makeStrConst Naming.placeholder, path, t, r) |> Some + | "Default", [path] -> Import(makeStrConst "default", path, t, r) |> Some + | "SideEffects", [path] -> Import(makeStrConst "", path, t, r) |> Some + | "All", [path] -> Import(makeStrConst "*", path, t, r) |> Some + | _, [selector; path] -> Import(selector, path, t, r) |> Some | _ -> None // Dynamic casting, erase | "op_BangHat", [arg] -> Some arg @@ -1117,65 +1081,42 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp match arg, i.GenericArgs with | NewAnonymousRecord(_, exprs, fieldNames, _, _), [_; (_,DeclaredType(ent, []))] when ent.IsInterface -> - // TODO: Check also if there are extra fields in the record not present in the interface? - (None, FSharp2Fable.Helpers.getAllInterfaceMembers ent |> Seq.filter (fun memb -> memb.IsPropertyGetterMethod)) - ||> Seq.fold (fun err memb -> - match err with - | Some _ -> err - | None -> - let expectedType = memb.ReturnParameter.Type |> makeType com - Array.tryFindIndex ((=) memb.DisplayName) fieldNames - |> function - | None -> - match expectedType with - | Option _ -> None // Optional fields can be missing - | _ -> sprintf "Object doesn't contain field '%s'" memb.DisplayName |> Some - | Some i -> - let e = List.item i exprs - match expectedType, e.Type with - | Any, _ -> true - | Option t1, Option t2 - | Option t1, t2 - | t1, t2 -> typeEquals false t1 t2 - |> function - | true -> None - | false -> - let typeName = getTypeFullName true expectedType - sprintf "Expecting type '%s' for field '%s'" typeName memb.DisplayName |> Some) + FSharp2Fable.TypeHelpers.fitsAnonRecordInInterface com exprs fieldNames ent |> function - | Some errMsg -> + | Error errMsg -> addWarning com ctx.InlinePath r errMsg Some arg - | None -> Some arg + | Ok () -> Some arg | _ -> Some arg | "op_Dynamic", [left; memb] -> getExpr r t left memb |> Some | "op_DynamicAssignment", [callee; prop; MaybeLambdaUncurriedAtCompileTime value] -> - Set(callee, ExprSet prop, value, r) |> Some + Set(callee, Some(ExprKey prop), value, r) |> Some | ("op_Dollar"|"createNew" as m), callee::args -> let args = destructureTupleArgs args - let argInfo = { makeSimpleCallInfo None args [] - with AutoUncurrying = true - IsJsConstructor = (m = "createNew") } - makeCall r t argInfo callee |> Some - | "emitJs", macro::args -> - let args = destructureTupleArgs args + if m = "createNew" then "new $0($1...)" else "$0($1...)" + |> emitJsExpr r t args |> Some + | Naming.StartsWith "emitJs" rest, [args; macro] -> match macro with - | Fable.Value(Fable.StringConstant macro,_) -> emitJs r t args macro |> Some + | Fable.Value(Fable.StringConstant macro,_) -> + let args = destructureTupleArgs [args] + let isStatement = rest = "Statement" + let info: Fable.EmitInfo = { Macro = macro; Args = args; IsJsStatement = isStatement } + Emit(info, t, r) |> Some | _ -> "emitJs only accepts string literals" |> addError com ctx.InlinePath r; None | "op_EqualsEqualsGreater", [name; MaybeLambdaUncurriedAtCompileTime value] -> NewTuple [name; value] |> makeValue r |> Some | "createObj", _ -> let m = if com.Options.debugMode then "createObjDebug" else "createObj" - Helper.CoreCall("Util", m, Any, args) |> Some + Helper.LibCall(com, "Util", m, Any, args) |> Some | "keyValueList", [caseRule; keyValueList] -> let args = [keyValueList; caseRule] let args = if com.Options.debugMode then args @ [makeBoolConst true] else args - Helper.CoreCall("Util", "keyValueList", Any, args) |> Some + Helper.LibCall(com, "Util", "keyValueList", Any, args) |> Some | "toPlainJsObj", _ -> let emptyObj = ObjectExpr([], t, None) Helper.GlobalCall("Object", Any, emptyObj::args, memb="assign", ?loc=r) |> Some | "jsOptions", [arg] -> - makePojoFromLambda arg |> Some + makePojoFromLambda com arg |> Some | "jsThis", _ -> makeTypedIdent t "this" |> IdentExpr |> Some | "jsConstructor", _ -> @@ -1193,10 +1134,10 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | _ -> None let getReference r t expr = get r t expr "contents" -let setReference r expr value = Set(expr, makeStrConst "contents" |> ExprSet, value, r) -let newReference r t value = Helper.JsConstructorCall(makeCoreRef t "FSharpRef" "Types", t, [value], ?loc=r) +let setReference r expr value = Set(expr, Some(ExprKey(makeStrConst "contents")), value, r) +let newReference com r t value = Helper.JsConstructorCall(makeLibRef com t "FSharpRef" "Types", t, [value], ?loc=r) -let references (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let references (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with | "get_Value", Some callee, _ -> getReference r t callee |> Some | "set_Value", Some callee, [value] -> setReference r callee value |> Some @@ -1211,14 +1152,14 @@ let getMangledNames (i: CallInfo) (thisArg: Expr option) = let mangledName = Naming.buildNameWithoutSanitationFrom entityName isStatic memberName i.OverloadSuffix.Value moduleName, mangledName -let bclType (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let bclType (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = let moduleName, mangledName = getMangledNames i thisArg let args = match thisArg with Some callee -> callee::args | _ -> args - Helper.CoreCall(moduleName, mangledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some let fsharpModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = let moduleName, mangledName = getMangledNames i thisArg - Helper.CoreCall(moduleName, mangledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some let getPrecompiledLibMangledName entityName memberName overloadSuffix isStatic = let memberName = Naming.sanitizeIdentForbiddenChars memberName @@ -1235,7 +1176,7 @@ let precompiledLib r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr if i.IsModuleValue then makeCustomImport t mangledName importPath else - let argInfo = { makeSimpleCallInfo thisArg args i.SignatureArgTypes with HasSpread = i.HasSpread } + let argInfo = { makeCallInfo thisArg args i.SignatureArgTypes with HasSpread = i.HasSpread } makeCustomImport Any mangledName importPath |> makeCall r t argInfo let fsFormat (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -1244,41 +1185,41 @@ let fsFormat (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op get None t callee "input" |> Some | "PrintFormatToStringThen", _, _ -> match args with - | [_] -> Helper.CoreCall("String", "toText", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | [_] -> Helper.LibCall(com, "String", "toText", t, args, i.SignatureArgTypes, ?loc=r) |> Some | [cont; fmt] -> Helper.InstanceCall(fmt, "cont", t, [cont]) |> Some | _ -> None | "PrintFormatToString", _, _ -> - Helper.CoreCall("String", "toText", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", "toText", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "PrintFormatLine", _, _ -> - Helper.CoreCall("String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("PrintFormatToError"|"PrintFormatLineToError"), _, _ -> // addWarning com ctx.FileName r "eprintf will behave as eprintfn" - Helper.CoreCall("String", "toConsoleError", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", "toConsoleError", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("PrintFormatToTextWriter"|"PrintFormatLineToTextWriter"), _, _::args -> // addWarning com ctx.FileName r "fprintfn will behave as printfn" - Helper.CoreCall("String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "PrintFormat", _, _ -> // addWarning com ctx.FileName r "Printf will behave as printfn" - Helper.CoreCall("String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "PrintFormatThen", _, arg::callee::_ -> Helper.InstanceCall(callee, "cont", t, [arg]) |> Some | "PrintFormatToStringThenFail", _, _ -> - Helper.CoreCall("String", "toFail", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", "toFail", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("PrintFormatToStringBuilder" // bprintf | "PrintFormatToStringBuilderThen" // Printf.kbprintf ), _, _ -> fsharpModule com ctx r t i thisArg args | ".ctor", _, arg::_ -> - Helper.CoreCall("String", "printf", t, [arg], i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", "printf", t, [arg], i.SignatureArgTypes, ?loc=r) |> Some | _ -> None let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = let curriedApply r t applied args = - Operation(CurriedApply(applied, args), t, r) + CurriedApply(applied, args, t, r) let compose (com: ICompiler) r t f1 f2 = let argType, retType = match t with - | FunctionType(LambdaType argType, retType) -> argType, retType + | LambdaType(argType, retType) -> argType, retType | _ -> Any, Any let tempVar = makeTypedIdent argType "arg" let tempVarExpr = @@ -1291,7 +1232,7 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o |> curriedApply None Any f1 |> List.singleton |> curriedApply r retType f2 - Function(Lambda tempVar, body, None) + Lambda(tempVar, body, None) let math r t (args: Expr list) argTypes methName = let meth = Naming.lowerFirst methName @@ -1299,14 +1240,14 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o match i.CompiledName, args with | "DefaultArg", _ -> - Helper.CoreCall("Option", "defaultArg", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Option", "defaultArg", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "DefaultAsyncBuilder", _ -> - makeCoreRef t "singleton" "AsyncBuilder" |> Some + makeLibRef com t "singleton" "AsyncBuilder" |> Some // Erased operators. // KeyValuePair is already compiled as a tuple | ("KeyValuePattern"|"Identity"|"Box"|"Unbox"|"ToEnum"), [arg] -> TypeCast(arg, t) |> Some // Cast to unit to make sure nothing is returned when wrapped in a lambda, see #1360 - | "Ignore", _ -> "void ($0)" |> emitJs r t args |> Some + | "Ignore", _ -> "void ($0)" |> emitJsExpr r t args |> Some // Number and String conversions | ("ToSByte"|"ToByte"|"ToInt8"|"ToUInt8"|"ToInt16"|"ToUInt16"|"ToInt"|"ToUInt"|"ToInt32"|"ToUInt32"), _ -> toInt com ctx r t args |> Some @@ -1334,7 +1275,7 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | Builtin BclDecimal -> "Seq", "rangeDecimal", addStep args | Builtin BclBigInt -> "BigInt", "range", addStep args | _ -> "Seq", "rangeNumber", addStep args - Helper.CoreCall(modul, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, modul, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some // Pipes and composition | "op_PipeRight", [x; f] | "op_PipeLeft", [f; x] -> curriedApply r t f [x] |> Some @@ -1364,30 +1305,30 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o ), _ -> fsharpModule com ctx r t i thisArg args // Exceptions | "FailWith", [msg] | "InvalidOp", [msg] -> - Throw(error msg, t, r) |> Some + makeThrow r (error msg) |> Some | "InvalidArg", [argName; msg] -> let msg = add (add msg (s "\\nParameter name: ")) argName - Throw(error msg, t, r) |> Some - | "Raise", [arg] -> Throw(arg, t, r) |> Some + makeThrow r (error msg) |> Some + | "Raise", [arg] -> makeThrow r arg |> Some | "Reraise", _ -> match ctx.CaughtException with - | Some ex -> Throw(IdentExpr ex, t, r) |> Some + | Some ex -> makeThrow r (IdentExpr ex) |> Some | None -> "`reraise` used in context where caught exception is not available, please report" |> addError com ctx.InlinePath r - Throw(error (s ""), t, r) |> Some + makeThrow r (error (s "")) |> Some // Math functions // TODO: optimize square pow: x * x | "Pow", _ | "PowInteger", _ | "op_Exponentiation", _ -> match resolveArgTypes i.SignatureArgTypes i.GenericArgs with | Builtin(BclDecimal)::_ -> - Helper.CoreCall("Decimal", "pow", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Decimal", "pow", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | _ -> math r t args i.SignatureArgTypes "pow" |> Some | ("Ceiling" | "Floor" as meth), _ -> let meth = Naming.lowerFirst meth match resolveArgTypes i.SignatureArgTypes i.GenericArgs with | Builtin(BclDecimal)::_ -> - Helper.CoreCall("Decimal", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | _ -> let meth = if meth = "ceiling" then "ceil" else meth math r t args i.SignatureArgTypes meth |> Some @@ -1399,7 +1340,7 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | "Abs", _ -> match resolveArgTypes i.SignatureArgTypes i.GenericArgs with | Builtin(BclInt64 | BclBigInt | BclDecimal as bt)::_ -> - Helper.CoreCall(coreModFor bt, "abs", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, coreModFor bt, "abs", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | _ -> math r t args i.SignatureArgTypes i.CompiledName |> Some | "Acos", _ | "Asin", _ | "Atan", _ | "Atan2", _ | "Cos", _ | "Cosh", _ | "Exp", _ | "Log", _ | "Log10", _ @@ -1408,36 +1349,36 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | "Round", _ -> match resolveArgTypes i.SignatureArgTypes i.GenericArgs with | Builtin(BclDecimal)::_ -> - Helper.CoreCall("Decimal", "round", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> Helper.CoreCall("Util", "round", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Decimal", "round", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | _ -> Helper.LibCall(com, "Util", "round", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | "Truncate", _ -> match resolveArgTypes i.SignatureArgTypes i.GenericArgs with | Builtin(BclDecimal)::_ -> - Helper.CoreCall("Decimal", "truncate", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Decimal", "truncate", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | _ -> Helper.GlobalCall("Math", t, args, i.SignatureArgTypes, memb="trunc", ?loc=r) |> Some | "Sign", _ -> let args = toFloat com ctx r t args |> List.singleton - Helper.CoreCall("Util", "sign", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Util", "sign", t, args, i.SignatureArgTypes, ?loc=r) |> Some // Numbers | ("Infinity"|"InfinitySingle"), _ -> Helper.GlobalIdent("Number", "POSITIVE_INFINITY", t, ?loc=r) |> Some | ("NaN"|"NaNSingle"), _ -> Helper.GlobalIdent("Number", "NaN", t, ?loc=r) |> Some - | "Fst", [tup] -> Get(tup, TupleGet 0, t, r) |> Some - | "Snd", [tup] -> Get(tup, TupleGet 1, t, r) |> Some + | "Fst", [tup] -> Get(tup, TupleIndex 0, t, r) |> Some + | "Snd", [tup] -> Get(tup, TupleIndex 1, t, r) |> Some // Reference | "op_Dereference", [arg] -> getReference r t arg |> Some | "op_ColonEquals", [o; v] -> setReference r o v |> Some - | "Ref", [arg] -> newReference r t arg |> Some + | "Ref", [arg] -> newReference com r t arg |> Some | ("Increment"|"Decrement"), _ -> if i.CompiledName = "Increment" then "void($0.contents++)" else "void($0.contents--)" - |> emitJs r t args |> Some + |> emitJsExpr r t args |> Some // Concatenates two lists - | "op_Append", _ -> Helper.CoreCall("List", "append", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | "op_Append", _ -> Helper.LibCall(com, "List", "append", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | (Operators.inequality | "Neq"), [left; right] -> equals com r false left right |> Some | (Operators.equality | "Eq"), [left; right] -> equals com r true left right |> Some | "IsNull", [arg] -> makeEqOp r arg (Null arg.Type |> makeValue None) BinaryEqual |> Some - | "Hash", [arg] -> structuralHash r arg |> Some + | "Hash", [arg] -> structuralHash com r arg |> Some // Comparison | "Compare", [left; right] -> compare com r left right |> Some | (Operators.lessThan | "Lt"), [left; right] -> compareIf com r left right BinaryLess |> Some @@ -1446,7 +1387,7 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | (Operators.greaterThanOrEqual | "Gte"), [left; right] -> compareIf com r left right BinaryGreaterOrEqual |> Some | ("Min"|"Max" as meth), _ -> let f = makeComparerFunction com t - Helper.CoreCall("Util", Naming.lowerFirst meth, t, f::args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Util", Naming.lowerFirst meth, t, f::args, i.SignatureArgTypes, ?loc=r) |> Some | "Not", [operand] -> // TODO: Check custom operator? makeUnOp r t operand UnaryNot |> Some | Patterns.SetContains Operators.standardSet, _ -> @@ -1460,7 +1401,7 @@ let chars (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (ar let icall r t args argTypes memb = match args, argTypes with | thisArg::args, _::argTypes -> - let info = makeSimpleCallInfo None args argTypes + let info = makeCallInfo None args argTypes getSimple thisArg memb |> makeCall r t info |> Some | _ -> None match i.CompiledName with @@ -1475,10 +1416,10 @@ let chars (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (ar | "IsHighSurrogate" | "IsLowSurrogate" | "IsSurrogate" -> let methName = Naming.lowerFirst i.CompiledName let methName = if List.length args > 1 then methName + "2" else methName - Helper.CoreCall("Char", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Char", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "IsSurrogatePair" | "Parse" -> let methName = Naming.lowerFirst i.CompiledName - Helper.CoreCall("Char", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Char", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None let implementedStringFunctions = @@ -1503,24 +1444,24 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt match fstArg.Type with | Char -> match args with - | [_; _] -> emitJs r t args "Array($1 + 1).join($0)" |> Some // String(char, int) + | [_; _] -> emitJsExpr r t args "Array($1 + 1).join($0)" |> Some // String(char, int) | _ -> "Unexpected arguments in System.String constructor." |> addErrorAndReturnNull com ctx.InlinePath r |> Some | Array _ -> match args with - | [_] -> emitJs r t args "$0.join('')" |> Some // String(char[]) - | [_; _; _] -> emitJs r t args "$0.join('').substr($1, $2)" |> Some // String(char[], int, int) + | [_] -> emitJsExpr r t args "$0.join('')" |> Some // String(char[]) + | [_; _; _] -> emitJsExpr r t args "$0.join('').substr($1, $2)" |> Some // String(char[], int, int) | _ -> "Unexpected arguments in System.String constructor." |> addErrorAndReturnNull com ctx.InlinePath r |> Some | _ -> fsFormat com ctx r t i thisArg args | "get_Length", Some c, _ -> get r t c "length" |> Some | "get_Chars", Some c, _ -> - Helper.CoreCall("String", "getCharAtIndex", t, args, i.SignatureArgTypes, c, ?loc=r) |> Some + Helper.LibCall(com, "String", "getCharAtIndex", t, args, i.SignatureArgTypes, c, ?loc=r) |> Some | "Equals", Some x, [y] | "Equals", None, [x; y] -> makeEqOp r x y BinaryEqualStrict |> Some | "Equals", Some x, [y; kind] | "Equals", None, [x; y; kind] -> - let left = Helper.CoreCall("String", "compare", Number Int32, [x; y; kind]) + let left = Helper.LibCall(com, "String", "compare", Number Int32, [x; y; kind]) makeEqOp r left (makeIntConst 0) BinaryEqualStrict |> Some | "Contains", Some c, arg::_ -> if (List.length args) > 1 then @@ -1531,7 +1472,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt let left = Helper.InstanceCall(c, "indexOf", Number Int32, args) makeEqOp r left (makeIntConst 0) BinaryEqualStrict |> Some | "StartsWith", Some c, [_str; _comp] -> - Helper.CoreCall("String", "startsWith", t, args, i.SignatureArgTypes, c, ?loc=r) |> Some + Helper.LibCall(com, "String", "startsWith", t, args, i.SignatureArgTypes, c, ?loc=r) |> Some | ReplaceName [ "ToUpper", "toLocaleUpperCase" "ToUpperInvariant", "toUpperCase" "ToLower", "toLocaleLowerCase" @@ -1555,7 +1496,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt match head.Type, tail with | Array _, [] -> true | _ -> false - Helper.CoreCall("String", methName, t, c::args, hasSpread=spread, ?loc=r) |> Some + Helper.LibCall(com, "String", methName, t, c::args, hasSpread=spread, ?loc=r) |> Some | "ToCharArray", Some c, _ -> stringToCharArray t c |> Some | "Split", Some c, _ -> @@ -1564,33 +1505,33 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | [] -> Helper.InstanceCall(c, "split", t, [makeStrConst ""]) |> Some | [Value(CharConstant _,_) as separator] | [Value(StringConstant _,_) as separator] - | [Value(NewArray(ArrayValues [separator],_),_)] -> + | [Value(NewArray([separator],_),_)] -> Helper.InstanceCall(c, "split", t, [separator]) |> Some | [arg1; ExprType(Enum _) as arg2] -> let arg1 = match arg1.Type with | Array _ -> arg1 - | _ -> Value(NewArray(ArrayValues [arg1], String), None) + | _ -> Value(NewArray([arg1], String), None) let args = [arg1; Value(Null Any, None); arg2] - Helper.CoreCall("String", "split", t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "String", "split", t, c::args, ?loc=r) |> Some | args -> - Helper.CoreCall("String", "split", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "String", "split", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | "Join", None, _ -> let methName = match i.SignatureArgTypes with | [_; Array _; Number _; Number _] -> "joinWithIndices" | _ -> "join" - Helper.CoreCall("String", methName, t, args, ?loc=r) |> Some + Helper.LibCall(com, "String", methName, t, args, ?loc=r) |> Some | "Concat", None, _ -> match i.SignatureArgTypes with | [Array _ | IEnumerable] -> - Helper.CoreCall("String", "join", t, ((makeStrConst "")::args), ?loc=r) |> Some + Helper.LibCall(com, "String", "join", t, ((makeStrConst "")::args), ?loc=r) |> Some | _ -> - Helper.CoreCall("String", "concat", t, args, hasSpread=true, ?loc=r) |> Some + Helper.LibCall(com, "String", "concat", t, args, hasSpread=true, ?loc=r) |> Some | "CompareOrdinal", None, _ -> - Helper.CoreCall("String", "compareOrdinal", t, args, ?loc=r) |> Some + Helper.LibCall(com, "String", "compareOrdinal", t, args, ?loc=r) |> Some | Patterns.SetContains implementedStringFunctions, thisArg, args -> - Helper.CoreCall("String", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, + Helper.LibCall(com, "String", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, hasSpread=i.HasSpread, ?thisArg=thisArg, ?loc=r) |> Some | _ -> None @@ -1600,20 +1541,20 @@ let stringModule (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr opti | ("Iterate" | "IterateIndexed" | "ForAll" | "Exists"), _ -> // Cast the string to char[], see #1279 let args = args |> List.replaceLast (fun e -> stringToCharArray e.Type e) - Helper.CoreCall("Seq", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Seq", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("Map" | "MapIndexed" | "Collect"), _ -> // Cast the string to char[], see #1279 let args = args |> List.replaceLast (fun e -> stringToCharArray e.Type e) let name = Naming.lowerFirst i.CompiledName - emitJs r t [Helper.CoreCall("Seq", name, Any, args, i.SignatureArgTypes)] "Array.from($0).join('')" |> Some + emitJsExpr r t [Helper.LibCall(com, "Seq", name, Any, args, i.SignatureArgTypes)] "Array.from($0).join('')" |> Some | "Concat", _ -> - Helper.CoreCall("String", "join", t, args, ?loc=r) |> Some + Helper.LibCall(com, "String", "join", t, args, ?loc=r) |> Some // Rest of StringModule methods | meth, args -> - Helper.CoreCall("String", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let getEnumerator r t expr = - Helper.CoreCall("Seq", "getEnumerator", t, [toSeq Any expr], ?loc=r) +let getEnumerator com r t expr = + Helper.LibCall(com, "Seq", "getEnumerator", t, [toSeq Any expr], ?loc=r) let seqs (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = let sort r returnType descending projection args genArg = @@ -1621,8 +1562,8 @@ let seqs (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp let identExpr ident = match projection with | Some projection -> - let info = makeSimpleCallInfo None [IdentExpr ident] [] - Operation(Call(projection, info), genArg, None) + let info = makeCallInfo None [IdentExpr ident] [] + Call(projection, info, genArg, None) | None -> IdentExpr ident let x = makeTypedIdent genArg "x" let y = makeTypedIdent genArg "y" @@ -1631,14 +1572,14 @@ let seqs (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp if descending then makeUnOp None (Fable.Number Int32) comparison UnaryMinus else comparison - Function(Delegate [x; y], comparison, None) - Helper.CoreCall("Seq", "sortWith", returnType, compareFn::args, ?loc=r) |> Some + Delegate([x; y], comparison, None) + Helper.LibCall(com, "Seq", "sortWith", returnType, compareFn::args, ?loc=r) |> Some match i.CompiledName, args with | "Cast", [arg] -> Some arg // Erase | ("Cache"|"ToArray"), [arg] -> toArray com t arg |> Some | "OfList", [arg] -> toSeq t arg |> Some - | "ToList", _ -> Helper.CoreCall("List", "ofSeq", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "ToList", _ -> Helper.LibCall(com, "List", "ofSeq", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "ChunkBySize" | "Permute" as meth, [arg1; arg2] -> let arg2 = toArray com (Array Any) arg2 let args = @@ -1646,11 +1587,11 @@ let seqs (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp | "Permute", DeclaredType(_seq, [genArg]) -> [arg1; arg2] @ [arrayCons com genArg] | _ -> [arg1; arg2] - let result = Helper.CoreCall("Array", Naming.lowerFirst meth, Any, args) - Helper.CoreCall("Seq", "ofArray", t, [result]) |> Some + let result = Helper.LibCall(com, "Array", Naming.lowerFirst meth, Any, args) + Helper.LibCall(com, "Seq", "ofArray", t, [result]) |> Some // For Using we need to cast the argument to IDisposable | "EnumerateUsing", [arg; f] -> - Helper.CoreCall("Seq", "enumerateUsing", t, [arg; f], i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Seq", "enumerateUsing", t, [arg; f], i.SignatureArgTypes, ?loc=r) |> Some | ("Sort" | "SortDescending" as meth), args -> (genArg com ctx r 0 i.GenericArgs) |> sort r t (meth = "SortDescending") None args | ("SortBy" | "SortByDescending" as meth), projection::args -> @@ -1658,17 +1599,17 @@ let seqs (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp | ("GroupBy" | "CountBy" as meth), args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Map" meth i.GenericArgs args - Helper.CoreCall("Map", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Map", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("Distinct" | "DistinctBy" as meth), args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Set" meth i.GenericArgs args - Helper.CoreCall("Set", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Set", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "TryExactlyOne", args -> - tryCoreOp r t "Seq" "exactlyOne" args |> Some + tryCoreOp com r t "Seq" "exactlyOne" args |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq" meth i.GenericArgs args - Helper.CoreCall("Seq", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Seq", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with @@ -1684,40 +1625,40 @@ let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this | ".ctor", _, args -> Helper.GlobalCall("Array", t, args, memb="from", ?loc=r) |> Some | "get_Item", Some ar, [idx] -> getExpr r t ar idx |> Some - | "set_Item", Some ar, [idx; value] -> Set(ar, ExprSet idx, value, r) |> Some + | "set_Item", Some ar, [idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some | "Add", Some ar, [arg] -> - "void ($0)" |> emitJs r t [Helper.InstanceCall(ar, "push", t, [arg])] |> Some + "void ($0)" |> emitJsExpr r t [Helper.InstanceCall(ar, "push", t, [arg])] |> Some | "Remove", Some ar, [arg] -> - Helper.CoreCall("Array", "removeInPlace", t, [arg; ar], ?loc=r) |> Some + Helper.LibCall(com, "Array", "removeInPlace", t, [arg; ar], ?loc=r) |> Some | "RemoveAll", Some ar, [arg] -> - Helper.CoreCall("Array", "removeAllInPlace", t, [arg; ar], ?loc=r) |> Some + Helper.LibCall(com, "Array", "removeAllInPlace", t, [arg; ar], ?loc=r) |> Some | "FindIndex", Some ar, [arg] -> Helper.InstanceCall(ar, "findIndex", t, [arg], ?loc=r) |> Some | "FindLastIndex", Some ar, [arg] -> - Helper.CoreCall("Array", "findLastIndex", t, [arg; ar], ?loc=r) |> Some - | "GetEnumerator", Some ar, _ -> getEnumerator r t ar |> Some + Helper.LibCall(com, "Array", "findLastIndex", t, [arg; ar], ?loc=r) |> Some + | "GetEnumerator", Some ar, _ -> getEnumerator com r t ar |> Some // ICollection members, implemented in dictionaries and sets too. We need runtime checks (see #1120) | "get_Count", Some (MaybeCasted(ar)), _ -> match ar.Type with // Fable translates System.Collections.Generic.List as Array // TODO: Check also IList? | Array _ -> get r t ar "length" |> Some - | _ -> Helper.CoreCall("Util", "count", t, [ar], ?loc=r) |> Some + | _ -> Helper.LibCall(com, "Util", "count", t, [ar], ?loc=r) |> Some | "Clear", Some ar, _ -> - Helper.CoreCall("Util", "clear", t, [ar], ?loc=r) |> Some + Helper.LibCall(com, "Util", "clear", t, [ar], ?loc=r) |> Some | "Find", Some ar, [arg] -> - let opt = Helper.CoreCall("Seq", "tryFind", t, [arg; ar; defaultof com ctx t], ?loc=r) - Helper.CoreCall("Option", "value", t, [opt], ?loc=r) |> Some + let opt = Helper.LibCall(com, "Seq", "tryFind", t, [arg; ar; defaultof com ctx t], ?loc=r) + Helper.LibCall(com, "Option", "value", t, [opt], ?loc=r) |> Some | "Exists", Some ar, [arg] -> let left = Helper.InstanceCall(ar, "findIndex", Number Int32, [arg], ?loc=r) makeEqOp r left (makeIntConst -1) BinaryGreater |> Some | "FindLast", Some ar, [arg] -> - let opt = Helper.CoreCall("Seq", "tryFindBack", t, [arg; ar; defaultof com ctx t], ?loc=r) - Helper.CoreCall("Option", "value", t, [opt], ?loc=r) |> Some + let opt = Helper.LibCall(com, "Seq", "tryFindBack", t, [arg; ar; defaultof com ctx t], ?loc=r) + Helper.LibCall(com, "Option", "value", t, [opt], ?loc=r) |> Some | "FindAll", Some ar, [arg] -> - Helper.CoreCall("Seq", "filter", t, [arg; ar], ?loc=r) |> toArray com t |> Some + Helper.LibCall(com, "Seq", "filter", t, [arg; ar], ?loc=r) |> toArray com t |> Some | "AddRange", Some ar, [arg] -> - Helper.CoreCall("Array", "addRangeInPlace", t, [arg; ar], ?loc=r) |> Some + Helper.LibCall(com, "Array", "addRangeInPlace", t, [arg; ar], ?loc=r) |> Some | "Contains", Some (MaybeCasted(ar)), [arg] -> match ar.Type with | Array _ -> @@ -1737,7 +1678,7 @@ let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this | "Sort", Some ar, [] -> let compareFn = (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com Helper.InstanceCall(ar, "sort", t, [compareFn], ?loc=r) |> Some - | "Sort", Some ar, [ExprType(Fable.FunctionType _)] -> + | "Sort", Some ar, [ExprType(Fable.DelegateType _)] -> Helper.InstanceCall(ar, "sort", t, args, ?loc=r) |> Some | "ToArray", Some ar, [] -> Helper.InstanceCall(ar, "slice", t, args, ?loc=r) |> Some @@ -1754,40 +1695,40 @@ let nativeArrayFunctions = "ReduceBack", "reduceRight" "SortInPlaceWith", "sort" |] -let tuples (_: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg with - | "get_Item1", Some x -> Get(x, TupleGet 0, t, r) |> Some - | "get_Item2", Some x -> Get(x, TupleGet 1, t, r) |> Some - | "get_Item3", Some x -> Get(x, TupleGet 2, t, r) |> Some - | "get_Item4", Some x -> Get(x, TupleGet 3, t, r) |> Some - | "get_Item5", Some x -> Get(x, TupleGet 4, t, r) |> Some - | "get_Item6", Some x -> Get(x, TupleGet 5, t, r) |> Some - | "get_Item7", Some x -> Get(x, TupleGet 6, t, r) |> Some - | "get_Rest", Some x -> Get(x, TupleGet 7, t, r) |> Some + | "get_Item1", Some x -> Get(x, TupleIndex 0, t, r) |> Some + | "get_Item2", Some x -> Get(x, TupleIndex 1, t, r) |> Some + | "get_Item3", Some x -> Get(x, TupleIndex 2, t, r) |> Some + | "get_Item4", Some x -> Get(x, TupleIndex 3, t, r) |> Some + | "get_Item5", Some x -> Get(x, TupleIndex 4, t, r) |> Some + | "get_Item6", Some x -> Get(x, TupleIndex 5, t, r) |> Some + | "get_Item7", Some x -> Get(x, TupleIndex 6, t, r) |> Some + | "get_Rest", Some x -> Get(x, TupleIndex 7, t, r) |> Some | _ -> None -let arrays (_: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let arrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with | "get_Length", Some ar, _ -> get r t ar "length" |> Some | "get_Item", Some ar, [idx] -> getExpr r t ar idx |> Some - | "set_Item", Some ar, [idx; value] -> Set(ar, ExprSet idx, value, r) |> Some + | "set_Item", Some ar, [idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some | "Copy", None, [source; target; count] -> - Helper.CoreCall("Array", "copyTo", t, [source; makeIntConst 0; target; makeIntConst 0; count], i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Array", "copyTo", t, [source; makeIntConst 0; target; makeIntConst 0; count], i.SignatureArgTypes, ?loc=r) |> Some | "Copy", None, [source; sourceIndex; target; targetIndex; count] -> - Helper.CoreCall("Array", "copyTo", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "GetEnumerator", Some ar, _ -> getEnumerator r t ar |> Some + Helper.LibCall(com, "Array", "copyTo", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "GetEnumerator", Some ar, _ -> getEnumerator com r t ar |> Some | _ -> None let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = let inline newArray size t = - Value(NewArray(ArrayAlloc size, t), None) + Value(NewArrayAlloc(size, t), None) let createArray size value = match t, value with | Array(Number _ as t2), None when com.Options.typedArrays -> newArray size t2 | Array t2, value -> let value = value |> Option.defaultWith (fun () -> getZero com ctx t2) // If we don't fill the array some operations may behave unexpectedly, like Array.prototype.reduce - Helper.CoreCall("Array", "fill", t, [newArray size t2; makeIntConst 0; size; value]) + Helper.LibCall(com, "Array", "fill", t, [newArray size t2; makeIntConst 0; size; value]) | _ -> sprintf "Expecting an array type but got %A" t |> addErrorAndReturnNull com ctx.InlinePath r match i.CompiledName, args with @@ -1797,7 +1738,7 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex | ("Length" | "Count"), [arg] -> get r t arg "length" |> Some | "Item", [idx; ar] -> getExpr r t ar idx |> Some | "Get", [ar; idx] -> getExpr r t ar idx |> Some - | "Set", [ar; idx; value] -> Set(ar, ExprSet idx, value, r) |> Some + | "Set", [ar; idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some | "ZeroCreate", [count] -> createArray count None |> Some | "Create", [count; value] -> createArray count (Some value) |> Some | "Empty", _ -> @@ -1806,10 +1747,10 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex | "IsEmpty", [ar] -> eq (get r (Number Int32) ar "length") (makeIntConst 0) |> Some | "AllPairs", args -> - let allPairs = Helper.CoreCall("Seq", "allPairs", t, args, i.SignatureArgTypes, ?loc=r) + let allPairs = Helper.LibCall(com, "Seq", "allPairs", t, args, i.SignatureArgTypes, ?loc=r) toArray com t allPairs |> Some | "TryExactlyOne", args -> - tryCoreOp r t "Array" "exactlyOne" args |> Some + tryCoreOp com r t "Array" "exactlyOne" args |> Some | "SortInPlace", args -> let _, thisArg = List.splitLast args let argTypes = List.take (List.length args) i.SignatureArgTypes @@ -1822,7 +1763,7 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Array" meth i.GenericArgs args - Helper.CoreCall("Array", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Array", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some let lists (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with @@ -1834,7 +1775,7 @@ let lists (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Ex "get_Length", "length" "GetSlice", "slice" ] methName, Some x, _ -> let args = match args with [ExprType Unit] -> [x] | args -> args @ [x] - Helper.CoreCall("List", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "List", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "get_IsEmpty", Some x, _ -> Test(x, ListTest false, r) |> Some | "get_Empty", None, _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some | "Cons", None, [h;t] -> NewList(Some(h,t), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some @@ -1853,14 +1794,14 @@ let listModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Exp | "ToSeq", [x] -> toSeq t x |> Some | "ToArray", [x] -> listToArray com r t x |> Some | "AllPairs", args -> - let allPairs = Helper.CoreCall("Seq", "allPairs", t, args, i.SignatureArgTypes, ?loc=r) - toList t allPairs |> Some + let allPairs = Helper.LibCall(com, "Seq", "allPairs", t, args, i.SignatureArgTypes, ?loc=r) + toList com t allPairs |> Some | "TryExactlyOne", args -> - tryCoreOp r t "List" "exactlyOne" args |> Some + tryCoreOp com r t "List" "exactlyOne" args |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "List" meth i.GenericArgs args - Helper.CoreCall("List", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "List", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some let sets (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with @@ -1869,12 +1810,12 @@ let sets (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp let isStatic = Option.isNone thisArg let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpSet" isStatic i.CompiledName i.OverloadSuffix.Value let args = injectArg com ctx r "Set" mangledName i.GenericArgs args - Helper.CoreCall("Set", mangledName, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Set", mangledName, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some let setModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = let meth = Naming.lowerFirst i.CompiledName let args = injectArg com ctx r "Set" meth i.GenericArgs args - Helper.CoreCall("Set", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Set", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some let maps (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with @@ -1883,23 +1824,23 @@ let maps (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp let isStatic = Option.isNone thisArg let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpMap" isStatic i.CompiledName i.OverloadSuffix.Value let args = injectArg com ctx r "Map" mangledName i.GenericArgs args - Helper.CoreCall("Map", mangledName, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Map", mangledName, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some let mapModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = let meth = Naming.lowerFirst i.CompiledName let args = injectArg com ctx r "Map" meth i.GenericArgs args - Helper.CoreCall("Map", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Map", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let results (_: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let results (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = match i.CompiledName with | "Map" -> Some "mapOk" | "MapError" -> Some "mapError" | "Bind" -> Some "bindOk" | _ -> None - |> Option.map (fun meth -> Helper.CoreCall("Option", meth, t, args, i.SignatureArgTypes, ?loc=r)) + |> Option.map (fun meth -> Helper.LibCall(com, "Option", meth, t, args, i.SignatureArgTypes, ?loc=r)) // See fable-library/Option.ts for more info on how options behave in Fable runtime -let options (_: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let options (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with | "get_Value", Some c, _ -> Get(c, OptionValue, t, r) |> Some | "get_IsSome", Some c, _ -> Test(c, OptionTest true, r) |> Some @@ -1908,33 +1849,33 @@ let options (_: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Ex let optionModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = let toArray r t arg = - Helper.CoreCall("Option", "toArray", Array t, [arg], ?loc=r) + Helper.LibCall(com, "Option", "toArray", Array t, [arg], ?loc=r) match i.CompiledName, args with | "None", _ -> NewOption(None, t) |> makeValue r |> Some | "GetValue", [c] -> Get(c, OptionValue, t, r) |> Some | ("OfObj" | "OfNullable"), _ -> - Helper.CoreCall("Option", "ofNullable", t, args, ?loc=r) |> Some + Helper.LibCall(com, "Option", "ofNullable", t, args, ?loc=r) |> Some | ("ToObj" | "ToNullable"), _ -> - Helper.CoreCall("Option", "toNullable", t, args, ?loc=r) |> Some + Helper.LibCall(com, "Option", "toNullable", t, args, ?loc=r) |> Some | "IsSome", [c] -> Test(c, OptionTest true, r) |> Some | "IsNone", [c] -> Test(c, OptionTest false, r) |> Some | ("Filter" | "Flatten" | "Map" | "Map2" | "Map3" | "Bind" as meth), args -> - Helper.CoreCall("Option", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Option", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "ToArray", [arg] -> toArray r t arg |> Some | "FoldBack", [folder; opt; state] -> - Helper.CoreCall("Seq", "foldBack", t, [folder; toArray None t opt; state], i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Seq", "foldBack", t, [folder; toArray None t opt; state], i.SignatureArgTypes, ?loc=r) |> Some | ("DefaultValue" | "OrElse"), _ -> - Helper.CoreCall("Option", "defaultArg", t, List.rev args, ?loc=r) |> Some + Helper.LibCall(com, "Option", "defaultArg", t, List.rev args, ?loc=r) |> Some | ("DefaultWith" | "OrElseWith"), _ -> - Helper.CoreCall("Option", "defaultArgWith", t, List.rev args, List.rev i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Option", "defaultArgWith", t, List.rev args, List.rev i.SignatureArgTypes, ?loc=r) |> Some | ("Count" | "Contains" | "Exists" | "Fold" | "ForAll" | "Iterate" | "ToList" as meth), _ -> let args = args |> List.replaceLast (toArray None t) let moduleName, meth = if meth = "ToList" then "List", "ofArray" else "Seq", Naming.lowerFirst meth - Helper.CoreCall(moduleName, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, moduleName, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -1946,10 +1887,10 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let isFloatOrDecimal, numberModule, unsigned, bitsize = getParseParams kind if isFloatOrDecimal then - Helper.CoreCall(numberModule, Naming.lowerFirst meth, t, + Helper.LibCall(com, numberModule, Naming.lowerFirst meth, t, [str], [i.SignatureArgTypes.Head], ?loc=r) |> Some else - Helper.CoreCall(numberModule, Naming.lowerFirst meth, t, + Helper.LibCall(com, numberModule, Naming.lowerFirst meth, t, [str; makeIntConst style; makeBoolConst unsigned; makeIntConst bitsize], [i.SignatureArgTypes.Head; Number Int32; Boolean; Number Int32], ?loc=r) |> Some let isFloat = @@ -1960,7 +1901,7 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op | "IsNaN", [_] when isFloat -> Helper.GlobalCall("Number", t, args, memb="isNaN", ?loc=r) |> Some | "IsInfinity", [_] when isFloat -> - Helper.CoreCall("Double", "isInfinity", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Double", "isInfinity", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("Parse" | "TryParse") as meth, str::Value(EnumConstant(Value(NumberConstant(style, _),_),_),_)::_ -> let style = int style @@ -1984,8 +1925,8 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let style = int System.Globalization.NumberStyles.Any parseCall meth str style | "ToString", [Value (StringConstant _, _) as format] -> - let format = emitJs r String [format] "'{0:' + $0 + '}'" - Helper.CoreCall("String", "format", t, [format; thisArg.Value], [format.Type; thisArg.Value.Type], ?loc=r) |> Some + let format = emitJsExpr r String [format] "'{0:' + $0 + '}'" + Helper.LibCall(com, "String", "format", t, [format; thisArg.Value], [format.Type; thisArg.Value.Type], ?loc=r) |> Some | "ToString", _ -> Helper.GlobalCall("String", String, [thisArg.Value], ?loc=r) |> Some | _ -> @@ -1994,16 +1935,16 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let decimals (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, args with | (".ctor" | "MakeDecimal"), ([low; mid; high; isNegative; scale] as args) -> - Helper.CoreCall("Decimal", "fromParts", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ".ctor", [Value(NewArray(ArrayValues ([low; mid; high; signExp] as args),_),_)] -> - Helper.CoreCall("Decimal", "fromInts", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Decimal", "fromParts", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ".ctor", [Value(NewArray(([low; mid; high; signExp] as args),_),_)] -> + Helper.LibCall(com, "Decimal", "fromInts", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ".ctor", [arg] -> match arg.Type with | Array (Number Int32) -> - Helper.CoreCall("Decimal", "fromIntArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | _ -> makeDecimalFromExpr r t arg |> Some + Helper.LibCall(com, "Decimal", "fromIntArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | _ -> makeDecimalFromExpr com r t arg |> Some | "GetBits", _ -> - Helper.CoreCall("Decimal", "getBits", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Decimal", "getBits", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("Parse" | "TryParse"), _ -> parseNum com ctx r t i thisArg args | Operators.lessThan, [left; right] -> compareIf com r left right BinaryLess |> Some @@ -2031,7 +1972,7 @@ let decimals (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: | ("Ceiling" | "Floor" | "Round" | "Truncate" | "Add" | "Subtract" | "Multiply" | "Divide" | "Remainder" | "Negate" as meth), _ -> let meth = Naming.lowerFirst meth - Helper.CoreCall("Decimal", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "ToString", _ -> Helper.InstanceCall(thisArg.Value, "toString", String, []) |> Some | _,_ -> None @@ -2040,11 +1981,11 @@ let bigints (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: | None, ".ctor" -> match i.SignatureArgTypes with | [Array _] -> - Helper.CoreCall("BigInt", "fromByteArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "BigInt", "fromByteArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some | [Builtin(BclInt64|BclUInt64)] -> - Helper.CoreCall("BigInt", "fromInt64", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "BigInt", "fromInt64", t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> - Helper.CoreCall("BigInt", "fromInt32", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "BigInt", "fromInt32", t, args, i.SignatureArgTypes, ?loc=r) |> Some | None, "op_Explicit" -> match t with | NumberExt n -> @@ -2057,12 +1998,12 @@ let bigints (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: | _ -> None | None, "DivRem" -> let args = List.take 2 args // implementation takes 2 args, ignore the third arg - Helper.CoreCall("BigInt", "divRem", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "BigInt", "divRem", t, args, i.SignatureArgTypes, ?loc=r) |> Some | None, meth when meth.StartsWith("get_") -> - Helper.CoreValue("BigInt", meth, t) |> Some + Helper.LibValue(com, "BigInt", meth, t) |> Some | callee, meth -> let args = match callee with None -> args | Some c -> c::args - Helper.CoreCall("BigInt", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "BigInt", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some // Compile static strings to their constant values // reference: https://msdn.microsoft.com/en-us/visualfsharpdocs/conceptual/languageprimitives.errorstrings-module-%5bfsharp%5d @@ -2095,7 +2036,7 @@ let languagePrimitives (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | Value(EnumConstant(v,_),_) -> v |> Some | _ -> None | ("GenericHash" | "GenericHashIntrinsic"), [arg] -> - structuralHash r arg |> Some + structuralHash com r arg |> Some | ("FastHashTuple2" | "FastHashTuple3" | "FastHashTuple4" | "FastHashTuple5" | "GenericHashWithComparer" | "GenericHashWithComparerIntrinsic"), [comp; arg] -> Helper.InstanceCall(comp, "GetHashCode", t, [arg], i.SignatureArgTypes, ?loc=r) |> Some @@ -2123,7 +2064,7 @@ let languagePrimitives (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | ("PhysicalEquality" | "PhysicalEqualityIntrinsic"), [left; right] -> makeEqOp r left right BinaryEqualStrict |> Some | ("PhysicalHash" | "PhysicalHashIntrinsic"), [arg] -> - Helper.CoreCall("Util", "identityHash", Number Int32, [arg], ?loc=r) |> Some + Helper.LibCall(com, "Util", "identityHash", Number Int32, [arg], ?loc=r) |> Some | ("GenericEqualityComparer" | "GenericEqualityERComparer" | "FastGenericComparer" @@ -2145,7 +2086,7 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | "MakeDecimal", _, _ -> decimals com ctx r t i thisArg args | "GetString", _, [ar; idx] | "GetArray", _, [ar; idx] -> getExpr r t ar idx |> Some - | "SetArray", _, [ar; idx; value] -> Set(ar, ExprSet idx, value, r) |> Some + | "SetArray", _, [ar; idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some | ("GetArraySlice" | "GetStringSlice"), None, [ar; lower; upper] -> let upper = match upper with @@ -2153,7 +2094,7 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | _ -> add upper (makeIntConst 1) Helper.InstanceCall(ar, "slice", t, [lower; upper], ?loc=r) |> Some | "SetArraySlice", None, args -> - Helper.CoreCall("Array", "setSlice", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Array", "setSlice", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("TypeTestGeneric" | "TypeTestFast"), None, [expr] -> Test(expr, TypeTest((genArg com ctx r 0 i.GenericArgs)), r) |> Some | "CreateInstance", None, _ -> @@ -2168,12 +2109,12 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | "PowDouble", None, _ -> Helper.GlobalCall("Math", t, args, i.SignatureArgTypes, memb="pow", ?loc=r) |> Some | "PowDecimal", None, _ -> - Helper.CoreCall("Decimal", "pow", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Decimal", "pow", t, args, i.SignatureArgTypes, ?loc=r) |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangechar-function-%5bfsharp%5d // Type: RangeChar : char -> char -> seq // Usage: RangeChar start stop | "RangeChar", None, _ -> - Helper.CoreCall("Seq", "rangeChar", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Seq", "rangeChar", t, args, i.SignatureArgTypes, ?loc=r) |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangedouble-function-%5bfsharp%5d // Type: RangeDouble: float -> float -> float -> seq // Usage: RangeDouble start step stop @@ -2181,31 +2122,31 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | "RangeInt16" | "RangeUInt16" | "RangeInt32" | "RangeUInt32" | "RangeSingle" | "RangeDouble"), None, args -> - Helper.CoreCall("Seq", "rangeNumber", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Seq", "rangeNumber", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("RangeInt64" | "RangeUInt64"), None, args -> let isUnsigned = makeBoolConst (i.CompiledName = "RangeUInt64") - Helper.CoreCall("Seq", "rangeLong", t, args @ [isUnsigned] , i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Seq", "rangeLong", t, args @ [isUnsigned] , i.SignatureArgTypes, ?loc=r) |> Some | _ -> None -let runtimeHelpers (_: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let runtimeHelpers (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = match i.CompiledName, args with | "GetHashCode", [arg] -> - identityHash r arg |> Some + identityHash com r arg |> Some | _ -> None -let funcs (_: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let funcs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = match i.CompiledName, thisArg with // Just use Emit to change the type of the arg, Fable will automatically uncurry the function - | "Adapt", _ -> emitJs r t args "$0" |> Some + | "Adapt", _ -> emitJsExpr r t args "$0" |> Some | "Invoke", Some callee -> Helper.Application(callee, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None -let keyValuePairs (_: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let keyValuePairs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = match i.CompiledName, thisArg with | ".ctor", _ -> Value(NewTuple args, r) |> Some - | "get_Key", Some c -> Get(c, TupleGet 0, t, r) |> Some - | "get_Value", Some c -> Get(c, TupleGet 1, t, r) |> Some + | "get_Key", Some c -> Get(c, TupleIndex 0, t, r) |> Some + | "get_Value", Some c -> Get(c, TupleIndex 1, t, r) |> Some | _ -> None let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -2218,25 +2159,25 @@ let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp makeDictionary com r t arg |> Some | [IDictionary; IEqualityComparer], [arg; eqComp] -> makeComparerFromEqualityComparer eqComp - |> makeDictionaryWithComparer r t arg |> Some + |> makeDictionaryWithComparer com r t arg |> Some | [IEqualityComparer], [eqComp] | [Number _; IEqualityComparer], [_; eqComp] -> makeComparerFromEqualityComparer eqComp - |> makeDictionaryWithComparer r t (makeArray Any []) |> Some + |> makeDictionaryWithComparer com r t (makeArray Any []) |> Some | _ -> None | "get_IsReadOnly", _ -> makeBoolConst false |> Some | "get_Count", _ -> get r t thisArg.Value "size" |> Some - | "GetEnumerator", Some callee -> getEnumerator r t callee |> Some + | "GetEnumerator", Some callee -> getEnumerator com r t callee |> Some | "ContainsValue", _ -> match thisArg, args with - | Some c, [arg] -> Helper.CoreCall("Util", "containsValue", t, [arg; c], ?loc=r) |> Some + | Some c, [arg] -> Helper.LibCall(com, "Util", "containsValue", t, [arg; c], ?loc=r) |> Some | _ -> None | "TryGetValue", _ -> - Helper.CoreCall("Util", "tryGetValue", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Util", "tryGetValue", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | "Add", _ -> - Helper.CoreCall("Util", "addToDict", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Util", "addToDict", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | "get_Item", _ -> - Helper.CoreCall("Util", "getItemFromDict", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Util", "getItemFromDict", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | ReplaceName ["set_Item", "set" "get_Keys", "keys" "get_Values", "values" @@ -2256,10 +2197,10 @@ let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op makeHashSet com r t arg |> Some | [IEnumerable; IEqualityComparer], [arg; eqComp] -> makeComparerFromEqualityComparer eqComp - |> makeHashSetWithComparer r t arg |> Some + |> makeHashSetWithComparer com r t arg |> Some | [IEqualityComparer], [eqComp] -> makeComparerFromEqualityComparer eqComp - |> makeHashSetWithComparer r t (makeArray Any []) |> Some + |> makeHashSetWithComparer com r t (makeArray Any []) |> Some | _ -> None | "get_Count", _, _ -> get r t thisArg.Value "size" |> Some | "get_IsReadOnly", _, _ -> BoolConstant false |> makeValue r |> Some @@ -2268,19 +2209,19 @@ let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op "Remove", "delete" ] methName, Some c, args -> Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "Add", Some c, [arg] -> - Helper.CoreCall("Util", "addToSet", t, [arg; c], ?loc=r) |> Some + Helper.LibCall(com, "Util", "addToSet", t, [arg; c], ?loc=r) |> Some | ("IsProperSubsetOf" | "IsProperSupersetOf" | "UnionWith" | "IntersectWith" | "ExceptWith" | "IsSubsetOf" | "IsSupersetOf" as meth), Some c, args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Set" meth i.GenericArgs args - Helper.CoreCall("Set", meth, t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "Set", meth, t, c::args, ?loc=r) |> Some // | "CopyTo" // TODO!!! // | "SetEquals" // | "Overlaps" // | "SymmetricExceptWith" | _ -> None -let exceptions (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let exceptions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg with | ".ctor", _ -> Helper.JsConstructorCall(makeIdentExpr "Error", t, args, ?loc=r) |> Some | "get_Message", Some e -> get r t e "message" |> Some @@ -2291,14 +2232,14 @@ let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some | "GetHashCode", Some arg, _ -> - identityHash r arg |> Some + identityHash com r arg |> Some | "ToString", Some arg, _ -> toString com ctx r [arg] |> Some | "ReferenceEquals", _, [left; right] -> makeEqOp r left right BinaryEqualStrict |> Some | "Equals", Some arg1, [arg2] | "Equals", None, [arg1; arg2] -> - Helper.CoreCall("Util", "equals", t, [arg1; arg2], ?loc=r) |> Some + Helper.LibCall(com, "Util", "equals", t, [arg1; arg2], ?loc=r) |> Some | "GetType", Some arg, _ -> if arg.Type = Any then "Types can only be resolved at compile time. At runtime this will be same as `typeof`" @@ -2306,7 +2247,7 @@ let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt makeTypeInfo r arg.Type |> Some | _ -> None -let valueTypes (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let valueTypes (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg with | ".ctor", _ -> typedObjExpr t [] |> Some | "ToString", Some thisArg -> @@ -2318,12 +2259,12 @@ let valueTypes (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let unchecked (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = match i.CompiledName with | "DefaultOf" -> (genArg com ctx r 0 i.GenericArgs) |> defaultof com ctx |> Some - | "Hash" -> structuralHash r args.Head |> Some - | "Equals" -> Helper.CoreCall("Util", "equals", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "Compare" -> Helper.CoreCall("Util", "compare", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "Hash" -> structuralHash com r args.Head |> Some + | "Equals" -> Helper.LibCall(com, "Util", "equals", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "Compare" -> Helper.LibCall(com, "Util", "compare", t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None -let enums (_: ICompiler) (_: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enums (com: ICompiler) (_: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match thisArg, i.CompiledName, args with | Some this, "HasFlag", [arg] -> // x.HasFlags(y) => (int x) &&& (int y) <> 0 @@ -2337,15 +2278,15 @@ let enums (_: ICompiler) (_: Context) r t (i: CallInfo) (thisArg: Expr option) ( "GetNames", "getEnumNames" "GetValues", "getEnumValues" "GetUnderlyingType", "getEnumUnderlyingType"]) meth, args -> - Helper.CoreCall("Reflection", meth, t, args, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some | _ -> None -let log (_: ICompiler) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let log (com: ICompiler) r t (i: CallInfo) (_: Expr option) (args: Expr list) = let args = match args with | [] -> [] | [v] -> [v] - | (Value(StringConstant _, _))::_ -> [Helper.CoreCall("String", "format", t, args, i.SignatureArgTypes)] + | (Value(StringConstant _, _))::_ -> [Helper.LibCall(com, "String", "format", t, args, i.SignatureArgTypes)] | _ -> [args.Head] Helper.GlobalCall("console", t, args, memb="log", ?loc=r) @@ -2365,21 +2306,21 @@ let bitConvert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option | Builtin BclInt64 -> "getBytesInt64" | Builtin BclUInt64 -> "getBytesUInt64" | x -> failwithf "Unsupported type in BitConverter.GetBytes(): %A" x - let expr = Helper.CoreCall("BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) + let expr = Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) if com.Options.typedArrays then expr |> Some else toArray com t expr |> Some // convert to dynamic array | _ -> let memberName = Naming.lowerFirst i.CompiledName - Helper.CoreCall("BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) |> Some let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = match i.CompiledName with | "ToSByte" | "ToByte" | "ToInt16" | "ToUInt16" | "ToInt32" | "ToUInt32" - -> round args |> toInt com ctx r t |> Some - | "ToInt64" -> round args |> toLong com ctx r false t |> Some - | "ToUInt64" -> round args |> toLong com ctx r true t |> Some + -> round com args |> toInt com ctx r t |> Some + | "ToInt64" -> round com args |> toLong com ctx r false t |> Some + | "ToUInt64" -> round com args |> toLong com ctx r true t |> Some | "ToSingle" | "ToDouble" -> toFloat com ctx r t args |> Some | "ToDecimal" -> toDecimal com ctx r t args |> Some | "ToChar" -> toChar args.Head |> Some @@ -2388,7 +2329,7 @@ let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) ( if not(List.isSingle args) then sprintf "Convert.%s only accepts one single argument" (Naming.upperFirst i.CompiledName) |> addWarning com ctx.InlinePath r - Helper.CoreCall("String", (Naming.lowerFirst i.CompiledName), t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "String", (Naming.lowerFirst i.CompiledName), t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -2406,14 +2347,14 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio addWarning com ctx.InlinePath r "Write will behave as WriteLine" log com r t i thisArg args |> Some | "WriteLine" -> log com r t i thisArg args |> Some - | "Break" -> Debugger r |> Some + | "Break" -> makeDebugger r |> Some | "Assert" -> // emit i "if (!$0) { debugger; }" i.args |> Some - let cond = Operation(UnaryOperation (UnaryNot, args.Head), Boolean, r) - IfThenElse(cond, Debugger r, Value(Null Unit, None), r) |> Some + let cond = Operation(Unary(UnaryNot, args.Head), Boolean, r) + IfThenElse(cond, makeDebugger r, Value(Null Unit, None), r) |> Some | _ -> None -let dates (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = let getTime (e: Expr) = Helper.InstanceCall(e, "getTime", t, []) let moduleName = @@ -2422,40 +2363,40 @@ let dates (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) match i.CompiledName with | ".ctor" -> match args with - | [] -> Helper.CoreCall(moduleName, "minValue", t, [], [], ?loc=r) |> Some + | [] -> Helper.LibCall(com, moduleName, "minValue", t, [], [], ?loc=r) |> Some | ExprType(Builtin BclInt64)::_ -> - Helper.CoreCall(moduleName, "fromTicks", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, moduleName, "fromTicks", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ExprType(DeclaredType(e,[]))::_ when e.FullName = Types.datetime -> - Helper.CoreCall("DateOffset", "fromDate", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "DateOffset", "fromDate", t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> let last = List.last args match args.Length, last.Type with - | 7, Enum ent when ent.TryFullName = Some "System.DateTimeKind" -> + | 7, Enum ent when ent.FullName = "System.DateTimeKind" -> let args = (List.take 6 args) @ [makeIntConst 0; last] let argTypes = (List.take 6 i.SignatureArgTypes) @ [Number Int32; last.Type] - Helper.CoreCall("Date", "create", t, args, argTypes, ?loc=r) |> Some + Helper.LibCall(com, "Date", "create", t, args, argTypes, ?loc=r) |> Some | _ -> - Helper.CoreCall(moduleName, "create", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, moduleName, "create", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "ToString" -> - Helper.CoreCall("Date", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "Date", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | "get_Kind" | "get_Offset" -> Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> get r t thisArg.Value |> Some // DateTimeOffset | "get_LocalDateTime" -> - Helper.CoreCall("DateOffset", "toLocalTime", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + Helper.LibCall(com, "DateOffset", "toLocalTime", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some | "get_UtcDateTime" -> - Helper.CoreCall("DateOffset", "toUniversalTime", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + Helper.LibCall(com, "DateOffset", "toUniversalTime", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some | "get_DateTime" -> let kind = System.DateTimeKind.Unspecified |> int |> makeIntConst - Helper.CoreCall("Date", "fromDateTimeOffset", t, [thisArg.Value; kind], [thisArg.Value.Type; kind.Type], ?loc=r) |> Some + Helper.LibCall(com, "Date", "fromDateTimeOffset", t, [thisArg.Value; kind], [thisArg.Value.Type; kind.Type], ?loc=r) |> Some | "FromUnixTimeSeconds" | "FromUnixTimeMilliseconds" -> - let value = Helper.CoreCall("Long", "toNumber", Number Float64, args, i.SignatureArgTypes) + let value = Helper.LibCall(com, "Long", "toNumber", Number Float64, args, i.SignatureArgTypes) let value = if i.CompiledName = "FromUnixTimeSeconds" then makeBinOp r t value (makeIntConst 1000) BinaryMultiply else value - Helper.CoreCall("DateOffset", "default", t, [value; makeIntConst 0], [value.Type; Number Int32], ?loc=r) |> Some + Helper.LibCall(com, "DateOffset", "default", t, [value; makeIntConst 0], [value.Type; Number Int32], ?loc=r) |> Some | "ToUnixTimeSeconds" | "ToUnixTimeMilliseconds" -> let ms = getTime thisArg.Value @@ -2463,28 +2404,28 @@ let dates (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) if i.CompiledName = "ToUnixTimeSeconds" then [makeBinOp r t ms (makeIntConst 1000) BinaryDivide] else [ms] - Helper.CoreCall("Long", "fromNumber", t, args, ?loc=r) |> Some + Helper.LibCall(com, "Long", "fromNumber", t, args, ?loc=r) |> Some | "get_Ticks" -> - Helper.CoreCall("Date", "getTicks", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + Helper.LibCall(com, "Date", "getTicks", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some | "get_UtcTicks" -> - Helper.CoreCall("DateOffset", "getUtcTicks", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + Helper.LibCall(com, "DateOffset", "getUtcTicks", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some | "AddTicks" -> match thisArg, args with | Some c, [ticks] -> - let ms = Helper.CoreCall("Long", "op_Division", i.SignatureArgTypes.Head, [ticks; makeIntConst 10000], [ticks.Type; Number Int32]) - let ms = Helper.CoreCall("Long", "toNumber", Number Float64, [ms], [ms.Type]) - Helper.CoreCall(moduleName, "addMilliseconds", Number Float64, [c; ms], [c.Type; ms.Type], ?loc=r) |> Some + let ms = Helper.LibCall(com, "Long", "op_Division", i.SignatureArgTypes.Head, [ticks; makeIntConst 10000], [ticks.Type; Number Int32]) + let ms = Helper.LibCall(com, "Long", "toNumber", Number Float64, [ms], [ms.Type]) + Helper.LibCall(com, moduleName, "addMilliseconds", Number Float64, [c; ms], [c.Type; ms.Type], ?loc=r) |> Some | _ -> None | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.CoreCall(moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = // let callee = match i.callee with Some c -> c | None -> i.args.Head match i.CompiledName with | ".ctor" -> let meth = match args with [ticks] -> "fromTicks" | _ -> "create" - Helper.CoreCall("TimeSpan", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "TimeSpan", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "FromMilliseconds" -> TypeCast(args.Head, t) |> Some | "get_TotalMilliseconds" -> TypeCast(thisArg.Value, t) |> Some | "ToString" when (args.Length = 1) -> @@ -2496,24 +2437,24 @@ let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | Value (StringConstant "c", _) | Value (StringConstant "g", _) | Value (StringConstant "G", _) -> - Helper.CoreCall("TimeSpan", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "TimeSpan", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some | _ -> "TimeSpan.ToString don't support custom format. It only handles \"c\", \"g\" and \"G\" format, with CultureInfo.InvariantCulture." |> addError com ctx.InlinePath r None | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.CoreCall("TimeSpan", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "TimeSpan", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let timers (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let timers (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with - | ".ctor", _, _ -> Helper.CoreCall("Timer", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some + | ".ctor", _, _ -> Helper.LibCall(com, "Timer", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some | Naming.StartsWith "get_" meth, Some x, _ -> get r t x meth |> Some - | Naming.StartsWith "set_" meth, Some x, [value] -> Set(x, ExprSet(makeStrConst meth), value, r) |> Some + | Naming.StartsWith "set_" meth, Some x, [value] -> Set(x, Some(ExprKey(makeStrConst meth)), value, r) |> Some | meth, Some x, args -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None -let systemEnv (_: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Type) (i: CallInfo) (_: Expr option) (_: Expr list) = +let systemEnv (com: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Type) (i: CallInfo) (_: Expr option) (_: Expr list) = match i.CompiledName with | "get_NewLine" -> Some (makeStrConst "\n") | _ -> None @@ -2521,14 +2462,14 @@ let systemEnv (_: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Type) // Initial support, making at least InvariantCulture compile-able // to be used System.Double.Parse and System.Single.Parse // see https://github.com/fable-compiler/Fable/pull/1197#issuecomment-348034660 -let globalization (_: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (_: Expr option) (_: Expr list) = +let globalization (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (_: Expr option) (_: Expr list) = match i.CompiledName with | "get_InvariantCulture" -> // System.Globalization namespace is not supported by Fable. The value InvariantCulture will be compiled to an empty object literal ObjectExpr([], t, None) |> Some | _ -> None -let random (_: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let random (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = match i.CompiledName with | ".ctor" -> ObjectExpr ([], t, None) |> Some | "Next" -> @@ -2538,7 +2479,7 @@ let random (_: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (arg | [max] -> makeIntConst 0, max | [min; max] -> min, max | _ -> failwith "Unexpected arg count for Random.Next" - Helper.CoreCall("Util", "randomNext", t, [min; max], [min.Type; max.Type], ?loc=r) |> Some + Helper.LibCall(com, "Util", "randomNext", t, [min; max], [min.Type; max.Type], ?loc=r) |> Some | "NextDouble" -> Helper.GlobalCall ("Math", t, [], [], memb="random") |> Some | "NextBytes" -> @@ -2546,30 +2487,30 @@ let random (_: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (arg match args with | [b] -> b | _ -> failwith "Unexpected arg count for Random.NextBytes" - Helper.CoreCall("Util", "randomBytes", t, [byteArray], [byteArray.Type], ?loc=r) |> Some + Helper.LibCall(com, "Util", "randomBytes", t, [byteArray], [byteArray.Type], ?loc=r) |> Some | _ -> None -let cancels (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let cancels (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with - | ".ctor" -> Helper.CoreCall("Async", "createCancellationToken", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> Helper.LibCall(com, "Async", "createCancellationToken", t, args, i.SignatureArgTypes) |> Some | "get_Token" -> thisArg | "Cancel" | "CancelAfter" | "get_IsCancellationRequested" -> let args, argTypes = match thisArg with Some c -> c::args, c.Type::i.SignatureArgTypes | None -> args, i.SignatureArgTypes - Helper.CoreCall("Async", Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst, t, args, argTypes, ?loc=r) |> Some + Helper.LibCall(com, "Async", Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst, t, args, argTypes, ?loc=r) |> Some // TODO: Add check so CancellationTokenSource cannot be cancelled after disposed? | "Dispose" -> Null Type.Unit |> makeValue r |> Some | "Register" -> Helper.InstanceCall(thisArg.Value, "register", t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None -let monitor (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let monitor (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with | "Enter" | "Exit" -> Null Type.Unit |> makeValue r |> Some | _ -> None -let activator (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let activator (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with | "CreateInstance", None, ([_type] | [_type; (ExprType (Array Any))]) -> - Helper.CoreCall("Reflection", "createInstance", t, args, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "createInstance", t, args, ?loc=r) |> Some | _ -> None let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -2581,8 +2522,8 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp | _ -> false match i.CompiledName with // TODO: Use RegexConst if no options have been passed? - | ".ctor" -> Helper.CoreCall("RegExp", "create", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "get_Options" -> Helper.CoreCall("RegExp", "options", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + | ".ctor" -> Helper.LibCall(com, "RegExp", "create", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "get_Options" -> Helper.LibCall(com, "RegExp", "options", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some // Capture | "get_Index" -> if not isGroup @@ -2592,7 +2533,7 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp | "get_Value" -> if isGroup // In JS Regex group values can be undefined, ensure they're empty strings #838 - then Operation(LogicalOperation(LogicalOr, thisArg.Value, makeStrConst ""), t, r) |> Some + then Operation(Logical(LogicalOr, thisArg.Value, makeStrConst ""), t, r) |> Some else propInt 0 thisArg.Value |> Some | "get_Length" -> if isGroup @@ -2607,12 +2548,12 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp | "get_Count" -> propStr "length" thisArg.Value |> Some | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.CoreCall("RegExp", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall(com, "RegExp", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some let encoding (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args.Length with | ("get_Unicode" | "get_UTF8"), _, _ -> - Helper.CoreCall("Encoding", i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Encoding", i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "GetBytes", Some callee, (1 | 3) -> let meth = Naming.lowerFirst i.CompiledName let expr = Helper.InstanceCall(callee, meth, t, args, i.SignatureArgTypes, ?loc=r) @@ -2623,35 +2564,35 @@ let encoding (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op Helper.InstanceCall(callee, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None -let enumerables (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (_: Expr list) = +let enumerables (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (_: Expr list) = match thisArg, i.CompiledName with // This property only belongs to Key and Value Collections - | Some callee, "get_Count" -> Helper.CoreCall("Seq", "length", t, [callee], ?loc=r) |> Some - | Some callee, "GetEnumerator" -> getEnumerator r t callee |> Some + | Some callee, "get_Count" -> Helper.LibCall(com, "Seq", "length", t, [callee], ?loc=r) |> Some + | Some callee, "GetEnumerator" -> getEnumerator com r t callee |> Some | _ -> None -let enumerators (_: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enumerators (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg with | "get_Current", Some x -> get r t x "Current" |> Some | meth, Some x -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None -let events (_: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let events (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg with - | ".ctor", _ -> Helper.CoreCall("Event", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some + | ".ctor", _ -> Helper.LibCall(com, "Event", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some | "get_Publish", Some x -> get r t x "Publish" |> Some | meth, Some x -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | meth, None -> Helper.CoreCall("Event", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | meth, None -> Helper.LibCall(com, "Event", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let observable (_: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = - Helper.CoreCall("Observable", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some +let observable (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall(com, "Observable", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let mailbox (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let mailbox (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match thisArg with | None -> match i.CompiledName with - | ".ctor" -> Helper.CoreCall("MailboxProcessor", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some - | "Start" -> Helper.CoreCall("MailboxProcessor", "start", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ".ctor" -> Helper.LibCall(com, "MailboxProcessor", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some + | "Start" -> Helper.LibCall(com, "MailboxProcessor", "start", t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None | Some callee -> match i.CompiledName with @@ -2661,52 +2602,52 @@ let mailbox (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio if i.CompiledName = "Start" then "startInstance" else Naming.lowerFirst i.CompiledName - Helper.CoreCall("MailboxProcessor", memb, t, args, i.SignatureArgTypes, thisArg=callee, ?loc=r) |> Some + Helper.LibCall(com, "MailboxProcessor", memb, t, args, i.SignatureArgTypes, thisArg=callee, ?loc=r) |> Some | "Reply" -> Helper.InstanceCall(callee, "reply", t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None let asyncBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match thisArg, i.CompiledName, args with - | _, "Singleton", _ -> makeCoreRef t "singleton" "AsyncBuilder" |> Some + | _, "Singleton", _ -> makeLibRef com t "singleton" "AsyncBuilder" |> Some // For Using we need to cast the argument to IDisposable | Some x, "Using", [arg; f] -> Helper.InstanceCall(x, "Using", t, [arg; f], i.SignatureArgTypes, ?loc=r) |> Some | Some x, meth, _ -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | None, meth, _ -> Helper.CoreCall("AsyncBuilder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | None, meth, _ -> Helper.LibCall(com, "AsyncBuilder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = match i.CompiledName with // TODO: Throw error for RunSynchronously | "Start" -> "Async.Start will behave as StartImmediate" |> addWarning com ctx.InlinePath r - Helper.CoreCall("Async", "start", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Async", "start", t, args, i.SignatureArgTypes, ?loc=r) |> Some // Make sure cancellationToken is called as a function and not a getter - | "get_CancellationToken" -> Helper.CoreCall("Async", "cancellationToken", t, [], ?loc=r) |> Some + | "get_CancellationToken" -> Helper.LibCall(com, "Async", "cancellationToken", t, [], ?loc=r) |> Some // `catch` cannot be used as a function name in JS - | "Catch" -> Helper.CoreCall("Async", "catchAsync", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "Catch" -> Helper.LibCall(com, "Async", "catchAsync", t, args, i.SignatureArgTypes, ?loc=r) |> Some // Fable.Core extensions - | meth -> Helper.CoreCall("Async", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | meth -> Helper.LibCall(com, "Async", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let guids (_: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let guids (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with - | "NewGuid" -> Helper.CoreCall("String", "newGuid", t, []) |> Some - | "Parse" -> Helper.CoreCall("String", "validateGuid", t, args, i.SignatureArgTypes) |> Some - | "TryParse" -> Helper.CoreCall("String", "validateGuid", t, [args.Head; makeBoolConst true], [args.Head.Type; Boolean]) |> Some - | "ToByteArray" -> Helper.CoreCall("String", "guidToArray", t, [thisArg.Value], [thisArg.Value.Type]) |> Some + | "NewGuid" -> Helper.LibCall(com, "String", "newGuid", t, []) |> Some + | "Parse" -> Helper.LibCall(com, "String", "validateGuid", t, args, i.SignatureArgTypes) |> Some + | "TryParse" -> Helper.LibCall(com, "String", "validateGuid", t, [args.Head; makeBoolConst true], [args.Head.Type; Boolean]) |> Some + | "ToByteArray" -> Helper.LibCall(com, "String", "guidToArray", t, [thisArg.Value], [thisArg.Value.Type]) |> Some | ".ctor" -> match args with | [] -> emptyGuid() |> Some - | [ExprType (Array _)] -> Helper.CoreCall("String", "arrayToGuid", t, args, i.SignatureArgTypes) |> Some - | [ExprType String] -> Helper.CoreCall("String", "validateGuid", t, args, i.SignatureArgTypes) |> Some + | [ExprType (Array _)] -> Helper.LibCall(com, "String", "arrayToGuid", t, args, i.SignatureArgTypes) |> Some + | [ExprType String] -> Helper.LibCall(com, "String", "validateGuid", t, args, i.SignatureArgTypes) |> Some | _ -> None | _ -> None -let uris (_: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with - | ".ctor" -> Helper.CoreCall("Uri", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some - | "UnescapeDataString" -> Helper.CoreCall("Util", "unescapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeDataString" -> Helper.CoreCall("Util", "escapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeUriString" -> Helper.CoreCall("Util", "escapeUriString", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> Helper.LibCall(com, "Uri", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some + | "UnescapeDataString" -> Helper.LibCall(com, "Util", "unescapeDataString", t, args, i.SignatureArgTypes) |> Some + | "EscapeDataString" -> Helper.LibCall(com, "Util", "escapeDataString", t, args, i.SignatureArgTypes) |> Some + | "EscapeUriString" -> Helper.LibCall(com, "Util", "escapeUriString", t, args, i.SignatureArgTypes) |> Some | "get_IsAbsoluteUri" -> Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> get r t thisArg.Value |> Some | "get_Scheme" -> @@ -2723,16 +2664,16 @@ let uris (_: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> get r t thisArg.Value |> Some | _ -> None -let laziness (_: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let laziness (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with - | (".ctor"|"Create"),_,_ -> Helper.CoreCall("Util", "Lazy", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some - | "CreateFromValue",_,_ -> Helper.CoreCall("Util", "lazyFromValue", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | (".ctor"|"Create"),_,_ -> Helper.LibCall(com, "Util", "Lazy", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some + | "CreateFromValue",_,_ -> Helper.LibCall(com, "Util", "lazyFromValue", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "Force", Some callee, _ -> get r t callee "Value" |> Some | ("get_Value"|"get_IsValueCreated"), Some callee, _ -> Naming.removeGetSetPrefix i.CompiledName |> get r t callee |> Some | _ -> None -let controlExtensions (_: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with | "AddToObservable" -> Some "add" | "SubscribeToObservable" -> Some "subscribe" @@ -2743,7 +2684,7 @@ let controlExtensions (_: ICompiler) (ctx: Context) (_: SourceLocation option) t |> Option.map (fun thisArg -> thisArg::args, thisArg.Type::i.SignatureArgTypes) |> Option.defaultValue (args, i.SignatureArgTypes) |> fun (args, argTypes) -> List.rev args, List.rev argTypes - Helper.CoreCall("Observable", meth, t, args, argTypes)) + Helper.LibCall(com, "Observable", meth, t, args, argTypes)) let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = let returnString r x = StringConstant x |> makeValue r |> Some @@ -2775,11 +2716,25 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | "get_IsGenericType" -> List.isEmpty exprType.Generics |> not |> BoolConstant |> makeValue r |> Some | "get_GenericTypeArguments" | "GetGenericArguments" -> - let arVals = exprType.Generics |> List.map (makeTypeInfo r) |> ArrayValues + let arVals = exprType.Generics |> List.map (makeTypeInfo r) NewArray(arVals, Any) |> makeValue r |> Some | "GetGenericTypeDefinition" -> let newGen = exprType.Generics |> List.map (fun _ -> Any) - exprType.ReplaceGenerics(newGen) |> TypeInfo |> makeValue exprRange |> Some + let exprType = + match exprType with + | Option _ -> Option newGen.Head + | Array _ -> Array newGen.Head + | List _ -> List newGen.Head + | LambdaType _ -> + let argTypes, returnType = List.splitLast newGen + LambdaType(argTypes.Head, returnType) + | DelegateType _ -> + let argTypes, returnType = List.splitLast newGen + DelegateType(argTypes, returnType) + | Tuple _ -> Tuple newGen + | DeclaredType (ent, _) -> DeclaredType(ent, newGen) + | t -> t + TypeInfo exprType |> makeValue exprRange |> Some | _ -> None | _ -> None match resolved, thisArg with @@ -2788,64 +2743,64 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio match i.CompiledName with | "GetTypeInfo" -> Some thisArg | "get_GenericTypeArguments" | "GetGenericArguments" -> - Helper.CoreCall("Reflection", "getGenerics", t, [thisArg], ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "getGenerics", t, [thisArg], ?loc=r) |> Some | "MakeGenericType" -> - Helper.CoreCall("Reflection", "makeGenericType", t, thisArg::args, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "makeGenericType", t, thisArg::args, ?loc=r) |> Some | "get_FullName" | "get_Namespace" | "get_IsArray" | "GetElementType" | "get_IsGenericType" | "GetGenericTypeDefinition" | "get_IsEnum" | "GetEnumUnderlyingType" | "GetEnumValues" | "GetEnumNames" -> let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.CoreCall("Reflection", meth, t, [thisArg], ?loc=r) |> Some + Helper.LibCall(com, "Reflection", meth, t, [thisArg], ?loc=r) |> Some | _ -> None | None, None -> None -let fsharpType methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpType com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = match methName with | "MakeTupleType" -> - Helper.CoreCall("Reflection", "tuple_type", t, args, i.SignatureArgTypes, hasSpread=true, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "tuple_type", t, args, i.SignatureArgTypes, hasSpread=true, ?loc=r) |> Some // Prevent name clash with FSharpValue.GetRecordFields | "GetRecordFields" -> - Helper.CoreCall("Reflection", "getRecordElements", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "getRecordElements", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "GetUnionCases" | "GetTupleElements" | "GetFunctionElements" | "IsUnion" | "IsRecord" | "IsTuple" | "IsFunction" -> - Helper.CoreCall("Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "IsExceptionRepresentation" | "GetExceptionFields" -> None // TODO!!! | _ -> None -let fsharpValue methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpValue com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = match methName with | "GetUnionFields" | "GetRecordFields" | "GetRecordField" | "GetTupleFields" | "GetTupleField" | "MakeUnion" | "MakeRecord" | "MakeTuple" -> - Helper.CoreCall("Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "GetExceptionFields" -> None // TODO!!! | _ -> None -let curryExprAtRuntime arity (expr: Expr) = - Helper.CoreCall("Util", "curry", expr.Type, [makeIntConst arity; expr]) +let curryExprAtRuntime com arity (expr: Expr) = + Helper.LibCall(com, "Util", "curry", expr.Type, [makeIntConst arity; expr]) -let uncurryExprAtRuntime arity (expr: Expr) = - Helper.CoreCall("Util", "uncurry", expr.Type, [makeIntConst arity; expr]) +let uncurryExprAtRuntime com arity (expr: Expr) = + Helper.LibCall(com, "Util", "uncurry", expr.Type, [makeIntConst arity; expr]) -let partialApplyAtRuntime t arity (fn: Expr) (args: Expr list) = - let args = NewArray(ArrayValues args, Any) |> makeValue None - Helper.CoreCall("Util", "partialApply", t, [makeIntConst arity; fn; args]) +let partialApplyAtRuntime com t arity (fn: Expr) (args: Expr list) = + let args = NewArray(args, Any) |> makeValue None + Helper.LibCall(com, "Util", "partialApply", t, [makeIntConst arity; fn; args]) -let tryField returnTyp ownerTyp fieldName = +let tryField com returnTyp ownerTyp fieldName = match ownerTyp, fieldName with | Builtin BclDecimal, _ -> - Helper.CoreValue(coreModFor BclDecimal, "get_" + fieldName, returnTyp) |> Some + Helper.LibValue(com, coreModFor BclDecimal, "get_" + fieldName, returnTyp) |> Some | String, "Empty" -> makeStrConst "" |> Some | Builtin BclGuid, "Empty" -> emptyGuid() |> Some | Builtin BclTimeSpan, "Zero" -> makeIntConst 0 |> Some | Builtin BclDateTime, ("MaxValue" | "MinValue") -> - Helper.CoreCall(coreModFor BclDateTime, Naming.lowerFirst fieldName, returnTyp, []) |> Some + Helper.LibCall(com, coreModFor BclDateTime, Naming.lowerFirst fieldName, returnTyp, []) |> Some | Builtin BclDateTimeOffset, ("MaxValue" | "MinValue") -> - Helper.CoreCall(coreModFor BclDateTimeOffset, Naming.lowerFirst fieldName, returnTyp, []) |> Some + Helper.LibCall(com, coreModFor BclDateTimeOffset, Naming.lowerFirst fieldName, returnTyp, []) |> Some | DeclaredType(ent, genArgs), fieldName -> - match ent.TryFullName with - | Some "System.BitConverter" -> - Helper.CoreCall("BitConverter", Naming.lowerFirst fieldName, returnTyp, []) |> Some + match ent.FullName with + | "System.BitConverter" -> + Helper.LibCall(com, "BitConverter", Naming.lowerFirst fieldName, returnTyp, []) |> Some | _ -> None | _ -> None @@ -2977,31 +2932,31 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr | Naming.StartsWith "System.Func" _ | Naming.StartsWith "Microsoft.FSharp.Core.FSharpFunc" _ | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> funcs com ctx r t info thisArg args - | "Microsoft.FSharp.Reflection.FSharpType" -> fsharpType info.CompiledName r t info args - | "Microsoft.FSharp.Reflection.FSharpValue" -> fsharpValue info.CompiledName r t info args + | "Microsoft.FSharp.Reflection.FSharpType" -> fsharpType com info.CompiledName r t info args + | "Microsoft.FSharp.Reflection.FSharpValue" -> fsharpValue com info.CompiledName r t info args | "Microsoft.FSharp.Reflection.FSharpReflectionExtensions" -> // In netcore F# Reflection methods become extensions // with names like `FSharpType.GetExceptionFields.Static` let isFSharpType = info.CompiledName.StartsWith("FSharpType") let methName = info.CompiledName |> Naming.extensionMethodName if isFSharpType - then fsharpType methName r t info args - else fsharpValue methName r t info args + then fsharpType com methName r t info args + else fsharpValue com methName r t info args | "Microsoft.FSharp.Reflection.UnionCaseInfo" | "System.Reflection.PropertyInfo" | "System.Reflection.MemberInfo" -> match thisArg, info.CompiledName with | Some c, "get_Tag" -> makeStrConst "tag" |> getExpr r t c |> Some | Some c, "get_PropertyType" -> makeIntConst 1 |> getExpr r t c |> Some - | Some c, "GetFields" -> Helper.CoreCall("Reflection", "getUnionCaseFields", t, [c], ?loc=r) |> Some - | Some c, "GetValue" -> Helper.CoreCall("Reflection", "getValue", t, c::args, ?loc=r) |> Some + | Some c, "GetFields" -> Helper.LibCall(com, "Reflection", "getUnionCaseFields", t, [c], ?loc=r) |> Some + | Some c, "GetValue" -> Helper.LibCall(com, "Reflection", "getValue", t, c::args, ?loc=r) |> Some | Some c, "get_Name" -> match c with | Value(TypeInfo exprType, loc) -> getTypeName com ctx loc exprType |> StringConstant |> makeValue r |> Some | c -> - Helper.CoreCall("Reflection", "name", t, [c], ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "name", t, [c], ?loc=r) |> Some | _ -> None | _ when not info.IsInterface -> com.Options.precompiledLib @@ -3009,13 +2964,13 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr |> Option.map (precompiledLib r t info thisArg args) | _ -> None -let tryBaseConstructor com (ent: FSharpEntity) (memb: FSharpMemberOrFunctionOrValue) genArgs args = +let tryBaseConstructor com (ent: Entity) (argTypes: Lazy) genArgs args = match ent.FullName with - | Types.exception_ -> Some(makeCoreRef Any "Exception" "Types", args) - | Types.attribute -> Some(makeCoreRef Any "Attribute" "Types", args) + | Types.exception_ -> Some(makeLibRef com Any "Exception" "Types", args) + | Types.attribute -> Some(makeLibRef com Any "Attribute" "Types", args) | Types.dictionary -> let args = - match FSharp2Fable.TypeHelpers.getArgTypes com memb, args with + match argTypes.Value, args with | ([]|[Number _]), _ -> [makeArray Any []; makeEqualityComparer com (Seq.head genArgs)] | [IDictionary], [arg] -> @@ -3027,10 +2982,10 @@ let tryBaseConstructor com (ent: FSharpEntity) (memb: FSharpMemberOrFunctionOrVa [makeArray Any []; makeComparerFromEqualityComparer eqComp] | _ -> failwith "Unexpected dictionary constructor" let entityName = Naming.sanitizeIdentForbiddenChars "MutableMap`2" - Some(makeCoreRef Any entityName "MutableMap", args) + Some(makeLibRef com Any entityName "MutableMap", args) | Types.hashset -> let args = - match FSharp2Fable.TypeHelpers.getArgTypes com memb, args with + match argTypes.Value, args with | [], _ -> [makeArray Any []; makeEqualityComparer com (Seq.head genArgs)] | [IEnumerable], [arg] -> @@ -3041,5 +2996,5 @@ let tryBaseConstructor com (ent: FSharpEntity) (memb: FSharpMemberOrFunctionOrVa [makeArray Any []; makeComparerFromEqualityComparer eqComp] | _ -> failwith "Unexpected hashset constructor" let entityName = Naming.sanitizeIdentForbiddenChars "MutableSet`1" - Some(makeCoreRef Any entityName "MutableSet", args) + Some(makeLibRef com Any entityName "MutableSet", args) | _ -> None diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index 5f02a3623..dc186de76 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -21,7 +21,6 @@ module Atts = let [] emitProperty = "Fable.Core.EmitPropertyAttribute" // typeof.FullName let [] erase = "Fable.Core.EraseAttribute" // typeof.FullName let [] stringEnum = "Fable.Core.StringEnumAttribute" // typeof.FullName - let [] paramList = "Fable.Core.ParamListAttribute" // typeof.FullName let [] inject = "Fable.Core.InjectAttribute" // typeof.FullName [] @@ -194,6 +193,10 @@ module Log = let addError (com: ICompiler) inlinePath range error = addLog com inlinePath range error Severity.Error + let addWarningAndReturnNull (com: ICompiler) inlinePath range error = + addLog com inlinePath range error Severity.Warning + AST.Fable.Value(AST.Fable.Null AST.Fable.Any, None) + let addErrorAndReturnNull (com: ICompiler) inlinePath range error = addLog com inlinePath range error Severity.Error AST.Fable.Value(AST.Fable.Null AST.Fable.Any, None) @@ -220,22 +223,22 @@ module AST = let (|NestedLambdaType|_|) t = let rec nestedLambda acc = function - | FunctionType(LambdaType arg, returnType) -> + | LambdaType(arg, returnType) -> nestedLambda (arg::acc) returnType | returnType -> Some(List.rev acc, returnType) match t with - | FunctionType(LambdaType arg, returnType) -> nestedLambda [arg] returnType + | LambdaType(arg, returnType) -> nestedLambda [arg] returnType | _ -> None /// Only matches lambda immediately nested within each other let rec nestedLambda checkArity expr = let rec inner accArgs body name = match body with - | Function(Lambda arg, body, None) -> + | Lambda(arg, body, None) -> inner (arg::accArgs) body name | _ -> List.rev accArgs, body, name match expr with - | Function(Lambda arg, body, name) -> + | Lambda(arg, body, name) -> let args, body, name = inner [arg] body name if checkArity then match expr.Type with @@ -256,26 +259,26 @@ module AST = let (|NestedApply|_|) expr = let rec nestedApply r t accArgs applied = match applied with - | Operation(CurriedApply(applied, args), _, _) -> + | CurriedApply(applied, args, _, _) -> nestedApply r t (args@accArgs) applied | _ -> Some(applied, accArgs, t, r) match expr with - | Operation(CurriedApply(applied, args), t, r) -> + | CurriedApply(applied, args, t, r) -> nestedApply r t args applied | _ -> None let (|LambdaUncurriedAtCompileTime|_|) arity expr = let rec uncurryLambdaInner name accArgs remainingArity expr = if remainingArity = Some 0 - then Function(Delegate(List.rev accArgs), expr, name) |> Some + then Delegate(List.rev accArgs, expr, name) |> Some else match expr, remainingArity with - | Function(Lambda arg, body, name2), _ -> + | Lambda(arg, body, name2), _ -> let remainingArity = remainingArity |> Option.map (fun x -> x - 1) uncurryLambdaInner (Option.orElse name2 name) (arg::accArgs) remainingArity body // If there's no arity expectation we can return the flattened part | _, None when List.isEmpty accArgs |> not -> - Function(Delegate(List.rev accArgs), expr, name) |> Some + Delegate(List.rev accArgs, expr, name) |> Some // We cannot flatten lambda to the expected arity | _, _ -> None match expr with @@ -306,10 +309,10 @@ module AST = | Get(e,kind,_,_) -> match kind with // OptionValue has a runtime check - | ListHead | ListTail | TupleGet _ + | ListHead | ListTail | TupleIndex _ | UnionTag | UnionField _ -> canHaveSideEffects e - | FieldGet(_,isFieldMutable,_) -> - if isFieldMutable then true + | ByKey(FieldKey fi) -> + if fi.IsMutable then true else canHaveSideEffects e | _ -> true | _ -> true @@ -320,39 +323,48 @@ module AST = | Any | Unit | GenericParam _ | Option _ -> true | _ -> false - /// ATTENTION: Make sure the ident name is unique - let makeIdent name = - { Name = name - Type = Any - Kind = CompilerGenerated - IsMutable = false - Range = None } + let makeFieldKey name isMutable typ = + FieldKey({ new Field with + member _.Name = name + member _.IsMutable = isMutable + member _.IsStatic = false + member _.FieldType = typ + member _.LiteralValue = None }) /// ATTENTION: Make sure the ident name is unique let makeTypedIdent typ name = { Name = name Type = typ - Kind = CompilerGenerated + IsCompilerGenerated = true + IsThisArgument = false IsMutable = false Range = None } + /// ATTENTION: Make sure the ident name is unique + let makeIdent name = + makeTypedIdent Any name + /// ATTENTION: Make sure the ident name is unique let makeIdentExpr name = makeIdent name |> IdentExpr - let makeLoop range loopKind = Loop (loopKind, range) + let makeWhileLoop range guardExpr bodyExpr = + WhileLoop (guardExpr, bodyExpr, range) + + let makeForLoop range isUp ident start limit body = + ForLoop (ident, start, limit, body, isUp, range) let makeBinOp range typ left right op = - Operation(BinaryOperation(op, left, right), typ, range) + Operation(Binary(op, left, right), typ, range) let makeUnOp range typ arg op = - Operation(UnaryOperation(op, arg), typ, range) + Operation(Unary(op, arg), typ, range) let makeLogOp range left right op = - Operation(LogicalOperation(op, left, right), Boolean, range) + Operation(Logical(op, left, right), Boolean, range) let makeEqOp range left right op = - Operation(BinaryOperation(op, left, right), Boolean, range) + Operation(Binary(op, left, right), Boolean, range) let makeNull () = Value(Null Any, None) @@ -361,48 +373,63 @@ module AST = Value(value, r) let makeArray elementType arrExprs = - NewArray(ArrayValues arrExprs, elementType) |> makeValue None + NewArray(arrExprs, elementType) |> makeValue None let makeDelegate args body = - Function(Delegate args, body, None) + Delegate(args, body, None) let makeLambda (args: Ident list) (body: Expr) = (args, body) ||> List.foldBack (fun arg body -> - Function(Lambda arg, body, None)) + Lambda(arg, body, None)) let makeBoolConst (x: bool) = BoolConstant x |> makeValue None let makeStrConst (x: string) = StringConstant x |> makeValue None let makeIntConst (x: int) = NumberConstant (float x, Int32) |> makeValue None let makeFloatConst (x: float) = NumberConstant (x, Float64) |> makeValue None - let makeCoreRef t memberName moduleName = - Import(makeStrConst memberName, makeStrConst moduleName, Library, t, None) + let getLibPath (com: ICompiler) moduleName = + let ext = if com.Options.typescript then "" else Naming.targetFileExtension + com.LibraryDir + "/" + moduleName + ext + + let makeLibRef (com: ICompiler) t memberName moduleName = + Import(makeStrConst memberName, makeStrConst (getLibPath com moduleName), t, None) let makeCustomImport t (selector: string) (path: string) = - Import(selector.Trim() |> makeStrConst, path.Trim() |> makeStrConst, CustomImport, t, None) + Import(selector.Trim() |> makeStrConst, path.Trim() |> makeStrConst, t, None) let makeInternalImport (com: ICompiler) t (selector: string) (path: string) = let path = Path.getRelativeFileOrDirPath false com.CurrentFile false path - Import(makeStrConst selector, makeStrConst path, Internal, t, None) + Import(makeStrConst selector, makeStrConst path, t, None) - let makeSimpleCallInfo thisArg args argTypes = + let makeCallInfo thisArg args argTypes = { ThisArg = thisArg Args = args SignatureArgTypes = argTypes HasSpread = false - AutoUncurrying = false IsJsConstructor = false } + let emitJsExpr r t args macro = + Emit({ Macro = macro; Args = args; IsJsStatement = false }, t, r) + + let emitJsStatement r args macro = + Emit({ Macro = macro; Args = args; IsJsStatement = true }, Unit, r) + + let makeThrow range errorExpr = + emitJsStatement range [errorExpr] "throw $0" + + let makeDebugger range = + emitJsStatement range [] "debugger" + let destructureTupleArgs = function | [MaybeCasted(Value(UnitConstant,_))] -> [] | [MaybeCasted(Value(NewTuple(args),_))] -> args | args -> args let makeCall r t argInfo calleeExpr = - Operation(Call(calleeExpr, argInfo), t, r) + Call(calleeExpr, argInfo, t, r) let getExpr r t left memb = - Get(left, ExprGet memb, t, r) + Get(left, ByKey(ExprKey memb), t, r) let get r t left membName = makeStrConst membName |> getExpr r t left @@ -451,10 +478,8 @@ module AST = /// When strict is false doesn't take generic params into account (e.g. when solving SRTP) let rec typeEquals strict typ1 typ2 = - let entEquals (ent1: FSharp.Compiler.SourceCodeServices.FSharpEntity) gen1 (ent2: FSharp.Compiler.SourceCodeServices.FSharpEntity) gen2 = - match ent1.TryFullName, ent2.TryFullName with - | Some n1, Some n2 when n1 = n2 -> listEquals (typeEquals strict) gen1 gen2 - | _ -> false + let entEquals (ent1: Entity) gen1 (ent2: Entity) gen2 = + ent1.FullName = ent2.FullName && listEquals (typeEquals strict) gen1 gen2 match typ1, typ2 with | Any, Any | Unit, Unit @@ -468,24 +493,21 @@ module AST = | Array t1, Array t2 | List t1, List t2 -> typeEquals strict t1 t2 | Tuple ts1, Tuple ts2 -> listEquals (typeEquals strict) ts1 ts2 - | FunctionType(LambdaType a1, t1), FunctionType(LambdaType a2, t2) -> + | LambdaType(a1, t1), LambdaType(a2, t2) -> typeEquals strict a1 a2 && typeEquals strict t1 t2 - | FunctionType(DelegateType as1, t1), FunctionType(DelegateType as2, t2) -> + | DelegateType(as1, t1), DelegateType(as2, t2) -> listEquals (typeEquals strict) as1 as2 && typeEquals strict t1 t2 | DeclaredType(ent1, gen1), DeclaredType(ent2, gen2) -> - match ent1.TryFullName, ent2.TryFullName with - | Some n1, Some n2 when n1 = n2 -> listEquals (typeEquals strict) gen1 gen2 - | _ -> false + ent1.FullName = ent2.FullName && listEquals (typeEquals strict) gen1 gen2 | GenericParam _, _ | _, GenericParam _ when not strict -> true | GenericParam name1, GenericParam name2 -> name1 = name2 | _ -> false let rec getTypeFullName prettify t = - let getEntityFullName (ent: FSharp.Compiler.SourceCodeServices.FSharpEntity) gen = - match ent.TryFullName with - | None -> Naming.unknown - | Some fullname when List.isEmpty gen -> fullname - | Some fullname -> + let getEntityFullName (ent: Entity) gen = + let fullname = ent.FullName + if List.isEmpty gen then fullname + else let gen = (List.map (getTypeFullName prettify) gen |> String.concat ",") let fullname = if prettify then @@ -516,13 +538,13 @@ module AST = | UInt32 -> Types.uint32 | Float32 -> Types.float32 | Float64 -> Types.float64 - | FunctionType(LambdaType argType, returnType) -> + | LambdaType(argType, returnType) -> let argType = getTypeFullName prettify argType let returnType = getTypeFullName prettify returnType if prettify then argType + " -> " + returnType else "Microsoft.FSharp.Core.FSharpFunc`2[" + argType + "," + returnType + "]" - | FunctionType(DelegateType argTypes, returnType) -> + | DelegateType(argTypes, returnType) -> sprintf "System.Func`%i[%s,%s]" (List.length argTypes + 1) (List.map (getTypeFullName prettify) argTypes |> String.concat ",") From 6e20b9597edf9b191ee23dc5ec8f7ebdbd5c1d7c Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Wed, 19 Aug 2020 00:17:10 +0900 Subject: [PATCH 4/8] Fix (almost) tests build --- src/Fable.Cli/Main.fs | 11 +++++------ src/Fable.Core/Fable.Core.JsInterop.fs | 4 ++-- src/Fable.Core/Fable.Core.Types.fs | 7 ++++--- src/Fable.Transforms/AST/AST.Fable.fs | 1 + src/Fable.Transforms/FSharp2Fable.Util.fs | 4 ++-- src/Fable.Transforms/FSharp2Fable.fs | 10 ++++++++-- src/Fable.Transforms/Fable2Babel.fs | 24 +++++++++++------------ src/fable-library/splitter.config.js | 4 ++-- tests/Main/JsInteropTests.fs | 11 ++++++++--- tests/Main/OptionTests.fs | 12 ++++++------ 10 files changed, 50 insertions(+), 38 deletions(-) diff --git a/src/Fable.Cli/Main.fs b/src/Fable.Cli/Main.fs index 03ccfb3a0..c23e3de51 100644 --- a/src/Fable.Cli/Main.fs +++ b/src/Fable.Cli/Main.fs @@ -51,11 +51,10 @@ let parseArguments args = match Int32.TryParse portArg with | true, port -> port | false, _ -> - printfn "Value for --port is not a valid integer, using default port" - Literals.DEFAULT_PORT + printfn "Value for --port is not a valid integer, using free port" + getFreePort() | None -> - // Literals.DEFAULT_PORT - getFreePort() // Make free port the default + getFreePort() let workingDir = match tryFindArgValue "--cwd" args with | Some cwd -> Path.GetFullPath(cwd) @@ -128,7 +127,7 @@ let setGlobalParams(args: string[]) = ) let printHelp() = - (Literals.VERSION, Literals.DEFAULT_PORT) ||> printfn """Fable F# to JS compiler (%s) + Literals.VERSION |> printfn """Fable F# to JS compiler (%s) Usage: dotnet fable [command] [script] [fable arguments] [-- [script arguments]] Commands: @@ -138,7 +137,7 @@ Commands: yarn-run Run Fable while a yarn script is running node-run Run Fable while a node script is running shell-run Run Fable while a shell script is running - start Start Fable as a standalone daemon (default port: %i) + start Start Fable as a standalone daemon [webpack-cli] Other commands will be assumed to be binaries in `node_modules/.bin` Fable arguments: diff --git a/src/Fable.Core/Fable.Core.JsInterop.fs b/src/Fable.Core/Fable.Core.JsInterop.fs index 000318024..d379451ef 100644 --- a/src/Fable.Core/Fable.Core.JsInterop.fs +++ b/src/Fable.Core/Fable.Core.JsInterop.fs @@ -35,12 +35,12 @@ let createNew (o: obj) (args: obj): obj = jsNative /// Destructure a tuple of arguments and applies to literal JS code as with EmitAttribute. /// E.g. `emitJsExpr (arg1, arg2) "$0 + $1"` in JS becomes `arg1 + arg2` -let emitJsExpr (args: obj) (jsCode: string): 'T = jsNative +let emitJsExpr<'T> (args: obj) (jsCode: string): 'T = jsNative /// Same as emitJsExpr but intended for JS code that must appear in a statement position /// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements /// E.g. `emitJsExpr aValue "while($0 < 5) doSomething()"` -let emitJsStatement (args: obj) (jsCode: string): 'T = jsNative +let emitJsStatement<'T> (args: obj) (jsCode: string): 'T = jsNative /// Create a literal JS object from a collection of key-value tuples. /// E.g. `createObj [ "a" ==> 5 ]` in JS becomes `{ a: 5 }` diff --git a/src/Fable.Core/Fable.Core.Types.fs b/src/Fable.Core/Fable.Core.Types.fs index 38978b64c..79588596b 100644 --- a/src/Fable.Core/Fable.Core.Types.fs +++ b/src/Fable.Core/Fable.Core.Types.fs @@ -49,8 +49,9 @@ type ImportAllAttribute(from: string) = /// Function calls will be replaced by inlined JS code. /// More info: http://fable.io/docs/interacting.html#emit-attribute -type EmitAttribute(macro: string, ?isStatement: bool) = +type EmitAttribute(macro: string, isStatement: bool) = inherit Attribute() + new (macro: string) = EmitAttribute(macro, isStatement=false) /// Same as `Emit("$0.methodName($1...)")` type EmitMethodAttribute(methodName: string) = @@ -74,9 +75,9 @@ type EmitPropertyAttribute(propertyName: string) = /// Compile union types as string literals. /// More info: http://fable.io/docs/interacting.html#StringEnum-attribute [] -type StringEnumAttribute() = +type StringEnumAttribute(caseRules: CaseRules) = inherit Attribute() - new (caseRules: CaseRules) = StringEnumAttribute() + new () = StringEnumAttribute(CaseRules.LowerFirst) /// Experimental: Currently only intended for some specific libraries [] diff --git a/src/Fable.Transforms/AST/AST.Fable.fs b/src/Fable.Transforms/AST/AST.Fable.fs index f05aecce2..349b8d130 100644 --- a/src/Fable.Transforms/AST/AST.Fable.fs +++ b/src/Fable.Transforms/AST/AST.Fable.fs @@ -85,6 +85,7 @@ type Entity = abstract FSharpFields: Field list abstract UnionCases: UnionCase list abstract IsPublic: bool + abstract IsFSharpAbbreviation: bool abstract IsFSharpUnion: bool abstract IsFSharpRecord: bool abstract IsValueType: bool diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 80b38b887..d739fa9e0 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -135,6 +135,7 @@ type FsEnt(ent: FSharpEntity) = ent.UnionCases |> Seq.mapToList (fun x -> FsUnionCase(x) :> Fable.UnionCase) member _.IsPublic = FsEnt.IsPublic ent + member _.IsFSharpAbbreviation = ent.IsFSharpAbbreviation member _.IsFSharpUnion = ent.IsFSharpUnion member _.IsFSharpRecord = ent.IsFSharpRecord member _.IsFSharpExceptionDeclaration = ent.IsFSharpExceptionDeclaration @@ -1076,8 +1077,7 @@ module Util = /// We can add a suffix to the entity name for special methods, like reflection declaration let entityRefWithSuffix (com: ICompiler) (ent: Fable.Entity) suffix = let error msg = - ent.FullName - |> sprintf "%s: %s" msg + sprintf "%s: %s" msg ent.FullName |> addErrorAndReturnNull com [] None if ent.IsInterface then error "Cannot reference an interface" diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 98f18b579..5d4f566e9 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1046,7 +1046,10 @@ let rec private getUsedRootNames com (usedNames: Set) decls = match decl with | FSharpImplementationFileDeclaration.Entity(ent, []) -> let ent = FsEnt(ent) :> Fable.Entity - if isErasedOrStringEnumEntity ent then usedNames + if ent.IsInterface || ent.IsFSharpAbbreviation + || isErasedOrStringEnumEntity ent + || isGlobalOrImportedEntity ent then + usedNames else getEntityDeclarationName com ent |> addUsedRootName com usedNames @@ -1064,7 +1067,10 @@ let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = match fsDecl with | FSharpImplementationFileDeclaration.Entity(ent, []) -> let fableEnt = FsEnt(ent) :> Fable.Entity - if isErasedOrStringEnumEntity fableEnt then [] + if ent.IsInterface || ent.IsFSharpAbbreviation + || isErasedOrStringEnumEntity fableEnt + || isGlobalOrImportedEntity fableEnt then + [] else let entityName = getEntityDeclarationName com fableEnt let ident = makeRangedIdent ent.DeclarationLocation ent.DisplayName entityName diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 3bd75c888..09e975ddf 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -2003,8 +2003,8 @@ module Util = let args = fieldIds |> Array.map typedPattern declareType com ctx ent id args body baseExpr - let transformImplicitConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (id: Fable.Ident) (info: Fable.MemberDeclInfo) args body baseCall = - let consIdent = Identifier(id.Name) :> Expression + let transformImplicitConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (entIdent: Fable.Ident) (consIdent: Fable.Ident) (info: Fable.MemberDeclInfo) args body baseCall = + let classIdent = Identifier(entIdent.Name) :> Expression let babelArgs, body, returnType, typeParamDecl = getMemberArgsAndBody com ctx ClassConstructor info.HasSpread args body @@ -2012,7 +2012,7 @@ module Util = // change constructor's return type from void to entity type if com.Options.typescript then let genParams = getEntityGenParams ent - let returnType = getGenericTypeAnnotation com ctx id genParams + let returnType = getGenericTypeAnnotation com ctx entIdent genParams let typeParamDecl = makeTypeParamDecl genParams |> mergeTypeParamDecls typeParamDecl returnType, typeParamDecl else @@ -2042,7 +2042,7 @@ module Util = let exposedCons = let exposedConsBody = BlockStatement [| ReturnStatement - (NewExpression(consIdent, List.toArray argExprs)) |] |> U2.Case1 + (NewExpression(classIdent, List.toArray argExprs)) |] |> U2.Case1 makeFunctionExpression None (consArgs, exposedConsBody, returnType, typeParamDecl) let baseExpr, body = @@ -2063,8 +2063,8 @@ module Util = | None -> None, body [ - yield! declareType com ctx ent id babelArgs body baseExpr - yield declareModuleMember info.IsPublic id false exposedCons + yield! declareType com ctx ent entIdent babelArgs body baseExpr + yield declareModuleMember info.IsPublic consIdent false exposedCons ] let rec transformDeclaration (com: IBabelCompiler) ctx decl = @@ -2092,14 +2092,14 @@ module Util = else [transformModuleFunction com ctx memb.Info memb.Ident memb.Args memb.Body] - | Fable.ClassDeclaration(ent, ident, cons, baseCall, attachedMembers) -> + | Fable.ClassDeclaration(ent, entIdent, cons, baseCall, attachedMembers) -> let cons = match cons with - | Some memb -> - withCurrentScope ctx memb.UsedNames <| fun ctx -> - transformImplicitConstructor com ctx ent ident memb.Info memb.Args memb.Body baseCall - | None when ent.IsFSharpUnion -> transformUnionConstructor com ctx ent ident - | None -> transformCompilerGeneratedConstructor com ctx ent ident + | Some cons -> + withCurrentScope ctx cons.UsedNames <| fun ctx -> + transformImplicitConstructor com ctx ent entIdent cons.Ident cons.Info cons.Args cons.Body baseCall + | None when ent.IsFSharpUnion -> transformUnionConstructor com ctx ent entIdent + | None -> transformCompilerGeneratedConstructor com ctx ent entIdent let attachedMembers = attachedMembers |> List.collect (fun memb -> diff --git a/src/fable-library/splitter.config.js b/src/fable-library/splitter.config.js index 6e5b4b052..1d43d73f3 100644 --- a/src/fable-library/splitter.config.js +++ b/src/fable-library/splitter.config.js @@ -1,5 +1,5 @@ const path = require("path"); - +const portArgIndex = process.argv.indexOf("--port"); const useCommonjs = process.argv.find(v => v === "--commonjs"); console.log("Compiling to " + (useCommonjs ? "commonjs" : "ES2015 modules") + "...") @@ -21,6 +21,7 @@ const outDir = useCommonjs : "../../build/fable-library"; module.exports = { + port: portArgIndex >= 0 ? process.argv[portArgIndex + 1] : undefined, cli: { path: resolve("../Fable.Cli"), fableLibrary: "force:${outDir}", @@ -29,7 +30,6 @@ module.exports = { entry: resolve("Fable.Library.fsproj"), outDir: resolve(outDir), allFiles: true, - // port: 61225, babel: babelOptions, fable: fableOptions, }; diff --git a/tests/Main/JsInteropTests.fs b/tests/Main/JsInteropTests.fs index 44847cf00..1d9811c0c 100644 --- a/tests/Main/JsInteropTests.fs +++ b/tests/Main/JsInteropTests.fs @@ -346,14 +346,19 @@ let tests = style.Bar |> equal "foo" style.Add(3,5) |> equal 8 - testCase "emitJs works" <| fun () -> + testCase "emitJsExpr works" <| fun () -> let x = 4 let y = 8 - let z1: int = emitJs "$0 * Math.pow(2, $1)" (x, y) - let z2: int = emitJs "$0 << $1" (x, y) + let z1: int = emitJsExpr (x, y) "$0 * Math.pow(2, $1)" + let z2: int = emitJsExpr (x, y) "$0 << $1" equal z1 z2 equal 1024 z1 + testCase "emitJsStatement works" <| fun () -> + let f x y: int = + emitJsStatement (x, y) "return $0 << $1" + f 4 8 |> equal 1024 + testCase "Assigning null with emit works" <| fun () -> let x = createEmpty x.["prop"] <- "prop value" diff --git a/tests/Main/OptionTests.fs b/tests/Main/OptionTests.fs index 54dbbb1a7..3c3acc578 100644 --- a/tests/Main/OptionTests.fs +++ b/tests/Main/OptionTests.fs @@ -284,8 +284,8 @@ let tests = #if FABLE_COMPILER testCase "None and unit compile to JS undefined" <| fun () -> - let isActualJsNull (x: obj) = emitJs "$0 === null" x - let isActualJsUndefined (x: obj) = emitJs "$0 === void 0" x + let isActualJsNull (x: obj) = emitJsExpr x "$0 === null" + let isActualJsUndefined (x: obj) = emitJsExpr x "$0 === void 0" let x: int option = None let y = () @@ -295,8 +295,8 @@ let tests = isActualJsUndefined y |> equal true testCase "Option.toObj/toNullable converts to null" <| fun () -> - let isActualJsNull (x: obj) = emitJs "$0 === null" x - let isActualJsUndefined (x: obj) = emitJs "$0 === void 0" x + let isActualJsNull (x: obj) = emitJsExpr x "$0 === null" + let isActualJsUndefined (x: obj) = emitJsExpr x "$0 === void 0" let x: string option = None let x2: int option = None @@ -308,8 +308,8 @@ let tests = isActualJsUndefined z |> equal false testCase "Option.ofObj/ofNullable converts to undefined" <| fun () -> - let isActualJsNull (x: obj) = emitJs "$0 === null" x - let isActualJsUndefined (x: obj) = emitJs "$0 === void 0" x + let isActualJsNull (x: obj) = emitJsExpr x "$0 === null" + let isActualJsUndefined (x: obj) = emitJsExpr x "$0 === void 0" let x: string = null let x2: Nullable = Nullable() From cd0412d3af10694a049f219214bd8c7dc741c9d8 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Fri, 21 Aug 2020 02:42:59 +0900 Subject: [PATCH 5/8] Compile to classes and fix some tests --- src/Fable.Cli/Parser.fs | 3 - src/Fable.Transforms/FSharp2Fable.Util.fs | 6 +- src/Fable.Transforms/FSharp2Fable.fs | 4 +- src/Fable.Transforms/Fable2Babel.fs | 235 ++++++------------ src/Fable.Transforms/Global/Compiler.fs | 1 - src/Fable.Transforms/Replacements.fs | 15 +- src/Fable.Transforms/Transforms.Util.fs | 3 - src/fable-compiler-js/src/Platform.fs | 1 - src/fable-compiler-js/src/app.fs | 2 - src/fable-library/Types.ts | 90 ++----- src/fable-library/Util.ts | 4 + src/fable-standalone/src/Interfaces.fs | 1 - src/fable-standalone/src/Main.fs | 2 - src/fable-standalone/src/Worker/Worker.fs | 2 - .../test/bench-compiler/Platform.fs | 1 - .../test/bench-compiler/app.fs | 2 - 16 files changed, 122 insertions(+), 250 deletions(-) diff --git a/src/Fable.Cli/Parser.fs b/src/Fable.Cli/Parser.fs index f8518dc58..8ae2d20cb 100644 --- a/src/Fable.Cli/Parser.fs +++ b/src/Fable.Cli/Parser.fs @@ -13,7 +13,6 @@ type Message = noRestore: bool typedArrays: bool clampByteArrays: bool - classTypes: bool typescript: bool extra: IDictionary } @@ -57,7 +56,6 @@ let private parseDic (key: string) (o: JObject): IDictionary = let toCompilerOptions (msg: Message): CompilerOptions = { typedArrays = msg.typedArrays clampByteArrays = msg.clampByteArrays - classTypes = msg.classTypes typescript = msg.typescript debugMode = Array.contains "DEBUG" msg.define verbosity = GlobalParams.Singleton.Verbosity @@ -81,6 +79,5 @@ let parse (msg: string) = noRestore = parseBoolean false "noRestore" json typedArrays = parseBoolean false "typedArrays" json clampByteArrays = parseBoolean false "clampByteArrays" json - classTypes = parseBoolean false "classTypes" json typescript = parseBoolean false "typescript" json extra = parseDic "extra" json } diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index d739fa9e0..b5de29ec8 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -1066,13 +1066,9 @@ module Util = match ent.AssemblyPath with | Some asmPath -> not(String.IsNullOrEmpty(asmPath)) // Do we still need the IsNullOrEmpty check? | None -> -#if FABLE_COMPILER - // When compiling Fable itself, Fable.Core entities will be part of the code base, + // When compiling tests or Fable itself, Fable.Core entities will be part of the code base, // but still need to be replaced ent.FullName.StartsWith("Fable.Core.") -#else - false -#endif /// We can add a suffix to the entity name for special methods, like reflection declaration let entityRefWithSuffix (com: ICompiler) (ent: Fable.Entity) suffix = diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 5d4f566e9..98449c65b 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -606,7 +606,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let errorMessage = "The match cases were incomplete" let rangeOfElseExpr = makeRangeFrom elseExpr let errorExpr = Replacements.Helpers.error (Fable.Value(Fable.StringConstant errorMessage, None)) - makeThrow rangeOfElseExpr errorExpr + Replacements.makeThrow com rangeOfElseExpr Fable.Any errorExpr | _ -> fableElseExpr @@ -802,7 +802,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = fileNameWhereErrorOccurs let errorExpr = Replacements.Helpers.error (Fable.Value(Fable.StringConstant errorMessage, None)) // Creates a "throw Error({errorMessage})" expression - let throwExpr = makeThrow rangeOfLastDecisionTarget errorExpr + let throwExpr = Replacements.makeThrow com rangeOfLastDecisionTarget Fable.Any errorExpr fableDecisionTargets |> List.replaceLast (fun _lastExpr -> [], throwExpr) diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 09e975ddf..dab9a018e 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -353,31 +353,17 @@ module Annotation = let genTypeParams = getEntityGenParams ent let newTypeParams = Set.difference genTypeParams ctx.ScopedTypeParams let ctx = { ctx with ScopedTypeParams = Set.union ctx.ScopedTypeParams newTypeParams } - let fields = - if not (com.Options.classTypes) - then Util.getEntityFieldsAsProps com ctx ent - else Array.empty let attached = Util.getEntityExplicitInterfaceMembers com ctx ent - let baseExt = - match baseExpr with - | Some expr when not (com.Options.classTypes) -> - match expr with - | :? Identifier as id -> - let typeParamInst = - ent.BaseDeclaration |> Option.bind (fun x -> - getEntityGenParams x.Definition |> makeTypeParamInst) - InterfaceExtends(id, ?typeParameters=typeParamInst) |> Seq.singleton - | _ -> Seq.empty - | _ -> Seq.empty - let interfaceExt = Util.getInterfaceExtends com ctx ent - let combinedExt = Seq.append baseExt interfaceExt |> Seq.toArray - let extends = if Array.isEmpty combinedExt then None else Some combinedExt + let extends = + Util.getInterfaceExtends com ctx ent + |> Seq.toArray + |> function [||] -> None | e -> Some e // Type declaration merging only works well with class declarations, not class expressions, // but Babel does not allow duplicate declarations (interface and class with the same name) // so we're adding a prefix to the interface name, which will be removed after transpiling. - let prefix = if com.Options.classTypes then "$INTERFACE_DECL_PREFIX$_" else "" + let prefix = "$INTERFACE_DECL_PREFIX$_" let id = Identifier(prefix + ident.Name) - let body = ObjectTypeAnnotation([| yield! fields; yield! attached |]) + let body = ObjectTypeAnnotation([| yield! attached |]) let typeParamDecl = genTypeParams |> makeTypeParamDecl InterfaceDeclaration(id, body, ?extends_=extends, ?typeParameters=typeParamDecl) @@ -677,9 +663,6 @@ module Util = | [] -> expr | m::ms -> get None expr m |> getParts ms - let jsObject methodName args = - CallExpression(get None (Identifier "Object") methodName, args) :> Expression - let makeList com ctx headAndTail = match headAndTail with | None -> [||] @@ -942,7 +925,7 @@ module Util = let values = List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values let consRef = jsConstructor com ctx ent let typeParamInst = - if com.Options.typescript && (com.Options.classTypes || ent.FullName = Types.reference) + if com.Options.typescript && (ent.FullName = Types.reference) then makeGenTypeParamInst com ctx genArgs else None upcast NewExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r) @@ -956,7 +939,7 @@ module Util = let consRef = jsConstructor com ctx ent let values = List.map (fun x -> com.TransformAsExpr(ctx, x)) values let typeParamInst = - if com.Options.typescript && com.Options.classTypes + if com.Options.typescript then makeGenTypeParamInst com ctx genArgs else None let values = (ofInt tag)::values |> List.toArray @@ -1148,9 +1131,7 @@ module Util = | Function(args, body) -> let name = Some var.Name transformFunctionWithAnnotations com ctx name args body - |> (if com.Options.classTypes || com.Options.typescript - then makeArrowFunctionExpression name - else makeFunctionExpression name) + |> makeArrowFunctionExpression name | _ -> com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type @@ -1417,15 +1398,11 @@ module Util = | Fable.Lambda(arg, body, name) -> transformFunctionWithAnnotations com ctx name [arg] body - |> (if com.Options.classTypes || com.Options.typescript - then makeArrowFunctionExpression name - else makeFunctionExpression name) + |> makeArrowFunctionExpression name | Fable.Delegate(args, body, name) -> transformFunctionWithAnnotations com ctx name args body - |> (if com.Options.classTypes || com.Options.typescript - then makeArrowFunctionExpression name - else makeFunctionExpression name) + |> makeArrowFunctionExpression name | Fable.ObjectExpr (members, _, baseCall) -> transformObjectExpr com ctx members baseCall @@ -1498,16 +1475,12 @@ module Util = | Fable.Lambda(arg, body, name) -> [|transformFunctionWithAnnotations com ctx name [arg] body - |> (if com.Options.classTypes || com.Options.typescript - then makeArrowFunctionExpression name - else makeFunctionExpression name) + |> makeArrowFunctionExpression name |> resolveExpr expr.Type returnStrategy|] | Fable.Delegate(args, body, name) -> [|transformFunctionWithAnnotations com ctx name args body - |> (if com.Options.classTypes || com.Options.typescript - then makeArrowFunctionExpression name - else makeFunctionExpression name) + |> makeArrowFunctionExpression name |> resolveExpr expr.Type returnStrategy|] | Fable.ObjectExpr (members, t, baseCall) -> @@ -1519,9 +1492,12 @@ module Util = | Fable.CurriedApply(callee, args, typ, range) -> transformCurriedApplyAsStatements com ctx range typ returnStrategy callee args - // Ignore the return strategy - | Fable.Emit(info, _, range) -> - [|ExpressionStatement(transformEmit com ctx range info)|] + | Fable.Emit(info, t, range) -> + let e = transformEmit com ctx range info + if info.IsJsStatement then + // Ignore the return strategy + [|ExpressionStatement(e)|] + else [|resolveExpr t returnStrategy e|] | Fable.Operation(kind, t, range) -> [|transformOperation com ctx range kind |> resolveExpr t returnStrategy|] @@ -1790,7 +1766,6 @@ module Util = let getEntityFieldsAsProps (com: IBabelCompiler) ctx (ent: Fable.Entity) = ent.FSharpFields - |> Seq.filter (fun field -> com.Options.classTypes || not (field.IsStatic)) |> Seq.map (fun field -> let id = if Naming.hasIdentForbiddenChars field.Name @@ -1811,26 +1786,7 @@ module Util = id) |> Seq.toArray - let declareObjectType (com: IBabelCompiler) ctx (ent: Fable.Entity) ident (consArgs: Pattern[]) (consBody: BlockStatement) (baseExpr: Expression option) = - let consArgs, returnType, typeParamDecl = - if com.Options.typescript then - let genParams = getEntityGenParams ent - let ta = getGenericTypeAnnotation com ctx ident genParams - let thisArg = Identifier("this", ?typeAnnotation=ta) |> toPattern - let consArgs = Array.append [| thisArg |] consArgs - let returnType = None - let typeParamDecl = makeEntityTypeParamDecl com ctx ent - consArgs, returnType, typeParamDecl - else - consArgs, None, None - let consFunction = makeFunctionExpression None (consArgs, U2.Case1 consBody, returnType, typeParamDecl) - match baseExpr with - | Some e -> [|consFunction; e|] - | None -> [|consFunction|] - |> libCall com ctx None "Types" "declare" - |> declareModuleMember ent.IsPublic ident false - - let declareClassType (com: IBabelCompiler) ctx (ent: Fable.Entity) ident (consArgs: Pattern[]) (consBody: BlockStatement) (baseExpr: Expression option) = + let declareClassType (com: IBabelCompiler) ctx (ent: Fable.Entity) ident (consArgs: Pattern[]) (consBody: BlockStatement) (baseExpr: Expression option) classMembers = let consId = Identifier "constructor" let typeParamDecl = makeEntityTypeParamDecl com ctx ent let baseRef = @@ -1843,7 +1799,7 @@ module Util = let super = callSuperConstructor None [] |> ExpressionStatement :> Statement BlockStatement (Array.append [|super|] consBody.Body) else consBody - let classCons = ClassMethod(Babel.ClassImplicitConstructor, consId, consArgs, consBody) + let classCons = ClassMethod(ClassImplicitConstructor, consId, consArgs, consBody) let classFields = if com.Options.typescript then getEntityFieldsAsProps com ctx ent @@ -1852,16 +1808,13 @@ module Util = ClassProperty(prop.Key, ?``static``=prop.Static, ?typeAnnotation=ta) |> U2.Case2) else Array.empty // no need for constructor in unions - let classMethods = if ent.IsFSharpUnion then [||] else [| U2.Case1 classCons |] - let classBody = ClassBody([| yield! classFields; yield! classMethods |]) + let classMembers = if ent.IsFSharpUnion then classMembers else Array.append [| U2.Case1 classCons |] classMembers + let classBody = ClassBody([| yield! classFields; yield! classMembers |]) let classExpr = ClassExpression(classBody, ?superClass=Some baseRef, ?typeParameters=typeParamDecl) classExpr |> declareModuleMember ent.IsPublic ident false - let declareType (com: IBabelCompiler) ctx (ent: Fable.Entity) ident (consArgs: Pattern[]) (consBody: BlockStatement) baseExpr: U2 list = - let typeDeclaration = - if com.Options.classTypes - then declareClassType com ctx ent ident consArgs consBody baseExpr - else declareObjectType com ctx ent ident consArgs consBody baseExpr + let declareType (com: IBabelCompiler) ctx (ent: Fable.Entity) ident (consArgs: Pattern[]) (consBody: BlockStatement) baseExpr classMembers: U2 list = + let typeDeclaration = declareClassType com ctx ent ident consArgs consBody baseExpr classMembers let reflectionDeclaration = let genArgs = Array.init (ent.GenericParameters.Length) (fun i -> "gen" + string i |> makeIdent |> typedIdent com ctx) let body = transformReflectionInfo com ctx ident.Range ent (Array.map (fun x -> x :> _) genArgs) @@ -1874,7 +1827,7 @@ module Util = let ident = makeIdent (ident.Name + Naming.reflectionSuffix) makeFunctionExpression None (args, U2.Case2 body, returnType, None) |> declareModuleMember ent.IsPublic ident false - if com.Options.typescript then // && not (com.Options.classTypes && (ent.IsUnion || ent.IsFSharpRecord)) then + if com.Options.typescript then let interfaceDecl = makeInterfaceDecl com ctx ent ident baseExpr let interfaceDeclaration = ExportNamedDeclaration(interfaceDecl) :> ModuleDeclaration |> U2.Case2 [interfaceDeclaration; typeDeclaration; reflectionDeclaration] @@ -1903,52 +1856,31 @@ module Util = else Array.map U2.Case1 statements |> Array.toList let transformAttachedProperty (com: IBabelCompiler) ctx entity (ident: Fable.Ident) (info: Fable.MemberDeclInfo) args body = - let key = if info.IsGetter then "get" else "set" + let kind = if info.IsGetter then ClassGetter else ClassSetter let args, body, returnType, typeParamDecl = getMemberArgsAndBody com ctx Attached false args body - let funcExpr = makeFunctionExpression None (args, U2.Case1 body, returnType, typeParamDecl) - let funcCons = - FSharp2Fable.Util.entityRef com entity - |> transformAsExpr com ctx - jsObject "defineProperty" [| - get None funcCons "prototype" - StringLiteral ident.Name - ObjectExpression [| - ObjectProperty(StringLiteral "configurable", BooleanLiteral true) |> U3.Case1 - ObjectProperty(StringLiteral key, funcExpr) |> U3.Case1 - |] - |] - |> ExpressionStatement :> Statement - |> U2<_,ModuleDeclaration>.Case1 |> List.singleton - - let attachTo object memberExpr expr = - let memb = getExpr None object memberExpr - assign None memb expr - |> ExpressionStatement :> Statement - |> U2<_,ModuleDeclaration>.Case1 - - let attachToPrototype funcCons memberName expr = - let prototype = get None funcCons "prototype" - attachTo prototype (StringLiteral memberName) expr + let key, computed = memberFromName ident.Name + ClassMethod(kind, key, args, body, computed_=computed) + |> U2<_,ClassProperty>.Case1 + |> Array.singleton let transformAttachedMethod (com: IBabelCompiler) ctx entity (ident: Fable.Ident) (info: Fable.MemberDeclInfo) args body = - let funcCons = - FSharp2Fable.Util.entityRef com entity - |> transformAsExpr com ctx let args, body, returnType, typeParamDecl = getMemberArgsAndBody com ctx Attached info.HasSpread args body + let key, computed = memberFromName ident.Name let method = - makeFunctionExpression None (args, U2.Case1 body, returnType, typeParamDecl) - |> attachToPrototype funcCons ident.Name + ClassMethod(ClassFunction, key, args, body, computed_=computed) + |> U2<_,ClassProperty>.Case1 if info.IsEnumerator then let iterator = - FunctionExpression([||], enumerator2iterator com ctx) :> Expression - |> attachToPrototype funcCons "Symbol.iterator" - [method; iterator] + let key, computed = memberFromName "Symbol.iterator" + ClassMethod(ClassFunction, key, [||], enumerator2iterator com ctx, computed_=computed) + |> U2<_,ClassProperty>.Case1 + [|method; iterator|] else - [method] + [|method|] - let transformUnionConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (id: Fable.Ident) = + let transformUnion (com: IBabelCompiler) ctx (ent: Fable.Entity) (id: Fable.Ident) classMembers = let baseRef = libValue com ctx "Types" "Union" let tagId = makeTypedIdent (Fable.Number Int32) "tag" let fieldsId = makeTypedIdent (Fable.Array Fable.Any) "fields" @@ -1956,34 +1888,36 @@ module Util = [| typedIdent com ctx tagId |> toPattern typedIdent com ctx fieldsId |> restElement |] let body = - if com.Options.classTypes then - [ (ident tagId) :> Expression - SpreadElement(ident fieldsId) :> Expression ] - |> callSuperConstructor None - |> ExpressionStatement :> Statement |> Array.singleton |> BlockStatement - else - [| tagId; fieldsId |] - |> Array.map (fun id -> - let left = get None thisExpr id.Name - let right = - match id.Type with - | Fable.Number _ -> - BinaryExpression(BinaryOrBitwise, ident id, NumericLiteral(0.)) :> Expression - | _ -> ident id :> Expression - assign None left right |> ExpressionStatement :> Statement) - |> BlockStatement - [ - yield! declareType com ctx ent id args body (Some baseRef) - yield + [ (ident tagId) :> Expression + SpreadElement(ident fieldsId) :> Expression ] + |> callSuperConstructor None + |> ExpressionStatement :> Statement |> Array.singleton |> BlockStatement + // [| tagId; fieldsId |] + // |> Array.map (fun id -> + // let left = get None thisExpr id.Name + // let right = + // match id.Type with + // | Fable.Number _ -> + // BinaryExpression(BinaryOrBitwise, ident id, NumericLiteral(0.)) :> Expression + // | _ -> ident id :> Expression + // assign None left right |> ExpressionStatement :> Statement) + // |> BlockStatement + + let cases = + let body = ent.UnionCases |> Seq.map (getUnionCaseName >> makeStrConst) |> Seq.toList |> makeArray com ctx - |> fun cases -> makeFunctionExpression None ([||], U2.Case2 cases, None, None) - |> attachToPrototype (ident id) "cases" - ] + |> ExpressionStatement :> Statement + |> Array.singleton + |> BlockStatement + ClassMethod(ClassFunction, Identifier "cases", [||], body) |> U2<_, ClassProperty>.Case1 - let transformCompilerGeneratedConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (id: Fable.Ident) = + Array.append [|cases|] classMembers + |> declareType com ctx ent id args body (Some baseRef) + + let transformClassWithCompilerGeneratedConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (id: Fable.Ident) classMembers = let fieldIds = getEntityFieldsAsIdents com ent let args = fieldIds |> Array.map ident let body = @@ -2001,9 +1935,9 @@ module Util = else None let typedPattern = typedIdent com ctx >> toPattern let args = fieldIds |> Array.map typedPattern - declareType com ctx ent id args body baseExpr + declareType com ctx ent id args body baseExpr classMembers - let transformImplicitConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (entIdent: Fable.Ident) (consIdent: Fable.Ident) (info: Fable.MemberDeclInfo) args body baseCall = + let transformClassWithImplicitConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (entIdent: Fable.Ident) (consIdent: Fable.Ident) (info: Fable.MemberDeclInfo) args body baseCall classMembers = let classIdent = Identifier(entIdent.Name) :> Expression let babelArgs, body, returnType, typeParamDecl = getMemberArgsAndBody com ctx ClassConstructor info.HasSpread args body @@ -2031,13 +1965,7 @@ module Util = args |> List.map typedPattern, args |> List.map identAsExpr - let consArgs = - if com.Options.typescript && not (com.Options.classTypes) then - let ta = UnionTypeAnnotation [| returnType.Value.TypeAnnotation; VoidTypeAnnotation() |] - let thisArg = Identifier("this", ?typeAnnotation=(ta |> TypeAnnotation |> Some)) |> toPattern - List.toArray (thisArg :: argIdents) - else - List.toArray argIdents + let consArgs = List.toArray argIdents let exposedCons = let exposedConsBody = @@ -2051,9 +1979,7 @@ module Util = match baseCall with | Fable.Call(TransformExpr com ctx baseRef, info,_,_) -> let args = transformCallArgs com ctx info.HasSpread info.Args - let baseCall = - if com.Options.classTypes then callSuperConstructor baseCall.Range args - else callFunctionWithThisContext baseCall.Range baseRef args + let baseCall = callSuperConstructor baseCall.Range args Some baseRef, body.Body |> Array.append [|ExpressionStatement baseCall|] |> BlockStatement @@ -2063,7 +1989,7 @@ module Util = | None -> None, body [ - yield! declareType com ctx ent entIdent babelArgs body baseExpr + yield! declareType com ctx ent entIdent babelArgs body baseExpr classMembers yield declareModuleMember info.IsPublic consIdent false exposedCons ] @@ -2093,23 +2019,22 @@ module Util = [transformModuleFunction com ctx memb.Info memb.Ident memb.Args memb.Body] | Fable.ClassDeclaration(ent, entIdent, cons, baseCall, attachedMembers) -> - let cons = - match cons with - | Some cons -> - withCurrentScope ctx cons.UsedNames <| fun ctx -> - transformImplicitConstructor com ctx ent entIdent cons.Ident cons.Info cons.Args cons.Body baseCall - | None when ent.IsFSharpUnion -> transformUnionConstructor com ctx ent entIdent - | None -> transformCompilerGeneratedConstructor com ctx ent entIdent - - let attachedMembers = - attachedMembers |> List.collect (fun memb -> + let classMembers = + attachedMembers + |> List.toArray + |> Array.collect (fun memb -> withCurrentScope ctx memb.UsedNames <| fun ctx -> if memb.Info.IsGetter || memb.Info.IsSetter then transformAttachedProperty com ctx ent memb.Ident memb.Info memb.Args memb.Body else transformAttachedMethod com ctx ent memb.Ident memb.Info memb.Args memb.Body) - cons @ attachedMembers + match cons with + | Some cons -> + withCurrentScope ctx cons.UsedNames <| fun ctx -> + transformClassWithImplicitConstructor com ctx ent entIdent cons.Ident cons.Info cons.Args cons.Body baseCall classMembers + | None when ent.IsFSharpUnion -> transformUnion com ctx ent entIdent classMembers + | None -> transformClassWithCompilerGeneratedConstructor com ctx ent entIdent classMembers let transformImports (imports: Import seq): U2 list = imports |> Seq.map (fun import -> diff --git a/src/Fable.Transforms/Global/Compiler.fs b/src/Fable.Transforms/Global/Compiler.fs index d24c00c5c..ca0b8a33d 100644 --- a/src/Fable.Transforms/Global/Compiler.fs +++ b/src/Fable.Transforms/Global/Compiler.fs @@ -9,7 +9,6 @@ type Verbosity = type CompilerOptions = { typedArrays: bool clampByteArrays: bool - classTypes: bool typescript: bool debugMode: bool verbosity: Verbosity diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index 84bfabf8b..c6d7d56e8 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -291,6 +291,9 @@ let coreModFor = function | BclDictionary _ -> "MutableMap" | BclKeyValuePair _ -> failwith "Cannot decide core module" +let makeThrow com r t err = + Helper.LibCall(com, "Util", "raise", t, [err], ?loc=r) + let makeLongInt com r t signed (x: uint64) = let lowBits = NumberConstant (float (uint32 x), Float64) let highBits = NumberConstant (float (x >>> 32), Float64) @@ -997,7 +1000,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp let runtimeMsg = "A function supposed to be replaced by JS native code has been called, please check." |> StringConstant |> makeValue None - makeThrow r (error runtimeMsg) |> Some + makeThrow com r t (error runtimeMsg) |> Some | _, ("nameof"|"nameof2" as meth) -> match args with | [Nameof com ctx name as arg] -> @@ -1305,18 +1308,18 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o ), _ -> fsharpModule com ctx r t i thisArg args // Exceptions | "FailWith", [msg] | "InvalidOp", [msg] -> - makeThrow r (error msg) |> Some + makeThrow com r t (error msg) |> Some | "InvalidArg", [argName; msg] -> let msg = add (add msg (s "\\nParameter name: ")) argName - makeThrow r (error msg) |> Some - | "Raise", [arg] -> makeThrow r arg |> Some + makeThrow com r t (error msg) |> Some + | "Raise", [arg] -> makeThrow com r t arg |> Some | "Reraise", _ -> match ctx.CaughtException with - | Some ex -> makeThrow r (IdentExpr ex) |> Some + | Some ex -> makeThrow com r t (IdentExpr ex) |> Some | None -> "`reraise` used in context where caught exception is not available, please report" |> addError com ctx.InlinePath r - makeThrow r (error (s "")) |> Some + makeThrow com r t (error (s "")) |> Some // Math functions // TODO: optimize square pow: x * x | "Pow", _ | "PowInteger", _ | "op_Exponentiation", _ -> diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index dc186de76..88a615fec 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -414,9 +414,6 @@ module AST = let emitJsStatement r args macro = Emit({ Macro = macro; Args = args; IsJsStatement = true }, Unit, r) - let makeThrow range errorExpr = - emitJsStatement range [errorExpr] "throw $0" - let makeDebugger range = emitJsStatement range [] "debugger" diff --git a/src/fable-compiler-js/src/Platform.fs b/src/fable-compiler-js/src/Platform.fs index c4ca63e7b..4bede62c4 100644 --- a/src/fable-compiler-js/src/Platform.fs +++ b/src/fable-compiler-js/src/Platform.fs @@ -6,7 +6,6 @@ type CmdLineOptions = { commonjs: bool optimize: bool sourceMaps: bool - classTypes: bool typescript: bool watchMode: bool } diff --git a/src/fable-compiler-js/src/app.fs b/src/fable-compiler-js/src/app.fs index 44a4a5aaf..7d1afc9d3 100644 --- a/src/fable-compiler-js/src/app.fs +++ b/src/fable-compiler-js/src/app.fs @@ -27,7 +27,6 @@ let printErrors showWarnings (errors: Fable.Standalone.Error[]) = let toFableCompilerConfig (options: CmdLineOptions): Fable.Standalone.CompilerConfig = { typedArrays = false clampByteArrays = false - classTypes = options.classTypes typescript = options.typescript precompiledLib = None } @@ -98,7 +97,6 @@ let run opts projectFileName outDir = commonjs = Option.isSome commandToRun || opts |> Array.contains "--commonjs" optimize = opts |> Array.contains "--optimize-fcs" sourceMaps = opts |> Array.contains "--sourceMaps" - classTypes = opts |> Array.contains "--classTypes" typescript = opts |> Array.contains "--typescript" watchMode = opts |> Array.contains "--watch" } diff --git a/src/fable-library/Types.ts b/src/fable-library/Types.ts index 4752a9d73..07dee3857 100644 --- a/src/fable-library/Types.ts +++ b/src/fable-library/Types.ts @@ -5,33 +5,6 @@ function sameType(x: any, y: any) { return y != null && Object.getPrototypeOf(x).constructor === Object.getPrototypeOf(y).constructor; } -// Taken from Babel helpers -function inherits(subClass: any, superClass: any) { - // if (typeof superClass !== "function" && superClass !== null) { - // throw new TypeError( - // "Super expression must either be null or a function, not " + - // typeof superClass - // ); - // } - subClass.prototype = Object.create(superClass && superClass.prototype, { - constructor: { - value: subClass, - enumerable: false, - writable: true, - configurable: true, - }, - }); - // if (superClass) - // Object.setPrototypeOf - // ? Object.setPrototypeOf(subClass, superClass) - // : (subClass.__proto__ = superClass); - } - - export function declare(cons: any, superClass?: any) { - inherits(cons, superClass || SystemObject); - return cons; -} - export class SystemObject implements IEquatable { public toString() { @@ -258,45 +231,33 @@ export class FSharpRef extends Record { // EXCEPTIONS -// export class Exception extends Error { -// constructor(message?: string) { -// super(message) -// if (Error.captureStackTrace) { -// Error.captureStackTrace(this, Exception) -// } -// } - -// public toString() { -// return this.ToString(); -// } - -// public ToString() { -// return Object.getPrototypeOf(this).constructor.name; -// } - -// public GetHashCode(x?: any) { -// return identityHash(x ?? this); -// } - -// public Equals(x: any, y?: any) { -// return x === (y ?? this); -// } -// } - -export interface Exception extends SystemObject { - stack?: string; - message?: string; -} +export class Exception extends Error { + constructor(message?: string) { + super(message) + if (Error.captureStackTrace) { + Error.captureStackTrace(this, Exception) + } + } -// TODO: When moving to classTypes we can change this to a class extending error -// See above and https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Error (Custom Error Types) -export const Exception = declare(function Exception(this: Exception, message?: string) { - this.stack = Error().stack; - this.message = message; -}, SystemObject); + public toString() { + return this.ToString(); + } + + public ToString() { + return Object.getPrototypeOf(this).constructor.name; + } + + public GetHashCode(x?: any) { + return identityHash(x ?? this); + } + + public Equals(x: any, y?: any) { + return x === (y ?? this); + } +} export function isException(x: any) { - return x instanceof Error || x instanceof Exception; + return x instanceof Error; } function getFSharpExceptionFieldNames(self: any) { @@ -350,4 +311,5 @@ export class MatchFailureException extends FSharpException { } } -export const Attribute = declare(function Attribute() { return; }, SystemObject); +export class Attribute extends SystemObject { +} diff --git a/src/fable-library/Util.ts b/src/fable-library/Util.ts index ce84d0b5f..11b95e47d 100644 --- a/src/fable-library/Util.ts +++ b/src/fable-library/Util.ts @@ -797,3 +797,7 @@ export function getItemFromDict(map: Map, key: K) { throw new Error(`The given key '${key}' was not present in the dictionary.`); } } + +export function raise(err: Error): T { + throw err; +} \ No newline at end of file diff --git a/src/fable-standalone/src/Interfaces.fs b/src/fable-standalone/src/Interfaces.fs index 09216035d..5cb71aedb 100644 --- a/src/fable-standalone/src/Interfaces.fs +++ b/src/fable-standalone/src/Interfaces.fs @@ -50,7 +50,6 @@ type IBabelResult = type CompilerConfig = { typedArrays: bool clampByteArrays: bool - classTypes: bool typescript: bool precompiledLib: (string -> (string * string) option) option } diff --git a/src/fable-standalone/src/Main.fs b/src/fable-standalone/src/Main.fs index d87a74329..420e79aea 100644 --- a/src/fable-standalone/src/Main.fs +++ b/src/fable-standalone/src/Main.fs @@ -216,7 +216,6 @@ let getCompletionsAtLocation (parseResults: ParseResults) (line: int) (col: int) let defaultCompilerConfig: CompilerConfig = { typedArrays = false clampByteArrays = false - classTypes = false typescript = false precompiledLib = None } @@ -225,7 +224,6 @@ let makeCompilerOptions (config: CompilerConfig option) (otherFSharpOptions: str let isDebug = otherFSharpOptions |> Array.exists (fun x -> x = "--define:DEBUG" || x = "-d:DEBUG") { typedArrays = config.typedArrays clampByteArrays = config.clampByteArrays - classTypes = config.classTypes typescript = config.typescript debugMode = isDebug verbosity = Fable.Verbosity.Normal diff --git a/src/fable-standalone/src/Worker/Worker.fs b/src/fable-standalone/src/Worker/Worker.fs index f1bd4a6f0..c36065c5f 100644 --- a/src/fable-standalone/src/Worker/Worker.fs +++ b/src/fable-standalone/src/Worker/Worker.fs @@ -115,7 +115,6 @@ let rec loop (box: MailboxProcessor) (state: State) = async { let nonFSharpOptions = Map [ "--typedArrays", false "--clampByteArrays", false - "--classTypes", false "typescript", false ] let nonFSharpOptions, otherFSharpOptions = @@ -130,7 +129,6 @@ let rec loop (box: MailboxProcessor) (state: State) = async { let fableConfig = { typedArrays = Map.find "--typedArrays" nonFSharpOptions clampByteArrays = Map.find "--clampByteArrays" nonFSharpOptions - classTypes = Map.find "--classTypes" nonFSharpOptions typescript = Map.find "--typescript" nonFSharpOptions precompiledLib = Some (fun x -> resolveLibCall(fable.LibMap, x)) } fable.Manager.CompileToBabelAst("fable-library", parseResults, FILE_NAME, fableConfig)) () diff --git a/src/fable-standalone/test/bench-compiler/Platform.fs b/src/fable-standalone/test/bench-compiler/Platform.fs index 4a3bb5f08..8156522a4 100644 --- a/src/fable-standalone/test/bench-compiler/Platform.fs +++ b/src/fable-standalone/test/bench-compiler/Platform.fs @@ -4,7 +4,6 @@ type CmdLineOptions = { commonjs: bool optimize: bool sourceMaps: bool - classTypes: bool typescript: bool watchMode: bool } diff --git a/src/fable-standalone/test/bench-compiler/app.fs b/src/fable-standalone/test/bench-compiler/app.fs index 0c1265636..9b9b66b66 100644 --- a/src/fable-standalone/test/bench-compiler/app.fs +++ b/src/fable-standalone/test/bench-compiler/app.fs @@ -21,7 +21,6 @@ let printErrors showWarnings (errors: Fable.Standalone.Error[]) = let toFableCompilerConfig (options: CmdLineOptions): Fable.Standalone.CompilerConfig = { typedArrays = false clampByteArrays = false - classTypes = options.classTypes typescript = options.typescript precompiledLib = None } @@ -100,7 +99,6 @@ let parseArguments (argv: string[]) = commonjs = opts |> Array.contains "--commonjs" optimize = opts |> Array.contains "--optimize-fcs" sourceMaps = opts |> Array.contains "--sourceMaps" - classTypes = opts |> Array.contains "--classTypes" typescript = opts |> Array.contains "--typescript" watchMode = opts |> Array.contains "--watch" } From 5dadb220e32f7be9780b340405ea6940609f09b7 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Sat, 22 Aug 2020 01:43:52 +0900 Subject: [PATCH 6/8] Fix tests --- .vscode/launch.json | 6 +- src/Fable.Core/Fable.Core.JsInterop.fs | 8 +- src/Fable.Transforms/AST/AST.Fable.fs | 5 + src/Fable.Transforms/FSharp2Fable.Util.fs | 80 ++++++---- src/Fable.Transforms/FSharp2Fable.fs | 22 ++- src/Fable.Transforms/Fable2Babel.fs | 5 +- src/Fable.Transforms/FableTransforms.fs | 1 - src/Fable.Transforms/Inject.fs | 4 +- src/Fable.Transforms/OverloadSuffix.fs | 2 + src/Fable.Transforms/Replacements.fs | 174 +++++++++++----------- src/Fable.Transforms/Transforms.Util.fs | 9 +- src/fable-library/Util.ts | 4 - tests/DllRef/Lib2.fs | 2 + tests/DllRef/js2/lib.js | 6 + tests/Main/JsInteropTests.fs | 11 +- 15 files changed, 186 insertions(+), 153 deletions(-) diff --git a/.vscode/launch.json b/.vscode/launch.json index 7c5cacf78..9430f8af0 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -28,11 +28,11 @@ "name": ".NET Core Launch (console)", "type": "coreclr", "request": "launch", - "program": "${workspaceRoot}/src/Fable.Cli/bin/Debug/netcoreapp2.1/Fable.Cli.dll", - "args": ["fable-splitter", "--args", "-c tests/splitter.config.js"], + "program": "${workspaceRoot}/src/Fable.Cli/bin/Debug/netcoreapp3.1/Fable.Cli.dll", + "args": ["start","--port", "61225"], "cwd": "${workspaceRoot}", "stopAtEntry": false, - "console": "internalConsole" + "console": "internalConsole", }, { "name": ".NET Core Attach", diff --git a/src/Fable.Core/Fable.Core.JsInterop.fs b/src/Fable.Core/Fable.Core.JsInterop.fs index d379451ef..271e0a003 100644 --- a/src/Fable.Core/Fable.Core.JsInterop.fs +++ b/src/Fable.Core/Fable.Core.JsInterop.fs @@ -44,7 +44,7 @@ let emitJsStatement<'T> (args: obj) (jsCode: string): 'T = jsNative /// Create a literal JS object from a collection of key-value tuples. /// E.g. `createObj [ "a" ==> 5 ]` in JS becomes `{ a: 5 }` -let createObj (fields: #seq): obj = jsNative +let createObj (fields: seq): obj = jsNative /// Create a literal JS object from a collection of union constructors. /// E.g. `keyValueList CaseRules.LowerFirst [ MyUnion 4 ]` in JS becomes `{ myUnion: 4 }` @@ -97,12 +97,6 @@ let importValueDynamic (x: 'T): JS.Promise<'T> = jsNative /// Used when you need to send an F# record to a JS library accepting only plain JS objects (POJOs) let toPlainJsObj(o: 'T): obj = jsNative -/// Compiles to JS `this` keyword. -/// -/// ## Sample -/// jqueryMethod(fun x y -> jsThis?add(x, y)) -let [] jsThis<'T> : 'T = jsNative - /// JS `in` operator let [] isIn (key: string) (target: obj): bool = jsNative diff --git a/src/Fable.Transforms/AST/AST.Fable.fs b/src/Fable.Transforms/AST/AST.Fable.fs index 349b8d130..d24380d89 100644 --- a/src/Fable.Transforms/AST/AST.Fable.fs +++ b/src/Fable.Transforms/AST/AST.Fable.fs @@ -63,6 +63,8 @@ type Parameter = abstract Name: string option abstract Type: Type +// TODO: More properties needed here Attributes, IsPublic, IsInstance... +// Merge with MemberDeclInfo somehow? type MemberFunctionOrValue = abstract DisplayName: string abstract CompiledName: string @@ -72,6 +74,7 @@ type MemberFunctionOrValue = abstract IsExplicitInterfaceImplementation: bool abstract ApparentEnclosingEntity: Entity +// TODO: Add FableDeclarationName to be able to get a reference to the entity type Entity = abstract DisplayName: string abstract FullName: string @@ -105,6 +108,8 @@ type MemberDeclInfo = abstract IsMangled: bool type MemberDecl = { + // TODO: It may be better to just use the declaration name instead + // of the entity, same for class declarations Ident: Ident Args: Ident list Body: Expr diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index b5de29ec8..f4d1b94fb 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -56,7 +56,7 @@ type FsUnionCase(uci: FSharpUnionCase) = type FsAtt(att: FSharpAttribute) = interface Fable.Attribute with member _.FullName = defaultArg att.AttributeType.TryFullName "" - member _.ConstructorArguments = [] + member _.ConstructorArguments = att.ConstructorArguments |> Seq.mapToList snd type FsGenParam(gen: FSharpGenericParameter) = interface Fable.GenericParam with @@ -642,26 +642,33 @@ module Patterns = | true, kind -> Some kind | false, _ -> None - let (|OptionUnion|ListUnion|ErasedUnion|StringEnum|DiscriminatedUnion|) (NonAbbreviatedType typ: FSharpType) = + let (|OptionUnion|ListUnion|ErasedUnion|ErasedUnionCase|StringEnum|DiscriminatedUnion|) + (NonAbbreviatedType typ: FSharpType, unionCase: FSharpUnionCase) = let getCaseRule (att: FSharpAttribute) = match Seq.tryHead att.ConstructorArguments with | Some(_, (:? int as rule)) -> enum(rule) | _ -> CaseRules.LowerFirst - match tryDefinition typ with - | None -> failwith "Union without definition" - | Some(tdef, fullName) -> - match defaultArg fullName tdef.CompiledName with - | Types.valueOption - | Types.option -> OptionUnion typ.GenericArguments.[0] - | Types.list -> ListUnion typ.GenericArguments.[0] - | _ -> - tdef.Attributes |> Seq.tryPick (fun att -> - match att.AttributeType.TryFullName with - | Some Atts.erase -> Some (ErasedUnion(tdef, typ.GenericArguments, getCaseRule att)) - | Some Atts.stringEnum -> Some (StringEnum(tdef, getCaseRule att)) - | _ -> None) - |> Option.defaultValue (DiscriminatedUnion(tdef, typ.GenericArguments)) + unionCase.Attributes |> Seq.tryPick (fun att -> + match att.AttributeType.TryFullName with + | Some Atts.erase -> Some ErasedUnionCase + | _ -> None) + |> Option.defaultWith (fun () -> + match tryDefinition typ with + | None -> failwith "Union without definition" + | Some(tdef, fullName) -> + match defaultArg fullName tdef.CompiledName with + | Types.valueOption + | Types.option -> OptionUnion typ.GenericArguments.[0] + | Types.list -> ListUnion typ.GenericArguments.[0] + | _ -> + tdef.Attributes |> Seq.tryPick (fun att -> + match att.AttributeType.TryFullName with + | Some Atts.erase -> Some (ErasedUnion(tdef, typ.GenericArguments, getCaseRule att)) + | Some Atts.stringEnum -> Some (StringEnum(tdef, getCaseRule att)) + | _ -> None) + |> Option.defaultValue (DiscriminatedUnion(tdef, typ.GenericArguments)) + ) let (|ContainsAtt|_|) (fullName: string) (ent: FSharpEntity) = tryFindAtt fullName ent.Attributes @@ -924,6 +931,11 @@ module Util = let thisArg = { thisArg with IsThisArgument = true } let ctx = { ctx with BoundMemberThis = Some thisArg } ctx, [thisArg], restArgs1::restArgs2 + | (firstArg::restArgs1)::restArgs2 when firstArg.IsConstructorThisValue -> + let ctx, thisArg = putArgInScope com ctx firstArg + let thisArg = { thisArg with IsThisArgument = true } + let ctx = { ctx with BoundConstructorThis = Some thisArg } + ctx, [thisArg], restArgs1::restArgs2 | _ -> ctx, [], args let ctx, args = (args, (ctx, [])) ||> List.foldBack (fun tupledArg (ctx, accArgs) -> @@ -991,23 +1003,22 @@ module Util = let (|GlobalAtt|ImportAtt|NoGlobalNorImport|) (atts: Fable.Attribute seq) = let (|AttFullName|) (att: Fable.Attribute) = att.FullName, att - let (|AttArguments|) (att: Fable.Attribute) = att.ConstructorArguments atts |> Seq.tryPick (function | AttFullName(Atts.global_, att) -> - match att with - | AttArguments [:? string as customName] -> GlobalAtt(Some customName) |> Some + match att.ConstructorArguments with + | [:? string as customName] -> GlobalAtt(Some customName) |> Some | _ -> GlobalAtt(None) |> Some | AttFullName(Naming.StartsWith Atts.import _ as fullName, att) -> - match fullName, att with - | Atts.importAll, AttArguments [(:? string as path)] -> + match fullName, att.ConstructorArguments with + | Atts.importAll, [(:? string as path)] -> ImportAtt("*", path.Trim()) |> Some - | Atts.importDefault, AttArguments [(:? string as path)] -> + | Atts.importDefault, [(:? string as path)] -> ImportAtt("default", path.Trim()) |> Some - | Atts.importMember, AttArguments [(:? string as path)] -> + | Atts.importMember, [(:? string as path)] -> ImportAtt(Naming.placeholder, path.Trim()) |> Some - | _, AttArguments [(:? string as selector); (:? string as path)] -> + | _, [(:? string as selector); (:? string as path)] -> ImportAtt(selector.Trim(), path.Trim()) |> Some | _ -> None @@ -1043,7 +1054,7 @@ module Util = let selector = if selector = Naming.placeholder then ent.DisplayName else selector - fixImportedRelativePath com ent.SourcePath path + fixImportedRelativePath com path ent.SourcePath |> makeCustomImport Fable.Any selector |> Some | _ -> None @@ -1216,10 +1227,23 @@ module Util = |> addErrorAndReturnNull com ctx.InlinePath r |> Some | _ -> None - let (|Emitted|_|) com r typ thisArg args (memb: FSharpMemberOrFunctionOrValue) = + let (|Emitted|_|) com r typ thisArg args hasSpread (memb: FSharpMemberOrFunctionOrValue) = + let (|SplitLast|_|) = function + | [] -> None + | xs -> List.splitLast xs |> Some + memb.Attributes |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with | Some(Naming.StartsWith Atts.emit _ as attFullName) -> + let args = + match hasSpread, args with + | _, [Fable.Value(Fable.UnitConstant, _)] -> [] + | true, SplitLast(args, Fable.Value(Fable.NewArray(args2, _),_)) -> args @ args2 + | true, _ -> + "Don't pass an array to ParamArray for methods tha emit JS" + |> addErrorAndReturnNull com [] r + |> List.singleton + | _ -> args let args = (Option.toList thisArg) @ args let args = // Allow combination of Import and Emit attributes @@ -1357,7 +1381,7 @@ module Util = let makeCallWithArgInfo com ctx r typ genArgs callee (memb: FSharpMemberOrFunctionOrValue) (callInfo: Fable.CallInfo) = match memb, memb.DeclaringEntity with - | Emitted com r typ callInfo.ThisArg callInfo.Args emitted, _ -> emitted + | Emitted com r typ callInfo.ThisArg callInfo.Args callInfo.HasSpread emitted, _ -> emitted | Imported com r typ (Some callInfo) imported -> imported | Replaced com ctx r typ genArgs callInfo replaced -> replaced | Inlined com ctx r genArgs callee callInfo.Args expr, _ -> expr @@ -1401,7 +1425,7 @@ module Util = sprintf "Value %s is replaced with unit constant" v.DisplayName |> addWarning com ctx.InlinePath r Fable.Value(Fable.UnitConstant, r) - | Emitted com r typ None [] emitted, _ -> emitted + | Emitted com r typ None [] false emitted, _ -> emitted | Imported com r typ None imported -> imported | Try (tryGetIdentFromScope ctx r) expr, _ -> expr | _ -> memberRefTyped com ctx r typ v diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 98449c65b..8b550f0aa 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -32,7 +32,7 @@ let private transformBaseConsCall com ctx r (baseEnt: FSharpEntity) (baseCons: F let argTypes = lazy getArgTypes com baseCons let baseArgs = transformExprList com ctx baseArgs |> run let genArgs = genArgs |> Seq.map (makeType ctx.GenericArgs) - match Replacements.tryBaseConstructor com baseEnt argTypes genArgs baseArgs with + match Replacements.tryBaseConstructor com ctx baseEnt argTypes genArgs baseArgs with | Some(baseRef, args) -> let callInfo: Fable.CallInfo = { ThisArg = None @@ -53,8 +53,10 @@ let private transformBaseConsCall com ctx r (baseEnt: FSharpEntity) (baseCons: F | e -> e // Unexpected, throw error? let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (argExprs: Fable.Expr list) = - match fsType with - | ErasedUnion(tdef, genArgs, rule) -> + match fsType, unionCase with + | ErasedUnionCase -> + Fable.NewTuple argExprs |> makeValue r + | ErasedUnion(tdef, _genArgs, rule) -> match argExprs with | [] -> transformStringEnum rule unionCase | [argExpr] -> argExpr @@ -281,7 +283,10 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r unionExpr fsType (unionCase: FSharpUnionCase) = trampoline { let! unionExpr = transformExpr com ctx unionExpr - match fsType with + match fsType, unionCase with + | ErasedUnionCase -> + return "Cannot test erased union cases" + |> addErrorAndReturnNull com ctx.InlinePath r | ErasedUnion(tdef, genArgs, rule) -> match unionCase.UnionCaseFields.Count with | 0 -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqualStrict @@ -606,7 +611,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = let errorMessage = "The match cases were incomplete" let rangeOfElseExpr = makeRangeFrom elseExpr let errorExpr = Replacements.Helpers.error (Fable.Value(Fable.StringConstant errorMessage, None)) - Replacements.makeThrow com rangeOfElseExpr Fable.Any errorExpr + makeThrow rangeOfElseExpr Fable.Any errorExpr | _ -> fableElseExpr @@ -660,7 +665,10 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = | BasicPatterns.UnionCaseGet (unionExpr, fsType, unionCase, field) -> let r = makeRangeFrom fsExpr let! unionExpr = transformExpr com ctx unionExpr - match fsType with + match fsType, unionCase with + | ErasedUnionCase -> + let index = unionCase.UnionCaseFields |> Seq.findIndex (fun x -> x.Name = field.Name) + return Fable.Get(unionExpr, Fable.TupleIndex(index), makeType ctx.GenericArgs fsType, r) | ErasedUnion _ -> if unionCase.UnionCaseFields.Count = 1 then return unionExpr else @@ -802,7 +810,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = fileNameWhereErrorOccurs let errorExpr = Replacements.Helpers.error (Fable.Value(Fable.StringConstant errorMessage, None)) // Creates a "throw Error({errorMessage})" expression - let throwExpr = Replacements.makeThrow com rangeOfLastDecisionTarget Fable.Any errorExpr + let throwExpr = makeThrow rangeOfLastDecisionTarget Fable.Any errorExpr fableDecisionTargets |> List.replaceLast (fun _lastExpr -> [], throwExpr) diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index dab9a018e..124131f25 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -1495,8 +1495,7 @@ module Util = | Fable.Emit(info, t, range) -> let e = transformEmit com ctx range info if info.IsJsStatement then - // Ignore the return strategy - [|ExpressionStatement(e)|] + [|ExpressionStatement(e)|] // Ignore the return strategy else [|resolveExpr t returnStrategy e|] | Fable.Operation(kind, t, range) -> @@ -1909,7 +1908,7 @@ module Util = |> Seq.map (getUnionCaseName >> makeStrConst) |> Seq.toList |> makeArray com ctx - |> ExpressionStatement :> Statement + |> ReturnStatement :> Statement |> Array.singleton |> BlockStatement ClassMethod(ClassFunction, Identifier "cases", [||], body) |> U2<_, ClassProperty>.Case1 diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 3a6dc4996..e051a0794 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -2,7 +2,6 @@ module Fable.Transforms.FableTransforms open Fable open Fable.AST.Fable -open FSharp.Compiler.SourceCodeServices // TODO: Use trampoline here? let visit f e = diff --git a/src/Fable.Transforms/Inject.fs b/src/Fable.Transforms/Inject.fs index 76b36a54c..46bb932c1 100644 --- a/src/Fable.Transforms/Inject.fs +++ b/src/Fable.Transforms/Inject.fs @@ -32,9 +32,9 @@ let (|GeneratedInterface|_|) com ctx r t = let fn = Fable.Value(Fable.TypeInfo t, r) |> makeDelegate [] Replacements.Helpers.objExpr ["ResolveType", fn] |> Some | Types.comparer -> - Replacements.makeComparer com t |> Some + Replacements.makeComparer com ctx t |> Some | Types.equalityComparer -> - Replacements.makeEqualityComparer com t |> Some + Replacements.makeEqualityComparer com ctx t |> Some | Types.adder -> Replacements.makeGenericAdder com ctx t |> Some | Types.averager -> diff --git a/src/Fable.Transforms/OverloadSuffix.fs b/src/Fable.Transforms/OverloadSuffix.fs index b033a42f9..c58a28c17 100644 --- a/src/Fable.Transforms/OverloadSuffix.fs +++ b/src/Fable.Transforms/OverloadSuffix.fs @@ -135,6 +135,8 @@ let hasEmptyOverloadSuffix (curriedParamTypes: ParamTypes) = let getHash (entity: FSharpEntity) (m: FSharpMemberOrFunctionOrValue) = // Members with curried params cannot be overloaded in F# + // TODO: Also private methods defined with `let` cannot be overloaded + // but I don't know how to identify them in the AST if m.CurriedParameterGroups.Count <> 1 then "" else let paramTypes = m.CurriedParameterGroups.[0] |> Seq.map (fun p -> p.Type) |> Seq.toList diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index c6d7d56e8..0e9550aac 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -291,8 +291,9 @@ let coreModFor = function | BclDictionary _ -> "MutableMap" | BclKeyValuePair _ -> failwith "Cannot decide core module" -let makeThrow com r t err = - Helper.LibCall(com, "Util", "raise", t, [err], ?loc=r) +let makeUniqueIdent ctx t name = + FSharp2Fable.Helpers.getIdentUniqueName ctx name + |> makeTypedIdent t let makeLongInt com r t signed (x: uint64) = let lowBits = NumberConstant (float (uint32 x), Float64) @@ -713,7 +714,7 @@ let identityHash com r (arg: Expr) = let structuralHash com r (arg: Expr) = Helper.LibCall(com, "Util", "structuralHash", Number Int32, [arg], ?loc=r) -let rec equals (com: ICompiler) r equal (left: Expr) (right: Expr) = +let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) = let is equal expr = if equal then expr @@ -730,7 +731,7 @@ let rec equals (com: ICompiler) r equal (left: Expr) (right: Expr) = | Builtin(BclInt64|BclUInt64|BclDecimal|BclBigInt as bt) -> Helper.LibCall(com, coreModFor bt, "equals", Boolean, [left; right], ?loc=r) |> is equal | Array t -> - let f = makeComparerFunction com t + let f = makeComparerFunction com ctx t Helper.LibCall(com, "Array", "equalsWith", Boolean, [f; left; right], ?loc=r) |> is equal | List _ -> Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal @@ -742,7 +743,7 @@ let rec equals (com: ICompiler) r equal (left: Expr) (right: Expr) = Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal /// Compare function that will call Util.compare or instance `CompareTo` as appropriate -and compare (com: ICompiler) r (left: Expr) (right: Expr) = +and compare (com: ICompiler) ctx r (left: Expr) (right: Expr) = match left.Type with | Builtin(BclGuid|BclTimeSpan) | Boolean | Char | String | Number _ | Enum _ -> @@ -752,7 +753,7 @@ and compare (com: ICompiler) r (left: Expr) (right: Expr) = | Builtin(BclInt64|BclUInt64|BclDecimal|BclBigInt as bt) -> Helper.LibCall(com, coreModFor bt, "compare", Number Int32, [left; right], ?loc=r) | Array t -> - let f = makeComparerFunction com t + let f = makeComparerFunction com ctx t Helper.LibCall(com, "Array", "compareWith", Number Int32, [f; left; right], ?loc=r) | List _ -> Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r) @@ -764,28 +765,28 @@ and compare (com: ICompiler) r (left: Expr) (right: Expr) = Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r) /// Wraps comparison with the binary operator, like `comparison < 0` -and compareIf (com: ICompiler) r (left: Expr) (right: Expr) op = +and compareIf (com: ICompiler) ctx r (left: Expr) (right: Expr) op = match left.Type with | Builtin(BclGuid|BclTimeSpan) | Boolean | Char | String | Number _ | Enum _ -> makeEqOp r left right op | _ -> - let comparison = compare com r left right + let comparison = compare com ctx r left right makeEqOp r comparison (makeIntConst 0) op -and makeComparerFunction (com: ICompiler) typArg = - let x = makeTypedIdent typArg "x" - let y = makeTypedIdent typArg "y" - let body = compare com None (IdentExpr x) (IdentExpr y) +and makeComparerFunction (com: ICompiler) ctx typArg = + let x = makeUniqueIdent ctx typArg "x" + let y = makeUniqueIdent ctx typArg "y" + let body = compare com ctx None (IdentExpr x) (IdentExpr y) Delegate([x; y], body, None) -and makeComparer (com: ICompiler) typArg = - objExpr ["Compare", makeComparerFunction com typArg] +and makeComparer (com: ICompiler) ctx typArg = + objExpr ["Compare", makeComparerFunction com ctx typArg] -let makeEqualityComparer (com: ICompiler) typArg = - let x = makeTypedIdent typArg "x" - let y = makeTypedIdent typArg "y" - let body = equals com None true (IdentExpr x) (IdentExpr y) +let makeEqualityComparer (com: ICompiler) ctx typArg = + let x = makeUniqueIdent ctx typArg "x" + let y = makeUniqueIdent ctx typArg "y" + let body = equals com ctx None true (IdentExpr x) (IdentExpr y) let f = Delegate([x; y], body, None) objExpr ["Equals", f "GetHashCode", makeLibRef com Any "structuralHash" "Util"] @@ -796,34 +797,34 @@ let inline makeComparerFromEqualityComparer e = // Helper.LibCall(com, "Util", "comparerFromEqualityComparer", Any, [e]) /// Adds comparer as last argument for set creator methods -let makeSet (com: ICompiler) r t methName args genArg = - let args = args @ [makeComparer com genArg] +let makeSet (com: ICompiler) ctx r t methName args genArg = + let args = args @ [makeComparer com ctx genArg] Helper.LibCall(com, "Set", Naming.lowerFirst methName, t, args, ?loc=r) /// Adds comparer as last argument for map creator methods -let makeMap (com: ICompiler) r t methName args genArg = - let args = args @ [makeComparer com genArg] +let makeMap (com: ICompiler) ctx r t methName args genArg = + let args = args @ [makeComparer com ctx genArg] Helper.LibCall(com, "Map", Naming.lowerFirst methName, t, args, ?loc=r) let makeDictionaryWithComparer com r t sourceSeq comparer = Helper.LibCall(com, "Map", "createMutable", t, [sourceSeq; comparer], ?loc=r) -let makeDictionary (com: ICompiler) r t sourceSeq = +let makeDictionary (com: ICompiler) ctx r t sourceSeq = match t with | DeclaredType(_,[key;_]) when not(isCompatibleWithJsComparison key) -> - // makeComparer com key - makeEqualityComparer com key + // makeComparer com ctx key + makeEqualityComparer com ctx key |> makeDictionaryWithComparer com r t sourceSeq | _ -> Helper.GlobalCall("Map", t, [sourceSeq], isJsConstructor=true, ?loc=r) let makeHashSetWithComparer com r t sourceSeq comparer = Helper.LibCall(com, "Set", "createMutable", t, [sourceSeq; comparer], ?loc=r) -let makeHashSet (com: ICompiler) r t sourceSeq = +let makeHashSet (com: ICompiler) ctx r t sourceSeq = match t with | DeclaredType(_,[key]) when not(isCompatibleWithJsComparison key) -> - // makeComparer com key - makeEqualityComparer com key + // makeComparer com ctx key + makeEqualityComparer com ctx key |> makeHashSetWithComparer com r t sourceSeq | _ -> Helper.GlobalCall("Set", t, [sourceSeq], isJsConstructor=true, ?loc=r) @@ -835,7 +836,7 @@ let rec getZero (com: ICompiler) ctx (t: Type) = | Builtin BclTimeSpan -> makeIntConst 0 | Builtin BclDateTime as t -> Helper.LibCall(com, "Date", "minValue", t, []) | Builtin BclDateTimeOffset as t -> Helper.LibCall(com, "DateOffset", "minValue", t, []) - | Builtin (FSharpSet genArg) as t -> makeSet com None t "Empty" [] genArg + | Builtin (FSharpSet genArg) as t -> makeSet com ctx None t "Empty" [] genArg | Builtin (BclInt64|BclUInt64) as t -> Helper.LibCall(com, "Long", "fromInt", t, [makeIntConst 0]) | Builtin BclBigInt as t -> Helper.LibCall(com, "BigInt", "fromInt32", t, [makeIntConst 0]) | Builtin BclDecimal as t -> makeIntConst 0 |> makeDecimalFromExpr com None t @@ -855,8 +856,8 @@ let getOne (com: ICompiler) ctx (t: Type) = | _ -> makeIntConst 1 let makeAddFunction (com: ICompiler) ctx t = - let x = makeTypedIdent t "x" - let y = makeTypedIdent t "y" + let x = makeUniqueIdent ctx t "x" + let y = makeUniqueIdent ctx t "y" let body = applyOp com ctx None t Operators.addition [IdentExpr x; IdentExpr y] [t; t] [] Delegate([x; y], body, None) @@ -868,8 +869,8 @@ let makeGenericAdder (com: ICompiler) ctx t = let makeGenericAverager (com: ICompiler) ctx t = let divideFn = - let x = makeTypedIdent t "x" - let i = makeTypedIdent (Number Int32) "i" + let x = makeUniqueIdent ctx t "x" + let i = makeUniqueIdent ctx (Number Int32) "i" let body = applyOp com ctx None t Operators.divideByInt [IdentExpr x; IdentExpr i] [t; Number Int32] [] Delegate([x; i], body, None) objExpr [ @@ -900,9 +901,9 @@ let injectArg com (ctx: Context) r moduleName methName (genArgs: (string * Type) let buildArg = function | (Types.comparer, GenericArg genArgs (_,genArg)) -> - makeComparer com genArg |> Some + makeComparer com ctx genArg |> Some | (Types.equalityComparer, GenericArg genArgs (_,genArg)) -> - makeEqualityComparer com genArg |> Some + makeEqualityComparer com ctx genArg |> Some | (Types.arrayCons, GenericArg genArgs (_,genArg)) -> arrayCons com genArg |> Some | (Types.adder, GenericArg genArgs (_,genArg)) -> @@ -1000,7 +1001,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp let runtimeMsg = "A function supposed to be replaced by JS native code has been called, please check." |> StringConstant |> makeValue None - makeThrow com r t (error runtimeMsg) |> Some + makeThrow r t (error runtimeMsg) |> Some | _, ("nameof"|"nameof2" as meth) -> match args with | [Nameof com ctx name as arg] -> @@ -1091,13 +1092,14 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp Some arg | Ok () -> Some arg | _ -> Some arg - | "op_Dynamic", [left; memb] -> getExpr r t left memb |> Some + | "op_Dynamic", [left; memb] -> + getExpr r t left memb |> Some | "op_DynamicAssignment", [callee; prop; MaybeLambdaUncurriedAtCompileTime value] -> Set(callee, Some(ExprKey prop), value, r) |> Some | ("op_Dollar"|"createNew" as m), callee::args -> let args = destructureTupleArgs args if m = "createNew" then "new $0($1...)" else "$0($1...)" - |> emitJsExpr r t args |> Some + |> emitJsExpr r t (callee::args) |> Some | Naming.StartsWith "emitJs" rest, [args; macro] -> match macro with | Fable.Value(Fable.StringConstant macro,_) -> @@ -1109,6 +1111,10 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | "op_EqualsEqualsGreater", [name; MaybeLambdaUncurriedAtCompileTime value] -> NewTuple [name; value] |> makeValue r |> Some | "createObj", _ -> + let args = + match args with + | [Value(ListLiteral(args,t),r)] -> [NewArray(args, t) |> makeValue r] + | _ -> args let m = if com.Options.debugMode then "createObjDebug" else "createObj" Helper.LibCall(com, "Util", m, Any, args) |> Some | "keyValueList", [caseRule; keyValueList] -> @@ -1120,8 +1126,6 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp Helper.GlobalCall("Object", Any, emptyObj::args, memb="assign", ?loc=r) |> Some | "jsOptions", [arg] -> makePojoFromLambda com arg |> Some - | "jsThis", _ -> - makeTypedIdent t "this" |> IdentExpr |> Some | "jsConstructor", _ -> match (genArg com ctx r 0 i.GenericArgs) with | DeclaredType(ent, _) -> jsConstructor com ent |> Some @@ -1150,8 +1154,8 @@ let getMangledNames (i: CallInfo) (thisArg: Expr option) = let isStatic = Option.isNone thisArg let pos = i.DeclaringEntityFullName.LastIndexOf('.') let moduleName = i.DeclaringEntityFullName.Substring(0, pos).Replace("Microsoft.", "") - let entityName = Naming.sanitizeIdentForbiddenChars (i.DeclaringEntityFullName.Substring(pos + 1)) - let memberName = Naming.sanitizeIdentForbiddenChars (i.CompiledName) + let entityName = i.DeclaringEntityFullName.Substring(pos + 1) |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier + let memberName = if i.CompiledName = ".ctor" then "$ctor" else FSharp2Fable.Helpers.cleanNameAsJsIdentifier i.CompiledName let mangledName = Naming.buildNameWithoutSanitationFrom entityName isStatic memberName i.OverloadSuffix.Value moduleName, mangledName @@ -1224,7 +1228,7 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o match t with | LambdaType(argType, retType) -> argType, retType | _ -> Any, Any - let tempVar = makeTypedIdent argType "arg" + let tempVar = makeUniqueIdent ctx argType "arg" let tempVarExpr = match argType with // Erase unit references, because the arg may be erased @@ -1261,8 +1265,8 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | "ToChar", _ -> toChar args.Head |> Some | "ToString", _ -> toString com ctx r args |> Some | "CreateSequence", [xs] -> toSeq t xs |> Some - | "CreateDictionary", [arg] -> makeDictionary com r t arg |> Some - | "CreateSet", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com r t "OfSeq" args |> Some + | "CreateDictionary", [arg] -> makeDictionary com ctx r t arg |> Some + | "CreateSet", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com ctx r t "OfSeq" args |> Some // Ranges | ("op_Range"|"op_RangeStep"), _ -> let genArg = genArg com ctx r 0 i.GenericArgs @@ -1308,18 +1312,18 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o ), _ -> fsharpModule com ctx r t i thisArg args // Exceptions | "FailWith", [msg] | "InvalidOp", [msg] -> - makeThrow com r t (error msg) |> Some + makeThrow r t (error msg) |> Some | "InvalidArg", [argName; msg] -> let msg = add (add msg (s "\\nParameter name: ")) argName - makeThrow com r t (error msg) |> Some - | "Raise", [arg] -> makeThrow com r t arg |> Some + makeThrow r t (error msg) |> Some + | "Raise", [arg] -> makeThrow r t arg |> Some | "Reraise", _ -> match ctx.CaughtException with - | Some ex -> makeThrow com r t (IdentExpr ex) |> Some + | Some ex -> makeThrow r t (IdentExpr ex) |> Some | None -> "`reraise` used in context where caught exception is not available, please report" |> addError com ctx.InlinePath r - makeThrow com r t (error (s "")) |> Some + makeThrow r t (error (s "")) |> Some // Math functions // TODO: optimize square pow: x * x | "Pow", _ | "PowInteger", _ | "op_Exponentiation", _ -> @@ -1378,18 +1382,18 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o |> emitJsExpr r t args |> Some // Concatenates two lists | "op_Append", _ -> Helper.LibCall(com, "List", "append", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | (Operators.inequality | "Neq"), [left; right] -> equals com r false left right |> Some - | (Operators.equality | "Eq"), [left; right] -> equals com r true left right |> Some + | (Operators.inequality | "Neq"), [left; right] -> equals com ctx r false left right |> Some + | (Operators.equality | "Eq"), [left; right] -> equals com ctx r true left right |> Some | "IsNull", [arg] -> makeEqOp r arg (Null arg.Type |> makeValue None) BinaryEqual |> Some | "Hash", [arg] -> structuralHash com r arg |> Some // Comparison - | "Compare", [left; right] -> compare com r left right |> Some - | (Operators.lessThan | "Lt"), [left; right] -> compareIf com r left right BinaryLess |> Some - | (Operators.lessThanOrEqual | "Lte"), [left; right] -> compareIf com r left right BinaryLessOrEqual |> Some - | (Operators.greaterThan | "Gt"), [left; right] -> compareIf com r left right BinaryGreater |> Some - | (Operators.greaterThanOrEqual | "Gte"), [left; right] -> compareIf com r left right BinaryGreaterOrEqual |> Some + | "Compare", [left; right] -> compare com ctx r left right |> Some + | (Operators.lessThan | "Lt"), [left; right] -> compareIf com ctx r left right BinaryLess |> Some + | (Operators.lessThanOrEqual | "Lte"), [left; right] -> compareIf com ctx r left right BinaryLessOrEqual |> Some + | (Operators.greaterThan | "Gt"), [left; right] -> compareIf com ctx r left right BinaryGreater |> Some + | (Operators.greaterThanOrEqual | "Gte"), [left; right] -> compareIf com ctx r left right BinaryGreaterOrEqual |> Some | ("Min"|"Max" as meth), _ -> - let f = makeComparerFunction com t + let f = makeComparerFunction com ctx t Helper.LibCall(com, "Util", Naming.lowerFirst meth, t, f::args, i.SignatureArgTypes, ?loc=r) |> Some | "Not", [operand] -> // TODO: Check custom operator? makeUnOp r t operand UnaryNot |> Some @@ -1568,10 +1572,10 @@ let seqs (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp let info = makeCallInfo None [IdentExpr ident] [] Call(projection, info, genArg, None) | None -> IdentExpr ident - let x = makeTypedIdent genArg "x" - let y = makeTypedIdent genArg "y" + let x = makeUniqueIdent ctx genArg "x" + let y = makeUniqueIdent ctx genArg "y" let comparison = - let comparison = compare com None (identExpr x) (identExpr y) + let comparison = compare com ctx None (identExpr x) (identExpr y) if descending then makeUnOp None (Fable.Number Int32) comparison UnaryMinus else comparison @@ -1679,7 +1683,7 @@ let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this | "Reverse", Some ar, [] -> Helper.InstanceCall(ar, "reverse", t, args, ?loc=r) |> Some | "Sort", Some ar, [] -> - let compareFn = (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com + let compareFn = (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com ctx Helper.InstanceCall(ar, "sort", t, [compareFn], ?loc=r) |> Some | "Sort", Some ar, [ExprType(Fable.DelegateType _)] -> Helper.InstanceCall(ar, "sort", t, args, ?loc=r) |> Some @@ -1757,7 +1761,7 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex | "SortInPlace", args -> let _, thisArg = List.splitLast args let argTypes = List.take (List.length args) i.SignatureArgTypes - let compareFn = (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com + let compareFn = (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com ctx Helper.InstanceCall(thisArg, "sort", t, [compareFn], argTypes, ?loc=r) |> Some | Patterns.DicContains nativeArrayFunctions meth, _ -> let args, thisArg = List.splitLast args @@ -1808,7 +1812,7 @@ let listModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Exp let sets (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with - | ".ctor" -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com r t "OfSeq" args |> Some + | ".ctor" -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com ctx r t "OfSeq" args |> Some | _ -> let isStatic = Option.isNone thisArg let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpSet" isStatic i.CompiledName i.OverloadSuffix.Value @@ -1822,7 +1826,7 @@ let setModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr let maps (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName with - | ".ctor" -> (genArg com ctx r 0 i.GenericArgs) |> makeMap com r t "OfSeq" args |> Some + | ".ctor" -> (genArg com ctx r 0 i.GenericArgs) |> makeMap com ctx r t "OfSeq" args |> Some | _ -> let isStatic = Option.isNone thisArg let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpMap" isStatic i.CompiledName i.OverloadSuffix.Value @@ -1950,10 +1954,10 @@ let decimals (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Helper.LibCall(com, "Decimal", "getBits", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("Parse" | "TryParse"), _ -> parseNum com ctx r t i thisArg args - | Operators.lessThan, [left; right] -> compareIf com r left right BinaryLess |> Some - | Operators.lessThanOrEqual, [left; right] -> compareIf com r left right BinaryLessOrEqual |> Some - | Operators.greaterThan, [left; right] -> compareIf com r left right BinaryGreater |> Some - | Operators.greaterThanOrEqual, [left; right] -> compareIf com r left right BinaryGreaterOrEqual |> Some + | Operators.lessThan, [left; right] -> compareIf com ctx r left right BinaryLess |> Some + | Operators.lessThanOrEqual, [left; right] -> compareIf com ctx r left right BinaryLessOrEqual |> Some + | Operators.greaterThan, [left; right] -> compareIf com ctx r left right BinaryGreater |> Some + | Operators.greaterThanOrEqual, [left; right] -> compareIf com ctx r left right BinaryGreaterOrEqual |> Some |(Operators.addition | Operators.subtraction | Operators.multiply @@ -2044,23 +2048,23 @@ let languagePrimitives (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | "GenericHashWithComparer" | "GenericHashWithComparerIntrinsic"), [comp; arg] -> Helper.InstanceCall(comp, "GetHashCode", t, [arg], i.SignatureArgTypes, ?loc=r) |> Some | ("GenericComparison" | "GenericComparisonIntrinsic"), [left; right] -> - compare com r left right |> Some + compare com ctx r left right |> Some | ("FastCompareTuple2" | "FastCompareTuple3" | "FastCompareTuple4" | "FastCompareTuple5" | "GenericComparisonWithComparer" | "GenericComparisonWithComparerIntrinsic"), [comp; left; right] -> Helper.InstanceCall(comp, "Compare", t, [left; right], i.SignatureArgTypes, ?loc=r) |> Some | ("GenericLessThan" | "GenericLessThanIntrinsic"), [left; right] -> - compareIf com r left right BinaryLess |> Some + compareIf com ctx r left right BinaryLess |> Some | ("GenericLessOrEqual" | "GenericLessOrEqualIntrinsic"), [left; right] -> - compareIf com r left right BinaryLessOrEqual |> Some + compareIf com ctx r left right BinaryLessOrEqual |> Some | ("GenericGreaterThan" | "GenericGreaterThanIntrinsic"), [left; right] -> - compareIf com r left right BinaryGreater |> Some + compareIf com ctx r left right BinaryGreater |> Some | ("GenericGreaterOrEqual" | "GenericGreaterOrEqualIntrinsic"), [left; right] -> - compareIf com r left right BinaryGreaterOrEqual |> Some + compareIf com ctx r left right BinaryGreaterOrEqual |> Some | ("GenericEquality" | "GenericEqualityIntrinsic"), [left; right] -> - equals com r true left right |> Some + equals com ctx r true left right |> Some | ("GenericEqualityER" | "GenericEqualityERIntrinsic"), [left; right] -> // TODO: In ER mode, equality on two NaNs returns "true". - equals com r true left right |> Some + equals com ctx r true left right |> Some | ("FastEqualsTuple2" | "FastEqualsTuple3" | "FastEqualsTuple4" | "FastEqualsTuple5" | "GenericEqualityWithComparer" | "GenericEqualityWithComparerIntrinsic"), [comp; left; right] -> Helper.InstanceCall(comp, "Equals", t, [left; right], i.SignatureArgTypes, ?loc=r) |> Some @@ -2157,9 +2161,9 @@ let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | ".ctor", _ -> match i.SignatureArgTypes, args with | ([]|[Number _]), _ -> - makeDictionary com r t (makeArray Any []) |> Some + makeDictionary com ctx r t (makeArray Any []) |> Some | [IDictionary], [arg] -> - makeDictionary com r t arg |> Some + makeDictionary com ctx r t arg |> Some | [IDictionary; IEqualityComparer], [arg; eqComp] -> makeComparerFromEqualityComparer eqComp |> makeDictionaryWithComparer com r t arg |> Some @@ -2195,9 +2199,9 @@ let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op | ".ctor", _, _ -> match i.SignatureArgTypes, args with | [], _ -> - makeHashSet com r t (makeArray Any []) |> Some + makeHashSet com ctx r t (makeArray Any []) |> Some | [IEnumerable], [arg] -> - makeHashSet com r t arg |> Some + makeHashSet com ctx r t arg |> Some | [IEnumerable; IEqualityComparer], [arg; eqComp] -> makeComparerFromEqualityComparer eqComp |> makeHashSetWithComparer com r t arg |> Some @@ -2967,7 +2971,7 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr |> Option.map (precompiledLib r t info thisArg args) | _ -> None -let tryBaseConstructor com (ent: Entity) (argTypes: Lazy) genArgs args = +let tryBaseConstructor com ctx (ent: Entity) (argTypes: Lazy) genArgs args = match ent.FullName with | Types.exception_ -> Some(makeLibRef com Any "Exception" "Types", args) | Types.attribute -> Some(makeLibRef com Any "Attribute" "Types", args) @@ -2975,9 +2979,9 @@ let tryBaseConstructor com (ent: Entity) (argTypes: Lazy) genArgs arg let args = match argTypes.Value, args with | ([]|[Number _]), _ -> - [makeArray Any []; makeEqualityComparer com (Seq.head genArgs)] + [makeArray Any []; makeEqualityComparer com ctx (Seq.head genArgs)] | [IDictionary], [arg] -> - [arg; makeEqualityComparer com (Seq.head genArgs)] + [arg; makeEqualityComparer com ctx (Seq.head genArgs)] | [IDictionary; IEqualityComparer], [arg; eqComp] -> [arg; makeComparerFromEqualityComparer eqComp] | [IEqualityComparer], [eqComp] @@ -2990,9 +2994,9 @@ let tryBaseConstructor com (ent: Entity) (argTypes: Lazy) genArgs arg let args = match argTypes.Value, args with | [], _ -> - [makeArray Any []; makeEqualityComparer com (Seq.head genArgs)] + [makeArray Any []; makeEqualityComparer com ctx (Seq.head genArgs)] | [IEnumerable], [arg] -> - [arg; makeEqualityComparer com (Seq.head genArgs)] + [arg; makeEqualityComparer com ctx (Seq.head genArgs)] | [IEnumerable; IEqualityComparer], [arg; eqComp] -> [arg; makeComparerFromEqualityComparer eqComp] | [IEqualityComparer], [eqComp] -> diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index 88a615fec..14a98a0fa 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -411,11 +411,14 @@ module AST = let emitJsExpr r t args macro = Emit({ Macro = macro; Args = args; IsJsStatement = false }, t, r) - let emitJsStatement r args macro = - Emit({ Macro = macro; Args = args; IsJsStatement = true }, Unit, r) + let emitJsStatement r t args macro = + Emit({ Macro = macro; Args = args; IsJsStatement = true }, t, r) + + let makeThrow r t err = + emitJsStatement r t [err] "throw $0" let makeDebugger range = - emitJsStatement range [] "debugger" + emitJsStatement range Unit [] "debugger" let destructureTupleArgs = function | [MaybeCasted(Value(UnitConstant,_))] -> [] diff --git a/src/fable-library/Util.ts b/src/fable-library/Util.ts index 11b95e47d..ce84d0b5f 100644 --- a/src/fable-library/Util.ts +++ b/src/fable-library/Util.ts @@ -797,7 +797,3 @@ export function getItemFromDict(map: Map, key: K) { throw new Error(`The given key '${key}' was not present in the dictionary.`); } } - -export function raise(err: Error): T { - throw err; -} \ No newline at end of file diff --git a/tests/DllRef/Lib2.fs b/tests/DllRef/Lib2.fs index ee106440d..1947a570f 100644 --- a/tests/DllRef/Lib2.fs +++ b/tests/DllRef/Lib2.fs @@ -20,6 +20,8 @@ let bar: string = importDefault "./js2/lib.js" /// JSConstructor works let BarCons: JsConstructor = import "Bar" "./js2/lib.js" + +let getArgCount: obj = importMember "./js2/lib.js" #else let foo = "foo" diff --git a/tests/DllRef/js2/lib.js b/tests/DllRef/js2/lib.js index c99343b5d..2163a2256 100644 --- a/tests/DllRef/js2/lib.js +++ b/tests/DllRef/js2/lib.js @@ -19,4 +19,10 @@ export class Bar { } } +export const getArgCount = { + foo() { + return arguments.length; + } +}; + export default "bar"; \ No newline at end of file diff --git a/tests/Main/JsInteropTests.fs b/tests/Main/JsInteropTests.fs index 1d9811c0c..849c378ba 100644 --- a/tests/Main/JsInteropTests.fs +++ b/tests/Main/JsInteropTests.fs @@ -47,8 +47,6 @@ type Props = | Names of NameProp array | [] Custom of key:string * value:obj -let [] argCount: int = jsNative - [] type ErasedUnion = | ErasedInt of int @@ -283,19 +281,12 @@ let tests = equal "5" u.bar testCase "Unit argument is not replaced by null in dynamic programming" <| fun () -> - let o = createObj ["foo" ==> fun () -> argCount] + let o = Fable.Tests.DllRef.Lib2.getArgCount o?foo() |> equal 0 let f = box o?foo f$() |> equal 0 (f :?> JsFunc).Invoke() |> unbox |> equal 0 - testCase "jsThis works" <| fun () -> - let o = createObj [ - "z" ==> 5 - "add" ==> fun x y -> x + y + jsThis?z - ] - o?add(2,3) |> equal 10 - testCase "Erase attribute works" <| fun () -> let convert = function | ErasedInt i -> string(i * 2) From e8fddb5f255f4614c788cc7692a137e31b0b93d2 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Sat, 22 Aug 2020 02:13:37 +0900 Subject: [PATCH 7/8] Fix fcs bundling --- global.json | 3 ++- src/Fable.Transforms/FSharp2Fable.Util.fs | 5 +++-- src/Fable.Transforms/Replacements.fs | 7 ++++--- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/global.json b/global.json index 0ebfb85f9..4dd0ac7e6 100644 --- a/global.json +++ b/global.json @@ -1,5 +1,6 @@ { "sdk": { - "version": "3.1.300" + "version": "3.1.300", + "rollForward": "minor" } } diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index f4d1b94fb..07fa11601 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -251,7 +251,8 @@ module Helpers = else fullName let cleanNameAsJsIdentifier (name: string) = - name.Replace('.','_').Replace('`','$') + if name = ".ctor" then "$ctor" + else name.Replace('.','_').Replace('`','$') let getEntityDeclarationName (com: ICompiler) (ent: Fable.Entity) = let entityName = getEntityMangledName com true ent |> cleanNameAsJsIdentifier @@ -281,7 +282,7 @@ module Helpers = let getMemberDeclarationName (com: ICompiler) (memb: FSharpMemberOrFunctionOrValue) = let name, part = getMemberMangledName com true memb let name = cleanNameAsJsIdentifier name - let part = part.Replace(fun s -> if s = ".ctor" then "$ctor" else s) + let part = part.Replace(cleanNameAsJsIdentifier) let sanitizedName = Naming.sanitizeIdent (fun _ -> false) name part sanitizedName, not(String.IsNullOrEmpty(part.OverloadSuffix)) diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index 0e9550aac..4ba37d209 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -1155,7 +1155,7 @@ let getMangledNames (i: CallInfo) (thisArg: Expr option) = let pos = i.DeclaringEntityFullName.LastIndexOf('.') let moduleName = i.DeclaringEntityFullName.Substring(0, pos).Replace("Microsoft.", "") let entityName = i.DeclaringEntityFullName.Substring(pos + 1) |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier - let memberName = if i.CompiledName = ".ctor" then "$ctor" else FSharp2Fable.Helpers.cleanNameAsJsIdentifier i.CompiledName + let memberName = i.CompiledName |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier let mangledName = Naming.buildNameWithoutSanitationFrom entityName isStatic memberName i.OverloadSuffix.Value moduleName, mangledName @@ -1168,6 +1168,7 @@ let fsharpModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this let moduleName, mangledName = getMangledNames i thisArg Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some +// TODO: This is likely broken let getPrecompiledLibMangledName entityName memberName overloadSuffix isStatic = let memberName = Naming.sanitizeIdentForbiddenChars memberName let entityName = Naming.sanitizeIdentForbiddenChars entityName @@ -2988,7 +2989,7 @@ let tryBaseConstructor com ctx (ent: Entity) (argTypes: Lazy) genArgs | [Number _; IEqualityComparer], [_; eqComp] -> [makeArray Any []; makeComparerFromEqualityComparer eqComp] | _ -> failwith "Unexpected dictionary constructor" - let entityName = Naming.sanitizeIdentForbiddenChars "MutableMap`2" + let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "MutableMap`2" Some(makeLibRef com Any entityName "MutableMap", args) | Types.hashset -> let args = @@ -3002,6 +3003,6 @@ let tryBaseConstructor com ctx (ent: Entity) (argTypes: Lazy) genArgs | [IEqualityComparer], [eqComp] -> [makeArray Any []; makeComparerFromEqualityComparer eqComp] | _ -> failwith "Unexpected hashset constructor" - let entityName = Naming.sanitizeIdentForbiddenChars "MutableSet`1" + let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "MutableSet`1" Some(makeLibRef com Any entityName "MutableSet", args) | _ -> None From ea45ca1f0e96f72cbe3e400b94e496bba8bc1f18 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Sat, 22 Aug 2020 19:44:15 +0900 Subject: [PATCH 8/8] Fix fable-standalone build --- src/Fable.Transforms/AST/AST.Fable.fs | 11 ++-- src/Fable.Transforms/FSharp2Fable.Util.fs | 8 +-- src/Fable.Transforms/FSharp2Fable.fs | 14 ++--- src/Fable.Transforms/Fable2Babel.fs | 8 +-- src/Fable.Transforms/FableTransforms.fs | 7 ++- src/Fable.Transforms/Replacements.fs | 62 +++++++++++------------ src/Fable.Transforms/Transforms.Util.fs | 25 +++++---- src/fable-standalone/splitter.config.js | 2 + src/quicktest/splitter.config.js | 2 +- 9 files changed, 78 insertions(+), 61 deletions(-) diff --git a/src/Fable.Transforms/AST/AST.Fable.fs b/src/Fable.Transforms/AST/AST.Fable.fs index d24380d89..59a74ef62 100644 --- a/src/Fable.Transforms/AST/AST.Fable.fs +++ b/src/Fable.Transforms/AST/AST.Fable.fs @@ -217,6 +217,11 @@ type EmitInfo = Args: Expr list IsJsStatement: bool } +type ImportInfo = + { Selector: Expr + Path: Expr + IsCompilerGenerated: bool } + type OperationKind = | Unary of UnaryOperator * Expr | Binary of BinaryOperator * left: Expr * right: Expr @@ -264,7 +269,7 @@ type Expr = | Operation of OperationKind * typ: Type * range: SourceLocation option // JS related: imports and statements - | Import of selector: Expr * path: Expr * Type * SourceLocation option + | Import of ImportInfo * Type * SourceLocation option | Emit of EmitInfo * typ: Type * range: SourceLocation option // Pattern matching @@ -291,7 +296,7 @@ type Expr = | Call(_,_,t,_) | CurriedApply(_,_,t,_) | TypeCast (_, t) - | Import (_, _, t, _) + | Import (_, t, _) | Curry (_, _, t, _) | ObjectExpr (_, t, _) | Operation (_, t, _) @@ -323,7 +328,7 @@ type Expr = | Call(_,_,_,r) | CurriedApply(_,_,_,r) | Emit (_,_,r) - | Import(_,_,_,r) + | Import(_,_,r) | Curry(_,_,_,r) | Value (_, r) | IfThenElse (_, _, _, r) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 07fa11601..43631a375 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -1042,7 +1042,7 @@ module Util = let path = FsMemberFunctionOrValue.SourcePath memb |> fixImportedRelativePath com path - makeCustomImport typ selector path |> Some + makeImportCompilerGenerated typ selector path |> Some | _ -> None let tryGlobalOrImportedEntity (com: ICompiler) (ent: Fable.Entity) = @@ -1056,7 +1056,7 @@ module Util = if selector = Naming.placeholder then ent.DisplayName else selector fixImportedRelativePath com path ent.SourcePath - |> makeCustomImport Fable.Any selector |> Some + |> makeImportCompilerGenerated Fable.Any selector |> Some | _ -> None let isErasedOrStringEnumEntity (ent: Fable.Entity) = @@ -1095,7 +1095,7 @@ module Util = if file = com.CurrentFile then makeIdentExpr entityName elif ent.IsPublic then - makeInternalImport com Fable.Any entityName file + makeImportInternal com Fable.Any entityName file else error "Cannot inline functions that reference private entities" @@ -1124,7 +1124,7 @@ module Util = // If the overload suffix changes, we need to recompile the files that call this member if hasOverloadSuffix then com.AddInlineDependency(file) - makeInternalImport com typ memberName file + makeImportInternal com typ memberName file else defaultArg (memb.TryGetFullDisplayName()) memb.CompiledName |> sprintf "Cannot reference private members from other files: %s" diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 8b550f0aa..2daea4c1c 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -914,7 +914,7 @@ let private transformImport com r typ isMutable isPublic name selector path = [Fable.MemberDeclaration { Ident = ident Args = [] - Body = Fable.Import(selector, path, typ, r) + Body = makeImportUserGenerated r typ selector path UsedNames = Set.empty Info = info }] @@ -922,7 +922,7 @@ let private transformMemberValue (com: IFableCompiler) ctx isPublic name (memb: let value = transformExpr com ctx value |> run match value with // Accept import expressions, e.g. let foo = import "foo" "myLib" - | Fable.Import(selector, path, typ, r) -> + | Fable.Import(info, typ, r) when not info.IsCompilerGenerated -> match typ with | Fable.LambdaType(_, Fable.LambdaType(_, _)) -> "Change declaration of member: " + name + "\n" @@ -930,8 +930,8 @@ let private transformMemberValue (com: IFableCompiler) ctx isPublic name (memb: + "Use following syntax: `let add (x:int) (y:int): int = import ...`" |> addError com ctx.InlinePath None | _ -> () - let selector = importExprSelector memb selector - transformImport com r typ memb.IsMutable isPublic name selector path + let selector = importExprSelector memb info.Selector + transformImport com r typ memb.IsMutable isPublic name selector info.Path | fableValue -> let info = MemberDeclInfo(memb.Attributes, isValue=true, isPublic=isPublic, isMutable=memb.IsMutable) [Fable.MemberDeclaration @@ -953,11 +953,11 @@ let private transformMemberFunction (com: IFableCompiler) ctx isPublic name (mem let body = transformExpr com bodyCtx body |> run match body with // Accept import expressions, e.g. let foo x y = import "foo" "myLib" - | Fable.Import(selector, path, _, r) -> + | Fable.Import(info, _, r) when not info.IsCompilerGenerated -> // Use the full function type let typ = makeType Map.empty memb.FullType - let selector = importExprSelector memb selector - transformImport com r typ false isPublic name selector path + let selector = importExprSelector memb info.Selector + transformImport com r typ false isPublic name selector info.Path | body -> // If this is a static constructor, call it immediately if memb.CompiledName = ".cctor" then diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 124131f25..3347fa37c 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -1124,9 +1124,9 @@ module Util = let transformBindingExprBody (com: IBabelCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) = match value with // Check imports with name placeholder - | Fable.Import((Fable.Value(Fable.StringConstant Naming.placeholder,_)), path, _, r) -> + | Fable.Import({ Selector = Fable.Value(Fable.StringConstant Naming.placeholder,_); Path = path }, _, r) -> transformImport com ctx r (makeStrConst var.Name) path - | Function(_,Fable.Import(Fable.Value(Fable.StringConstant Naming.placeholder,_), path, _, r)) -> + | Function(_,Fable.Import({ Selector = Fable.Value(Fable.StringConstant Naming.placeholder,_); Path = path }, _, r)) -> transformImport com ctx r (makeStrConst var.Name) path | Function(args, body) -> let name = Some var.Name @@ -1390,7 +1390,7 @@ module Util = | Fable.IdentExpr id -> upcast ident id - | Fable.Import(selector, path, _, r) -> + | Fable.Import({ Selector = selector; Path = path }, _, r) -> transformImport com ctx r selector path | Fable.Test(expr, kind, range) -> @@ -1467,7 +1467,7 @@ module Util = | Fable.IdentExpr id -> [|identAsExpr id |> resolveExpr id.Type returnStrategy|] - | Fable.Import(selector, path, t, r) -> + | Fable.Import({ Selector = selector; Path = path }, t, r) -> [|transformImport com ctx r selector path |> resolveExpr t returnStrategy|] | Fable.Test(expr, kind, range) -> diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index e051a0794..4301ae205 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -8,7 +8,9 @@ let visit f e = match e with | IdentExpr _ -> e | TypeCast(e, t) -> TypeCast(f e, t) - | Import(e1, e2, t, r) -> Import(f e1, f e2, t, r) + | Import(info, t, r) -> + Import({ info with Selector = f info.Selector + Path = f info.Path }, t, r) | Value(kind, r) -> match kind with | ThisValue _ | BaseValue _ @@ -89,10 +91,11 @@ let rec visitFromOutsideIn (f: Expr->Expr option) e = | Some e -> e | None -> visit (visitFromOutsideIn f) e +// TODO: We should likely make this a property of Fable.Expr let getSubExpressions = function | IdentExpr _ -> [] | TypeCast(e,_) -> [e] - | Import(e1,e2,_,_) -> [e1;e2] + | Import(info,_,_) -> [info.Selector; info.Path] | Value(kind,_) -> match kind with | ThisValue _ | BaseValue _ diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index 4ba37d209..20b9f901b 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -27,11 +27,11 @@ type Helper = Call(callee, info, returnType, loc) static member LibValue(com, coreModule: string, coreMember: string, returnType: Type) = - makeLibRef com returnType coreMember coreModule + makeImportLib com returnType coreMember coreModule static member LibCall(com, coreModule: string, coreMember: string, returnType: Type, args: Expr list, ?argTypes: Type list, ?thisArg: Expr, ?hasSpread: bool, ?isJsConstructor: bool, ?loc: SourceLocation) = - let callee = makeLibRef com Any coreMember coreModule + let callee = makeImportLib com Any coreMember coreModule let info = makeCallInfo thisArg args (defaultArg argTypes []) Call(callee, { info with HasSpread = defaultArg hasSpread false IsJsConstructor = defaultArg isJsConstructor false }, returnType, loc) @@ -789,7 +789,7 @@ let makeEqualityComparer (com: ICompiler) ctx typArg = let body = equals com ctx None true (IdentExpr x) (IdentExpr y) let f = Delegate([x; y], body, None) objExpr ["Equals", f - "GetHashCode", makeLibRef com Any "structuralHash" "Util"] + "GetHashCode", makeImportLib com Any "structuralHash" "Util"] // TODO: Try to detect at compile-time if the object already implements `Compare`? let inline makeComparerFromEqualityComparer e = @@ -927,14 +927,14 @@ let tryEntityRef (com: Fable.ICompiler) (ent: Entity) = match ent.FullName with | BuiltinDefinition BclDateTime | BuiltinDefinition BclDateTimeOffset -> makeIdentExpr "Date" |> Some - | BuiltinDefinition BclTimer -> makeLibRef com Any "default" "Timer" |> Some + | BuiltinDefinition BclTimer -> makeImportLib com Any "default" "Timer" |> Some | BuiltinDefinition BclInt64 - | BuiltinDefinition BclUInt64 -> makeLibRef com Any "default" "Long" |> Some - | BuiltinDefinition BclDecimal -> makeLibRef com Any "default" "Decimal" |> Some - | BuiltinDefinition BclBigInt -> makeLibRef com Any "BigInteger" "BigInt/z" |> Some - | BuiltinDefinition(FSharpReference _) -> makeLibRef com Any "FSharpRef" "Types" |> Some - | BuiltinDefinition(FSharpResult _) -> makeLibRef com Any "Result" "Option" |> Some - | BuiltinDefinition(FSharpChoice _) -> makeLibRef com Any "Choice" "Option" |> Some + | BuiltinDefinition BclUInt64 -> makeImportLib com Any "default" "Long" |> Some + | BuiltinDefinition BclDecimal -> makeImportLib com Any "default" "Decimal" |> Some + | BuiltinDefinition BclBigInt -> makeImportLib com Any "BigInteger" "BigInt/z" |> Some + | BuiltinDefinition(FSharpReference _) -> makeImportLib com Any "FSharpRef" "Types" |> Some + | BuiltinDefinition(FSharpResult _) -> makeImportLib com Any "Result" "Option" |> Some + | BuiltinDefinition(FSharpChoice _) -> makeImportLib com Any "Choice" "Option" |> Some // | BuiltinDefinition BclGuid -> jsTypeof "string" expr // | BuiltinDefinition BclTimeSpan -> jsTypeof "number" expr // | BuiltinDefinition BclHashSet _ -> fail "MutableSet" // TODO: @@ -942,14 +942,14 @@ let tryEntityRef (com: Fable.ICompiler) (ent: Entity) = // | BuiltinDefinition BclKeyValuePair _ -> fail "KeyValuePair" // TODO: // | BuiltinDefinition FSharpSet _ -> fail "Set" // TODO: // | BuiltinDefinition FSharpMap _ -> fail "Map" // TODO: - | Types.matchFail -> makeLibRef com Any "MatchFailureException" "Types" |> Some + | Types.matchFail -> makeImportLib com Any "MatchFailureException" "Types" |> Some | Types.exception_ -> makeIdentExpr "Error" |> Some | entFullName -> com.Options.precompiledLib |> Option.bind (fun tryLib -> tryLib entFullName) |> Option.map (fun (entityName, importPath) -> let entityName = Naming.sanitizeIdentForbiddenChars entityName |> Naming.checkJsKeywords - makeCustomImport Any entityName importPath) + makeImportCompilerGenerated Any entityName importPath) let tryJsConstructor com ent = if FSharp2Fable.Util.isReplacementCandidate ent then tryEntityRef com ent @@ -1063,21 +1063,21 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | arg -> arg match arg with // TODO: Check this is not a fable-library import? - | Import(selector,path,_,_) -> - dynamicImport selector path |> Some - | NestedLambda(args, Call(Import(selector,path,_,_),info,_,_), None) - when argEquals args info.Args -> - dynamicImport selector path |> Some + | Import(info,_,_) -> + dynamicImport info.Selector info.Path |> Some + | NestedLambda(args, Call(Import(importInfo,_,_),callInfo,_,_), None) + when argEquals args callInfo.Args -> + dynamicImport importInfo.Selector importInfo.Path |> Some | _ -> "The imported value is not coming from a different file" |> addErrorAndReturnNull com ctx.InlinePath r |> Some | Naming.StartsWith "import" suffix, _ -> match suffix, args with - | "Member", [path] -> Import(makeStrConst Naming.placeholder, path, t, r) |> Some - | "Default", [path] -> Import(makeStrConst "default", path, t, r) |> Some - | "SideEffects", [path] -> Import(makeStrConst "", path, t, r) |> Some - | "All", [path] -> Import(makeStrConst "*", path, t, r) |> Some - | _, [selector; path] -> Import(selector, path, t, r) |> Some + | "Member", [path] -> makeImportUserGenerated r t (makeStrConst Naming.placeholder) path |> Some + | "Default", [path] -> makeImportUserGenerated r t (makeStrConst "default") path |> Some + | "SideEffects", [path] -> makeImportUserGenerated r t (makeStrConst "") path |> Some + | "All", [path] -> makeImportUserGenerated r t (makeStrConst "*") path |> Some + | _, [selector; path] -> makeImportUserGenerated r t (selector) path |> Some | _ -> None // Dynamic casting, erase | "op_BangHat", [arg] -> Some arg @@ -1142,7 +1142,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp let getReference r t expr = get r t expr "contents" let setReference r expr value = Set(expr, Some(ExprKey(makeStrConst "contents")), value, r) -let newReference com r t value = Helper.JsConstructorCall(makeLibRef com t "FSharpRef" "Types", t, [value], ?loc=r) +let newReference com r t value = Helper.JsConstructorCall(makeImportLib com t "FSharpRef" "Types", t, [value], ?loc=r) let references (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with @@ -1182,10 +1182,10 @@ let getPrecompiledLibMangledName entityName memberName overloadSuffix isStatic = let precompiledLib r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) (entityName, importPath) = let mangledName = getPrecompiledLibMangledName entityName i.CompiledName i.OverloadSuffix.Value (Option.isNone thisArg) if i.IsModuleValue - then makeCustomImport t mangledName importPath + then makeImportCompilerGenerated t mangledName importPath else let argInfo = { makeCallInfo thisArg args i.SignatureArgTypes with HasSpread = i.HasSpread } - makeCustomImport Any mangledName importPath |> makeCall r t argInfo + makeImportCompilerGenerated Any mangledName importPath |> makeCall r t argInfo let fsFormat (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with @@ -1250,7 +1250,7 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | "DefaultArg", _ -> Helper.LibCall(com, "Option", "defaultArg", t, args, i.SignatureArgTypes, ?loc=r) |> Some | "DefaultAsyncBuilder", _ -> - makeLibRef com t "singleton" "AsyncBuilder" |> Some + makeImportLib com t "singleton" "AsyncBuilder" |> Some // Erased operators. // KeyValuePair is already compiled as a tuple | ("KeyValuePattern"|"Identity"|"Box"|"Unbox"|"ToEnum"), [arg] -> TypeCast(arg, t) |> Some @@ -2616,7 +2616,7 @@ let mailbox (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt let asyncBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match thisArg, i.CompiledName, args with - | _, "Singleton", _ -> makeLibRef com t "singleton" "AsyncBuilder" |> Some + | _, "Singleton", _ -> makeImportLib com t "singleton" "AsyncBuilder" |> Some // For Using we need to cast the argument to IDisposable | Some x, "Using", [arg; f] -> Helper.InstanceCall(x, "Using", t, [arg; f], i.SignatureArgTypes, ?loc=r) |> Some @@ -2974,8 +2974,8 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr let tryBaseConstructor com ctx (ent: Entity) (argTypes: Lazy) genArgs args = match ent.FullName with - | Types.exception_ -> Some(makeLibRef com Any "Exception" "Types", args) - | Types.attribute -> Some(makeLibRef com Any "Attribute" "Types", args) + | Types.exception_ -> Some(makeImportLib com Any "Exception" "Types", args) + | Types.attribute -> Some(makeImportLib com Any "Attribute" "Types", args) | Types.dictionary -> let args = match argTypes.Value, args with @@ -2990,7 +2990,7 @@ let tryBaseConstructor com ctx (ent: Entity) (argTypes: Lazy) genArgs [makeArray Any []; makeComparerFromEqualityComparer eqComp] | _ -> failwith "Unexpected dictionary constructor" let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "MutableMap`2" - Some(makeLibRef com Any entityName "MutableMap", args) + Some(makeImportLib com Any entityName "MutableMap", args) | Types.hashset -> let args = match argTypes.Value, args with @@ -3004,5 +3004,5 @@ let tryBaseConstructor com ctx (ent: Entity) (argTypes: Lazy) genArgs [makeArray Any []; makeComparerFromEqualityComparer eqComp] | _ -> failwith "Unexpected hashset constructor" let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "MutableSet`1" - Some(makeLibRef com Any entityName "MutableSet", args) + Some(makeImportLib com Any entityName "MutableSet", args) | _ -> None diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index 14a98a0fa..3a87addf9 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -391,15 +391,22 @@ module AST = let ext = if com.Options.typescript then "" else Naming.targetFileExtension com.LibraryDir + "/" + moduleName + ext - let makeLibRef (com: ICompiler) t memberName moduleName = - Import(makeStrConst memberName, makeStrConst (getLibPath com moduleName), t, None) - - let makeCustomImport t (selector: string) (path: string) = - Import(selector.Trim() |> makeStrConst, path.Trim() |> makeStrConst, t, None) - - let makeInternalImport (com: ICompiler) t (selector: string) (path: string) = - let path = Path.getRelativeFileOrDirPath false com.CurrentFile false path - Import(makeStrConst selector, makeStrConst path, t, None) + let makeImportUserGenerated r t selector path = + Import({ Selector = selector + Path = path + IsCompilerGenerated = false }, t, r) + + let makeImportCompilerGenerated t (selector: string) (path: string) = + Import({ Selector = selector.Trim() |> makeStrConst + Path = path.Trim() |> makeStrConst + IsCompilerGenerated = true }, t, None) + + let makeImportLib (com: ICompiler) t memberName moduleName = + makeImportCompilerGenerated t memberName (getLibPath com moduleName) + + let makeImportInternal (com: ICompiler) t (selector: string) (path: string) = + Path.getRelativeFileOrDirPath false com.CurrentFile false path + |> makeImportCompilerGenerated t selector let makeCallInfo thisArg args argTypes = { ThisArg = thisArg diff --git a/src/fable-standalone/splitter.config.js b/src/fable-standalone/splitter.config.js index 1f9ed9d57..59d0a6268 100644 --- a/src/fable-standalone/splitter.config.js +++ b/src/fable-standalone/splitter.config.js @@ -23,7 +23,9 @@ const fableOptions = { // extra: { saveAst: "./ast" } }; +const portArgIndex = process.argv.indexOf("--port"); module.exports = { + port: portArgIndex >= 0 ? process.argv[portArgIndex + 1] : undefined, cli: { path: resolve("../Fable.Cli") }, entry: resolve("./src/Fable.Standalone.fsproj"), outDir: resolve("../../build/fable-standalone/out-bundle"), diff --git a/src/quicktest/splitter.config.js b/src/quicktest/splitter.config.js index aa1ab9ad6..9ec592070 100644 --- a/src/quicktest/splitter.config.js +++ b/src/quicktest/splitter.config.js @@ -2,7 +2,7 @@ const path = require("path"); const portArgIndex = process.argv.indexOf("--port"); module.exports = { - port: portArgIndex >= 0 ? process.argv[portArgIndex + 1] : undefined, + port: portArgIndex >= 0 ? process.argv[portArgIndex + 1] : undefined, noReferences: true, cli: { path: resolve("../Fable.Cli") }, entry: resolve("QuickTest.fsproj"),