Make internal pattern match names invisible

Fixes #46

lib/typing/patternmatching.ml

@@ -40,7 +40,7 @@ module type S = sig
     (Ast.loc * Ast.pattern * Ast.expr) list ->
     Typed_tree.typed_expr
 
-  val pattern_id : int -> Ast.pattern -> string * Ast.loc
+  val pattern_id : int -> Ast.pattern -> string * Ast.loc * bool (* Is wildcard *)
 
   val convert_decl :
     Env.t -> Ast.decl list -> Env.t * (string * typed_expr) list
@@ -1200,8 +1200,8 @@ module Make (C : Core) (R : Recs) = struct
     | [] -> List.rev expanded
 
   let pattern_id i = function
-    | Ast.Pvar (loc, id) -> (id, loc)
-    | Ptup (loc, _) | Pwildcard loc | Precord (loc, _) -> (expr_name [ i ], loc)
+    | Ast.Pvar (loc, id) -> (id, loc, false)
+    | Ptup (loc, _) | Pwildcard loc | Precord (loc, _) -> (expr_name [ i ], loc, true)
     | Pctor ((loc, _), _) | Plit_int (loc, _) | Plit_char (loc, _) | Por (loc, _)
       ->
         raise (Error (loc, "Unexpected pattern in declaration"))

lib/typing/patternmatching.mli

@@ -27,7 +27,7 @@ module type S = sig
     (Ast.loc * Ast.pattern * Ast.expr) list ->
     Typed_tree.typed_expr
 
-  val pattern_id : int -> Ast.pattern -> string * Ast.loc
+  val pattern_id : int -> Ast.pattern -> string * Ast.loc * bool
 
   val convert_decl :
     Env.t -> Ast.decl list -> Env.t * (string * Typed_tree.typed_expr) list

lib/typing/typing.ml

