Something went wrong. Try again.
The Monad language. Dependent types, functional programming compiled with LLVM. Hobby project. monad-lang.org
dependent-types language compiler programming-language functional-programming
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452/// External-tool glue: LLVM IR text -> object file -> linked binary.////// This lived twice -- `link_ir` in the compiler's CLI and an inlined copy/// of the same llc/clang/link sequence in the codegen e2e harness, which/// had already drifted (different flags, no build-commit define). It is one/// implementation here, in the `llvm` mote, because none of it knows/// anything about Monad terms: it is the LLVM toolchain seen from outside.////// The runtime C file is a PARAMETER, never a literal. The `runtime` mote/// owns that path (`Runtime.c_path`) and depends on this one, so baking it/// in here would invert the dependency -- and it was previously copied into/// four call sites, each of which had to be found and fixed by hand when/// the file moved.open IO {println}use std::process {exec_cmd, Proc.capture}use std::bench {Bench.now, Bench.report_since}use std::log {fail_line, ok_line, stage}use lib::target {TargetSpec}/// `llc -filetype=obj`, for the machine this compiler is running on.////// A sibling-function wrapper rather than a required argument, for the same/// reason `compile_db_decls_ir` gives: the codegen e2e harnesses that call/// this build and immediately run a binary, so a target is not a thing any/// of them has. A native spec is flag-free, so this buys argv stability, not/// portability: the module header is still `emit.mo`'s x86_64 literal.#[partial]pub def compile_ir_to_obj (ir_path : String) (obj_path : String) : IO I64 := do { let native <- TargetSpec.native; compile_ir_to_obj_with native ir_path obj_path}/// `llc -filetype=obj` for `target`. Returns llc's exit code.////// The target supplies `-mtriple` only when llc's spelling differs from the/// module header's (`llvm/src/target.mo`), so a native build's argv is/// byte-for-byte what it was before targets existed and only a cross build's/// changes.#[partial]pub def compile_ir_to_obj_with (target : TargetSpec) (ir_path : String) (obj_path : String) : IO I64 := do { exec_cmd "llc" (List.append ["-filetype=obj"] (List.append (TargetSpec.llc_argv target) [ir_path, "-o", obj_path]))}/// `clang -c` on the runtime. `extra_flags` carries anything the caller/// wants defined at compile time (the build-commit define, `-v`).////// `-pthread` is not decoration: the runtime is a THREADED Boehm build/// (`GC_THREADS` at the head of runtime/src/runtime.c) and its fiber/// objects are real OS threads, so the compile needs `_REENTRANT` set for/// the system headers and the link needs the threads library. On a glibc/// 2.34+ system the symbols live in libc and the link would happen to/// succeed without it, which is exactly why it is spelled out.#[partial]pub def compile_runtime_obj (runtime_c : String) (extra_flags : List String) (obj_path : String) : IO I64 := do { let inc <- darwin_gc_flag "-I" "includedir"; exec_cmd "clang" (List.append ["-pthread", "-c", runtime_c] (List.append inc (List.append extra_flags ["-o", obj_path])))}/// Link objects into an executable. `-lgc`: the generated runtime's heap is/// collected (see `monad_alloc` in runtime/src/runtime.c, and/// plans/bootstrapping/linear-types-memory.md for why that is temporary)./// The include and library search paths come from the nix cc-wrapper via/// `boehmgc` in nix/packages.nix, so nothing here hardcodes a store path; on/// macOS, from pkg-config (`darwin_gc_flag`)./// `-pthread` here for the same reason as `compile_runtime_obj` above.#[partial]pub def link_objects (objs : List String) (output : String) (extra_flags : List String) : IO I64 := do { let lib <- darwin_gc_flag "-L" "libdir"; exec_cmd "clang" (List.append ["-pthread"] (List.append objs (List.append lib (List.append ["-lgc"] (List.append extra_flags ["-o", output])))))}/// `<flag><dir>` for Boehm GC's `var` directory (`includedir`, `libdir`)/// as `pkg-config` reports it -- macOS only, and nothing when pkg-config/// is absent or does not know `bdw-gc`.////// On Linux the toolchain already finds libgc (the nix cc-wrapper via/// `boehmgc` in nix/packages.nix, or the distro's default paths), so the argv/// there stays exactly what it was. On macOS outside nix, nothing puts a/// package manager's prefix on clang's search path. Asking pkg-config/// rather than naming one keeps this neutral between Homebrew, MacPorts/// and nix: each ships `bdw-gc.pc`, and `PKG_CONFIG_PATH` picks between/// them. Temporary along with libgc itself (see `link_objects`).#[partial]def darwin_gc_flag (flag : String) (var : String) : IO (List String) := do { let darwin <- os_is_darwin; if darwin then do { let dir <- capture_line "pkg-config" ["--variable=" ++ var, "bdw-gc"]; return (dir_flag flag dir) } else return List.empty}/// Whether this compiler is running on macOS, by `uname -s`.#[partial]def os_is_darwin : IO Bool := do { let os <- capture_line "uname" ["-s"]; return (match os { Option.some s => String.beq s "Darwin", Option.none => false, })}def dir_flag (flag : String) (dir : Option String) : List String := match dir { Option.some d => [flag ++ d], Option.none => List.empty,}/// A command's trimmed output, or `none` when it fails (including when it/// is not installed) or prints nothing.#[partial]def capture_line (cmd : String) (args : List String) : IO (Option String) := do { let r <- Proc.capture cmd args; match r { Pair.pair code out => if code == 0 && Bool.not (String.is_empty (String.trim out)) then return (Option.some (String.trim out)) else return Option.none }}/// Maps library names (e.g. `["m"]` from a mote's `[link] libs`) to the/// `clang` flags that link them (`["-lm"]`). Lives here rather/// than in the compiler because `link_objects` above is what knows the/// linker's argv shape -- codegen collects the names and deliberately/// does not translate them.#[partial]pub def map_dash_l (libs : List String) : List String := match libs { List.empty => List.empty, List.cons hd tl => List.cons (String.concat "-l" hd) (map_dash_l tl),}/// The `-L` flags for a program's `[link] pkg-config` packages (the/// closure's union, `lang.module`'s `collect_link_pkgs`), as/// `pkg-config --libs-only-L` reports them.////// This is what makes WHERE a mote's libs live the compiler's business/// rather than the environment's. Leaving it to the nix cc-wrapper's/// `NIX_LDFLAGS` broke `-lssl` in CI: the store-built rung-1's wrapper/// SETS `NIX_LDFLAGS` to libgc's directory alone, so the devshell's/// openssl `-L` never reached the linker, while every other link (only/// `-lgc`) went through fine.////// No packages, no fork, and the argv stays exactly what it was. A failed/// query (pkg-config missing, or a package it does not know) warns with/// the names and links on with no extra flags: the toolchain's own search/// path may still find the libs, and when it does not, ld's/// `cannot find -l...` follows a line saying why.#[partial]pub def pkg_config_link_flags (pkgs : List String) : IO (List String) := match pkgs { List.empty => do { return List.empty }, List.cons _ _ => do { let r <- Proc.capture "pkg-config" (List.cons "--libs-only-L" pkgs); match r { Pair.pair code out => if code == 0 then return (split_ws_bytes (String.to_list out) List.empty) else do { fail_line ("pkg-config could not resolve [link] pkg-config = " ++ ws_join pkgs ++ "; linking with the toolchain's default search path"); return List.empty } } }}/// Whitespace-separated words, empty ones dropped. `cur` is the word/// being read, reversed.#[partial]def split_ws_bytes (bytes : List U8) (cur : List U8) : List String := match bytes { List.empty => ws_word cur, List.cons b rest => if U8.beq b 32u8 || U8.beq b 9u8 || U8.beq b 10u8 || U8.beq b 13u8 then List.append (ws_word cur) (split_ws_bytes rest List.empty) else split_ws_bytes rest (List.cons b cur),}#[partial]def ws_join (xs : List String) : String := match xs { List.empty => "", List.cons hd tl => match tl { List.empty => hd, List.cons _ _ => hd ++ " " ++ ws_join tl, },}def ws_word (rev : List U8) : List String := match rev { List.empty => List.empty, List.cons _ _ => [String.from_list (List.reverse rev)],}#[test]def test_split_ws_bytes_reads_pkg_config_output : Bool := match split_ws_bytes (String.to_list "-L/a/lib -L/b/lib \n") List.empty { List.cons a rest => match rest { List.cons b tail => String.beq a "-L/a/lib" && String.beq b "-L/b/lib" && List.is_empty tail, List.empty => false, }, List.empty => false, }#[test]def test_split_ws_bytes_of_blank_output_is_empty : Bool := List.is_empty (split_ws_bytes (String.to_list " \n") List.empty)/// `-v`, or NOTHING AT ALL. An empty STRING in argv is a FILENAME, not an/// absent flag -- the wrapped native clang tolerates `clang -c "" x.c`, which/// is why this went unnoticed, while a cross gcc refuses the whole command/// with `error: : linker input file not found`.def verbose_argv (verbose : Bool) : List String := if verbose then ["-v"] else List.empty/// `MONAD_BUILD_COMMIT`, trimmed, or `""` when it is unset (or set to/// nothing but whitespace). A nix build's source is a store copy: no `.git`,/// so the compiler inside it cannot name its own revision, and the flake/// exports the one it is building instead.#[partial]def env_commit_hash (from_env : Option String) : String := match from_env { Option.some s => String.trim s, Option.none => ""}/// The commit to bake into a linked binary as `-DMONAD_BUILD_COMMIT`, from/// the two sources that can know it, in the order that lets the more/// specific answer win.////// `MONAD_BUILD_COMMIT` wins because a nix build's source is a store copy/// with no `.git` in it: the flake exports the revision it is building, and/// that is the only source that can answer there.////// Otherwise the answer is the COMPILER's own revision -- the string/// `monad version` prints, threaded down from `cli/src/main.mo`'s/// `build_commit` native. This used to be a `git rev-parse --short HEAD`/// probe run in the WORKING DIRECTORY, which asked the wrong repository/// entirely: a user compiling their own program got their own repo's HEAD/// stamped into monad's runtime (two forks per link to do it). Outside any/// repository the probe's redirect still created the file, so the trim/// produced `""` rather than the `unknown` the docs promise -- the/// compiler could always have named itself here, and now does.////// `unknown` survives as the last resort, for a compiler that cannot name/// itself (the `monad-rs run cli/src/main.mo` prototype, where the native/// falls back to its own default): the string it stamps is then the one the/// docs already described.pub def build_commit_define (from_env : Option String) (compiler_commit : String) : String := if String.is_empty (env_commit_hash from_env) then (if String.is_empty (String.trim compiler_commit) then "unknown" else String.trim compiler_commit) else env_commit_hash from_env/// Write LLVM IR to disk and link it into a native binary via llc + clang./// Returns 0 on success, 1 on any tool failure (each reported on the way/// out).////// `ir_path` is the file `llc` is pointed at, and the CALLER owns it./// That is deliberate: `llc` records its input's name in the object it/// emits, so this path ends up inside the linked binary. Naming it after/// the caller's output would therefore make the artifact depend on/// something that is not an input, and two builds of one source under two/// output names would differ by a byte -- see `Build.artifact_ir_path`,/// which is what the cached `build` path passes here. A caller with no/// key to name it by (a `run`, a test driver, a build whose compiler/// digest could not be taken) passes the output-derived path by way of/// `cli/src/main.mo`'s `resolve_ir_path`, which is the behaviour every one/// of them had before this was a parameter.////// The output-derived `.ll` is still written, as a convenience copy, for/// the readers that already know that path -- `tools/debug_transparency_/// oracle.sh` and anyone inspecting a build by hand. It is written from/// the same text rather than copied, and it is never what `llc` reads:/// a convenience copy that the compiler consulted would put the leak/// straight back.////// `link_libs` is the deduplicated union of `[link] libs` across every mote/// in the program's dependency closure (`lang.module`'s `collect_link_libs`);/// each becomes a `-l<lib>` on the final link, which is what makes a mote/// declaring `libs = ["m"]` actually link libm. Empty preserves the original/// no-extra-flags behaviour.////// `link_pkgs` is the same union over `[link] pkg-config`: where those/// libs live, resolved to `-L` flags by `pkg_config_link_flags` rather/// than left to the environment.////// `compiler_commit` is the revision of the COMPILER doing the linking/// (`cli/src/main.mo`'s `build_commit` native, the same string `monad/// version` prints), which is what gets stamped into the linked program/// unless `MONAD_BUILD_COMMIT` overrides it -- see `build_commit_define`./// It is a parameter rather than something this def works out for itself/// because the answer is the caller's identity, and because finding it out/// used to cost a `git` fork in the working directory that named the wrong/// repository.////// Per-stage `Bench.report` timing is gated on `verbose`, same convention as/// `lang.codegen.emit`'s `compile_loaded_modules_to_ir` -- added to measure/// where the "compile_file total minus compile_loaded_modules_to_ir total"/// remainder actually goes, before guessing at a fix.#[partial]pub def link_ir (runtime_c : String) (ir_text : String) (ir_path : Path) (output_dir : Path) (output_name : Path) (link_libs : List String) (link_pkgs : List String) (compiler_commit : String) (verbose : Bool) (spec : TargetSpec) : IO I64 { // `Path.join` here is THE fix for the mangled-double-slash bug this // whole `Path` type exists to prevent: if `output_name` is already // absolute, it replaces `output_dir` outright instead of naively // concatenating (`os.path.join`-style semantics). let target := Path.join output_dir output_name; let obj_path := Path.with_suffix target ".o"; // Beside the other artifacts (i.e. next to `target`), NOT in // `output_dir` -- an absolute or directory-bearing `output_name` // makes those two different places, and only the former is created // below. let runtime_obj := Path.with_suffix target "_runtime.o"; let ir_path_s := Path.to_string ir_path; let obj_path_s := Path.to_string obj_path; let runtime_obj_s := Path.to_string runtime_obj; let output_path_s := Path.to_string target; // Nothing creates the directory these artifacts are written into. // The CLI's default output dir is `/tmp/monad_out_<pid>` -- a fresh // path every single run -- so `clang -o .../monad_runtime.o` failed // with "unable to open output file ... No such file or directory" // AFTER a full ~18-minute codegen had already succeeded. Derived from // the JOINED target rather than `output_dir` alone, because // `Path.join` lets an absolute `output_name` replace `output_dir` // outright, and because a relative name like `out/hello` puts the // real directory inside the NAME. An empty result means "current // directory", which needs no mkdir. let target_dir : String := Path.parent target; let _mkdir <- (if String.beq target_dir "" then return 0 else exec_cmd "mkdir" ["-p", target_dir]); // ...and the IR's own directory, which is a DIFFERENT one on the // cached `build` path: the target sits in `<target-dir>/<profile>/` // while the IR sits in `<target-dir>/store/`. Two calls rather than // one because which two directories those are is the caller's // business; `mkdir -p` is idempotent, and this is two forks against a // compile that costs tens of seconds. let ir_dir : String := Path.parent ir_path; let _mkdir_ir <- (if String.beq ir_dir "" then return 0 else exec_cmd "mkdir" ["-p", ir_dir]); let t_write : I64 <- Bench.now; IO.write_file ir_path ir_text; // The convenience copy, for a reader that already knows this path // because `-o` implies it. Skipped when it IS the IR (the callers with // no key to name one by), so the common case still writes one file. let beside : String := Path.to_string (Path.with_suffix target ".ll"); if Bool.not (String.beq beside ir_path_s) then do { IO.write_file (Path.path beside) ir_text; return unit } else return unit; if verbose then do { Bench.report_since "link_ir: write .ll" t_write; return unit } else return unit; // Stage trace (`std.log`): each line prints BEFORE its `Bench.now` // start, so a user watching a long stage sees life before it ends. stage verbose "link: llc"; let t_llc : I64 <- Bench.now; let result <- compile_ir_to_obj_with spec ir_path_s obj_path_s; if verbose then do { Bench.report_since "link_ir: llc" t_llc; return unit } else return unit; if not (result == 0) then do { fail_line ("Compiling ir " ++ ir_path_s ++ " with llc failed"); return 1 } else do { stage verbose "link: clang runtime.c"; let t_rtc : I64 <- Bench.now; let from_env <- IO.get_env "MONAD_BUILD_COMMIT"; let build_hash : String := build_commit_define from_env compiler_commit; let commit_flag := "-DMONAD_BUILD_COMMIT=\"" ++ build_hash ++ "\""; let result <- compile_runtime_obj runtime_c (List.append [commit_flag] (verbose_argv verbose)) runtime_obj_s; if verbose then do { Bench.report_since "link_ir: clang runtime.c" t_rtc; return unit } else return unit; if not (result == 0) then do { fail_line "compiling runtime failed"; return 1 } else do { stage verbose "link: clang link"; let t_link : I64 <- Bench.now; // `-l<lib>` for every library the program's motes declared, // ahead of the verbose flag. An empty `link_libs` leaves the // argv exactly as it was. let dash_l : List String := map_dash_l link_libs; // `-L` before the `-l`s it serves; `link_objects` puts both // after the objects. let pkg_flags : List String <- pkg_config_link_flags link_pkgs; let link_flags : List String := List.append pkg_flags (List.append dash_l (verbose_argv verbose)); let result <- link_objects [obj_path_s, runtime_obj_s] output_path_s link_flags; if verbose then do { Bench.report_since "link_ir: clang link" t_link; return unit } else return unit; if not (result == 0) then do { fail_line "linking failed"; return 1 } else do { ok_line "Compilation finished"; return 0 } } }}// `build_commit_define`'s three answers, pinned. Its whole job is to pick// between sources that disagree -- the flake's export, the compiler's own// revision and "no answer at all" -- and the middle one is the only case a// developer ever sees, which is why it is the one a regression would land in// silently: a binary stamped with the wrong revision still builds and runs.#[test]def test_build_commit_define_prefers_the_environment : Bool := String.beq (build_commit_define (Option.some "env-c0ffee") "compiler-1") "env-c0ffee"#[test]def test_build_commit_define_trims_the_environment : Bool := String.beq (build_commit_define (Option.some " env-c0ffee ") "compiler-1") "env-c0ffee"// A set-but-blank variable is the shape `git rev-parse` left behind when it// had nothing to say (the redirect still wrote the file), so it has to read// as unset rather than as a revision spelled with spaces.#[test]def test_build_commit_define_reads_a_blank_environment_as_unset : Bool := String.beq (build_commit_define (Option.some " ") "compiler-1") "compiler-1"#[test]def test_build_commit_define_falls_back_to_the_compiler : Bool := String.beq (build_commit_define Option.none "compiler-1") "compiler-1"#[test]def test_build_commit_define_keeps_unknown_as_the_last_resort : Bool := String.beq (build_commit_define Option.none "") "unknown"#[test]def test_build_commit_define_keeps_unknown_when_the_compiler_is_blank : Bool := String.beq (build_commit_define Option.none " ") "unknown"// An empty STRING in argv is a filename, not an absent flag -- a cross cc dies// on it where the wrapped native clang tolerates it -- so the non-verbose// answer has to be an empty LIST.#[test]def test_verbose_argv_is_empty_when_not_verbose : Bool := List.is_empty (verbose_argv false)#[test]def test_verbose_argv_is_the_flag_when_verbose : Bool := match verbose_argv true { List.cons hd tl => String.beq hd "-v" && List.is_empty tl, List.empty => false, }