diff --git a/src/Fable.Cli/Main.fs b/src/Fable.Cli/Main.fs index 5a120b0b7..cd5bac658 100644 --- a/src/Fable.Cli/Main.fs +++ b/src/Fable.Cli/Main.fs @@ -117,7 +117,7 @@ module private Util = LogEntry.Make(severity, msg, fileName = er.FileName, range = range, tag = "FSHARP") ) - let getOutPath (cliArgs: CliArgs) pathResolver file = + let getOutPath (cliArgs: CliArgs) (beamModuleName: string -> string option) pathResolver file = match cliArgs.CompilerOptions.Language with // For Python we must have an outDir since all compiled files must be inside the same subdir, so if `outDir` is not // set we set `outDir` to the directory of the project file being compiled. @@ -155,9 +155,18 @@ module private Util = | Beam -> let fileExt = cliArgs.CompilerOptions.FileExtension - // An Erlang module's file name must match the `-module` atom it declares, so the - // output file is named after the module, not after the F# source file. - let fileName = Pipeline.Beam.moduleName cliArgs file + fileExt + // An Erlang module's file name must match the `-module` atom it declares, so the output + // file is named after the module, not after the F# source file. `beamModuleName` sees a + // name pinned with [], which lives in the F# AST: while compiling we + // ask the compiler, but a caller that only *predicts* an out path (watch's up-to-date + // check) has no compiler and looks the name up in the map from the last cycle instead. + // Predicting the derived name for a pinned file would never match what is on disk, and + // watch would recompile that file on every cycle, forever. + let moduleName = + beamModuleName file + |> Option.defaultWith (fun () -> Pipeline.Beam.moduleName cliArgs file) + + let fileName = moduleName + fileExt if Naming.isInFableModules file then // Package and library sources in fable_modules: preserve the containing @@ -206,7 +215,12 @@ module private Util = let fileName = (com :> Compiler).CurrentFile try - let outPath = getOutPath cliArgs pathResolver fileName + // We are compiling this file, so the F# AST is right here: ask it for a pinned name. + let beamModuleName path = + Fable.Beam.Naming.tryPinnedModuleName (com :> Compiler) path + |> Option.filter Fable.Beam.Naming.isValidModuleName + + let outPath = getOutPath cliArgs beamModuleName pathResolver fileName // ensure directory exists let dir = IO.Path.GetDirectoryName outPath @@ -613,7 +627,10 @@ and FableCompiler(checker: InteractiveChecker, projCracked: ProjectCracked, fabl // Print F# AST to file if projCracked.CliArgs.PrintAst then - let outPath = getOutPath projCracked.CliArgs state.PathResolver file.FileName + // --printAst only needs the directory, so the file name doesn't matter. + let outPath = + getOutPath projCracked.CliArgs (fun _ -> None) state.PathResolver file.FileName + let outDir = IO.Path.GetDirectoryName(outPath) Printers.printAst outDir [ file ] @@ -847,8 +864,17 @@ type State = Watcher: Watcher option SilentCompilation: bool RecompileAllFiles: bool + /// Beam only: module names pinned with `[]`, as of the last compilation. + /// A pinned name lives in the F# AST, so it cannot be known before a file is type checked; + /// this is how the next cycle predicts the out path of a file it hasn't compiled yet. + BeamPinnedModuleNames: Map } + /// The Erlang module name pinned for a source file, if any. Empty until the first compilation + /// finishes, which only means an out path predicted before then falls back to the derived name. + member this.BeamPinnedModuleName(path: string) = + Map.tryFind path this.BeamPinnedModuleNames + member this.TriggeredByDependency(path: string, changes: ISet) = match Map.tryFind path this.WatchDependencies with | None -> false @@ -882,6 +908,7 @@ type State = PendingFiles = [||] SilentCompilation = false RecompileAllFiles = defaultArg recompileAllFiles false + BeamPinnedModuleNames = Map.empty } let private getFilesToCompile @@ -916,7 +943,7 @@ let private getFilesToCompile ) || ( // If files have been deleted, we should likely recompile after first deletion - let outPath = getOutPath state.CliArgs pathResolver path + let outPath = getOutPath state.CliArgs state.BeamPinnedModuleName pathResolver path let wasDeleted = (path.EndsWith(".fs") || path.EndsWith(".fsx")) && not (IO.File.Exists outPath) @@ -940,7 +967,8 @@ let private areCompiledFilesUpToDate (state: State) (filesToCompile: string[]) = || file.EndsWith(".fsx", StringComparison.Ordinal) ) |> Array.forall (fun source -> - let outPath = getOutPath state.CliArgs pathResolver source + let outPath = + getOutPath state.CliArgs state.BeamPinnedModuleName pathResolver source // Empty files are not written to disk so we only check date for existing files if IO.File.Exists(outPath) then foundCompiledFile <- true @@ -1015,18 +1043,42 @@ let private compileBeamFiles (workingDir: string) = :: mainErlFiles) |> ignore +/// Module names pinned with `[]`, keyed by source file. The CLI has to know +/// them too: it names each output file after the module inside it, it is where duplicate module +/// names are caught, and in watch mode it predicts an out path before there is a compiler to ask. +/// +/// This must agree with `Fable.Beam.Naming.erlangModuleNameFor`, which the code generator uses — +/// hence the same `canPinModuleName` rule, and the same dropping of invalid names (Fable2Beam +/// reports those against the offending file and falls back to the derived name). +let private beamPinnedModuleNames (fableProj: Project) = + fableProj.ImplementationFiles + |> Seq.filter (fun kv -> Fable.Beam.Naming.canPinModuleName kv.Key) + |> Seq.choose (fun kv -> + ReadOnlyDictionary.tryFind kv.Value.RootModule kv.Value.Entities + |> Option.bind Fable.Beam.Naming.tryModuleNameAttribute + |> Option.filter Fable.Beam.Naming.isValidModuleName + |> Option.map (fun name -> kv.Key, name) + ) + |> Map + /// Erlang's module namespace is flat and global, and an .erl file must be named after the module /// it declares. Two source files that map to the same module name therefore write the same output /// file, and whichever is compiled last silently overwrites the other — its functions simply /// disappear from the output. A module named after one of OTP's own is just as fatal: the two /// names are the same atom, and whichever module loses the lookup is unreachable. Both failures /// surface only as `undef` at runtime, so fail here instead, while we can still say which files -/// are to blame. -let private checkBeamModuleNames (cliArgs: CliArgs) (sourceFiles: string seq) = +/// are to blame. A pinned name is checked like any other — pinning is for naming a module the +/// contract requires, not for taking a name OTP already has. +let private checkBeamModuleNames (cliArgs: CliArgs) (pinned: Map) (sourceFiles: string seq) = + let moduleName path = + match Map.tryFind path pinned with + | Some name -> name + | None -> Pipeline.Beam.moduleName cliArgs path + let modules = sourceFiles |> Seq.filter Fable.Beam.Naming.isGeneratedModuleSource - |> Seq.map (fun path -> Pipeline.Beam.moduleName cliArgs path, path) + |> Seq.map (fun path -> moduleName path, path) |> Seq.toArray let fail (message: string) (details: string seq) = @@ -1052,8 +1104,8 @@ let private checkBeamModuleNames (cliArgs: CliArgs) (sourceFiles: string seq) = fail ("Erlang module names must be unique across the whole compilation: the module namespace " + "is global and each module is written to a file named after it, so one of these would " - + "silently overwrite the other. Rename one of the files, or move it to a different " - + "assembly.") + + "silently overwrite the other. Rename one of the files, move it to a different " + + "assembly, or pin a distinct name with [].") duplicates let shadowed = @@ -1065,8 +1117,9 @@ let private checkBeamModuleNames (cliArgs: CliArgs) (sourceFiles: string seq) = fail ("These files generate Erlang modules that shadow OTP's own: the module namespace is " + "global, so the generated module and OTP's would be the same atom and one of them " - + "unreachable. Rename the file, or move it to a directory or assembly whose name does " - + "not produce a clashing module name.") + + "unreachable. Rename the file, move it to a directory or assembly whose name does " + + "not produce a clashing module name, or pin a different name with " + + "[].") shadowed let private generateBeamScaffold (cliArgs: CliArgs) (entryModule: string) = @@ -1213,7 +1266,7 @@ let private checkRunProcess (state: State) (projCracked: ProjectCracked) (compil let findLastFileFullPath () = let pathResolver = state.GetPathResolver() let lastFile = Array.last projCracked.SourceFiles - getOutPath cliArgs pathResolver lastFile.NormalizedFullPath + getOutPath cliArgs state.BeamPinnedModuleName pathResolver lastFile.NormalizedFullPath // Fable's getRelativePath version ensures there's always a period in front of the path: ./ let findLastFileRelativePath () = @@ -1240,7 +1293,6 @@ let private checkRunProcess (state: State) (projCracked: ProjectCracked) (compil let lastFilePath = findLastFileRelativePath () "node", lastFilePath :: runProc.Args | Beam, Naming.placeholder -> - let moduleName = IO.Path.GetFileNameWithoutExtension(findLastFileFullPath ()) compileBeamFiles workingDir "erl", @@ -1251,7 +1303,9 @@ let private checkRunProcess (state: State) (projCracked: ProjectCracked) (compil "-pa" erlLibSrcRelDir // library .beam files are in fable_modules/.../src/ "-eval" - $"{moduleName}:main()" + // The scaffold always leaves a `main` module in src/ — either the entry + // module itself, or a shim forwarding to it. + "main:main()" "-s" "init" "stop" @@ -1381,11 +1435,6 @@ let private compilationCycle (state: State) (changes: ISet) = cliArgs | _ -> state, cliArgs - if cliArgs.CompilerOptions.Language = Beam then - projCracked.SourceFiles - |> Array.map (fun f -> f.NormalizedFullPath) - |> checkBeamModuleNames cliArgs - let! fableCompiler = match fableCompiler with | None -> FableCompiler.Init(projCracked) @@ -1544,15 +1593,39 @@ let private compilationCycle (state: State) (changes: ISet) = } // Generate rebar3 scaffold for BEAM target after successful compilation - if cliArgs.CompilerOptions.Language = Beam && not hasError then - // The last source file is the entry point of a Fable program: its module-level - // actions compile to that module's main/0. - let entryModule = - projCracked.SourceFiles - |> Array.last - |> fun f -> Pipeline.Beam.moduleName cliArgs f.NormalizedFullPath - - generateBeamScaffold cliArgs entryModule + let! beamPinned = + if cliArgs.CompilerOptions.Language <> Beam || hasError then + async.Return state.BeamPinnedModuleNames + else + async { + // A module name pinned with [] lives in the F# AST, which + // only exists once the files have been type checked — hence after + // compilation, not before. It can't be derived from the path, and checking + // the derived names early would reject a clash that a pinned name resolves. + let! fableProj = fableCompiler.GetFableProject() + let pinned = beamPinnedModuleNames fableProj + + projCracked.SourceFiles + |> Array.map (fun f -> f.NormalizedFullPath) + |> checkBeamModuleNames cliArgs pinned + + // The last source file is the entry point of a Fable program: its + // module-level actions compile to that module's main/0. + let lastFile = (Array.last projCracked.SourceFiles).NormalizedFullPath + + let entryModule = + match Map.tryFind lastFile pinned with + | Some name -> name + | None -> Pipeline.Beam.moduleName cliArgs lastFile + + generateBeamScaffold cliArgs entryModule + + return pinned + } + + // Remembered so the next cycle can predict the out path of a pinned file it has not + // compiled yet, instead of deriving a name that will never match what is on disk. + let state = { state with BeamPinnedModuleNames = beamPinned } // Run process let exitCode, state = diff --git a/src/Fable.Core/Fable.Core.Beam.fs b/src/Fable.Core/Fable.Core.Beam.fs new file mode 100644 index 000000000..4df894cf7 --- /dev/null +++ b/src/Fable.Core/Fable.Core.Beam.fs @@ -0,0 +1,20 @@ +module Fable.Core.Beam + +open System + +/// Pins the name of the Erlang module generated for this file. +/// +/// Erlang's module namespace is flat and global, so Fable qualifies generated module names with +/// the application they belong to (`MyApp/Server.fs` -> `my_app_server`). Use this attribute when +/// the module name is part of a contract and must be an exact, known atom — a module implementing +/// an OTP behaviour, or one called from hand-written Erlang. +/// +/// The name must be a plain Erlang atom: lowercase first letter, then letters, digits or +/// underscores. It must not collide with any other module in the compilation. +/// +/// [<Fable.Core.Beam.ModuleName("my_server")>] +/// module MyApp.Server +[] +type ModuleNameAttribute(name: string) = + inherit Attribute() + member _.Name = name diff --git a/src/Fable.Core/Fable.Core.fsproj b/src/Fable.Core/Fable.Core.fsproj index 1429eb226..7c3de6535 100644 --- a/src/Fable.Core/Fable.Core.fsproj +++ b/src/Fable.Core/Fable.Core.fsproj @@ -15,6 +15,7 @@ + diff --git a/src/Fable.Transforms/Beam/FABLE-BEAM.md b/src/Fable.Transforms/Beam/FABLE-BEAM.md index 7bbf34960..340b253e1 100644 --- a/src/Fable.Transforms/Beam/FABLE-BEAM.md +++ b/src/Fable.Transforms/Beam/FABLE-BEAM.md @@ -298,7 +298,7 @@ Two exemptions: - **Native Erlang modules** reached through `BeamInterop` (`string`, `lists`, ...) are of course referenced by their own names. -Naming lives in one place, `Fable.Beam.Naming.erlangModuleName` (`Beam/Prelude.fs`), because the +Naming lives in one place, `Fable.Beam.Naming.erlangModuleNameFor` (`Beam/Prelude.fs`), because the code generator (which must resolve an import to the atom the imported file declared) and the CLI (which must write the file under the name of the module inside it) have to agree exactly. @@ -312,6 +312,35 @@ Qualification is a convention, not a guarantee, so `checkBeamModuleNames` (`Fabl `Server.fs` produces `gen_server` — and fable-library's exempt modules are not qualified at all, so a `Timer.fs` added to it would silently shadow OTP's `timer`. +### Pinning a module name + +A derived name is right for ordinary code, but a module implementing an OTP behaviour — or one +called from hand-written Erlang — has its name as part of its contract. `[]` on a +file's root module pins the atom: + +```fsharp +[] +module MyApp.Server +``` + +The attribute must be fully qualified, since it precedes the module declaration and so cannot rely +on an `open`. The name has to be a plain unquoted Erlang atom (lowercase first letter, then +letters, digits, underscores) — anything else is a compile error — and it must not collide with +another module, which the duplicate check above enforces. + +A pinned name is checked like any other: it must not collide with another module, and it must not +be one of OTP's own — pinning is for naming a module its contract requires, not for taking a name +OTP already has. + +Resolving this is the one place the naming scheme needs more than the path: an import carries the +imported file's *path*, never its entity, so `erlangModuleNameFor` maps path → root module +(`GetRootModule`) → entity (`TryGetEntity`) → attribute. The CLI needs the same answer to name the +output file, and it can only get it *after* type checking — which is why the duplicate check runs +after compilation rather than before it, and why the CLI remembers the pinned names it found +(`State.BeamPinnedModuleNames`). Without that memory, watch mode would predict the *derived* out +path for a pinned file, never find it on disk, and conclude the file had been deleted — recompiling +it on every cycle, forever. + ### Entry point Since module names are qualified, the entry point of a project compiled from `Program.fs` is diff --git a/src/Fable.Transforms/Beam/Fable2Beam.Reflection.fs b/src/Fable.Transforms/Beam/Fable2Beam.Reflection.fs index ae34de9ef..cee79945e 100644 --- a/src/Fable.Transforms/Beam/Fable2Beam.Reflection.fs +++ b/src/Fable.Transforms/Beam/Fable2Beam.Reflection.fs @@ -211,7 +211,7 @@ let rec private transformTypeInfoRec if sourcePath = com.CurrentFile then None // local call else - Some(Fable.Beam.Naming.erlangModuleName com.ProjectFile sourcePath) + Some(Fable.Beam.Naming.erlangModuleNameFor com sourcePath) let funcName = FSharp2Fable.Helpers.getEntityDeclarationName com entRef |> reflectionFuncName diff --git a/src/Fable.Transforms/Beam/Fable2Beam.fs b/src/Fable.Transforms/Beam/Fable2Beam.fs index 6f6648b96..efb958c3d 100644 --- a/src/Fable.Transforms/Beam/Fable2Beam.fs +++ b/src/Fable.Transforms/Beam/Fable2Beam.fs @@ -184,7 +184,7 @@ let resolveImportModuleName (com: IBeamCompiler) (importPath: string) = if resolvedImportPath = currentFileFull then None else - Some(erlangModuleName com.ProjectFile resolvedImportPath) + Some(erlangModuleNameFor com resolvedImportPath) /// Detect whether an expression reads a *free* mutable ident — a module-level mutable /// not bound locally within the expression. Such reads must be snapshotted at module-init @@ -3822,7 +3822,11 @@ and transformDeclaration (com: IBeamCompiler) (ctx: Context) (decl: Declaration) transformClassDeclaration com ctx className ent decl let transformFile (com: Fable.Compiler) (file: File) : Beam.ErlModule = - let moduleName = erlangModuleName com.ProjectFile com.CurrentFile + // The file that declares a pinned name is the one place to report it as invalid — every file + // that imports it resolves the same name, and would otherwise report it again. + checkPinnedModuleName com com.CurrentFile + + let moduleName = erlangModuleNameFor com com.CurrentFile let ctx = { diff --git a/src/Fable.Transforms/Beam/Prelude.fs b/src/Fable.Transforms/Beam/Prelude.fs index 28368f6c9..78aaf670b 100644 --- a/src/Fable.Transforms/Beam/Prelude.fs +++ b/src/Fable.Transforms/Beam/Prelude.fs @@ -458,6 +458,77 @@ module Naming = else belowProjDir |> joinModuleName + /// A module name pinned with `[]` on a file's root module. + /// + /// The derived name is right for ordinary code, but a module implementing an OTP behaviour — + /// or one called from hand-written Erlang — has its name as part of its contract, and needs to + /// be able to say so. + let tryModuleNameAttribute (ent: Fable.AST.Fable.Entity) = + ent.Attributes + |> Seq.tryPick (fun att -> + if att.Entity.FullName = Fable.Transforms.Atts.beamModuleName then + match att.ConstructorArgs with + | [ :? string as name ] -> Some name + | _ -> None + else + None + ) + + /// The name is written straight into `-module(...)` and into the output file name, so it has to + /// be a plain unquoted Erlang atom. + let isValidModuleName (name: string) = + Regex.IsMatch(name, @"^[a-z][a-zA-Z0-9_]*$") && not (erlKeywords.Contains name) + + /// Whether a file's module name can be pinned at all. fable-library's modules keep their bare, + /// hand-maintained names, and a path that names no F# source names a module Fable does not + /// generate. The CLI and the code generator both have to apply this rule, or they would + /// disagree on the name of the very file they are compiling. + let canPinModuleName (filePath: string) = + isFSharpSource filePath && not (isFableLibraryPath filePath) + + /// The name pinned on a file's root module with `[]`, as + /// written — it may not be a valid atom. Reporting that is `checkPinnedModuleName`'s job, so + /// that an invalid name is reported once, against the file that declares it, rather than once + /// per file that imports it. + let tryPinnedModuleName (com: Fable.Compiler) (filePath: string) = + if not (canPinModuleName filePath) then + None + else + match com.GetRootModule(filePath) with + | "", _ -> None // a file with no root module has nothing to carry the attribute + | rootModule, _ -> + com.TryGetEntity( + { + FullName = rootModule + Path = Fable.AST.Fable.SourcePath filePath + } + ) + |> Option.bind tryModuleNameAttribute + + /// The Erlang module name of a source file: the name pinned on its root module by + /// `[]`, or else the name derived from its path. + /// + /// Resolving this from a path alone is what lets an *importing* file name the module it is + /// calling into — an import carries the imported file's path, never its entity. + let erlangModuleNameFor (com: Fable.Compiler) (filePath: string) = + match tryPinnedModuleName com filePath with + | Some name when isValidModuleName name -> name + | _ -> erlangModuleName com.ProjectFile filePath + + /// Report a pinned name that is not a plain Erlang atom. Called once for the file being + /// compiled, which is the only file the name is declared in; `erlangModuleNameFor` falls back + /// to the derived name so that compilation of the rest of the file can proceed. + let checkPinnedModuleName (com: Fable.Compiler) (filePath: string) = + match tryPinnedModuleName com filePath with + | Some name when not (isValidModuleName name) -> + com.AddLog( + $"'%s{name}' is not a valid Erlang module name. It must start with a lowercase " + + "letter and contain only letters, digits and underscores.", + Fable.Severity.Error, + fileName = filePath + ) + | _ -> () + let capitalizeFirst (s: string) = if s.Length = 0 then s diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index c5cc988a7..44bc253c6 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -121,6 +121,9 @@ module Atts = [] let jsxComponent = "Fable.Core.JSX.ComponentAttribute" // typeof.FullName + [] + let beamModuleName = "Fable.Core.Beam.ModuleNameAttribute" // typeof.FullName + [] let pyDecorator = "Fable.Core.Py.DecoratorAttribute" // typeof.FullName diff --git a/tests/Beam/Fable.Tests.Beam.fsproj b/tests/Beam/Fable.Tests.Beam.fsproj index 97b54d21e..1e79386ed 100644 --- a/tests/Beam/Fable.Tests.Beam.fsproj +++ b/tests/Beam/Fable.Tests.Beam.fsproj @@ -31,6 +31,7 @@ + diff --git a/tests/Beam/ModuleNamingTests.fs b/tests/Beam/ModuleNamingTests.fs index 1ff43a471..80c40387d 100644 --- a/tests/Beam/ModuleNamingTests.fs +++ b/tests/Beam/ModuleNamingTests.fs @@ -3,6 +3,10 @@ module Fable.Tests.ModuleNaming open Fable.Tests.Util open Util.Testing +#if FABLE_COMPILER +open Fable.Core.BeamInterop +#endif + // Erlang's module namespace is flat and global, so the Beam backend qualifies every generated // module with the app it belongs to. These tests call across file boundaries into modules whose // file names would otherwise produce a colliding module name — a wrong module atom shows up as @@ -31,3 +35,28 @@ let ``test Module named String does not resolve to OTP string`` () = let ``test Same-named files in different directories both survive`` () = Naming.First.Types.area (Naming.First.Types.Circle 2.0) |> equal 12.0 Naming.Second.Types.name Naming.Second.Types.Red |> equal "red" + +// --- [] pins the generated module's name --- + +// Call the pinned module by the literal atom it is supposed to declare, so that a module named +// anything else is an `undef` at runtime rather than a silently passing test. On .NET the call +// goes through F# and only checks the values. +#if FABLE_COMPILER +let private pinnedValue () : int = emitErlExpr () "fable_tests_pinned:value()" + +let private pinnedDouble (x: int) : int = + emitErlExpr x "fable_tests_pinned:double($0)" +#else +let private pinnedValue () : int = Naming.Pinned.value +let private pinnedDouble (x: int) : int = Naming.Pinned.double x +#endif + +[] +let ``test ModuleName attribute pins the generated Erlang module name`` () = + pinnedValue () |> equal 42 + pinnedDouble 21 |> equal 42 + +[] +let ``test Callers of a pinned module resolve it by its pinned name`` () = + Naming.Pinned.value |> equal 42 + Naming.Pinned.double 21 |> equal 42 diff --git a/tests/Beam/Naming/Pinned.fs b/tests/Beam/Naming/Pinned.fs new file mode 100644 index 000000000..f271aefb2 --- /dev/null +++ b/tests/Beam/Naming/Pinned.fs @@ -0,0 +1,9 @@ +/// The derived name for this file would be `fable_tests_beam_naming_pinned`. The attribute pins it +/// to an exact atom instead — what a module implementing an OTP behaviour, or one called from +/// hand-written Erlang, needs. +[] +module Fable.Tests.Naming.Pinned + +let value = 42 + +let double (x: int) = x * 2