feat: Support partial application (-1 cases)

Here not supported the following yet:

- partial application with 2+ missing arguments
- variant functions to function objects
- static 1-ary function to function objects

boot/MiloneLang/CIrGen.fs

@@ -69,6 +69,22 @@ let ctxAddStmt (ctx: Ctx) stmt =
 let ctxAddDecl (ctx: Ctx) decl =
   { ctx with Decls = decl :: ctx.Decls }
 
+let ctxAddFunDecl (ctx: Ctx) sTy tTy =
+  let funTy = MTy.Fun (sTy, tTy)
+  let ident, ctx = ctxUniqueTyName ctx funTy
+  let selfTy = CTy.Struct ident
+  let envTy = CTy.Ptr CTy.Void
+  let sTy, ctx = cty ctx sTy
+  let tTy, ctx = cty ctx tTy
+  let fields = ["fun", CTy.FunPtr ([envTy; sTy], tTy); "env", envTy]
+  let ctx: Ctx =
+    { ctx with
+        TySerial = ctx.TySerial + 1
+        TyEnv = ctx.TyEnv |> Map.add funTy selfTy
+        Decls = CDecl.Struct (ident, fields, []) :: ctx.Decls
+    }
+  selfTy, ctx
+
 let ctxAddListDecl (ctx: Ctx) itemTy =
   let listTy = MTy.List itemTy
   let itemTy, ctx = cty ctx itemTy
@@ -179,9 +195,14 @@ let cty (ctx: Ctx) (ty: MTy): CTy * Ctx =
     CTy.Char, ctx
   | MTy.Str ->
     CTy.Struct "String", ctx
-  | MTy.Obj
-  | MTy.Fun _ ->
+  | MTy.Obj ->
     CTy.Ptr CTy.Void, ctx
+  | MTy.Fun (sTy, tTy) ->
+    match ctx.TyEnv |> Map.tryFind ty with
+    | None ->
+      ctxAddFunDecl ctx sTy tTy
+    | Some ty ->
+      ty, ctx
   | MTy.List itemTy ->
     match ctx.TyEnv |> Map.tryFind ty with
     | None ->
@@ -365,11 +386,29 @@ let genExprCall ctx callee args ty =
     let args, ctx = genExprList ctx args
     CExpr.Call (callee, args), ctx
 
+let genExprApp ctx callee arg =
+  let callee, ctx = genExpr ctx callee
+  let arg, ctx = genExpr ctx arg
+  let funPtr = CExpr.Nav (callee, "fun")
+  let envArg = CExpr.Nav (callee, "env")
+  CExpr.Call (funPtr, [envArg; arg]), ctx
+
 let genInitExprCore ctx serial expr ty =
   let ident = ctxUniqueName ctx serial
   let cty, ctx = cty ctx ty
   ctxAddStmt ctx (CStmt.Let (ident, expr, cty))
 
+let genInitFun ctx serial funSerial envSerial ty =
+  let ident = ctxUniqueName ctx serial
+  let ty, ctx = cty ctx ty
+  let fields =
+    [
+      "fun", CExpr.Ref (ctxUniqueName ctx funSerial)
+      "env", CExpr.Ref (ctxUniqueName ctx envSerial)
+    ]
+  let initExpr = CExpr.Init (fields, ty)
+  ctxAddStmt ctx (CStmt.Let (ident, Some initExpr, ty))
+
 let genInitBox ctx serial arg =
   let argTy, ctx = cty ctx (mexprTy arg)
   let arg, ctx = genExpr ctx arg
@@ -440,6 +479,11 @@ let genStmtLetVal ctx serial init ty =
   | MInit.Call (callee, args) ->
     let expr, ctx = genExprCall ctx callee args ty
     genInitExprCore ctx serial (Some expr) ty
+  | MInit.App (callee, arg) ->
+    let expr, ctx = genExprApp ctx callee arg
+    genInitExprCore ctx serial (Some expr) ty
+  | MInit.Fun (funSerial, envSerial) ->
+    genInitFun ctx serial funSerial envSerial ty
   | MInit.Box arg ->
     genInitBox ctx serial arg
   | MInit.Cons (head, tail, itemTy) ->

boot/MiloneLang/CPrinting.fs

@@ -32,6 +32,16 @@ let opStr op =
   | COp.Lt -> "<"
   | COp.Le -> "<="
 
+let cprintTyFunPtr name argTys resultTy acc =
+  let acc = cprintTy acc resultTy
+  let acc = acc *- "(*" *- name *- ")" *- "("
+  let rec go acc argTys =
+    (argTys, acc) |> join ", " (fun (argTy, acc) ->
+      cprintTy acc argTy
+    )
+  let acc = go acc argTys
+  acc *- ")"
+
 let rec cprintTy acc ty: string list =
   match ty with
   | CTy.Void ->
@@ -43,11 +53,21 @@ let rec cprintTy acc ty: string list =
   | CTy.Ptr ty ->
     let acc = cprintTy acc ty
     acc *- "*"
+  | CTy.FunPtr (argTys, resultTy) ->
+    cprintTyFunPtr "" argTys resultTy acc
   | CTy.Struct ident ->
     acc *- "struct " *- ident
   | CTy.Enum ident ->
     acc *- "enum " *- ident
 
+/// `T x` or `T (*x)(..)`
+let cprintTyWithName acc name ty =
+  match ty with
+  | CTy.FunPtr (argTys, resultTy) ->
+    cprintTyFunPtr name argTys resultTy acc
+  | _ ->
+    cprintTy acc ty *- " " *- name
+
 let rec cprintParams acc ps: string list =
   let rec go acc ps =
     match ps with
@@ -203,8 +223,7 @@ let cprintStmt acc indent stmt: string list =
     acc *- ";" *- eol
   | CStmt.Let (name, init, ty) ->
     let acc = acc *- indent
-    let acc = cprintTy acc ty
-    let acc = acc *- " " *- name
+    let acc = cprintTyWithName acc name ty
     let acc =
       match init with
       | Some init ->
@@ -219,8 +238,8 @@ let cprintStmt acc indent stmt: string list =
       | CTy.Ptr ty -> ty
       | _ -> failwithf "Expected pointer type but %A" valPtrTy
     let acc = acc *- indent
-    let acc = cprintTy acc varTy
-    let acc = acc *- " " *- name *- " = ("
+    let acc = cprintTyWithName acc name varTy
+    let acc = acc *- " = ("
     let acc = cprintTy acc varTy
     let acc = acc *- ")malloc(sizeof("
     let acc = cprintTy acc valTy
@@ -259,8 +278,8 @@ let cprintDecl acc decl =
           acc
         | (ident, ty) :: fields ->
           let acc = acc *- indent
-          let acc = cprintTy acc ty
-          let acc = acc *- " " *- ident *- ";" *- eol
+          let acc = cprintTyWithName acc ident ty
+          let acc = acc *- ";" *- eol
           go acc fields
       go acc fields
     let acc = acc *- "struct " *- ident *- " {" *- eol
@@ -289,8 +308,8 @@ let cprintDecl acc decl =
     let acc = acc *- "};" *- eol
     acc
   | CDecl.Fun (ident, args, resultTy, body) ->
-    let acc = cprintTy acc resultTy
-    let acc = acc *- " " *- ident *- "("
+    let acc = cprintTyWithName acc ident resultTy
+    let acc = acc *- "("
     let acc = cprintParams acc args
     let acc = acc *- ") {" *- eol
     let acc = cprintStmts acc "    " body