From 0941ea284fafd493259b1d5aafff58a60ab2d2ba Mon Sep 17 00:00:00 2001
From: Leonardo de Moura <leonardo@microsoft.com>
Date: Wed, 23 Oct 2019 15:06:44 -0700
Subject: [PATCH] feat: suppress irrelevant arguments in extern calls

---
 library/Init/Lean/Compiler/ExternAttr.lean | 10 --------
 library/Init/Lean/Compiler/IR/Basic.lean   |  4 +++
 library/Init/Lean/Compiler/IR/EmitC.lean   | 30 +++++++++++++++++++---
 3 files changed, 30 insertions(+), 14 deletions(-)

diff --git a/library/Init/Lean/Compiler/ExternAttr.lean b/library/Init/Lean/Compiler/ExternAttr.lean
index 4eec10fb24..5803003d3a 100644
--- a/library/Init/Lean/Compiler/ExternAttr.lean
+++ b/library/Init/Lean/Compiler/ExternAttr.lean
@@ -124,12 +124,6 @@ expandExternPatternAux args pattern.length pattern.mkIterator ""
 def mkSimpleFnCall (fn : String) (args : List String) : String :=
 fn ++ "(" ++ ((args.intersperse ", ").foldl HasAppend.append "") ++ ")"
 
-def expandExternEntry : ExternEntry → List String → Option String
-| ExternEntry.adhoc _, args       => none -- backend must expand it
-| ExternEntry.standard _ fn, args => some (mkSimpleFnCall fn args)
-| ExternEntry.inline _ pat, args  => some (expandExternPattern pat args)
-| ExternEntry.foreign _ fn, args  => some (mkSimpleFnCall fn args)
-
 def ExternEntry.backend : ExternEntry → Name
 | ExternEntry.adhoc n      => n
 | ExternEntry.inline n _   => n
@@ -146,10 +140,6 @@ def getExternEntryForAux (backend : Name) : List ExternEntry → Option ExternEn
 def getExternEntryFor (d : ExternAttrData) (backend : Name) : Option ExternEntry :=
 getExternEntryForAux backend d.entries
 
-def mkExternCall (d : ExternAttrData) (backend : Name) (args : List String) : Option String :=
-do e ← getExternEntryFor d backend;
-   expandExternEntry e args
-
 def isExtern (env : Environment) (fn : Name) : Bool :=
 (getExternAttrData env fn).isSome
 
diff --git a/library/Init/Lean/Compiler/IR/Basic.lean b/library/Init/Lean/Compiler/IR/Basic.lean
index 84405cf2db..9bb612715f 100644
--- a/library/Init/Lean/Compiler/IR/Basic.lean
+++ b/library/Init/Lean/Compiler/IR/Basic.lean
@@ -416,6 +416,10 @@ def resultType : Decl → IRType
 | Decl.fdecl _ _ t _  => t
 | Decl.extern _ _ t _ => t
 
+def isExtern : Decl → Bool
+| Decl.extern _ _ _ _ => true
+| _ => false
+
 end Decl
 
 @[export lean_ir_mk_decl] def mkDecl (f : FunId) (xs : Array Param) (ty : IRType) (b : FnBody) : Decl := Decl.fdecl f xs ty b
diff --git a/library/Init/Lean/Compiler/IR/EmitC.lean b/library/Init/Lean/Compiler/IR/EmitC.lean
index dc3e01be02..c952ae28ae 100644
--- a/library/Init/Lean/Compiler/IR/EmitC.lean
+++ b/library/Init/Lean/Compiler/IR/EmitC.lean
@@ -96,10 +96,13 @@ toCInitName n >>= emit
 
 def emitFnDeclAux (decl : Decl) (cppBaseName : String) (addExternForConsts : Bool) : M Unit :=
 do let ps := decl.params;
+   env ← getEnv;
    when (ps.isEmpty && addExternForConsts) (emit "extern ");
    emit (toCType decl.resultType ++ " " ++ cppBaseName);
    unless (ps.isEmpty) $ do {
      emit "(";
+     -- We omit irrelevant parameters for extern constants
+     let ps := if isExternC env decl.name then ps.filter (fun p => !p.ty.isIrrelevant) else ps;
      if ps.size > closureMaxArgs && isBoxedName decl.name then
        emit "lean_object**"
      else
@@ -394,14 +397,33 @@ do emitLhs z;
 def toStringArgs (ys : Array Arg) : List String :=
 ys.toList.map argToCString
 
+def emitSimpleExternalCall (f : String) (ps : Array Param) (ys : Array Arg) : M Unit :=
+do emit f; emit "(";
+   -- We must remove irrelevant arguments to extern calls.
+   ys.size.mfold
+     (fun i (first : Bool) =>
+       if (ps.get! i).ty.isIrrelevant then
+         pure first
+       else do
+         unless first (emit ", ");
+         emitArg (ys.get! i);
+         pure false)
+     true;
+   emitLn ");";
+   pure ()
+
+def emitExternCall (f : FunId) (ps : Array Param) (extData : ExternAttrData) (ys : Array Arg) : M Unit :=
+match getExternEntryFor extData `c with
+| some (ExternEntry.standard _ extFn) => emitSimpleExternalCall extFn ps ys
+| some (ExternEntry.inline _ pat)     => emit (expandExternPattern pat (toStringArgs ys))
+| some (ExternEntry.foreign _ extFn)  => emitSimpleExternalCall extFn ps ys
+| _ => throw ("failed to emit extern application '" ++ toString f ++ "'")
+
 def emitFullApp (z : VarId) (f : FunId) (ys : Array Arg) : M Unit :=
 do emitLhs z;
    decl ← getDecl f;
    match decl with
-   | Decl.extern _ _ _ extData =>
-     match mkExternCall extData `c (toStringArgs ys) with
-     | some c => emit c *> emitLn ";"
-     | none   => throw ("failed to emit extern application '" ++ toString f ++ "'")
+   | Decl.extern _ ps _ extData => emitExternCall f ps extData ys
    | _ => do emitCName f; when (ys.size > 0) (do emit "("; emitArgs ys; emit ")"); emitLn ";"
 
 def emitPartialApp (z : VarId) (f : FunId) (ys : Array Arg) : M Unit :=