@@ -323,7 +323,7 @@ let handle_params env loc (params : Ast.decl list) pattern_id ret =
 
   List.fold_left_map
     (fun (env, i) { Ast.loc; pattern; dattr; annot } ->
-      let id, idloc = pattern_id i pattern in
+      let id, idloc, _ = pattern_id i pattern in
       let type_id, qparams =
         match annot with
         | None ->
@@ -685,10 +685,11 @@ end = struct
 
   and convert_let ~global env loc (decl : Ast.decl)
       { Ast.pattr = _; pexpr = block } =
-    let id, idloc = pattern_id 0 decl.pattern in
+    let id, idloc, has_exprname = pattern_id 0 decl.pattern in
     let e1 = typeof_annot_decl env loc decl.annot block in
     let mut = mut_of_pattr decl.dattr in
-    let const = e1.attr.const && not mut in
+    let const = if has_exprname then false else e1.attr.const && not mut in
+    let global = if has_exprname then false else global in
     let env =
       Env.add_value id
         { Env.def_value with typ = e1.typ; const; global; mut }
@@ -715,7 +716,11 @@ end = struct
       handle_params env loc params pattern_id None
     in
     let nparams =
-      List.mapi (fun i (d : Ast.decl) -> fst (pattern_id i d.pattern)) params
+      List.mapi
+        (fun i (d : Ast.decl) ->
+          let id, _, _ = pattern_id i d.pattern in
+          id)
+        params
     in
 
     let env, param_exprs = convert_decl env params in
@@ -788,7 +793,11 @@ end = struct
       handle_params env loc params pattern_id return_annot
     in
     let nparams =
-      List.mapi (fun i (d : Ast.decl) -> fst (pattern_id i d.pattern)) params
+      List.mapi
+        (fun i (d : Ast.decl) ->
+          let id, _, _ = pattern_id i d.pattern in
+          id)
+        params
     in
 
     let body_env, param_exprs = convert_decl body_env params in

test/autogen.t/run.t

@@ -513,12 +513,10 @@ Copy closures
   source_filename = "context"
   target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
 
+  %closure = type { i8*, i8* }
   %tuple_int = type { i64 }
   %tuple_fn_.int = type { %closure }
-  %closure = type { i8*, i8* }
 
-  @schmu___expr0 = internal constant %tuple_int { i64 1 }
-  @schmu___expr0__2 = global %tuple_fn_.int zeroinitializer, align 16
   @schmu_c = global %closure zeroinitializer, align 16
   @0 = private unnamed_addr constant { i64, i64, [6 x i8] } { i64 5, i64 5, [6 x i8] c"hello\00" }
 
@@ -548,20 +546,23 @@ Copy closures
 
   define void @schmu_hmm(%closure* noalias %0) {
   entry:
-    %funptr1 = bitcast %closure* %0 to i8**
-    store i8* bitcast (i64 (i8*)* @schmu_capture to i8*), i8** %funptr1, align 8
-    %1 = tail call i8* @malloc(i64 24)
-    %clsr_schmu_capture = bitcast i8* %1 to { i8*, i8*, i64 }*
-    %2 = alloca i64, align 8
-    store i64 1, i64* %2, align 8
+    %1 = alloca %tuple_int, align 8
+    %"01" = bitcast %tuple_int* %1 to i64*
+    store i64 1, i64* %"01", align 8
+    %funptr2 = bitcast %closure* %0 to i8**
+    store i8* bitcast (i64 (i8*)* @schmu_capture to i8*), i8** %funptr2, align 8
+    %2 = tail call i8* @malloc(i64 24)
+    %clsr_schmu_capture = bitcast i8* %2 to { i8*, i8*, i64 }*
+    %3 = alloca i64, align 8
+    store i64 1, i64* %3, align 8
     %a = getelementptr inbounds { i8*, i8*, i64 }, { i8*, i8*, i64 }* %clsr_schmu_capture, i32 0, i32 2
     store i64 1, i64* %a, align 8
-    %ctor2 = bitcast { i8*, i8*, i64 }* %clsr_schmu_capture to i8**
-    store i8* bitcast (i8* (i8*)* @__ctor_tup-i to i8*), i8** %ctor2, align 8
+    %ctor3 = bitcast { i8*, i8*, i64 }* %clsr_schmu_capture to i8**
+    store i8* bitcast (i8* (i8*)* @__ctor_tup-i to i8*), i8** %ctor3, align 8
     %dtor = getelementptr inbounds { i8*, i8*, i64 }, { i8*, i8*, i64 }* %clsr_schmu_capture, i32 0, i32 1
     store i8* null, i8** %dtor, align 8
     %envptr = getelementptr inbounds %closure, %closure* %0, i32 0, i32 1
-    store i8* %1, i8** %envptr, align 8
+    store i8* %2, i8** %envptr, align 8
     ret void
   }
 
@@ -750,25 +751,28 @@ Copy closures
 
   define i64 @main(i64 %arg) {
   entry:
+    %0 = alloca %tuple_fn_.int, align 8
+    %"02" = bitcast %tuple_fn_.int* %0 to %closure*
     %ret = alloca %closure, align 8
     call void @schmu_hmm(%closure* %ret)
-    %0 = bitcast %closure* %ret to i8*
-    call void @llvm.memcpy.p0i8.p0i8.i64(i8* bitcast (%tuple_fn_.int* @schmu___expr0__2 to i8*), i8* %0, i64 16, i1 false)
-    call void @__copy_.i(%closure* getelementptr inbounds (%tuple_fn_.int, %tuple_fn_.int* @schmu___expr0__2, i32 0, i32 0))
+    %1 = bitcast %closure* %"02" to i8*
+    %2 = bitcast %closure* %ret to i8*
+    call void @llvm.memcpy.p0i8.p0i8.i64(i8* %1, i8* %2, i64 16, i1 false)
+    call void @__copy_.i(%closure* %"02")
     call void @schmu_test(%closure* @schmu_c)
-    %1 = alloca %closure, align 8
-    %2 = bitcast %closure* %1 to i8*
-    call void @llvm.memcpy.p0i8.p0i8.i64(i8* %2, i8* bitcast (%closure* @schmu_c to i8*), i64 16, i1 false)
-    call void @__copy_.u(%closure* %1)
-    %funcptr2 = bitcast %closure* %1 to i8**
-    %loadtmp = load i8*, i8** %funcptr2, align 8
+    %3 = alloca %closure, align 8
+    %4 = bitcast %closure* %3 to i8*
+    call void @llvm.memcpy.p0i8.p0i8.i64(i8* %4, i8* bitcast (%closure* @schmu_c to i8*), i64 16, i1 false)
+    call void @__copy_.u(%closure* %3)
+    %funcptr3 = bitcast %closure* %3 to i8**
+    %loadtmp = load i8*, i8** %funcptr3, align 8
     %casttmp = bitcast i8* %loadtmp to void (i8*)*
-    %envptr = getelementptr inbounds %closure, %closure* %1, i32 0, i32 1
+    %envptr = getelementptr inbounds %closure, %closure* %3, i32 0, i32 1
     %loadtmp1 = load i8*, i8** %envptr, align 8
     call void %casttmp(i8* %loadtmp1)
-    call void @__free_.u(%closure* %1)
+    call void @__free_.u(%closure* %3)
     call void @__free_.u(%closure* @schmu_c)
-    call void @__free_tup-.i(%tuple_fn_.int* @schmu___expr0__2)
+    call void @__free_tup-.i(%tuple_fn_.int* %0)
     call void @__free_.i(%closure* %ret)
     ret i64 0
   }