May 2020 - Typer - mailman.iro.umontreal.ca

[Git][monnier/typer][alice] add lexp_lexp' for genericity
by Alice de Berny 30 May '20

30 May '20

Alice de Berny pushed to branch alice at Stefan / Typer Commits: ff5ad4d5 by irradiee at 2020-05-30T13:45:44-04:00 add lexp_lexp' for genericity - - - - - 7 changed files: - src/debug.ml - src/elab.ml - src/eval.ml - src/inverse_subst.ml - src/lexp.ml - src/opslexp.ml - src/unification.ml Changes: ===================================== src/debug.ml ===================================== @@ -157,7 +157,7 @@ let debug_lexp_decls decls = ) decls -let print_hc_table = WHC.iter (fun e -> print_int (Hashtbl.hash e); +(* let print_hc_table table = WHC.iter (fun e -> print_int (Hashtbl.hash e); print_string "\t"; lexp_print e; - print_string "\n") hc_table + print_string "\n") table *) ===================================== src/elab.ml ===================================== @@ -121,7 +121,7 @@ let sform_default_ectx = ref empty_elab_context * to errors in the user's code). *) let elab_check_sort (ctx : elab_context) lsort var ltp = - let (lp, h) = (try OL.lexp_whnf lsort (ectx_to_lctx ctx) + let lp = lexp_lexp' (try OL.lexp_whnf lsort (ectx_to_lctx ctx) with e -> info ~print_action:(fun _ -> lexp_print lsort; print_newline ()) ~loc:(lexp_location lsort) @@ -416,7 +416,7 @@ let rec meta_to_var ids (e : lexp) = (* `o` is the binding depth at which we are relative to the "root" * of the expression (i.e. where the new vars will be inserted). *) and loop o e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm _ -> e | SortLevel SLz -> e @@ -579,7 +579,7 @@ and infer (p : sexp) (ctx : elab_context): lexp * ltype = and elab_special_form ctx f args ot = let loc = lexp_location f in - let (lp, h) = OL.lexp_whnf f (ectx_to_lctx ctx) in + let lp = lexp_lexp' (OL.lexp_whnf f (ectx_to_lctx ctx)) in match lp with | Builtin ((_, name), _, _) -> (* Special form. *) @@ -628,7 +628,7 @@ and get_implicit_arg ctx loc oname t = (* Build the list of implicit arguments to instantiate. *) and instantiate_implicit e t ctx = let rec instantiate t args = - let (lp, h) = OL.lexp_whnf t (ectx_to_lctx ctx) in + let lp = lexp_lexp' (OL.lexp_whnf t (ectx_to_lctx ctx)) in match lp with | Arrow ((Aerasable | Aimplicit) as ak, (_, v), t1, _, t2) -> let arg = get_implicit_arg ctx (lexp_location e) v t1 in @@ -641,7 +641,7 @@ and infer_type pexp ectx var = * Sort (?s), but in most cases the metavar would be allocated * unnecessarily. *) let t, s = infer pexp ectx in - (let (lp, h) = OL.lexp_whnf s (ectx_to_lctx ectx) in + (let lp = lexp_lexp' (OL.lexp_whnf s (ectx_to_lctx ectx)) in match lp with | Sort (_, _) -> () (* All clear! *) (* FIXME: We could automatically coerce Type levels to Sorts, so we @@ -705,7 +705,7 @@ and check (p : sexp) (t : ltype) (ctx : elab_context): lexp = * do lots of other things. *) and check_inferred ctx e inferred_t t = let (e, inferred_t) = - let (lp, h) = OL.lexp_whnf t (ectx_to_lctx ctx) in + let lp = lexp_lexp' (OL.lexp_whnf t (ectx_to_lctx ctx)) in match lp with | Arrow ((Aerasable | Aimplicit), _, _, _, _) -> (e, inferred_t) @@ -757,7 +757,7 @@ and check_case rtype (loc, target, ppatterns) ctx = | [] -> () in (cs, args) | None - -> let (lp, h) = OL.lexp_whnf it' (ectx_to_lctx ctx) in + -> let lp = lexp_lexp' (OL.lexp_whnf it' (ectx_to_lctx ctx)) in match lp with | Inductive (_, _, fargs, constructors) -> let (s, targs) = List.fold_left @@ -774,13 +774,13 @@ and check_case rtype (loc, target, ppatterns) ctx = it_cs_as := Some (it', cs, args); (cs, args) | _ -> let call_split e = - let (lp, h) = OL.lexp_whnf e (ectx_to_lctx ctx) in + let lp = lexp_lexp' (OL.lexp_whnf e (ectx_to_lctx ctx)) in match lp with | Call (f, args) -> (f, args) | _ -> (e,[]) in let (it, targs) = call_split tltp in let constructors = - let (lp, h) = OL.lexp_whnf it (ectx_to_lctx ctx) in + let lp = lexp_lexp' (OL.lexp_whnf it (ectx_to_lctx ctx)) in match lp with | Inductive (_, _, fargs, constructors) -> assert (List.length fargs = List.length targs); @@ -806,16 +806,16 @@ and check_case rtype (loc, target, ppatterns) ctx = let loc = sexp_location pctor in let lctor, ct = infer pctor ctx in let rec inst_args ctx e = - let (lp, h) = OL.lexp_whnf e (ectx_to_lctx ctx) in - match lp with + let lp = OL.lexp_whnf e (ectx_to_lctx ctx) in + match lexp_lexp' lp with | Lambda (Aerasable, v, t, body) -> let arg = newMetavar (ectx_to_lctx ctx) (ectx_to_scope_level ctx) v t in let nctx = ctx_extend ctx v Variable t in let body = inst_args nctx body in mkSusp body (S.substitute arg) - | e -> (e, h) in - let (lp, h') = nosusp (inst_args ctx lctor) in + | e -> lp in + let lp = lexp_lexp' (nosusp (inst_args ctx lctor)) in match lp with | Cons (it', (_, cons_name)) -> let _ = check_uniqueness pat cons_name lbranches in @@ -927,8 +927,8 @@ and elab_call ctx (func, ltp) (sargs: sexp list) = let loc = lexp_location func in let rec handle_fun_args largs sargs pending ltp = - let (ltp', h) = OL.lexp_whnf ltp (ectx_to_lctx ctx) in - match sargs, ltp' with + let ltp' = OL.lexp_whnf ltp (ectx_to_lctx ctx) in + match sargs, lexp_lexp' ltp' with | _, Arrow (ak, (_, Some aname), arg_type, _, ret_type) when SMap.mem aname pending -> let sarg = SMap.find aname pending in @@ -982,12 +982,12 @@ and elab_call ctx (func, ltp) (sargs: sexp list) = ^ "` have no matching formal args")); largs, ltp - | sarg :: sargs, _ - -> let (arg_type, ret_type) = match ltp' with + | sarg :: sargs, _ (* verifier ltp' *) + -> let (arg_type, ret_type) = match lexp_lexp' ltp' with | Arrow (ak, _, arg_type, _, ret_type) -> assert (ak = Anormal); (arg_type, ret_type) | _ -> unify_with_arrow ctx (sexp_location sarg) - (ltp', h) Anormal (dloc, None) None in + ltp' Anormal (dloc, None) None in let larg = check sarg arg_type ctx in handle_fun_args ((Anormal, larg) :: largs) sargs pending (L.mkSusp ret_type (S.substitute larg)) in @@ -1010,22 +1010,20 @@ and lexp_parse_inductive ctors ctx = * things like `fv` and `meta_to_var`. *) let altacc = List.fold_right (fun (ak, n, t) aa - -> let lp = - Arrow (ak, n, t, dummy_location, aa) - in (lp, lexp'_hash lp)) + -> + hc (Arrow (ak, n, t, dummy_location, aa))) acc impossible in let g = generalize nctx altacc in let altacc' = g (fun _ne vname t l e - -> let lp = - Arrow (Aerasable, vname, t, l, e) - in (lp, lexp'_hash lp)) + -> + hc (Arrow (Aerasable, vname, t, l, e))) altacc in if altacc' == altacc then acc (* No generalization! *) else (* Convert the Lexp back into a list of fields. *) let rec loop e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Arrow (ak, n, t, _, e) -> (ak, n, t)::(loop e) | _ -> assert (e = impossible); [] in @@ -1180,11 +1178,10 @@ and infer_and_generalize_type (ctx : elab_context) se name = * But we don't bother trying to catch all cases currently. *) let rec strip_rettype t = - let (t', h) = t in + let t' = lexp_lexp' t in match t' with | Arrow (ak, v, t1, l, t2) - -> let lp = Arrow (ak, v, t1, l, strip_rettype t2) - in (lp, lexp'_hash lp) + -> hc (Arrow (ak, v, t1, l, strip_rettype t2)) | Sort _ | Metavar _ -> type0 (* Abritrary closed constant. *) | _ -> t in let g = generalize nctx (strip_rettype t) in @@ -1368,7 +1365,7 @@ and sform_add_attribute ctx loc (sargs : sexp list) ot = | _ -> fatal ~loc "add-attribute expects 3 arguments (table; var; attr)" in let map, attr_type = - let (lp, h) = OL.lexp_whnf table (ectx_to_lctx ctx) in + let lp = lexp_lexp' (OL.lexp_whnf table (ectx_to_lctx ctx)) in match lp with | Builtin (_, attr_type, Some map) -> map, attr_type | _ -> fatal ~loc "add-attribute expects a table as first argument" in @@ -1386,7 +1383,7 @@ and get_attribute ctx loc largs = | _ -> fatal ~loc "get-attribute expects 2 arguments (table; var)" in let map = - let (lp, h) = OL.lexp_whnf table (ectx_to_lctx ctx) in + let lp = lexp_lexp' (OL.lexp_whnf table (ectx_to_lctx ctx)) in match lp with | Builtin (_, attr_type, Some map) -> map | _ -> fatal ~loc "get-attribute expects a table as first argument" in @@ -1406,10 +1403,10 @@ and sform_has_attribute ctx loc (sargs : sexp list) ot = | _ -> fatal ~loc "get-attribute expects 2 arguments (table; var)" in let map, attr_type = - let (lp, h) = OL.lexp_whnf table (ectx_to_lctx ctx) in - match lp with + let lp = OL.lexp_whnf table (ectx_to_lctx ctx) in + match lexp_lexp' lp with | Builtin (_, attr_type, Some map) -> map, attr_type - | lxp -> lexp_fatal loc (lxp, h) + | lxp -> lexp_fatal loc lp "get-attribute expects a table as first argument" in (BI.o2l_bool ctx (AttributeMap.mem var map), Lazy) @@ -1614,7 +1611,7 @@ let sform_identifier ctx loc sargs ot = let mv = newMetavar octx sl (loc, Some name) t in (if not (name = "") then let idx = - let (mv', h) = mv in + let mv' = lexp_lexp' mv in match mv' with | Metavar (idx, _, _) -> idx | _ -> fatal ~loc "newMetavar returned a non-Metavar" in @@ -1670,8 +1667,8 @@ let rec sform_lambda kind ctx loc sargs ot = None (* Read var type from the provided type *) | Some t - -> let (lp, h) = OL.lexp_whnf t (ectx_to_lctx ctx) in - match lp with + -> let lp = OL.lexp_whnf t (ectx_to_lctx ctx) in + match lexp_lexp' lp with | Arrow (ak2, _, lt1, _, lt2) when ak2 = kind -> (match olt1 with | None -> () @@ -1699,7 +1696,7 @@ let rec sform_lambda kind ctx loc sargs ot = | _ -> alt) | lt - -> let (lt1, lt2) = unify_with_arrow ctx loc (lt, h) kind arg olt1 + -> let (lt1, lt2) = unify_with_arrow ctx loc lp kind arg olt1 in mklam lt1 (Some lt2)) | _ -> sexp_error loc ("##lambda_"^(match kind with Anormal -> "->" ===================================== src/eval.ml ===================================== @@ -738,8 +738,8 @@ let constructor_p name ectx = (* Use `lexp_whnf` so that `name` can be indirectly * defined as a constructor * (e.g. as in `let foo = cons in case foo x xs | ...` *) - let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) - (ectx_to_lctx ectx) in + let lwhnf = lexp_lexp' (OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) + (ectx_to_lctx ectx)) in match lwhnf with | Cons _ -> true (* It's indeed a constructor! *) | _ -> false @@ -754,8 +754,8 @@ let erasable_p name nth ectx = else false | _ -> false in try let idx = senv_lookup name ectx in - let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) - (ectx_to_lctx ectx) in + let lwhnf = lexp_lexp' (OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) + (ectx_to_lctx ectx)) in match lwhnf with | Cons ((Var v, _), _) -> ( match (env_lookup_expr ectx v) with | Some (Inductive (_, _, _, ctors), _) -> @@ -775,8 +775,8 @@ let erasable_p2 t name ectx = args) | _ -> false in try let idx = senv_lookup t ectx in - let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some t), idx)) - (ectx_to_lctx ectx) in + let lwhnf = lexp_lexp' (OL.lexp_whnf (mkVar ((dummy_location, Some t), idx)) + (ectx_to_lctx ectx)) in match lwhnf with | Cons ((Var v, _), _) -> ( match (env_lookup_expr ectx v) with | Some (Inductive (_, _, _, ctors), _) -> @@ -794,8 +794,8 @@ let nth_ctor_arg name nth ectx = | exception (Failure _) -> "_" ) | _ -> "_" in try let idx = senv_lookup name ectx in - let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) - (ectx_to_lctx ectx) in + let lwhnf = lexp_lexp' (OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) + (ectx_to_lctx ectx)) in match lwhnf with | Cons ((Var v, _), _) -> ( match (env_lookup_expr ectx v) with | Some (Inductive (_, _, _, ctors), _) -> @@ -816,8 +816,8 @@ let ctor_arg_pos name arg ectx = | Some n -> n ) | _ -> (-1) in try let idx = senv_lookup name ectx in - let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) - (ectx_to_lctx ectx) in + let lwhnf = lexp_lexp' (OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) + (ectx_to_lctx ectx)) in match lwhnf with | Cons ((Var v, _), _) -> ( match (env_lookup_expr ectx v) with | Some (Inductive (_, _, _, ctors), _) -> ===================================== src/inverse_subst.ml ===================================== @@ -60,7 +60,7 @@ let transfo (s: Lexp.subst) : substIR option = let rec transfo (s: Lexp.subst) (off_acc: int) (idx: int) (imp_cnt : int) : substIR option = let indexOf (v: lexp): int = (* Helper : return the index of a variabble *) - let (v', h) = v in + let v' = lexp_lexp' v in match v' with | Var (_, v) -> v | _ -> assert false @@ -184,7 +184,7 @@ let inverse (s: Lexp.subst) : Lexp.subst option = let rec invertible (s: subst) : bool = match s with | S.Identity _ -> true | S.Cons (e, s, _) - -> (let (e', h) = e in + -> (let e' = lexp_lexp' e in match e' with Var _ -> true | _ -> e = impossible) && invertible s @@ -203,7 +203,7 @@ let rec lookup_inv_subst (i : db_index) (s : subst) : db_index with Not_invertible -> 0) | S.Cons (e, s, o) -> assert - (let (e', h) = e in + (let e' = lexp_lexp' e in match e' with Var _ -> true | _ -> e = impossible); 1 + lookup_inv_subst (i - o) s @@ -254,7 +254,7 @@ let rec compose_inv_subst (s' : subst) (s : subst) = match s' with * This can be used like mkSusp/push_susp, but it's not lazy. * This is because it can signal errors Not_invertible or Ambiguous. *) and apply_inv_subst (e : lexp) (s : subst) : lexp = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm _ -> e | SortLevel (SLz) -> e ===================================== src/lexp.ml ===================================== @@ -176,15 +176,21 @@ let metavar_lookup (id : meta_id) : metavar_info * try Hashtbl.find hc_table e * with Not_found -> Hashtbl.add hc_table e e; e *) let lexp_hash (e, h) = h - let lexp_to_lexp' (e, h) = e + +(* == depends on implementation when it involves non mutable types + * do not use (e, h) directly to "construct" a lexp ? + * in this case we had: ref lexp1' = ref lexp2' but not lexp1' == lexp2' ... *) + let lexp_lexp' (e, h) = e let rec apply_lxor (map : int list) : int = match map with | [] -> 0 | e :: l -> e lxor (apply_lxor l) +let combine_hash e1 e2 = e1 lxor e2 (* Hashtbl.hash for not lexp types - * TODO: find something else *) + * TODO: - find something else + * - extract the first arg of 2 arg types ? (SMap)*) let lexp'_hash (expr : lexp') = match expr with | Imm s -> Hashtbl.hash s @@ -192,9 +198,9 @@ let metavar_lookup (id : meta_id) : metavar_info -> (match l with | SLz -> Hashtbl.hash l | SLsucc lp -> lexp_hash lp - | SLlub (lp1, lp2) -> (lexp_hash lp1) lxor (lexp_hash lp2)) + | SLlub (lp1, lp2) -> combine_hash (lexp_hash lp1) (lexp_hash lp2)) | Sort (l, s) - -> (Hashtbl.hash l) lxor + -> combine_hash (Hashtbl.hash l) (match s with | Stype lp -> lexp_hash lp | StypeOmega -> Hashtbl.hash s @@ -202,49 +208,56 @@ let metavar_lookup (id : meta_id) : metavar_info | Builtin (v, t, m) as e -> Hashtbl.hash e | Var v -> Hashtbl.hash v | Let (l, ds, e) - -> (Hashtbl.hash l) lxor - ((apply_lxor (List.map (fun e -> let (n, lp, lt) = e in - ((Hashtbl.hash n) lxor ((lexp_hash lp) lxor (lexp_hash lt)))) - ds)) lxor (lexp_hash e)) + -> combine_hash (Hashtbl.hash l) + (combine_hash (apply_lxor (List.map (fun e -> let (n, lp, lt) = e in + (combine_hash (Hashtbl.hash n) (combine_hash (lexp_hash lp) (lexp_hash lt)))) + ds)) (lexp_hash e)) | Arrow (k, v, t1, l, t2) - -> ((Hashtbl.hash k) lxor (Hashtbl.hash v)) lxor - ((lexp_hash t1) lxor ((Hashtbl.hash l) lxor (lexp_hash t2))) + -> combine_hash (combine_hash (Hashtbl.hash k) (Hashtbl.hash v)) + (combine_hash (lexp_hash t1) (combine_hash (Hashtbl.hash l) (lexp_hash t2))) | Lambda (k, v, t, e) - -> ((Hashtbl.hash k) lxor (Hashtbl.hash v)) lxor - ((lexp_hash t) lxor (lexp_hash e)) + -> combine_hash (combine_hash (Hashtbl.hash k) (Hashtbl.hash v)) + (combine_hash (lexp_hash t) (lexp_hash e)) | Inductive (l, n, a, cs) - -> ((Hashtbl.hash l) lxor (Hashtbl.hash n)) lxor - ((apply_lxor (List.map (fun e -> let (ak, n, lt) = e in - ((Hashtbl.hash ak) lxor ((Hashtbl.hash n) lxor (lexp_hash lt)))) a)) - lxor Hashtbl.hash cs) - | Cons (t, n) -> (lexp_hash t) lxor (Hashtbl.hash n) + -> combine_hash (combine_hash (Hashtbl.hash l) (Hashtbl.hash n)) + (combine_hash (apply_lxor (List.map (fun e -> let (ak, n, lt) = e in + (combine_hash (Hashtbl.hash ak) + (combine_hash (Hashtbl.hash n) (lexp_hash lt)))) a)) + (Hashtbl.hash cs)) (* here *) + | Cons (t, n) -> combine_hash (lexp_hash t) (Hashtbl.hash n) | Case (l, e, rt, bs, d) - -> ((Hashtbl.hash l) lxor (lexp_hash e)) lxor - ((lexp_hash rt) lxor ((Hashtbl.hash bs) lxor + -> combine_hash (combine_hash (Hashtbl.hash l) (lexp_hash e)) + (combine_hash (lexp_hash rt) (combine_hash (Hashtbl.hash bs) (match d with - | Some (n, lp) -> (Hashtbl.hash n) lxor (lexp_hash lp) + | Some (n, lp) -> combine_hash (Hashtbl.hash n) (lexp_hash lp) | _ -> 0))) | Metavar (id, s, v) -> Hashtbl.hash expr - | Call (e, args) -> (lexp_hash e) lxor + | Call (e, args) -> combine_hash (lexp_hash e) (apply_lxor (List.map (fun e -> let (ak, lp) = e in - ((Hashtbl.hash ak) lxor (lexp_hash lp))) args)) - | Susp (lp, subst) -> (lexp_hash lp) lxor (Hashtbl.hash subst) + (combine_hash (Hashtbl.hash ak) (lexp_hash lp))) args)) + | Susp (lp, subst) -> combine_hash (lexp_hash lp) (Hashtbl.hash subst) let impossible = (let imp = Imm Sexp.dummy_epsilon in (imp, dummy_hash)) +let compare_hash x y = + let (x', h1) = x in + let (y', h2) = y in + compare h1 h2 = 0 + +(* May be a tree ? *) module WHC = Weak.Make (struct type t = lexp (* Using (=) instead of `compare` results * in an *enormous* slowdown. Apparently * `compare` checks == before recursing * but (=) doesn't? *) - let equal x y = (compare x y = 0) + let equal x y = (compare (lexp_lexp' x) (lexp_lexp' y) = 0) let hash = lexp_hash end) -(* TODO: maybe just a table ? *) let hc_table : WHC.t = WHC.create 1000 -let hc (e : lexp') : lexp = let h = lexp'_hash e in WHC.merge hc_table (e, h) +let hc (e : lexp') : lexp = +let lp = (e, lexp'_hash e) in WHC.merge hc_table lp let mkImm s = hc (Imm s) let mkSortLevel l = hc (SortLevel l) @@ -259,14 +272,14 @@ let mkCons (t, n) = hc (Cons (t, n)) let mkCase (l, e, rt, bs, d) = hc (Case (l, e, rt, bs, d)) let mkMetavar (n, s, v) = hc (Metavar (n, s, v)) let mkCall (f, es) - = let (f', h) = f in + = let f' = lexp_lexp' f in match f', es with | Call (f'', es'), _ -> hc (Call (f'', es' @ es)) | _, [] -> f | _ -> hc (Call (f, es)) and lexp_head e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm s -> if e = impossible then "impossible" else "Imm" ^ sexp_string s | Var _ -> "Var" @@ -285,8 +298,8 @@ and lexp_head e = | SortLevel _ -> "SortLevel" let mkSLlub' (e1, e2) = - let (e1', h1) = e1 in - let (e2', h2) = e2 in + let e1' = lexp_lexp' e1 in + let e2' = lexp_lexp' e2 in match (e1', e2') with (* FIXME: This first case should be handled by calling `mkSLlub` instead! *) | (SortLevel SLz, SortLevel l) | (SortLevel l, SortLevel SLz) -> l @@ -301,7 +314,7 @@ let mkSLlub' (e1, e2) = ("SLlub of non-level: " ^ lexp_head e1 ^ " ∪ " ^ lexp_head e2) let mkSLsucc e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | SortLevel _ | Var _ | Metavar _ | Susp _ -> SLsucc e @@ -338,11 +351,8 @@ let hcs_table : ((lexp * subst), lexp) Hashtbl.t = Hashtbl.create 1000 * ... *) -(* let mkSusp e s = let susp = mkSusp_aux e s in (susp, lexp'_hash susp) *) - -(* argh *) let rec mkSusp e s = - let (e', h) = e in + let e' = lexp_lexp' e in if S.identity_p s then e else (* We apply the substitution eagerly to some terms. * There's no deep technical rason for that: @@ -409,7 +419,7 @@ let _ = assert (S.identity_p (scompose (S.shift 5) (sunshift 5))) let rec lexp_location e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Sort (l,_) -> l | SortLevel (SLsucc e) -> lexp_location e @@ -437,7 +447,7 @@ let maybename n = match n with None -> "<anon>" | Some v -> v let sname (l,n) = (l, maybename n) let rec push_susp e s = (* Push a suspension one level down. *) - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm _ -> e | SortLevel (SLz) -> e @@ -497,7 +507,7 @@ let rec push_susp e s = (* Push a suspension one level down. *) | (Var _ | Metavar _) -> nosusp (mkSusp e s) and nosusp e = (* Return `e` with no outermost `Susp`. *) - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Susp(e, s) -> push_susp e s | _ -> e @@ -506,7 +516,7 @@ and nosusp e = (* Return `e` with no outermost `Susp`. *) (* Get rid of `Susp`ensions and instantiated `Metavar`s. *) let clean e = let rec clean s e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm _ -> e | SortLevel (SLz) -> e @@ -544,7 +554,7 @@ let clean e = L.rev ncase) cases in mkInductive (l, label, nargs, ncases) - | Cons (it, name) -> (let lp = Cons (clean s it, name) in (lp, lexp'_hash lp)) + | Cons (it, name) -> hc (Cons (clean s it, name)) | Case (l, e, ret, cases, default) -> mkCase (l, clean s e, clean s ret, SMap.map (fun (l, cargs, e) @@ -571,9 +581,9 @@ let stypecons = Symbol (U.dummy_location, "##typecons") (* ugly printing (sexp_print (pexp_unparse (lexp_unparse e))) *) let rec lexp_unparse lxp = - let (lxp', h) = lxp in + let lxp' = lexp_lexp' lxp in match lxp' with - | Susp _ as e -> lexp_unparse (nosusp (e, lexp'_hash e)) + | Susp _ as e -> lexp_unparse (nosusp (hc e)) | Imm (sexp) -> sexp | Builtin ((l,name), _, _) -> Symbol (l, "##" ^ name) (* FIXME: Add a Sexp syntax for debindex references. *) @@ -703,7 +713,7 @@ and subst_string s = match s with -> "(↑"^ string_of_int o ^ " " ^ subst_string (S.cons l s) ^ ")" and lexp_name e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm _ -> lexp_string e | Var _ -> lexp_string e @@ -794,7 +804,7 @@ let get_binary_op_name name = let rec get_precedence expr ctx = let lkp name = SMap.find name (pp_grammar ctx) in - let (e', h) = expr in + let e' = lexp_lexp' expr in match e' with | Lambda _ -> lkp "lambda" | Case _ -> lkp "case" @@ -864,7 +874,7 @@ and lexp_str ctx (exp : lexp) : string = | Anormal -> ":" | Aimplicit -> "::" | Aerasable -> ":::" in let get_name fname = - let (fn, h) = fname in + let fn = lexp_lexp' fname in match fn with | Builtin ((_, name), _, _) -> name, 0 | Var((_, Some name), idx) -> name, idx @@ -872,7 +882,7 @@ and lexp_str ctx (exp : lexp) : string = | Cons _ -> "__", 0 | _ -> "__", -1 in - let (e', h) = exp in + let e' = lexp_lexp' exp in match e' with | Imm(value) -> (match value with | String (_, s) -> tval ("\"" ^ s ^ "\"") @@ -1029,59 +1039,54 @@ and lexp_str_decls ctx decls = (** Syntactic equality (i.e. without β). *******) -let eq (e1 : lexp) (e2 : lexp) : bool = - let (e1', h1) = e1 in - let (e2', h2) = e2 in - compare h1 h2 == 0 - -(* - -let rec eq' e1 e2 = - e1 == e2 || - match (e1, e2) with +let rec eq e1 e2 = + let e1' = lexp_lexp' e1 in + let e2' = lexp_lexp' e2 in + e1' == e2' || + match (e1', e2') with | (Imm (Integer (_, i1)), Imm (Integer (_, i2))) -> i1 = i2 | (Imm (Float (_, x1)), Imm (Float (_, x2))) -> x1 = x2 | (Imm (String (_, s1)), Imm (String (_, s2))) -> s1 = s2 | (Imm s1, Imm s2) -> s1 = s2 | (SortLevel SLz, SortLevel SLz) -> true - | (SortLevel (SLsucc e1), SortLevel (SLsucc e2)) -> eq' e1 e2 + | (SortLevel (SLsucc e1), SortLevel (SLsucc e2)) -> eq e1 e2 | (SortLevel (SLlub (e11, e21)), SortLevel (SLlub (e12, e22))) - -> eq' e11 e12 && eq' e21 e22 + -> eq e11 e12 && eq e21 e22 | (Sort (_, StypeOmega), Sort (_, StypeOmega)) -> true | (Sort (_, StypeLevel), Sort (_, StypeLevel)) -> true - | (Sort (_, Stype e1), Sort (_, Stype e2)) -> eq' e1 e2 + | (Sort (_, Stype e1), Sort (_, Stype e2)) -> eq e1 e2 | (Builtin ((_, name1), _, _), Builtin ((_, name2), _, _)) -> name1 = name2 | (Var (_, i1), Var (_, i2)) -> i1 = i2 - | (Susp (e1, s1), e2) -> eq' (push_susp e1 s1) e2 - | (e1, Susp (e2, s2)) -> eq' e1 (push_susp e2 s2) + | (Susp (e1, s1), _) -> eq (push_susp e1 s1) e2 + | (_, Susp (e2, s2)) -> eq e1 (push_susp e2 s2) | (Let (_, defs1, e1), Let (_, defs2, e2)) - -> eq' e1 e2 && List.for_all2 (fun (_, e1, t1) (_, e2, t2) - -> eq' t1 t2 && eq' e1 e2) + -> eq e1 e2 && List.for_all2 (fun (_, e1, t1) (_, e2, t2) + -> eq t1 t2 && eq e1 e2) defs1 defs2 | (Arrow (ak1, _, t11, _, t21), Arrow (ak2, _, t12, _, t22)) - -> ak1 = ak2 && eq' t11 t12 && eq' t21 t22 + -> ak1 = ak2 && eq t11 t12 && eq t21 t22 | (Lambda (ak1, _, t1, e1), Lambda (ak2, _, t2, e2)) - -> ak1 = ak2 && eq' t1 t2 && eq' e1 e2 + -> ak1 = ak2 && eq t1 t2 && eq e1 e2 | (Call (e1, as1), Call (e2, as2)) - -> eq' e1 e2 && List.for_all2 (fun (ak1, e1) (ak2, e2) -> ak1 = ak2 && eq' e1 e2) + -> eq e1 e2 && List.for_all2 (fun (ak1, e1) (ak2, e2) -> ak1 = ak2 && eq e1 e2) as1 as2 | (Inductive (_, l1, as1, cases1), Inductive (_, l2, as2, cases2)) -> l1 = l2 - && List.for_all2 (fun (ak1, _, e1) (ak2, _, e2) -> ak1 = ak2 && eq' e1 e2) + && List.for_all2 (fun (ak1, _, e1) (ak2, _, e2) -> ak1 = ak2 && eq e1 e2) as1 as2 && SMap.equal (List.for_all2 (fun (ak1, _, e1) (ak2, _, e2) - -> ak1 = ak2 && eq' e1 e2)) + -> ak1 = ak2 && eq e1 e2)) cases1 cases2 - | (Cons (t1, (_, l1)), Cons (t2, (_, l2))) -> eq' t1 t2 && l1 = l2 + | (Cons (t1, (_, l1)), Cons (t2, (_, l2))) -> eq t1 t2 && l1 = l2 | (Case (_, e1, r1, cases1, def1), Case (_, e2, r2, cases2, def2)) - -> eq' e1 e2 && eq' r1 r2 + -> eq e1 e2 && eq r1 r2 && SMap.equal (fun (_, fields1, e1) (_, fields2, e2) - -> eq' e1 e2 && List.for_all2 (fun (ak1, _) (ak2, _) + -> eq e1 e2 && List.for_all2 (fun (ak1, _) (ak2, _) -> ak1 = ak2) fields1 fields2) cases1 cases2 && (match (def1, def2) with - | (Some (_, e1), Some (_, e2)) -> eq' e1 e2 + | (Some (_, e1), Some (_, e2)) -> eq e1 e2 | _ -> def1 = def2) | (Metavar (i1, s1, _), Metavar (i2, s2, _)) -> i1 = i2 && subst_eq s1 s2 @@ -1093,15 +1098,13 @@ and subst_eq s1 s2 = | (S.Identity o1, S.Identity o2) -> o1 = o2 | (S.Cons (e1, s1, o1), S.Cons (e2, s2, o2)) -> if o1 = o2 then - eq' e1 e2 && subst_eq s1 s2 + eq e1 e2 && subst_eq s1 s2 else if o1 > o2 then let o = o1 - o2 in - eq' (mkSusp e1 (S.shift o)) e2 + eq (mkSusp e1 (S.shift o)) e2 && subst_eq (S.mkShift s1 o) s2 else let o = o2 - o1 in - eq' e1 (mkSusp e2 (S.shift o)) + eq e1 (mkSusp e2 (S.shift o)) && subst_eq s1 (S.mkShift s2 o) | _ -> false - -*) ===================================== src/opslexp.ml ===================================== @@ -134,7 +134,7 @@ let lexp_close lctx e = * call-by-name behavior. *) let lexp_whnf e (ctx : DB.lexp_context) : lexp = let rec lexp_whnf e (ctx : DB.lexp_context) : lexp = - let (le', h) = e in + let le' = lexp_lexp' e in match le' with | Var v -> (match lookup_value ctx v with | None -> e @@ -145,7 +145,7 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = | Susp (e, s) -> lexp_whnf (push_susp e s) ctx | Call (e, []) -> lexp_whnf e ctx | Call (f, (((_, arg)::args) as xs)) -> - (let (lwhnf', h) = lexp_whnf f ctx in + (let lwhnf' = lexp_lexp' (lexp_whnf f ctx) in match lwhnf' with | Lambda (_, _, _, body) -> (* Here we apply whnf to the arg eagerly to kind of stay closer @@ -177,11 +177,11 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = ("Unhandled constructor " ^ name ^ "in case expression"); mkCase (l, e, rt, branches, default) in - (let (e'', h) = e' in + (let e'' = lexp_lexp' e' in match e'' with | Cons (_, (_, name)) -> reduce name [] | Call (f, aargs) -> - (let (lwhnf, h) = lexp_whnf f ctx in + (let lwhnf = lexp_lexp' (lexp_whnf f ctx) in match lwhnf with | Cons (_, (_, name)) -> reduce name aargs | _ -> mkCase (l, e, rt, branches, default)) @@ -196,7 +196,7 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = | Let (l, defs, body) -> lexp_whnf (push_susp body (lexp_defs_subst l S.identity defs)) ctx - | e -> (e, h) + | elem -> e in lexp_whnf e ctx @@ -205,10 +205,8 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = type set_plexp = (lexp * lexp) list let set_empty : set_plexp = [] let set_member_p (s : set_plexp) (e1 : lexp) (e2 : lexp) : bool - = lexp_print e2 ; print_string "\n" ; - lexp_print (Lexp.hc (let (e2', h) = e2 in e2')); - assert (lexp_hash e1 == lexp_hash (Lexp.hc (let (e1', h) = e1 in e1'))); - assert (lexp_hash e2 == lexp_hash (Lexp.hc (let (e2', h) = e2 in e2'))); + = assert (lexp_lexp' e1 == lexp_lexp' (Lexp.hc (lexp_lexp' e1))); + assert (lexp_lexp' e2 == lexp_lexp' (Lexp.hc (lexp_lexp' e2))); try let _ = List.find (fun (e1', e2') -> L.eq e1 e1' && L.eq e2 e2') s @@ -237,7 +235,7 @@ let level_canon e = if o < d then (c, IMap.add v d m) else acc in let rec canon e d ((c,m) as acc) = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | SortLevel SLz -> if c < d then (d, m) else acc | SortLevel (SLsucc e) -> canon e (d + 1) acc @@ -262,13 +260,13 @@ let level_leq (c1, m1) (c2, m2) = let rec conv_p' (ctx : DB.lexp_context) (vs : set_plexp) e1 e2 : bool = let e1' = lexp_whnf e1 ctx in let e2' = lexp_whnf e2 ctx in - e1' == e2' || - let changed = not (e1 == e1' && e2 == e2') in + let e1''= lexp_lexp' e1' in + let e2'' = lexp_lexp' e2' in + e1'' == e2'' || + let changed = not (lexp_lexp' e1 == e1'' && lexp_lexp' e2 == e2'') in if changed && set_member_p vs e1' e2' then true else let vs' = if changed then set_add vs e1' e2' else vs in let conv_p = conv_p' ctx vs' in - let (e1'', h1) = e1' in - let (e2'', h1) = e2' in match (e1'', e2'') with | (Imm (Integer (_, i1)), Imm (Integer (_, i2))) -> i1 = i2 | (Imm (Float (_, i1)), Imm (Float (_, i2))) -> i1 = i2 @@ -342,16 +340,16 @@ let conv_p (ctx : DB.lexp_context) e1 e2 (********* Testing if a lexp is properly typed *********) let rec mkSLlub ctx e1 e2 = - let (lwhnf1, h1) = lexp_whnf e1 ctx in - let (lwhnf2, h2) = lexp_whnf e2 ctx in - match (lwhnf1, lwhnf2) with + let lwhnf1 = lexp_whnf e1 ctx in + let lwhnf2 = lexp_whnf e2 ctx in + match (lexp_lexp' lwhnf1, lexp_lexp' lwhnf2) with | (SortLevel SLz, _) -> e2 | (_, SortLevel SLz) -> e1 | (SortLevel (SLsucc e1), SortLevel (SLsucc e2)) -> mkSortLevel (SLsucc (mkSLlub ctx e1 e2)) | (e1', e2') - -> let ce1 = level_canon (e1', h1) in - let ce2 = level_canon (e2', h2) in + -> let ce1 = level_canon lwhnf1 in + let ce2 = level_canon lwhnf2 in if level_leq ce1 ce2 then e2 else if level_leq ce2 ce1 then e1 else mkSortLevel (mkSLlub' (e1, e2)) (* FIXME: Could be more canonical *) @@ -365,8 +363,8 @@ type sort_compose_result let sort_compose ctx1 ctx2 l ak k1 k2 = (* BEWARE! Technically `k2` can refer to `v`, but this should only happen * if `v` is a TypeLevel. *) - let (lwhnf1, h1) = lexp_whnf k1 ctx1 in - let (lwhnf2, h2) = lexp_whnf k2 ctx2 in + let lwhnf1 = lexp_lexp' (lexp_whnf k1 ctx1) in + let lwhnf2 = lexp_lexp' (lexp_whnf k2 ctx2) in match (lwhnf1, lwhnf2) with | (Sort (_, s1), Sort (_, s2)) -> (match s1, s2 with @@ -422,7 +420,7 @@ let nerased_let defs erased = * will be non-erasable, so in `let x = z; y = x ...` * where `z` is erasable, `x` will be found * to be erasable, but not `y`. *) - let (e', h) = e in + let e' = lexp_lexp' e in match e' with Var (_, idx) -> DB.set_mem idx nerased | _ -> false) defs in @@ -445,14 +443,14 @@ let rec check'' erased ctx e = (* Log.internal_error "Type mismatch" *)) in let check_type erased ctx t = let s = check erased ctx t in - (let (lwhnf, h) = lexp_whnf s ctx in + (let lwhnf = lexp_lexp' (lexp_whnf s ctx) in match lwhnf with | Sort _ -> () | _ -> error_tc ~loc:(lexp_location t) ("Not a proper type: " ^ lexp_string t)); (* FIXME: return the `sort` rather than the surrounding `lexp`! *) s in - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm (Float (_, _)) -> DB.type_float | Imm (Integer (_, _)) -> DB.type_int @@ -544,7 +542,7 @@ let rec check'' erased ctx e = (fun ft (ak,arg) -> let at = check (if ak = P.Aerasable then DB.set_empty else erased) ctx arg in - let (lwhnf, h) = lexp_whnf ft ctx in + let lwhnf = lexp_lexp' (lexp_whnf ft ctx) in match lwhnf with | Arrow (ak', v, t1, l, t2) -> if not (ak == ak') then @@ -568,9 +566,8 @@ let rec check'' erased ctx e = let (level, _, _, _) = List.fold_left (fun (level, ictx, erased, n) (ak, v, t) -> - ((let (lwhnf, h) = - lexp_whnf (check_type erased ictx t) ictx in - match lwhnf with + ((let lwhnf = lexp_whnf (check_type erased ictx t) ictx in + match lexp_lexp' lwhnf with | Sort (_, Stype _) when ak == P.Aerasable && impredicative_erase -> level @@ -588,7 +585,7 @@ let rec check'' erased ctx e = ("Field type " ^ lexp_string t ^ " is not a Type! (" - ^ lexp_string (tt, h) ^")"); + ^ lexp_string lwhnf ^")"); level), DB.lctx_extend ictx v Variable t, DB.set_sink 1 erased, @@ -609,13 +606,13 @@ let rec check'' erased ctx e = | Case (l, e, ret, branches, default) (* FIXME: Check that the return type isn't TypeLevel. *) -> let call_split e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Call (f, args) -> (f, args) | _ -> (e,[]) in let etype = lexp_whnf (check erased ctx e) ctx in let it, aargs = call_split etype in - (let (lwhnf, h) = lexp_whnf it ctx in + (let lwhnf = lexp_lexp' (lexp_whnf it ctx) in match lwhnf, aargs with | Inductive (_, _, fargs, constructors), aargs -> let rec mksubst s fargs aargs = @@ -665,7 +662,7 @@ let rec check'' erased ctx e = | _,_ -> error_tc ~loc:l "Case on a non-inductive type!"); ret | Cons (t, (l, name)) - -> (let (lwhnf, h) = lexp_whnf t ctx in + -> (let lwhnf = lexp_lexp' (lexp_whnf t ctx) in match lwhnf with | Inductive (l, _, fargs, constructors) -> (try @@ -755,7 +752,7 @@ let fv_erase (fvs, mvs) = (fvs, mv_set_erase mvs) let rec fv (e : lexp) : (DB.set * mv_set) = let fv' e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm _ -> fv_empty | SortLevel SLz -> fv_empty @@ -831,7 +828,7 @@ let rec fv (e : lexp) : (DB.set * mv_set) = (* This should never signal any warning/error. *) let rec get_type ctx e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm (Float (_, _)) -> DB.type_float | Imm (Integer (_, _)) -> DB.type_int @@ -863,7 +860,7 @@ let rec get_type ctx e = -> let ft = get_type ctx f in List.fold_left (fun ft (ak,arg) - -> let (lwhnf, h) = lexp_whnf ft ctx in + -> let lwhnf = lexp_lexp' (lexp_whnf ft ctx) in match lwhnf with | Arrow (ak', v, t1, l, t2) -> mkSusp t2 (S.substitute arg) @@ -880,7 +877,7 @@ let rec get_type ctx e = let (level, _, _) = List.fold_left (fun (level, ictx, n) (ak, v, t) -> - ((let (lwhnf, h) = lexp_whnf (get_type ictx t) ictx in + ((let lwhnf = lexp_lexp' (lexp_whnf (get_type ictx t) ictx) in match lwhnf with | Sort (_, Stype _) when ak == P.Aerasable && impredicative_erase @@ -905,7 +902,7 @@ let rec get_type ctx e = tct | Case (l, e, ret, branches, default) -> ret | Cons (t, (l, name)) - -> (let (lwhnf, h) = lexp_whnf t ctx in + -> (let lwhnf = lexp_lexp' (lexp_whnf t ctx) in match lwhnf with | Inductive (l, _, fargs, constructors) -> (try @@ -940,7 +937,7 @@ let rec get_type ctx e = (*********** Type erasure, before evaluation. *****************) let rec erase_type (lxp: L.lexp): E.elexp = - let (lxp', h) = lxp in + let lxp' = lexp_lexp' lxp in match lxp' with | L.Imm(s) -> E.Imm(s) | L.Builtin(v, _, _) -> E.Builtin(v) @@ -1032,12 +1029,8 @@ let ctx2tup ctx nctx = let offset = List.length types in let types = List.rev types in (*Log.debug_msg ("Building tuple of size " ^ string_of_int offset ^ "\n");*) - let lexp = - Call - ((let lexp' = - Cons ( - ((let lexp'' = - Inductive (loc, type_label, [], + + hc (Call (hc (Cons (hc (Inductive (loc, type_label, [], SMap.add cons_name (List.map (fun (oname, t) -> (P.Aimplicit, oname, @@ -1051,24 +1044,22 @@ let ctx2tup ctx nctx = * equivalent and preferable). *) mkSusp t (S.shift offset))) types) - SMap.empty) in (lexp'', lexp'_hash lexp'')), - cons_label)) in (lexp', lexp'_hash lexp')), + SMap.empty)), + cons_label)), List.mapi (fun i (oname, t) -> (P.Aimplicit, mkVar (oname, offset - i - 1))) - types) in (lexp, lexp'_hash lexp) + types)) | (DB.CVlet (name, LetDef (_, e), t, _) :: blocs) - -> let lp = - Let (loc, [(name, mkSusp e (S.shift 1), t)], - mk_lets_and_tup blocs ((name, t) :: types)) in (lp, lexp'_hash lp) + -> hc (Let (loc, [(name, mkSusp e (S.shift 1), t)], + mk_lets_and_tup blocs ((name, t) :: types))) | (DB.CVfix (defs, _) :: blocs) - -> let lp = - Let (loc, defs, + -> hc (Let (loc, defs, mk_lets_and_tup blocs (List.append (List.rev (List.map (fun (oname, _, t) -> (oname, t)) defs)) - types)) in (lp, lexp'_hash lp) + types))) | _ -> assert false in mk_lets_and_tup (get_blocs nctx []) [] ===================================== src/unification.ml ===================================== @@ -62,7 +62,7 @@ let occurs_in (id: meta_id) (e : lexp) : bool = match metavar_lookup id with "Checking occurrence of an instantiated metavar!!" | MVar (sl, _, _) -> let rec oi e = - let (e', h) = e in + let e' = lexp_lexp' e in match e' with | Imm _ -> false | SortLevel SLz -> false @@ -191,8 +191,8 @@ and unify' (e1: lexp) (e2: lexp) let changed = true (* not (e1 == e1' && e2 == e2') *) in if changed && OL.set_member_p vs e1' e2' then [] else let vs' = if changed then OL.set_add vs e1' e2' else vs in - let (e1'', h1) = e1' in - let (e2'', h2) = e2' in + let e1'' = lexp_lexp' e1' in + let e2'' = lexp_lexp' e2' in match (e1'', e2'') with | ((Imm _, Imm _) | (Cons _, Cons _) | (Builtin _, Builtin _) | (Var _, Var _)) @@ -231,8 +231,8 @@ and unify' (e1: lexp) (e2: lexp) *) and unify_arrow (arrow: lexp) (lxp: lexp) ctx vs : return_type = - let (arrow', h1) = arrow in - let (lxp', h2) = lxp in + let arrow' = lexp_lexp' arrow in + let lxp' = lexp_lexp' lxp in match (arrow', lxp') with | (Arrow (var_kind1, v1, ltype1, _, lexp1), Arrow (var_kind2, _, ltype2, _, lexp2)) @@ -256,8 +256,8 @@ and unify_arrow (arrow: lexp) (lxp: lexp) ctx vs - Lambda , lexp -> unify lexp lambda subst *) and unify_lambda (lambda: lexp) (lxp: lexp) ctx vs : return_type = - let (lambda', h1) = lambda in - let (lxp', h2) = lxp in + let lambda' = lexp_lexp' lambda in + let lxp' = lexp_lexp' lxp in match (lambda', lxp') with | (Lambda (var_kind1, v1, ltype1, lexp1), Lambda (var_kind2, _, ltype2, lexp2)) @@ -308,7 +308,7 @@ and unify_metavar ctx idx s1 (lxp1: lexp) (lxp2: lexp) ^ lexp_string (OL.get_type ctx lxp) ^ "\n" ^ "for " ^ lexp_string lxp ^ "\n"); [(CKresidual, ctx, lxp1, lxp2)] in - let (lxp2', h) = lxp2 in + let lxp2' = lexp_lexp' lxp2 in match lxp2' with | Metavar (idx2, s2, name) -> if idx = idx2 then @@ -379,8 +379,8 @@ and unify_metavar ctx idx s1 (lxp1: lexp) (lxp2: lexp) *) and unify_call (call: lexp) (lxp: lexp) ctx vs : return_type = - let (call', h1) = call in - let (lxp', h2) = lxp in + let call' = lexp_lexp' call in + let lxp' = lexp_lexp' lxp in match (call', lxp') with | (Call (lxp_left, lxp_list1), Call (lxp_right, lxp_list2)) when OL.conv_p ctx lxp_left lxp_right @@ -450,8 +450,8 @@ and unify_call (call: lexp) (lxp: lexp) ctx vs - SortLevel, _ -> ERROR *) and unify_sortlvl (sortlvl: lexp) (lxp: lexp) ctx vs : return_type = - let (sortlvl', h1) = sortlvl in - let (lxp', h2) = lxp in + let sortlvl' = lexp_lexp' sortlvl in + let lxp' = lexp_lexp' lxp in match sortlvl', lxp' with | (SortLevel s, SortLevel s2) -> (match s, s2 with | SLz, SLz -> [] @@ -469,8 +469,8 @@ and unify_sortlvl (sortlvl: lexp) (lxp: lexp) ctx vs : return_type = - Sort, lexp -> ERROR *) and unify_sort (sort_: lexp) (lxp: lexp) ctx vs : return_type = - let (sort_', h1) = sort_ in - let (lxp', h2) = lxp in + let sort_' = lexp_lexp' sort_ in + let lxp' = lexp_lexp' lxp in match sort_', lxp' with | (Sort (_, srt), Sort (_, srt2)) -> (match srt, srt2 with | Stype lxp1, Stype lxp2 -> unify' lxp1 lxp2 ctx vs View it on GitLab: https://gitlab.com/monnier/typer/-/commit/ff5ad4d5847ac69fabe9f12c21c2d705d… -- View it on GitLab: https://gitlab.com/monnier/typer/-/commit/ff5ad4d5847ac69fabe9f12c21c2d705d… You're receiving this email because of your account on gitlab.com.

2 1

[Git][monnier/typer][alice] fix des repercussions du changement des lexp
by Alice de Berny 29 May '20

29 May '20

Alice de Berny pushed to branch alice at Stefan / Typer Commits: 63089e95 by irradiee at 2020-05-26T14:53:16-04:00 fix des repercussions du changement des lexp - - - - - 6 changed files: - src/elab.ml - src/eval.ml - src/inverse_subst.ml - src/lexp.ml - src/opslexp.ml - src/unification.ml Changes: ===================================== src/elab.ml ===================================== @@ -121,12 +121,13 @@ let sform_default_ectx = ref empty_elab_context * to errors in the user's code). *) let elab_check_sort (ctx : elab_context) lsort var ltp = - match (try OL.lexp_whnf lsort (ectx_to_lctx ctx) + let (lp, h) = (try OL.lexp_whnf lsort (ectx_to_lctx ctx) with e -> info ~print_action:(fun _ -> lexp_print lsort; print_newline ()) ~loc:(lexp_location lsort) "Exception during whnf of sort:"; - raise e) with + raise e) in + match lp with | Sort (_, _) -> () (* All clear! *) | _ -> let typestr = lexp_string ltp ^ " : " ^ lexp_string lsort in match var with @@ -323,7 +324,7 @@ let rec meta_to_var ids (e : lexp) = * into something like * * Γ ⊢ λ x₁…xₙ ≡> e[x₁…xₙ/m₁…mₙ] : τ₁…τₙ ≡> τ - * + * * The above substitution is not the usual capture-avoiding substitution * since it replaces metavars with vars rather than vars with terms. * It's more like *instanciation* of those metavars. @@ -414,7 +415,9 @@ let rec meta_to_var ids (e : lexp) = (* `o` is the binding depth at which we are relative to the "root" * of the expression (i.e. where the new vars will be inserted). *) - and loop o e = match e with + and loop o e = + let (e', h) = e in + match e' with | Imm _ -> e | SortLevel SLz -> e | SortLevel (SLsucc e) -> mkSortLevel (mkSLsucc (loop o e)) @@ -576,7 +579,8 @@ and infer (p : sexp) (ctx : elab_context): lexp * ltype = and elab_special_form ctx f args ot = let loc = lexp_location f in - match OL.lexp_whnf f (ectx_to_lctx ctx) with + let (lp, h) = OL.lexp_whnf f (ectx_to_lctx ctx) in + match lp with | Builtin ((_, name), _, _) -> (* Special form. *) (get_special_form name) ctx loc args ot @@ -624,7 +628,8 @@ and get_implicit_arg ctx loc oname t = (* Build the list of implicit arguments to instantiate. *) and instantiate_implicit e t ctx = let rec instantiate t args = - match OL.lexp_whnf t (ectx_to_lctx ctx) with + let (lp, h) = OL.lexp_whnf t (ectx_to_lctx ctx) in + match lp with | Arrow ((Aerasable | Aimplicit) as ak, (_, v), t1, _, t2) -> let arg = get_implicit_arg ctx (lexp_location e) v t1 in instantiate (mkSusp t2 (S.substitute arg)) ((ak, arg)::args) @@ -636,7 +641,8 @@ and infer_type pexp ectx var = * Sort (?s), but in most cases the metavar would be allocated * unnecessarily. *) let t, s = infer pexp ectx in - (match OL.lexp_whnf s (ectx_to_lctx ectx) with + (let (lp, h) = OL.lexp_whnf s (ectx_to_lctx ectx) in + match lp with | Sort (_, _) -> () (* All clear! *) (* FIXME: We could automatically coerce Type levels to Sorts, so we * could write `(a : TypeLevel) -> a -> a` instead of @@ -698,7 +704,9 @@ and check (p : sexp) (t : ltype) (ctx : elab_context): lexp = * we use is to instantiate implicit arguments when needed, but we could/should * do lots of other things. *) and check_inferred ctx e inferred_t t = - let (e, inferred_t) = match OL.lexp_whnf t (ectx_to_lctx ctx) with + let (e, inferred_t) = + let (lp, h) = OL.lexp_whnf t (ectx_to_lctx ctx) in + match lp with | Arrow ((Aerasable | Aimplicit), _, _, _, _) -> (e, inferred_t) | _ -> instantiate_implicit e inferred_t ctx in @@ -749,7 +757,8 @@ and check_case rtype (loc, target, ppatterns) ctx = | [] -> () in (cs, args) | None - -> match OL.lexp_whnf it' (ectx_to_lctx ctx) with + -> let (lp, h) = OL.lexp_whnf it' (ectx_to_lctx ctx) in + match lp with | Inductive (_, _, fargs, constructors) -> let (s, targs) = List.fold_left (fun (s, targs) (ak, name, t) @@ -764,11 +773,15 @@ and check_case rtype (loc, target, ppatterns) ctx = ltarget := check_inferred ctx tlxp tltp (mkCall (it', args)); it_cs_as := Some (it', cs, args); (cs, args) - | _ -> let call_split e = match (OL.lexp_whnf e (ectx_to_lctx ctx)) - with | Call (f, args) -> (f, args) + | _ -> let call_split e = + let (lp, h) = OL.lexp_whnf e (ectx_to_lctx ctx) in + match lp with + | Call (f, args) -> (f, args) | _ -> (e,[]) in let (it, targs) = call_split tltp in - let constructors = match OL.lexp_whnf it (ectx_to_lctx ctx) with + let constructors = + let (lp, h) = OL.lexp_whnf it (ectx_to_lctx ctx) in + match lp with | Inductive (_, _, fargs, constructors) -> assert (List.length fargs = List.length targs); constructors @@ -792,15 +805,18 @@ and check_case rtype (loc, target, ppatterns) ctx = let add_branch pctor pargs = let loc = sexp_location pctor in let lctor, ct = infer pctor ctx in - let rec inst_args ctx e = match OL.lexp_whnf e (ectx_to_lctx ctx) with + let rec inst_args ctx e = + let (lp, h) = OL.lexp_whnf e (ectx_to_lctx ctx) in + match lp with | Lambda (Aerasable, v, t, body) -> let arg = newMetavar (ectx_to_lctx ctx) (ectx_to_scope_level ctx) v t in let nctx = ctx_extend ctx v Variable t in let body = inst_args nctx body in mkSusp body (S.substitute arg) - | e -> e in - match nosusp (inst_args ctx lctor) with + | e -> (e, h) in + let (lp, h') = nosusp (inst_args ctx lctor) in + match lp with | Cons (it', (_, cons_name)) -> let _ = check_uniqueness pat cons_name lbranches in let (constructors, targs) = get_cs_as it' lctor in @@ -911,7 +927,7 @@ and elab_call ctx (func, ltp) (sargs: sexp list) = let loc = lexp_location func in let rec handle_fun_args largs sargs pending ltp = - let ltp' = OL.lexp_whnf ltp (ectx_to_lctx ctx) in + let (ltp', h) = OL.lexp_whnf ltp (ectx_to_lctx ctx) in match sargs, ltp' with | _, Arrow (ak, (_, Some aname), arg_type, _, ret_type) when SMap.mem aname pending @@ -971,7 +987,7 @@ and elab_call ctx (func, ltp) (sargs: sexp list) = | Arrow (ak, _, arg_type, _, ret_type) -> assert (ak = Anormal); (arg_type, ret_type) | _ -> unify_with_arrow ctx (sexp_location sarg) - ltp' Anormal (dloc, None) None in + (ltp', h) Anormal (dloc, None) None in let larg = check sarg arg_type ctx in handle_fun_args ((Anormal, larg) :: largs) sargs pending (L.mkSusp ret_type (S.substitute larg)) in @@ -994,17 +1010,23 @@ and lexp_parse_inductive ctors ctx = * things like `fv` and `meta_to_var`. *) let altacc = List.fold_right (fun (ak, n, t) aa - -> Arrow (ak, n, t, dummy_location, aa)) + -> let lp = + Arrow (ak, n, t, dummy_location, aa) + in (lp, lexp'_hash lp)) acc impossible in let g = generalize nctx altacc in let altacc' = g (fun _ne vname t l e - -> Arrow (Aerasable, vname, t, l, e)) + -> let lp = + Arrow (Aerasable, vname, t, l, e) + in (lp, lexp'_hash lp)) altacc in if altacc' == altacc then acc (* No generalization! *) else (* Convert the Lexp back into a list of fields. *) - let rec loop e = match e with + let rec loop e = + let (e', h) = e in + match e' with | Arrow (ak, n, t, _, e) -> (ak, n, t)::(loop e) | _ -> assert (e = impossible); [] in loop altacc' @@ -1157,8 +1179,12 @@ and infer_and_generalize_type (ctx : elab_context) se name = * * But we don't bother trying to catch all cases currently. *) - let rec strip_rettype t = match t with - | Arrow (ak, v, t1, l, t2) -> Arrow (ak, v, t1, l, strip_rettype t2) + let rec strip_rettype t = + let (t', h) = t in + match t' with + | Arrow (ak, v, t1, l, t2) + -> let lp = Arrow (ak, v, t1, l, strip_rettype t2) + in (lp, lexp'_hash lp) | Sort _ | Metavar _ -> type0 (* Abritrary closed constant. *) | _ -> t in let g = generalize nctx (strip_rettype t) in @@ -1338,10 +1364,12 @@ and sform_new_attribute ctx loc sargs ot = and sform_add_attribute ctx loc (sargs : sexp list) ot = let n = get_size ctx in let table, var, attr = match List.map (lexp_parse_sexp ctx) sargs with - | [table; Var((_, Some name), idx); attr] -> table, (n - idx, name), attr + | [table; (Var((_, Some name), idx), _); attr] -> table, (n - idx, name), attr | _ -> fatal ~loc "add-attribute expects 3 arguments (table; var; attr)" in - let map, attr_type = match OL.lexp_whnf table (ectx_to_lctx ctx) with + let map, attr_type = + let (lp, h) = OL.lexp_whnf table (ectx_to_lctx ctx) in + match lp with | Builtin (_, attr_type, Some map) -> map, attr_type | _ -> fatal ~loc "add-attribute expects a table as first argument" in @@ -1354,10 +1382,12 @@ and sform_add_attribute ctx loc (sargs : sexp list) ot = and get_attribute ctx loc largs = let ctx_n = get_size ctx in let table, var = match largs with - | [table; Var((_, Some name), idx)] -> table, (ctx_n - idx, name) + | [table; (Var((_, Some name), _), idx)] -> table, (ctx_n - idx, name) | _ -> fatal ~loc "get-attribute expects 2 arguments (table; var)" in - let map = match OL.lexp_whnf table (ectx_to_lctx ctx) with + let map = + let (lp, h) = OL.lexp_whnf table (ectx_to_lctx ctx) in + match lp with | Builtin (_, attr_type, Some map) -> map | _ -> fatal ~loc "get-attribute expects a table as first argument" in @@ -1372,19 +1402,21 @@ and sform_get_attribute ctx loc (sargs : sexp list) ot = and sform_has_attribute ctx loc (sargs : sexp list) ot = let n = get_size ctx in let table, var = match List.map (lexp_parse_sexp ctx) sargs with - | [table; Var((_, Some name), idx)] -> table, (n - idx, name) + | [table; (Var((_, Some name), _), idx)] -> table, (n - idx, name) | _ -> fatal ~loc "get-attribute expects 2 arguments (table; var)" in - let map, attr_type = match OL.lexp_whnf table (ectx_to_lctx ctx) with + let map, attr_type = + let (lp, h) = OL.lexp_whnf table (ectx_to_lctx ctx) in + match lp with | Builtin (_, attr_type, Some map) -> map, attr_type - | lxp -> lexp_fatal loc lxp + | lxp -> lexp_fatal loc (lxp, h) "get-attribute expects a table as first argument" in (BI.o2l_bool ctx (AttributeMap.mem var map), Lazy) and sform_declexpr ctx loc sargs ot = match List.map (lexp_parse_sexp ctx) sargs with - | [Var((_, vn), vi)] + | [(Var((_, vn), _), vi)] -> (match DB.env_lookup_expr ctx ((loc, vn), vi) with | Some lxp -> (lxp, Lazy) | None -> error ~loc "no expr available"; @@ -1395,7 +1427,7 @@ and sform_declexpr ctx loc sargs ot = let sform_decltype ctx loc sargs ot = match List.map (lexp_parse_sexp ctx) sargs with - | [Var((_, vn), vi)] + | [(Var((_, vn), _), vi)] -> (DB.env_lookup_type ctx ((loc, vn), vi), Lazy) | _ -> error ~loc "decltype expects one argument"; sform_dummy_ret ctx loc @@ -1581,7 +1613,9 @@ let sform_identifier ctx loc sargs ot = -> Inverse_subst.apply_inv_subst t subst in let mv = newMetavar octx sl (loc, Some name) t in (if not (name = "") then - let idx = match mv with + let idx = + let (mv', h) = mv in + match mv' with | Metavar (idx, _, _) -> idx | _ -> fatal ~loc "newMetavar returned a non-Metavar" in rmmap := SMap.add name idx (!rmmap)); @@ -1636,7 +1670,8 @@ let rec sform_lambda kind ctx loc sargs ot = None (* Read var type from the provided type *) | Some t - -> match OL.lexp_whnf t (ectx_to_lctx ctx) with + -> let (lp, h) = OL.lexp_whnf t (ectx_to_lctx ctx) in + match lp with | Arrow (ak2, _, lt1, _, lt2) when ak2 = kind -> (match olt1 with | None -> () @@ -1664,7 +1699,7 @@ let rec sform_lambda kind ctx loc sargs ot = | _ -> alt) | lt - -> let (lt1, lt2) = unify_with_arrow ctx loc lt kind arg olt1 + -> let (lt1, lt2) = unify_with_arrow ctx loc (lt, h) kind arg olt1 in mklam lt1 (Some lt2)) | _ -> sexp_error loc ("##lambda_"^(match kind with Anormal -> "->" @@ -1946,4 +1981,3 @@ let eval_decl_str str lctx rctx = let elxps = (List.map OL.clean_decls lxps) in (EV.eval_decls_toplevel elxps rctx), lctx with Log.Stop_Compilation s -> (prev_rctx, prev_lctx) - ===================================== src/eval.ml ===================================== @@ -484,7 +484,7 @@ and eval_call loc unef i f args = (* We may call a Vlexp e.g. for "x = Map Int String". * FIXME: The arg will sometimes be a Vlexp but not always, so this is * really just broken! *) - -> Vtype (L.mkCall (e, [(Anormal, Var (vdummy, -1))])) + -> Vtype (L.mkCall (e, [(Anormal, (Var (vdummy, -1), dummy_hash))])) | _ -> value_fatal loc f "Trying to call a non-function!" and eval_case ctx i loc target pat dflt = @@ -738,10 +738,11 @@ let constructor_p name ectx = (* Use `lexp_whnf` so that `name` can be indirectly * defined as a constructor * (e.g. as in `let foo = cons in case foo x xs | ...` *) - match OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) - (ectx_to_lctx ectx) with - | Cons _ -> true (* It's indeed a constructor! *) - | _ -> false + let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) + (ectx_to_lctx ectx) in + match lwhnf with + | Cons _ -> true (* It's indeed a constructor! *) + | _ -> false with Senv_Lookup_Fail _ -> false let erasable_p name nth ectx = @@ -753,10 +754,11 @@ let erasable_p name nth ectx = else false | _ -> false in try let idx = senv_lookup name ectx in - match OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) - (ectx_to_lctx ectx) with - | Cons (Var v, _) -> ( match (env_lookup_expr ectx v) with - | Some (Inductive (_, _, _, ctors)) -> + let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) + (ectx_to_lctx ectx) in + match lwhnf with + | Cons ((Var v, _), _) -> ( match (env_lookup_expr ectx v) with + | Some (Inductive (_, _, _, ctors), _) -> is_erasable ctors | _ -> false ) | _ -> false @@ -773,10 +775,11 @@ let erasable_p2 t name ectx = args) | _ -> false in try let idx = senv_lookup t ectx in - match OL.lexp_whnf (mkVar ((dummy_location, Some t), idx)) - (ectx_to_lctx ectx) with - | Cons (Var v, _) -> ( match (env_lookup_expr ectx v) with - | Some (Inductive (_, _, _, ctors)) -> + let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some t), idx)) + (ectx_to_lctx ectx) in + match lwhnf with + | Cons ((Var v, _), _) -> ( match (env_lookup_expr ectx v) with + | Some (Inductive (_, _, _, ctors), _) -> is_erasable ctors | _ -> false ) | _ -> false @@ -791,10 +794,11 @@ let nth_ctor_arg name nth ectx = | exception (Failure _) -> "_" ) | _ -> "_" in try let idx = senv_lookup name ectx in - match OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) - (ectx_to_lctx ectx) with - | Cons (Var v, _) -> ( match (env_lookup_expr ectx v) with - | Some (Inductive (_, _, _, ctors)) -> + let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) + (ectx_to_lctx ectx) in + match lwhnf with + | Cons ((Var v, _), _) -> ( match (env_lookup_expr ectx v) with + | Some (Inductive (_, _, _, ctors), _) -> find_nth ctors | _ -> "_" ) | _ -> "_" @@ -812,10 +816,11 @@ let ctor_arg_pos name arg ectx = | Some n -> n ) | _ -> (-1) in try let idx = senv_lookup name ectx in - match OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) - (ectx_to_lctx ectx) with - | Cons (Var v, _) -> ( match (env_lookup_expr ectx v) with - | Some (Inductive (_, _, _, ctors)) -> + let (lwhnf, h) = OL.lexp_whnf (mkVar ((dummy_location, Some name), idx)) + (ectx_to_lctx ectx) in + match lwhnf with + | Cons ((Var v, _), _) -> ( match (env_lookup_expr ectx v) with + | Some (Inductive (_, _, _, ctors), _) -> find_arg ctors | _ -> (-1) ) | _ -> (-1) ===================================== src/inverse_subst.ml ===================================== @@ -60,7 +60,8 @@ let transfo (s: Lexp.subst) : substIR option = let rec transfo (s: Lexp.subst) (off_acc: int) (idx: int) (imp_cnt : int) : substIR option = let indexOf (v: lexp): int = (* Helper : return the index of a variabble *) - match v with + let (v', h) = v in + match v' with | Var (_, v) -> v | _ -> assert false in @@ -68,15 +69,15 @@ let transfo (s: Lexp.subst) : substIR option = indexOf (mkSusp var (S.shift offset)) (* Helper : shift the index of a var *) in match s with - | S.Cons (Var _ as v, s, o) -> + | S.Cons ((Var _ as v, h), s, o) -> let off_acc = off_acc + o in (match transfo s off_acc (idx + 1) imp_cnt with | Some (tail, off, imp) - -> let newVar = shiftVar v off_acc + -> let newVar = shiftVar (v, h) off_acc in if newVar >= off then None (* Error *) - else Some (((shiftVar v off_acc), idx)::tail, off, imp) + else Some (((shiftVar (v, h) off_acc), idx)::tail, off, imp) | None -> None) - | S.Cons (Imm (Sexp.Symbol (_, "")), s, o) + | S.Cons ((Imm (Sexp.Symbol (_, "")), _), s, o) -> transfo s (o + off_acc) (idx + 1) (imp_cnt + 1) | S.Identity o -> Some ([], (o + off_acc), imp_cnt) | _ -> None (* Error *) @@ -145,7 +146,7 @@ let fill (l: (int * int) list) (nbVar: int) (shift: int): Lexp.subst option = let is_identity s = let rec is_identity s acc = match s with - | S.Cons(Var(_, idx), s1, 0) when idx = acc -> is_identity s1 (acc + 1) + | S.Cons((Var(_, idx), _), s1, 0) when idx = acc -> is_identity s1 (acc + 1) | S.Identity o -> acc = o | _ -> S.identity_p s in is_identity s 0 @@ -182,7 +183,9 @@ let inverse (s: Lexp.subst) : Lexp.subst option = * with non-variables, in which case the "inverse" is ambiguous. *) let rec invertible (s: subst) : bool = match s with | S.Identity _ -> true - | S.Cons (e, s, _) -> (match e with Var _ -> true | _ -> e = impossible) + | S.Cons (e, s, _) + -> (let (e', h) = e in + match e' with Var _ -> true | _ -> e = impossible) && invertible s exception Not_invertible @@ -193,13 +196,15 @@ let rec lookup_inv_subst (i : db_index) (s : subst) : db_index = match s with | (S.Identity o | S.Cons (_, _, o)) when i < o -> raise Not_invertible | S.Identity o -> i - o - | S.Cons (Var (_, i'), s, o) when i' = i - o + | S.Cons ((Var (_, i'), _), s, o) when i' = i - o -> (try let i'' = lookup_inv_subst i' s in assert (i'' != 0); raise Ambiguous with Not_invertible -> 0) | S.Cons (e, s, o) - -> assert (match e with Var _ -> true | _ -> e = impossible); + -> assert + (let (e', h) = e in + match e' with Var _ -> true | _ -> e = impossible); 1 + lookup_inv_subst (i - o) s (* When going under a binder, we have the rule @@ -248,7 +253,9 @@ let rec compose_inv_subst (s' : subst) (s : subst) = match s' with * The function presumes that `invertible s` was true. * This can be used like mkSusp/push_susp, but it's not lazy. * This is because it can signal errors Not_invertible or Ambiguous. *) -and apply_inv_subst (e : lexp) (s : subst) : lexp = match e with +and apply_inv_subst (e : lexp) (s : subst) : lexp = + let (e', h) = e in + match e' with | Imm _ -> e | SortLevel (SLz) -> e | SortLevel (SLsucc e) -> mkSortLevel (mkSLsucc (apply_inv_subst e s)) ===================================== src/lexp.ml ===================================== @@ -158,7 +158,8 @@ type metavar_info = type meta_subst = metavar_info U.IMap.t let dummy_scope_level = 0 -let impossible = Imm Sexp.dummy_epsilon + +let dummy_hash = 0 let builtin_size = ref 0 @@ -175,6 +176,7 @@ let metavar_lookup (id : meta_id) : metavar_info * try Hashtbl.find hc_table e * with Not_found -> Hashtbl.add hc_table e e; e *) let lexp_hash (e, h) = h + let lexp_to_lexp' (e, h) = e let rec apply_lxor (map : int list) : int = match map with @@ -183,7 +185,7 @@ let metavar_lookup (id : meta_id) : metavar_info (* Hashtbl.hash for not lexp types * TODO: find something else *) - let lexp'_hash expr = + let lexp'_hash (expr : lexp') = match expr with | Imm s -> Hashtbl.hash s | SortLevel l @@ -227,7 +229,9 @@ let metavar_lookup (id : meta_id) : metavar_info | Call (e, args) -> (lexp_hash e) lxor (apply_lxor (List.map (fun e -> let (ak, lp) = e in ((Hashtbl.hash ak) lxor (lexp_hash lp))) args)) -(* | Susp (lp, subst) -> (lexp_hash lp) lxor (Hashtbl.hash subst) *) + | Susp (lp, subst) -> (lexp_hash lp) lxor (Hashtbl.hash subst) + +let impossible = (let imp = Imm Sexp.dummy_epsilon in (imp, dummy_hash)) module WHC = Weak.Make (struct type t = lexp (* Using (=) instead of `compare` results @@ -255,13 +259,15 @@ let mkCons (t, n) = hc (Cons (t, n)) let mkCase (l, e, rt, bs, d) = hc (Case (l, e, rt, bs, d)) let mkMetavar (n, s, v) = hc (Metavar (n, s, v)) let mkCall (f, es) - = match f, es with - | Call (f', es'), _ -> hc (Call (f', es' @ es)) - | _, [] -> (f, lexp'_hash f) - | _ -> hc (Call ((f, lexp'_hash f), es)) + = let (f', h) = f in + match f', es with + | Call (f'', es'), _ -> hc (Call (f'', es' @ es)) + | _, [] -> f + | _ -> hc (Call (f, es)) and lexp_head e = - match e with + let (e', h) = e in + match e' with | Imm s -> if e = impossible then "impossible" else "Imm" ^ sexp_string s | Var _ -> "Var" | Let _ -> "let" @@ -278,7 +284,10 @@ and lexp_head e = | Sort _ -> "Sort" | SortLevel _ -> "SortLevel" -let mkSLlub' (e1, e2) = match (e1, e2) with +let mkSLlub' (e1, e2) = + let (e1', h1) = e1 in + let (e2', h2) = e2 in + match (e1', e2') with (* FIXME: This first case should be handled by calling `mkSLlub` instead! *) | (SortLevel SLz, SortLevel l) | (SortLevel l, SortLevel SLz) -> l | (SortLevel SLz, _) | (_, SortLevel SLz) @@ -287,14 +296,16 @@ let mkSLlub' (e1, e2) = match (e1, e2) with -> Log.log_fatal ~section:"internal" "lub of two SLsucc" | ((SortLevel _ | Var _ | Metavar _ | Susp _), (SortLevel _ | Var _ | Metavar _ | Susp _)) - -> SLlub ((e1, lexp'_hash e1), (e2, lexp'_hash e2)) + -> SLlub (e1, e2) | _ -> Log.log_fatal ~section:"internal" ("SLlub of non-level: " ^ lexp_head e1 ^ " ∪ " ^ lexp_head e2) -let mkSLsucc e = match e with - | SortLevel _ | Var _ | Metavar _ | Susp _ - -> SLsucc (e, lexp'_hash e) - | _ -> Log.log_fatal ~section:"internal" "SLsucc of non-level " +let mkSLsucc e = + let (e', h) = e in + match e' with + | SortLevel _ | Var _ | Metavar _ | Susp _ + -> SLsucc e + | _ -> Log.log_fatal ~section:"internal" "SLsucc of non-level " (********* Helper functions to use the Subst operations *********) (* This basically "ties the knot" between Subst and Lexp. @@ -398,7 +409,8 @@ let _ = assert (S.identity_p (scompose (S.shift 5) (sunshift 5))) let rec lexp_location e = - match e with + let (e', h) = e in + match e' with | Sort (l,_) -> l | SortLevel (SLsucc e) -> lexp_location e | SortLevel (SLlub (e, _)) -> lexp_location e @@ -425,10 +437,11 @@ let maybename n = match n with None -> "<anon>" | Some v -> v let sname (l,n) = (l, maybename n) let rec push_susp e s = (* Push a suspension one level down. *) - match e with + let (e', h) = e in + match e' with | Imm _ -> e | SortLevel (SLz) -> e - | SortLevel (SLsucc e') -> mkSortLevel (mkSLsucc (mkSusp e' s)) + | SortLevel (SLsucc e'') -> mkSortLevel (mkSLsucc (mkSusp e'' s)) | SortLevel (SLlub (e1, e2)) -> mkSortLevel (mkSLlub' (mkSusp e1 s, mkSusp e2 s)) | Sort (l, Stype e) -> mkSort (l, Stype (mkSusp e s)) @@ -484,14 +497,17 @@ let rec push_susp e s = (* Push a suspension one level down. *) | (Var _ | Metavar _) -> nosusp (mkSusp e s) and nosusp e = (* Return `e` with no outermost `Susp`. *) - match e with + let (e', h) = e in + match e' with | Susp(e, s) -> push_susp e s | _ -> e (* Get rid of `Susp`ensions and instantiated `Metavar`s. *) let clean e = - let rec clean s e = match e with + let rec clean s e = + let (e', h) = e in + match e' with | Imm _ -> e | SortLevel (SLz) -> e | SortLevel (SLsucc e) -> mkSortLevel (mkSLsucc (clean s e)) @@ -528,7 +544,7 @@ let clean e = L.rev ncase) cases in mkInductive (l, label, nargs, ncases) - | Cons (it, name) -> Cons (clean s it, name) + | Cons (it, name) -> (let lp = Cons (clean s it, name) in (lp, lexp'_hash lp)) | Case (l, e, ret, cases, default) -> mkCase (l, clean s e, clean s ret, SMap.map (fun (l, cargs, e) @@ -555,8 +571,9 @@ let stypecons = Symbol (U.dummy_location, "##typecons") (* ugly printing (sexp_print (pexp_unparse (lexp_unparse e))) *) let rec lexp_unparse lxp = - match lxp with - | Susp _ as e -> lexp_unparse (nosusp e) + let (lxp', h) = lxp in + match lxp' with + | Susp _ as e -> lexp_unparse (nosusp (e, lexp'_hash e)) | Imm (sexp) -> sexp | Builtin ((l,name), _, _) -> Symbol (l, "##" ^ name) (* FIXME: Add a Sexp syntax for debindex references. *) @@ -686,7 +703,8 @@ and subst_string s = match s with -> "(↑"^ string_of_int o ^ " " ^ subst_string (S.cons l s) ^ ")" and lexp_name e = - match e with + let (e', h) = e in + match e' with | Imm _ -> lexp_string e | Var _ -> lexp_string e | _ -> lexp_head e @@ -776,7 +794,8 @@ let get_binary_op_name name = let rec get_precedence expr ctx = let lkp name = SMap.find name (pp_grammar ctx) in - match expr with + let (e', h) = expr in + match e' with | Lambda _ -> lkp "lambda" | Case _ -> lkp "case" | Let _ -> lkp "let" @@ -844,14 +863,17 @@ and lexp_str ctx (exp : lexp) : string = let kindp_str k = match k with | Anormal -> ":" | Aimplicit -> "::" | Aerasable -> ":::" in - let get_name fname = match fname with + let get_name fname = + let (fn, h) = fname in + match fn with | Builtin ((_, name), _, _) -> name, 0 | Var((_, Some name), idx) -> name, idx | Lambda _ -> "__", 0 | Cons _ -> "__", 0 | _ -> "__", -1 in - match exp with + let (e', h) = exp in + match e' with | Imm(value) -> (match value with | String (_, s) -> tval ("\"" ^ s ^ "\"") | Integer(_, s) -> tval (string_of_int s) @@ -962,8 +984,10 @@ and lexp_str ctx (exp : lexp) : string = | Builtin ((_, name), _, _) -> "##" ^ name - | Sort (_, Stype (SortLevel SLz)) -> "##Type" - | Sort (_, Stype (SortLevel (SLsucc (SortLevel SLz)))) -> "##Type1" + | Sort (_, Stype ((SortLevel SLz), _)) -> "##Type" + | Sort (_, Stype ((SortLevel + (SLsucc + (SortLevel SLz, _))), _)) -> "##Type1" | Sort (_, Stype l) -> "(##Type_ " ^ lexp_string l ^ ")" | Sort (_, StypeLevel) -> "##TypeLevel.Sort" | Sort (_, StypeOmega) -> "##Type_ω" @@ -1005,7 +1029,14 @@ and lexp_str_decls ctx decls = (** Syntactic equality (i.e. without β). *******) -let rec eq e1 e2 = +let eq (e1 : lexp) (e2 : lexp) : bool = + let (e1', h1) = e1 in + let (e2', h2) = e2 in + compare h1 h2 == 0 + +(* + +let rec eq' e1 e2 = e1 == e2 || match (e1, e2) with | (Imm (Integer (_, i1)), Imm (Integer (_, i2))) -> i1 = i2 @@ -1013,44 +1044,44 @@ let rec eq e1 e2 = | (Imm (String (_, s1)), Imm (String (_, s2))) -> s1 = s2 | (Imm s1, Imm s2) -> s1 = s2 | (SortLevel SLz, SortLevel SLz) -> true - | (SortLevel (SLsucc e1), SortLevel (SLsucc e2)) -> eq e1 e2 + | (SortLevel (SLsucc e1), SortLevel (SLsucc e2)) -> eq' e1 e2 | (SortLevel (SLlub (e11, e21)), SortLevel (SLlub (e12, e22))) - -> eq e11 e12 && eq e21 e22 + -> eq' e11 e12 && eq' e21 e22 | (Sort (_, StypeOmega), Sort (_, StypeOmega)) -> true | (Sort (_, StypeLevel), Sort (_, StypeLevel)) -> true - | (Sort (_, Stype e1), Sort (_, Stype e2)) -> eq e1 e2 + | (Sort (_, Stype e1), Sort (_, Stype e2)) -> eq' e1 e2 | (Builtin ((_, name1), _, _), Builtin ((_, name2), _, _)) -> name1 = name2 | (Var (_, i1), Var (_, i2)) -> i1 = i2 - | (Susp (e1, s1), e2) -> eq (push_susp e1 s1) e2 - | (e1, Susp (e2, s2)) -> eq e1 (push_susp e2 s2) + | (Susp (e1, s1), e2) -> eq' (push_susp e1 s1) e2 + | (e1, Susp (e2, s2)) -> eq' e1 (push_susp e2 s2) | (Let (_, defs1, e1), Let (_, defs2, e2)) - -> eq e1 e2 && List.for_all2 (fun (_, e1, t1) (_, e2, t2) - -> eq t1 t2 && eq e1 e2) + -> eq' e1 e2 && List.for_all2 (fun (_, e1, t1) (_, e2, t2) + -> eq' t1 t2 && eq' e1 e2) defs1 defs2 | (Arrow (ak1, _, t11, _, t21), Arrow (ak2, _, t12, _, t22)) - -> ak1 = ak2 && eq t11 t12 && eq t21 t22 + -> ak1 = ak2 && eq' t11 t12 && eq' t21 t22 | (Lambda (ak1, _, t1, e1), Lambda (ak2, _, t2, e2)) - -> ak1 = ak2 && eq t1 t2 && eq e1 e2 + -> ak1 = ak2 && eq' t1 t2 && eq' e1 e2 | (Call (e1, as1), Call (e2, as2)) - -> eq e1 e2 && List.for_all2 (fun (ak1, e1) (ak2, e2) -> ak1 = ak2 && eq e1 e2) + -> eq' e1 e2 && List.for_all2 (fun (ak1, e1) (ak2, e2) -> ak1 = ak2 && eq' e1 e2) as1 as2 | (Inductive (_, l1, as1, cases1), Inductive (_, l2, as2, cases2)) -> l1 = l2 - && List.for_all2 (fun (ak1, _, e1) (ak2, _, e2) -> ak1 = ak2 && eq e1 e2) + && List.for_all2 (fun (ak1, _, e1) (ak2, _, e2) -> ak1 = ak2 && eq' e1 e2) as1 as2 && SMap.equal (List.for_all2 (fun (ak1, _, e1) (ak2, _, e2) - -> ak1 = ak2 && eq e1 e2)) + -> ak1 = ak2 && eq' e1 e2)) cases1 cases2 - | (Cons (t1, (_, l1)), Cons (t2, (_, l2))) -> eq t1 t2 && l1 = l2 + | (Cons (t1, (_, l1)), Cons (t2, (_, l2))) -> eq' t1 t2 && l1 = l2 | (Case (_, e1, r1, cases1, def1), Case (_, e2, r2, cases2, def2)) - -> eq e1 e2 && eq r1 r2 + -> eq' e1 e2 && eq' r1 r2 && SMap.equal (fun (_, fields1, e1) (_, fields2, e2) - -> eq e1 e2 && List.for_all2 (fun (ak1, _) (ak2, _) + -> eq' e1 e2 && List.for_all2 (fun (ak1, _) (ak2, _) -> ak1 = ak2) fields1 fields2) cases1 cases2 && (match (def1, def2) with - | (Some (_, e1), Some (_, e2)) -> eq e1 e2 + | (Some (_, e1), Some (_, e2)) -> eq' e1 e2 | _ -> def1 = def2) | (Metavar (i1, s1, _), Metavar (i2, s2, _)) -> i1 = i2 && subst_eq s1 s2 @@ -1062,13 +1093,15 @@ and subst_eq s1 s2 = | (S.Identity o1, S.Identity o2) -> o1 = o2 | (S.Cons (e1, s1, o1), S.Cons (e2, s2, o2)) -> if o1 = o2 then - eq e1 e2 && subst_eq s1 s2 + eq' e1 e2 && subst_eq s1 s2 else if o1 > o2 then let o = o1 - o2 in - eq (mkSusp e1 (S.shift o)) e2 + eq' (mkSusp e1 (S.shift o)) e2 && subst_eq (S.mkShift s1 o) s2 else let o = o2 - o1 in - eq e1 (mkSusp e2 (S.shift o)) + eq' e1 (mkSusp e2 (S.shift o)) && subst_eq s1 (S.mkShift s2 o) | _ -> false + +*) ===================================== src/opslexp.ml ===================================== @@ -134,7 +134,8 @@ let lexp_close lctx e = * call-by-name behavior. *) let lexp_whnf e (ctx : DB.lexp_context) : lexp = let rec lexp_whnf e (ctx : DB.lexp_context) : lexp = - match e with + let (le', h) = e in + match le' with | Var v -> (match lookup_value ctx v with | None -> e (* We can do this blindly even for recursive definitions! @@ -144,7 +145,8 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = | Susp (e, s) -> lexp_whnf (push_susp e s) ctx | Call (e, []) -> lexp_whnf e ctx | Call (f, (((_, arg)::args) as xs)) -> - (match lexp_whnf f ctx with + (let (lwhnf', h) = lexp_whnf f ctx in + match lwhnf' with | Lambda (_, _, _, body) -> (* Here we apply whnf to the arg eagerly to kind of stay closer * to the idea of call-by-value, although in this context @@ -175,10 +177,12 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = ("Unhandled constructor " ^ name ^ "in case expression"); mkCase (l, e, rt, branches, default) in - (match e' with + (let (e'', h) = e' in + match e'' with | Cons (_, (_, name)) -> reduce name [] | Call (f, aargs) -> - (match lexp_whnf f ctx with + (let (lwhnf, h) = lexp_whnf f ctx in + match lwhnf with | Cons (_, (_, name)) -> reduce name aargs | _ -> mkCase (l, e, rt, branches, default)) | _ -> mkCase (l, e, rt, branches, default)) @@ -192,7 +196,7 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = | Let (l, defs, body) -> lexp_whnf (push_susp body (lexp_defs_subst l S.identity defs)) ctx - | e -> e + | e -> (e, h) in lexp_whnf e ctx @@ -201,8 +205,10 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = type set_plexp = (lexp * lexp) list let set_empty : set_plexp = [] let set_member_p (s : set_plexp) (e1 : lexp) (e2 : lexp) : bool - = assert (e1 == Lexp.hc e1); - assert (e2 == Lexp.hc e2); + = lexp_print e2 ; print_string "\n" ; + lexp_print (Lexp.hc (let (e2', h) = e2 in e2')); + assert (lexp_hash e1 == lexp_hash (Lexp.hc (let (e1', h) = e1 in e1'))); + assert (lexp_hash e2 == lexp_hash (Lexp.hc (let (e2', h) = e2 in e2'))); try let _ = List.find (fun (e1', e2') -> L.eq e1 e1' && L.eq e2 e2') s @@ -230,7 +236,9 @@ let level_canon e = let o = try IMap.find v m with Not_found -> -1 in if o < d then (c, IMap.add v d m) else acc in - let rec canon e d ((c,m) as acc) = match e with + let rec canon e d ((c,m) as acc) = + let (e', h) = e in + match e' with | SortLevel SLz -> if c < d then (d, m) else acc | SortLevel (SLsucc e) -> canon e (d + 1) acc | SortLevel (SLlub (e1, e2)) -> canon e1 d (canon e2 d acc) @@ -259,7 +267,9 @@ let rec conv_p' (ctx : DB.lexp_context) (vs : set_plexp) e1 e2 : bool = if changed && set_member_p vs e1' e2' then true else let vs' = if changed then set_add vs e1' e2' else vs in let conv_p = conv_p' ctx vs' in - match (e1', e2') with + let (e1'', h1) = e1' in + let (e2'', h1) = e2' in + match (e1'', e2'') with | (Imm (Integer (_, i1)), Imm (Integer (_, i2))) -> i1 = i2 | (Imm (Float (_, i1)), Imm (Float (_, i2))) -> i1 = i2 | (Imm (String (_, i1)), Imm (String (_, i2))) -> i1 = i2 @@ -332,14 +342,16 @@ let conv_p (ctx : DB.lexp_context) e1 e2 (********* Testing if a lexp is properly typed *********) let rec mkSLlub ctx e1 e2 = - match (lexp_whnf e1 ctx, lexp_whnf e2 ctx) with + let (lwhnf1, h1) = lexp_whnf e1 ctx in + let (lwhnf2, h2) = lexp_whnf e2 ctx in + match (lwhnf1, lwhnf2) with | (SortLevel SLz, _) -> e2 | (_, SortLevel SLz) -> e1 | (SortLevel (SLsucc e1), SortLevel (SLsucc e2)) -> mkSortLevel (SLsucc (mkSLlub ctx e1 e2)) | (e1', e2') - -> let ce1 = level_canon e1' in - let ce2 = level_canon e2' in + -> let ce1 = level_canon (e1', h1) in + let ce2 = level_canon (e2', h2) in if level_leq ce1 ce2 then e2 else if level_leq ce2 ce1 then e1 else mkSortLevel (mkSLlub' (e1, e2)) (* FIXME: Could be more canonical *) @@ -353,7 +365,9 @@ type sort_compose_result let sort_compose ctx1 ctx2 l ak k1 k2 = (* BEWARE! Technically `k2` can refer to `v`, but this should only happen * if `v` is a TypeLevel. *) - match (lexp_whnf k1 ctx1, lexp_whnf k2 ctx2) with + let (lwhnf1, h1) = lexp_whnf k1 ctx1 in + let (lwhnf2, h2) = lexp_whnf k2 ctx2 in + match (lwhnf1, lwhnf2) with | (Sort (_, s1), Sort (_, s2)) -> (match s1, s2 with | (Stype l1, Stype l2) @@ -408,7 +422,8 @@ let nerased_let defs erased = * will be non-erasable, so in `let x = z; y = x ...` * where `z` is erasable, `x` will be found * to be erasable, but not `y`. *) - match e with Var (_, idx) -> DB.set_mem idx nerased + let (e', h) = e in + match e' with Var (_, idx) -> DB.set_mem idx nerased | _ -> false) defs in if not (List.mem true es) then nerased else @@ -430,14 +445,15 @@ let rec check'' erased ctx e = (* Log.internal_error "Type mismatch" *)) in let check_type erased ctx t = let s = check erased ctx t in - (match lexp_whnf s ctx with - | Sort _ -> () - | _ -> error_tc ~loc:(lexp_location t) - ("Not a proper type: " ^ lexp_string t)); - (* FIXME: return the `sort` rather than the surrounding `lexp`! *) - s in - - match e with + (let (lwhnf, h) = lexp_whnf s ctx in + match lwhnf with + | Sort _ -> () + | _ -> error_tc ~loc:(lexp_location t) + ("Not a proper type: " ^ lexp_string t)); + (* FIXME: return the `sort` rather than the surrounding `lexp`! *) + s in + let (e', h) = e in + match e' with | Imm (Float (_, _)) -> DB.type_float | Imm (Integer (_, _)) -> DB.type_int | Imm (String (_, _)) -> DB.type_string @@ -528,7 +544,8 @@ let rec check'' erased ctx e = (fun ft (ak,arg) -> let at = check (if ak = P.Aerasable then DB.set_empty else erased) ctx arg in - match lexp_whnf ft ctx with + let (lwhnf, h) = lexp_whnf ft ctx in + match lwhnf with | Arrow (ak', v, t1, l, t2) -> if not (ak == ak') then (error_tc ~loc:(lexp_location arg) @@ -551,8 +568,9 @@ let rec check'' erased ctx e = let (level, _, _, _) = List.fold_left (fun (level, ictx, erased, n) (ak, v, t) -> - ((match lexp_whnf (check_type erased ictx t) - ictx with + ((let (lwhnf, h) = + lexp_whnf (check_type erased ictx t) ictx in + match lwhnf with | Sort (_, Stype _) when ak == P.Aerasable && impredicative_erase -> level @@ -570,7 +588,7 @@ let rec check'' erased ctx e = ("Field type " ^ lexp_string t ^ " is not a Type! (" - ^ lexp_string tt ^")"); + ^ lexp_string (tt, h) ^")"); level), DB.lctx_extend ictx v Variable t, DB.set_sink 1 erased, @@ -590,12 +608,15 @@ let rec check'' erased ctx e = tct | Case (l, e, ret, branches, default) (* FIXME: Check that the return type isn't TypeLevel. *) - -> let call_split e = match e with + -> let call_split e = + let (e', h) = e in + match e' with | Call (f, args) -> (f, args) | _ -> (e,[]) in let etype = lexp_whnf (check erased ctx e) ctx in let it, aargs = call_split etype in - (match lexp_whnf it ctx, aargs with + (let (lwhnf, h) = lexp_whnf it ctx in + match lwhnf, aargs with | Inductive (_, _, fargs, constructors), aargs -> let rec mksubst s fargs aargs = match fargs, aargs with @@ -644,8 +665,9 @@ let rec check'' erased ctx e = | _,_ -> error_tc ~loc:l "Case on a non-inductive type!"); ret | Cons (t, (l, name)) - -> (match lexp_whnf t ctx with - | Inductive (l, _, fargs, constructors) + -> (let (lwhnf, h) = lexp_whnf t ctx in + match lwhnf with + | Inductive (l, _, fargs, constructors) -> (try let fieldtypes = SMap.find name constructors in let rec indtype fargs start_index = @@ -732,7 +754,9 @@ let fv_hoist n (fvs, mvs) = (DB.set_hoist n fvs, mvs) let fv_erase (fvs, mvs) = (fvs, mv_set_erase mvs) let rec fv (e : lexp) : (DB.set * mv_set) = - let fv' e = match e with + let fv' e = + let (e', h) = e in + match e' with | Imm _ -> fv_empty | SortLevel SLz -> fv_empty | SortLevel (SLsucc e) -> fv e @@ -807,7 +831,8 @@ let rec fv (e : lexp) : (DB.set * mv_set) = (* This should never signal any warning/error. *) let rec get_type ctx e = - match e with + let (e', h) = e in + match e' with | Imm (Float (_, _)) -> DB.type_float | Imm (Integer (_, _)) -> DB.type_int | Imm (String (_, _)) -> DB.type_string @@ -838,7 +863,8 @@ let rec get_type ctx e = -> let ft = get_type ctx f in List.fold_left (fun ft (ak,arg) - -> match lexp_whnf ft ctx with + -> let (lwhnf, h) = lexp_whnf ft ctx in + match lwhnf with | Arrow (ak', v, t1, l, t2) -> mkSusp t2 (S.substitute arg) | _ -> ft) @@ -854,7 +880,8 @@ let rec get_type ctx e = let (level, _, _) = List.fold_left (fun (level, ictx, n) (ak, v, t) -> - ((match lexp_whnf (get_type ictx t) ictx with + ((let (lwhnf, h) = lexp_whnf (get_type ictx t) ictx in + match lwhnf with | Sort (_, Stype _) when ak == P.Aerasable && impredicative_erase -> level @@ -878,7 +905,8 @@ let rec get_type ctx e = tct | Case (l, e, ret, branches, default) -> ret | Cons (t, (l, name)) - -> (match lexp_whnf t ctx with + -> (let (lwhnf, h) = lexp_whnf t ctx in + match lwhnf with | Inductive (l, _, fargs, constructors) -> (try let fieldtypes = SMap.find name constructors in @@ -912,8 +940,8 @@ let rec get_type ctx e = (*********** Type erasure, before evaluation. *****************) let rec erase_type (lxp: L.lexp): E.elexp = - - match lxp with + let (lxp', h) = lxp in + match lxp' with | L.Imm(s) -> E.Imm(s) | L.Builtin(v, _, _) -> E.Builtin(v) | L.Var(v) -> E.Var(v) @@ -1004,7 +1032,12 @@ let ctx2tup ctx nctx = let offset = List.length types in let types = List.rev types in (*Log.debug_msg ("Building tuple of size " ^ string_of_int offset ^ "\n");*) - Call (Cons (Inductive (loc, type_label, [], + let lexp = + Call + ((let lexp' = + Cons ( + ((let lexp'' = + Inductive (loc, type_label, [], SMap.add cons_name (List.map (fun (oname, t) -> (P.Aimplicit, oname, @@ -1018,22 +1051,24 @@ let ctx2tup ctx nctx = * equivalent and preferable). *) mkSusp t (S.shift offset))) types) - SMap.empty), - cons_label), + SMap.empty) in (lexp'', lexp'_hash lexp'')), + cons_label)) in (lexp', lexp'_hash lexp')), List.mapi (fun i (oname, t) -> (P.Aimplicit, mkVar (oname, offset - i - 1))) - types) + types) in (lexp, lexp'_hash lexp) | (DB.CVlet (name, LetDef (_, e), t, _) :: blocs) - -> Let (loc, [(name, mkSusp e (S.shift 1), t)], - mk_lets_and_tup blocs ((name, t) :: types)) + -> let lp = + Let (loc, [(name, mkSusp e (S.shift 1), t)], + mk_lets_and_tup blocs ((name, t) :: types)) in (lp, lexp'_hash lp) | (DB.CVfix (defs, _) :: blocs) - -> Let (loc, defs, + -> let lp = + Let (loc, defs, mk_lets_and_tup blocs (List.append (List.rev (List.map (fun (oname, _, t) -> (oname, t)) defs)) - types)) + types)) in (lp, lexp'_hash lp) | _ -> assert false in mk_lets_and_tup (get_blocs nctx []) [] ===================================== src/unification.ml ===================================== @@ -61,7 +61,9 @@ let occurs_in (id: meta_id) (e : lexp) : bool = match metavar_lookup id with | MVal _ -> Log.internal_error "Checking occurrence of an instantiated metavar!!" | MVar (sl, _, _) - -> let rec oi e = match e with + -> let rec oi e = + let (e', h) = e in + match e' with | Imm _ -> false | SortLevel SLz -> false | SortLevel (SLsucc e) -> oi e @@ -189,21 +191,23 @@ and unify' (e1: lexp) (e2: lexp) let changed = true (* not (e1 == e1' && e2 == e2') *) in if changed && OL.set_member_p vs e1' e2' then [] else let vs' = if changed then OL.set_add vs e1' e2' else vs in - match (e1', e2') with + let (e1'', h1) = e1' in + let (e2'', h2) = e2' in + match (e1'', e2'') with | ((Imm _, Imm _) | (Cons _, Cons _) | (Builtin _, Builtin _) | (Var _, Var _)) -> if OL.conv_p ctx e1' e2' then [] else [(CKimpossible, ctx, e1, e2)] - | (l, (Metavar (idx, s, _) as r)) -> unify_metavar ctx idx s r l - | ((Metavar (idx, s, _) as l), r) -> unify_metavar ctx idx s l r - | (l, (Call _ as r)) -> unify_call r l ctx vs' + | (l, (Metavar (idx, s, _) as r)) -> unify_metavar ctx idx s e2' e1' + | ((Metavar (idx, s, _) as l), r) -> unify_metavar ctx idx s e1' e2' + | (l, (Call _ as r)) -> unify_call e2' e1' ctx vs' (* | (l, (Case _ as r)) -> unify_case r l subst *) - | (Arrow _ as l, r) -> unify_arrow l r ctx vs' - | (Lambda _ as l, r) -> unify_lambda l r ctx vs' - | (Call _ as l, r) -> unify_call l r ctx vs' + | (Arrow _ as l, r) -> unify_arrow e1' e2' ctx vs' + | (Lambda _ as l, r) -> unify_lambda e1' e2' ctx vs' + | (Call _ as l, r) -> unify_call e1' e2' ctx vs' (* | (Case _ as l, r) -> unify_case l r subst *) (* | (Inductive _ as l, r) -> unify_induct l r subst *) - | (Sort _ as l, r) -> unify_sort l r ctx vs' - | (SortLevel _ as l, r) -> unify_sortlvl l r ctx vs' + | (Sort _ as l, r) -> unify_sort e1' e2' ctx vs' + | (SortLevel _ as l, r) -> unify_sortlvl e1' e2' ctx vs' | (Inductive (_loc1, label1, args1, consts1), Inductive (_loc2, label2, args2, consts2)) -> (* print_string ("Unifying inductives " @@ -227,7 +231,9 @@ and unify' (e1: lexp) (e2: lexp) *) and unify_arrow (arrow: lexp) (lxp: lexp) ctx vs : return_type = - match (arrow, lxp) with + let (arrow', h1) = arrow in + let (lxp', h2) = lxp in + match (arrow', lxp') with | (Arrow (var_kind1, v1, ltype1, _, lexp1), Arrow (var_kind2, _, ltype2, _, lexp2)) -> if var_kind1 = var_kind2 @@ -250,7 +256,9 @@ and unify_arrow (arrow: lexp) (lxp: lexp) ctx vs - Lambda , lexp -> unify lexp lambda subst *) and unify_lambda (lambda: lexp) (lxp: lexp) ctx vs : return_type = - match (lambda, lxp) with + let (lambda', h1) = lambda in + let (lxp', h2) = lxp in + match (lambda', lxp') with | (Lambda (var_kind1, v1, ltype1, lexp1), Lambda (var_kind2, _, ltype2, lexp2)) -> if var_kind1 = var_kind2 @@ -300,7 +308,8 @@ and unify_metavar ctx idx s1 (lxp1: lexp) (lxp2: lexp) ^ lexp_string (OL.get_type ctx lxp) ^ "\n" ^ "for " ^ lexp_string lxp ^ "\n"); [(CKresidual, ctx, lxp1, lxp2)] in - match lxp2 with + let (lxp2', h) = lxp2 in + match lxp2' with | Metavar (idx2, s2, name) -> if idx = idx2 then match common_subset ctx s1 s2 with @@ -370,7 +379,9 @@ and unify_metavar ctx idx s1 (lxp1: lexp) (lxp2: lexp) *) and unify_call (call: lexp) (lxp: lexp) ctx vs : return_type = - match (call, lxp) with + let (call', h1) = call in + let (lxp', h2) = lxp in + match (call', lxp') with | (Call (lxp_left, lxp_list1), Call (lxp_right, lxp_list2)) when OL.conv_p ctx lxp_left lxp_right -> List.fold_left (fun op ((ak1, e1), (ak2, e2)) @@ -439,7 +450,9 @@ and unify_call (call: lexp) (lxp: lexp) ctx vs - SortLevel, _ -> ERROR *) and unify_sortlvl (sortlvl: lexp) (lxp: lexp) ctx vs : return_type = - match sortlvl, lxp with + let (sortlvl', h1) = sortlvl in + let (lxp', h2) = lxp in + match sortlvl', lxp' with | (SortLevel s, SortLevel s2) -> (match s, s2 with | SLz, SLz -> [] | SLsucc l1, SLsucc l2 -> unify' l1 l2 ctx vs @@ -456,7 +469,9 @@ and unify_sortlvl (sortlvl: lexp) (lxp: lexp) ctx vs : return_type = - Sort, lexp -> ERROR *) and unify_sort (sort_: lexp) (lxp: lexp) ctx vs : return_type = - match sort_, lxp with + let (sort_', h1) = sort_ in + let (lxp', h2) = lxp in + match sort_', lxp' with | (Sort (_, srt), Sort (_, srt2)) -> (match srt, srt2 with | Stype lxp1, Stype lxp2 -> unify' lxp1 lxp2 ctx vs | StypeOmega, StypeOmega -> [] @@ -557,4 +572,3 @@ and unify_inductive ctx vs args1 args2 consts1 consts2 e1 e2 = * | None -> None) * | _, _ -> None * in test l1 l2 subst *) - View it on GitLab: https://gitlab.com/monnier/typer/-/commit/63089e95553de312dab7a21757a65cc5f… -- View it on GitLab: https://gitlab.com/monnier/typer/-/commit/63089e95553de312dab7a21757a65cc5f… You're receiving this email because of your account on gitlab.com.

2 1

[Git][monnier/typer][alice] add hash to lexp representation
by Alice de Berny 26 May '20

26 May '20

Alice de Berny pushed to branch alice at Stefan / Typer Commits: a289d4c4 by irradiee at 2020-05-24T21:45:19-04:00 add hash to lexp representation - - - - - 2 changed files: - src/debug.ml - src/lexp.ml Changes: ===================================== src/debug.ml ===================================== @@ -156,3 +156,8 @@ let debug_lexp_decls decls = str; ) decls + +let print_hc_table = WHC.iter (fun e -> print_int (Hashtbl.hash e); + print_string "\t"; + lexp_print e; + print_string "\n") hc_table ===================================== src/lexp.ml ===================================== @@ -60,7 +60,8 @@ module AttributeMap = Map.Make (struct type t = attribute_key let compare = comp type ltype = lexp and subst = lexp S.subst - and lexp = + and lexp = lexp' * int + and lexp' = | Imm of sexp (* Used for strings, ... *) | SortLevel of sort_level | Sort of U.location * sort @@ -173,6 +174,60 @@ let metavar_lookup (id : meta_id) : metavar_info * let hc (e : lexp) : lexp = * try Hashtbl.find hc_table e * with Not_found -> Hashtbl.add hc_table e e; e *) + let lexp_hash (e, h) = h + + let rec apply_lxor (map : int list) : int = + match map with + | [] -> 0 + | e :: l -> e lxor (apply_lxor l) + +(* Hashtbl.hash for not lexp types + * TODO: find something else *) + let lexp'_hash expr = + match expr with + | Imm s -> Hashtbl.hash s + | SortLevel l + -> (match l with + | SLz -> Hashtbl.hash l + | SLsucc lp -> lexp_hash lp + | SLlub (lp1, lp2) -> (lexp_hash lp1) lxor (lexp_hash lp2)) + | Sort (l, s) + -> (Hashtbl.hash l) lxor + (match s with + | Stype lp -> lexp_hash lp + | StypeOmega -> Hashtbl.hash s + | StypeLevel -> Hashtbl.hash s) + | Builtin (v, t, m) as e -> Hashtbl.hash e + | Var v -> Hashtbl.hash v + | Let (l, ds, e) + -> (Hashtbl.hash l) lxor + ((apply_lxor (List.map (fun e -> let (n, lp, lt) = e in + ((Hashtbl.hash n) lxor ((lexp_hash lp) lxor (lexp_hash lt)))) + ds)) lxor (lexp_hash e)) + | Arrow (k, v, t1, l, t2) + -> ((Hashtbl.hash k) lxor (Hashtbl.hash v)) lxor + ((lexp_hash t1) lxor ((Hashtbl.hash l) lxor (lexp_hash t2))) + | Lambda (k, v, t, e) + -> ((Hashtbl.hash k) lxor (Hashtbl.hash v)) lxor + ((lexp_hash t) lxor (lexp_hash e)) + | Inductive (l, n, a, cs) + -> ((Hashtbl.hash l) lxor (Hashtbl.hash n)) lxor + ((apply_lxor (List.map (fun e -> let (ak, n, lt) = e in + ((Hashtbl.hash ak) lxor ((Hashtbl.hash n) lxor (lexp_hash lt)))) a)) + lxor Hashtbl.hash cs) + | Cons (t, n) -> (lexp_hash t) lxor (Hashtbl.hash n) + | Case (l, e, rt, bs, d) + -> ((Hashtbl.hash l) lxor (lexp_hash e)) lxor + ((lexp_hash rt) lxor ((Hashtbl.hash bs) lxor + (match d with + | Some (n, lp) -> (Hashtbl.hash n) lxor (lexp_hash lp) + | _ -> 0))) + | Metavar (id, s, v) + -> Hashtbl.hash expr + | Call (e, args) -> (lexp_hash e) lxor + (apply_lxor (List.map (fun e -> let (ak, lp) = e in + ((Hashtbl.hash ak) lxor (lexp_hash lp))) args)) +(* | Susp (lp, subst) -> (lexp_hash lp) lxor (Hashtbl.hash subst) *) module WHC = Weak.Make (struct type t = lexp (* Using (=) instead of `compare` results @@ -180,11 +235,12 @@ module WHC = Weak.Make (struct type t = lexp * `compare` checks == before recursing * but (=) doesn't? *) let equal x y = (compare x y = 0) - let hash = Hashtbl.hash + let hash = lexp_hash end) -let hc_table : WHC.t = WHC.create 1000 -let hc : lexp -> lexp = WHC.merge hc_table +(* TODO: maybe just a table ? *) +let hc_table : WHC.t = WHC.create 1000 +let hc (e : lexp') : lexp = let h = lexp'_hash e in WHC.merge hc_table (e, h) let mkImm s = hc (Imm s) let mkSortLevel l = hc (SortLevel l) @@ -201,8 +257,8 @@ let mkMetavar (n, s, v) = hc (Metavar (n, s, v)) let mkCall (f, es) = match f, es with | Call (f', es'), _ -> hc (Call (f', es' @ es)) - | _, [] -> f - | _ -> hc (Call (f, es)) + | _, [] -> (f, lexp'_hash f) + | _ -> hc (Call ((f, lexp'_hash f), es)) and lexp_head e = match e with @@ -231,15 +287,15 @@ let mkSLlub' (e1, e2) = match (e1, e2) with -> Log.log_fatal ~section:"internal" "lub of two SLsucc" | ((SortLevel _ | Var _ | Metavar _ | Susp _), (SortLevel _ | Var _ | Metavar _ | Susp _)) - -> SLlub (e1, e2) + -> SLlub ((e1, lexp'_hash e1), (e2, lexp'_hash e2)) | _ -> Log.log_fatal ~section:"internal" ("SLlub of non-level: " ^ lexp_head e1 ^ " ∪ " ^ lexp_head e2) let mkSLsucc e = match e with | SortLevel _ | Var _ | Metavar _ | Susp _ - -> SLsucc e + -> SLsucc (e, lexp'_hash e) | _ -> Log.log_fatal ~section:"internal" "SLsucc of non-level " - + (********* Helper functions to use the Subst operations *********) (* This basically "ties the knot" between Subst and Lexp. * Maybe it would be cleaner to just move subst.ml into lexp.ml @@ -271,12 +327,16 @@ let hcs_table : ((lexp * subst), lexp) Hashtbl.t = Hashtbl.create 1000 * ... *) +(* let mkSusp e s = let susp = mkSusp_aux e s in (susp, lexp'_hash susp) *) + +(* argh *) let rec mkSusp e s = + let (e', h) = e in if S.identity_p s then e else (* We apply the substitution eagerly to some terms. * There's no deep technical rason for that: * it just seemed like a good idea to do it eagerly when it's easy. *) - match e with + match e' with | Imm _ -> e | Builtin _ -> e | Susp (e, s') -> mkSusp_memo e (scompose s' s) @@ -1012,4 +1072,3 @@ and subst_eq s1 s2 = eq e1 (mkSusp e2 (S.shift o)) && subst_eq s1 (S.mkShift s2 o) | _ -> false - View it on GitLab: https://gitlab.com/monnier/typer/-/commit/a289d4c4bfa3b951f0af0467c1b9540e6… -- View it on GitLab: https://gitlab.com/monnier/typer/-/commit/a289d4c4bfa3b951f0af0467c1b9540e6… You're receiving this email because of your account on gitlab.com.

2 1

[Git][monnier/typer] Pushed new branch alice
by Alice de Berny 24 May '20

24 May '20

Alice de Berny pushed new branch alice at Stefan / Typer -- View it on GitLab: https://gitlab.com/monnier/typer/-/tree/alice You're receiving this email because of your account on gitlab.com.

1 0

[Git][monnier/typer][ja-barszcz] [WIP] First draft of an instance search algorithm
by Jean-Alexandre Barszcz 17 May '20

17 May '20

Jean-Alexandre Barszcz pushed to branch ja-barszcz at Stefan / Typer Commits: 440cc0a6 by Jean-Alexandre Barszcz at 2020-05-15T19:14:06-04:00 [WIP] First draft of an instance search algorithm - - - - - 6 changed files: - samples/decidable.typer - src/elab.ml - src/log.ml - src/myers.ml - src/unification.ml - tests/unify_test.ml Changes: ===================================== samples/decidable.typer ===================================== @@ -135,3 +135,10 @@ decideLT = case p | ltZ => absurd (Eq_trans a) (discriminate_nocheck zero (succ ?)) | ltS => absurd (? : (a' < b')) (? : Not (a' < b'))); + +test1 : Bool; +test1 = + let inst = decideEven (a := (succ zero)) in + case (instance () : Decidable (even (succ zero))) + | yes => true + | no => false; % Why wrong index in eval ===================================== src/elab.ml ===================================== @@ -707,7 +707,8 @@ and check_inferred ctx e inferred_t t = -> lexp_error (lexp_location e) e ("Type mismatch(" ^ (match ck with | Unif.CKimpossible -> "impossible" - | Unif.CKresidual -> "residue") + | Unif.CKresidual -> "residue" + | _ -> failwith "impossible" ) ^ ")! Context expected:\n " ^ lexp_string t ^ "\nbut expression has type:\n " ^ lexp_string inferred_t ^ "\ncan't unify:\n " @@ -1646,7 +1647,8 @@ let rec sform_lambda kind ctx loc sargs ot = -> lexp_error (lexp_location lt1') lt1' ("Type mismatch(" ^ (match ck with | Unif.CKimpossible -> "impossible" - | Unif.CKresidual -> "residue") + | Unif.CKresidual -> "residue" + | _ -> failwith "impossible") ^ ")! Context expected:\n " ^ lexp_string lt1 ^ "\nbut parameter has type:\n " ^ lexp_string lt1' ^ "\ncan't unify:\n " @@ -1820,6 +1822,61 @@ let sform_load usr_elctx loc sargs ot = (tuple',Lazy) +let myers_filter_index (f : int -> 'a -> bool) (m : 'a M.myers) + : ((int * 'a) M.myers) + = snd (M.fold_right + (fun x (i, l') -> + if (f i x) then (i - 1, M.cons (i, x) l') + else (i - 1, l')) + m (M.length m - 1, M.nil)) + +(** + Draft of a special form "instance" that gets refers to a variable + of the requested type in the context. Ultimately, this search + should be automatically triggered at the call sites for a new kind + of argument (instance arguments) similarly to implicit arguments. + **) +let sform_instance ctx loc sargs ot = + let search (t : ltype) : lexp * sform_type = + Log.log_debug ~loc ("Searching for t = `" ^ (lexp_string t) ^ "`"); + let lctx = (ectx_to_lctx ctx) in + let env_elem_match (i : int) (e : DB.env_elem) : bool = + let (_, _, t') = e in + let t' = mkSusp t' (S.shift (i + 1)) in + (* TODO decompose the arrows to match on the result type and + then recursively search for the parameters' types *) + let constraints = Unif.unify ~checking:true t' t lctx in + List.for_all (function | (Unif.CKimpossible,_,_,_) -> false + | (Unif.CKresidual,_,_,_) -> + false (* Should be true maybe ? *) + | _ -> true) + constraints in + let candidates = + myers_filter_index env_elem_match lctx in + Log.log_debug ("Candidates for instance of type `" ^ lexp_string t ^ "`:") + ~print_action:(fun () -> + M.iter (fun (i, ((_, so),_,t')) -> + lalign_print_int i 4; + lalign_print_string (match so with | Some s -> s | None -> "<none>") 10; + print_endline (lexp_string t')) candidates); + match M.safe_car candidates with + | None -> + (error ~loc + ("No instance found in context for type `" ^ lexp_string t ^ "`"); + sform_dummy_ret ctx loc) + | Some (i, (vname, _, t')) -> + let t' = mkSusp t' (S.shift (i + 1)) in + Log.log_debug ~loc + ("Found candidate at index " ^ (string_of_int i) ^ ": `" ^ + (lexp_string (Var (vname, i))) ^ " : " ^ (lexp_string t') ^ "`"); + (Var (vname, i), Inferred t') (* FIXME : What location should we use here ? *) + in + match sargs, ot with + | ([se; _], _) -> search (infer_type se ctx (loc, None)) + | ([_], Some t) -> search t (* Dummy param to trigger the special form *) + | _ -> (sexp_error loc "##instance expects a type argument if not checked"; + sform_dummy_ret ctx loc) + (* Register special forms. *) let register_special_forms () = List.iter add_special_form @@ -1849,6 +1906,7 @@ let register_special_forms () = (* FIXME: These should be functions! *) ("decltype", sform_decltype); ("declexpr", sform_declexpr); + ("instance", sform_instance); ] (* Default context with builtin types ===================================== src/log.ml ===================================== @@ -133,11 +133,13 @@ let print_entry entry = let log_entry (entry : log_entry) = if (entry.level <= typer_log_config.level) then ( - log_push entry; - if (typer_log_config.print_at_log) + if (typer_log_config.print_at_log || + entry.level >= Debug) then (print_entry entry; flush stdout) + else + log_push entry ) let count_msgs (lvlp : log_level -> bool) = ===================================== src/myers.ml ===================================== @@ -54,11 +54,21 @@ let car l = | Mnil -> raise Not_found | Mcons (x, _, _, _) -> x +let safe_car l = + match l with + | Mnil -> None + | Mcons (x, _, _, _) -> Some x + let cdr l = match l with | Mnil -> Mnil | Mcons (_, l, _, _) -> l +let safe_cdr l = + match l with + | Mnil -> None + | Mcons (_, l, _, _) -> Some l + let case l n c = match l with | Mnil -> n () @@ -136,3 +146,6 @@ let rec fold_right f l i = match l with let map f l = fold_right (fun x l' -> cons (f x) l') l nil let iteri f l = fold_left (fun i x -> f i x; i + 1) 0 l + +let iter (f : 'a -> unit) (l : 'a myers) : unit + = fold_left (fun _ x -> f x; ()) () l ===================================== src/unification.ml ===================================== @@ -46,6 +46,7 @@ let create_metavar (ctx : DB.lexp_context) (sl : scope_level) (t : ltype) type constraint_kind = | CKimpossible (* Unification is simply impossible. *) | CKresidual (* We failed to find a unifier. *) + | CKassoc (* Couldn't associate because of checking mode *) (* FIXME: Each constraint should additionally come with a description of how it relates to its "top-level" or some other info which might let us fix the problem (e.g. by introducing coercions). *) @@ -174,13 +175,15 @@ let rec s_offset s = match s with The metavar unifier is the end rule, it can't call unify with its parameter (changing their order) *) -let rec unify (e1: lexp) (e2: lexp) +let rec unify ?(checking=false) + (e1: lexp) (e2: lexp) (ctx : DB.lexp_context) : return_type = - unify' e1 e2 ctx OL.set_empty + unify' e1 e2 ctx OL.set_empty checking and unify' (e1: lexp) (e2: lexp) (ctx : DB.lexp_context) (vs : OL.set_plexp) + (c : bool) (* checking mode ? *) : return_type = if e1 == e2 then [] else let e1' = OL.lexp_whnf e1 ctx in @@ -192,24 +195,24 @@ and unify' (e1: lexp) (e2: lexp) match (e1', e2') with | ((Imm _, Imm _) | (Cons _, Cons _) | (Builtin _, Builtin _)) -> if OL.conv_p ctx e1' e2' then [] else [(CKimpossible, ctx, e1, e2)] - | (l, (Metavar (idx, s, _) as r)) -> unify_metavar ctx idx s r l - | ((Metavar (idx, s, _) as l), r) -> unify_metavar ctx idx s l r - | (l, (Call _ as r)) -> unify_call r l ctx vs' - | ((Call _ as l), r) -> unify_call l r ctx vs' - | (l, (Var _ as r)) -> unify_var r l ctx vs' - | ((Var _ as l), r) -> unify_var l r ctx vs' - | (l, (Arrow _ as r)) -> unify_arrow r l ctx vs' - | ((Arrow _ as l), r) -> unify_arrow l r ctx vs' - | (l, (Lambda _ as r)) -> unify_lambda r l ctx vs' - | ((Lambda _ as l), r) -> unify_lambda l r ctx vs' + | (l, (Metavar (idx, s, _) as r)) -> unify_metavar c ctx idx s r l + | ((Metavar (idx, s, _) as l), r) -> unify_metavar c ctx idx s l r + | (l, (Call _ as r)) -> unify_call c r l ctx vs' + | ((Call _ as l), r) -> unify_call c l r ctx vs' + | (l, (Var _ as r)) -> unify_var r l ctx vs' + | ((Var _ as l), r) -> unify_var l r ctx vs' + | (l, (Arrow _ as r)) -> unify_arrow c r l ctx vs' + | ((Arrow _ as l), r) -> unify_arrow c l r ctx vs' + | (l, (Lambda _ as r)) -> unify_lambda c r l ctx vs' + | ((Lambda _ as l), r) -> unify_lambda c l r ctx vs' (* | (l, (Case _ as r)) -> unify_case r l subst *) (* | ((Case _ as l), r) -> unify_case l r subst *) (* | (l, (Inductive _ as r)) -> unify_induct r l subst *) (* | ((Inductive _ as l), r) -> unify_induct l r subst *) - | (l, (Sort _ as r)) -> unify_sort r l ctx vs' - | ((Sort _ as l), r) -> unify_sort l r ctx vs' - | (l, (SortLevel _ as r)) -> unify_sortlvl r l ctx vs' - | ((SortLevel _ as l), r) -> unify_sortlvl l r ctx vs' + | (l, (Sort _ as r)) -> unify_sort c r l ctx vs' + | ((Sort _ as l), r) -> unify_sort c l r ctx vs' + | (l, (SortLevel _ as r)) -> unify_sortlvl c r l ctx vs' + | ((SortLevel _ as l), r) -> unify_sortlvl c l r ctx vs' | (Inductive (_loc1, label1, args1, consts1), Inductive (_loc2, label2, args2, consts2)) -> (* print_string ("Unifying inductives " @@ -217,7 +220,7 @@ and unify' (e1: lexp) (e2: lexp) * ^ " and " * ^ snd label2 * ^ "\n"); *) - unify_inductive ctx vs' args1 args2 consts1 consts2 e1 e2 + unify_inductive c ctx vs' args1 args2 consts1 consts2 e1 e2 | _ -> (if OL.conv_p ctx e1' e2' then [] else ((* print_string "Unification failure on default\n"; *) [(CKresidual, ctx, e1, e2)])) @@ -230,16 +233,16 @@ and unify' (e1: lexp) (e2: lexp) else None - (_, _) -> None *) -and unify_arrow (arrow: lexp) (lxp: lexp) ctx vs +and unify_arrow (checking : bool) (arrow: lexp) (lxp: lexp) ctx vs : return_type = match (arrow, lxp) with | (Arrow (var_kind1, v1, ltype1, _, lexp1), Arrow (var_kind2, _, ltype2, _, lexp2)) -> if var_kind1 = var_kind2 - then (unify' ltype1 ltype2 ctx vs) + then (unify' ltype1 ltype2 ctx vs checking) @(unify' lexp1 (srename v1 lexp2) (DB.lexp_ctx_cons ctx v1 Variable ltype1) - (OL.set_shift vs)) + (OL.set_shift vs) checking) else [(CKimpossible, ctx, arrow, lxp)] | (_, _) -> [(CKimpossible, ctx, arrow, lxp)] @@ -248,15 +251,15 @@ and unify_arrow (arrow: lexp) (lxp: lexp) ctx vs then UNIFY ltype & lxp else ERROR - Lambda , _ -> Impossible *) -and unify_lambda (lambda: lexp) (lxp: lexp) ctx vs : return_type = +and unify_lambda (checking : bool) (lambda: lexp) (lxp: lexp) ctx vs : return_type = match (lambda, lxp) with | (Lambda (var_kind1, v1, ltype1, lexp1), Lambda (var_kind2, _, ltype2, lexp2)) -> if var_kind1 = var_kind2 - then (unify' ltype1 ltype2 ctx vs) + then (unify' ltype1 ltype2 ctx vs checking) @(unify' lexp1 lexp2 (DB.lexp_ctx_cons ctx v1 Variable ltype1) - (OL.set_shift vs)) + (OL.set_shift vs) checking) else [(CKimpossible, ctx, lambda, lxp)] | (_, _) -> [(CKimpossible, ctx, lambda, lxp)] @@ -265,7 +268,7 @@ and unify_lambda (lambda: lexp) (lxp: lexp) ctx vs : return_type = - metavar , metavar -> inverse subst (both sides) - metavar , lexp -> inverse subst *) -and unify_metavar ctx idx s1 (lxp1: lexp) (lxp2: lexp) +and unify_metavar (checking : bool) ctx idx s1 (lxp1: lexp) (lxp2: lexp) : return_type = let unif idx s lxp = let t = match metavar_lookup idx with @@ -281,7 +284,8 @@ and unify_metavar ctx idx s1 (lxp1: lexp) (lxp2: lexp) [(CKresidual, ctx, lxp1, lxp2)] | lxp' when occurs_in idx lxp' -> [(CKimpossible, ctx, lxp1, lxp2)] | lxp' - -> metavar_table := associate idx lxp' (!metavar_table); + -> if checking then [(CKassoc, ctx, lxp1, lxp2)] else ( + metavar_table := associate idx lxp' (!metavar_table); match unify t (OL.get_type ctx lxp) ctx with | [] as r -> r (* FIXME: Let's ignore the error for now. *) @@ -291,10 +295,10 @@ and unify_metavar ctx idx s1 (lxp1: lexp) (lxp2: lexp) ^ lexp_string t ^ " != " ^ lexp_string (OL.get_type ctx lxp) ^ "\n" ^ "for " ^ lexp_string lxp ^ "\n"); - [(CKresidual, ctx, lxp1, lxp2)] in + [(CKresidual, ctx, lxp1, lxp2)]) in match lxp2 with | Metavar (idx2, s2, name) - -> if idx = idx2 then + -> if idx = idx2 && not checking then match common_subset ctx s1 s2 with | S.Identity 0 -> [] (* Optimization! *) (* ¡ s1 != s2 ! @@ -370,14 +374,14 @@ and unify_var (var: lexp) (lxp: lexp) ctx vs - Call , Call -> UNIFY - Call , lexp -> CONSTRAINT *) -and unify_call (call: lexp) (lxp: lexp) ctx vs +and unify_call (checking : bool) (call: lexp) (lxp: lexp) ctx vs : return_type = match (call, lxp) with | (Call (lxp_left, lxp_list1), Call (lxp_right, lxp_list2)) when OL.conv_p ctx lxp_left lxp_right -> List.fold_left (fun op ((ak1, e1), (ak2, e2)) -> if ak1 == ak2 then - (unify' e1 e2 ctx vs)@op + (unify' e1 e2 ctx vs checking)@op else [(CKimpossible, ctx, call, lxp)]) [] (List.combine lxp_list1 lxp_list2) @@ -440,15 +444,15 @@ and unify_call (call: lexp) (lxp: lexp) ctx vs - SortLevel, SortLevel -> if SortLevel ~= SortLevel then OK else ERROR - SortLevel, _ -> ERROR *) -and unify_sortlvl (sortlvl: lexp) (lxp: lexp) ctx vs : return_type = +and unify_sortlvl (checking : bool) (sortlvl: lexp) (lxp: lexp) ctx vs : return_type = match sortlvl, lxp with | (SortLevel s, SortLevel s2) -> (match s, s2 with | SLz, SLz -> [] - | SLsucc l1, SLsucc l2 -> unify' l1 l2 ctx vs + | SLsucc l1, SLsucc l2 -> unify' l1 l2 ctx vs checking | SLlub (l11, l12), SLlub (l21, l22) -> (* FIXME: This SLlub representation needs to be * more "canonicalized" otherwise it's too restrictive! *) - (unify' l11 l21 ctx vs)@(unify' l12 l22 ctx vs) + (unify' l11 l21 ctx vs checking)@(unify' l12 l22 ctx vs checking) | _, _ -> [(CKimpossible, ctx, sortlvl, lxp)]) | _, _ -> [(CKresidual, ctx, sortlvl, lxp)] @@ -456,10 +460,10 @@ and unify_sortlvl (sortlvl: lexp) (lxp: lexp) ctx vs : return_type = - Sort, Sort -> if Sort ~= Sort then OK else ERROR - Sort, lexp -> ERROR *) -and unify_sort (sort_: lexp) (lxp: lexp) ctx vs : return_type = +and unify_sort (checking : bool) (sort_: lexp) (lxp: lexp) ctx vs : return_type = match sort_, lxp with | (Sort (_, srt), Sort (_, srt2)) -> (match srt, srt2 with - | Stype lxp1, Stype lxp2 -> unify' lxp1 lxp2 ctx vs + | Stype lxp1, Stype lxp2 -> unify' lxp1 lxp2 ctx vs checking | StypeOmega, StypeOmega -> [] | StypeLevel, StypeLevel -> [] | _, _ -> [(CKimpossible, ctx, sort_, lxp)]) @@ -513,7 +517,7 @@ and is_same arglist arglist2 = * | None -> test e subst) * ) None lst *) -and unify_inductive ctx vs args1 args2 consts1 consts2 e1 e2 = +and unify_inductive (checking : bool) ctx vs args1 args2 consts1 consts2 e1 e2 = let unif_formals ctx vs args1 args2 = if not (List.length args1 == List.length args2) then (ctx, vs, [(CKimpossible, ctx, e1, e2)]) @@ -522,7 +526,7 @@ and unify_inductive ctx vs args1 args2 consts1 consts2 e1 e2 = -> (DB.lexp_ctx_cons ctx v1 Variable t1, OL.set_shift vs, if not (ak1 == ak2) then [(CKimpossible, ctx, e1, e2)] - else (unify' t1 t2 ctx vs) @ residue)) + else (unify' t1 t2 ctx vs checking) @ residue)) (ctx, vs, []) (List.combine args1 args2) in let (ctx, vs, residue) = unif_formals ctx vs args1 args2 in ===================================== tests/unify_test.ml ===================================== @@ -199,6 +199,7 @@ let test_input (lxp1: lexp) (lxp2: lexp): unif_res = else (Unification, res, lxp1, lxp2) | (CKresidual, _, _, _)::_ -> (Constraint, res, lxp1, lxp2) | (CKimpossible, _, _, _)::_ -> (Nothing, res, lxp1, lxp2) + | _ -> failwith "impossible" let check (lxp1: lexp) (lxp2: lexp) (res: result): bool = let r, _, _, _ = test_input lxp1 lxp2 View it on GitLab: https://gitlab.com/monnier/typer/-/commit/440cc0a6a65fe16f62f600e4867bdcb7c… -- View it on GitLab: https://gitlab.com/monnier/typer/-/commit/440cc0a6a65fe16f62f600e4867bdcb7c… You're receiving this email because of your account on gitlab.com.

2 1

[Git][monnier/typer][master] 5 commits: Add a nix shell
by Jean-Alexandre Barszcz 15 May '20

15 May '20

Jean-Alexandre Barszcz pushed to branch master at Stefan / Typer Commits: bf3c818e by Jean-Alexandre Barszcz at 2020-04-12T02:05:40-04:00 Add a nix shell * shell.nix : When using nixpkgs/nixos, run `nix-shell` to get a shell with Typer's dependencies available. - - - - - c39ff3d5 by Jean-Alexandre Barszcz at 2020-04-12T02:05:40-04:00 Improve the implementation of Sexp.dispatch * src/elab.ml (sexp_dispatch) : Sexp.dispatch assumed that its arguments were closures. Instead, we use eval_call and also accept constructors, builtins, etc. - - - - - 7b623a26 by Jean-Alexandre Barszcz at 2020-04-12T02:05:40-04:00 Add the inductive type `Sexp_wrapper` to match on sexps * btl/pervasive.typer : Add the inductive type `Sexp_wrapper` to wrap the Sexp values in typer code, and the function `Sexp_wrap` to do the wrapping. This makes possible the use of pattern matching to destructure Sexps instead of the more verbose calls to `Sexp_dispatch`. - - - - - 8419c419 by Jean-Alexandre Barszcz at 2020-04-12T02:05:40-04:00 Fix lexp_whnf when the case scrutinee is a call * src/opslexp.ml (lexp_whnf) : Make sure that we take the WHNF of the function when the scrutinee of a case expression is a call, before checking that the function is a constructor. Otherwise, expressions like `case (let ... in (constructor ...))` fail to reduce, for example. - - - - - cc20d841 by Jean-Alexandre Barszcz at 2020-04-12T02:05:40-04:00 Fix some lexp constructor calls where hash-consing has been forgotten - - - - - 6 changed files: - btl/pervasive.typer - + shell.nix - src/eval.ml - src/inverse_subst.ml - src/lexp.ml - src/opslexp.ml Changes: ===================================== btl/pervasive.typer ===================================== @@ -358,6 +358,18 @@ type-impl = lambda (x : List Sexp) -> type_ = macro type-impl; +%%%% An inductive type to wrap Sexp + +type Sexp_wrapper + | node Sexp (List Sexp) + | symbol String + | string String + | integer Integer + | float Float + | block Sexp; + +Sexp_wrap s = Sexp_dispatch s node symbol string integer float block; + %%%% Tuples %% Sample tuple: a module holding Bool and its constructors. ===================================== shell.nix ===================================== @@ -0,0 +1,10 @@ +{ pkgs ? import <nixpkgs> {} }: +pkgs.mkShell { + name = "typer"; + buildInputs = + with pkgs.ocamlPackages; [ + pkgs.gnumake ocaml ocamlbuild findlib utop # tooling + zarith # ocaml libraries + merlin # for emacs + ]; +} ===================================== src/eval.ml ===================================== @@ -552,20 +552,11 @@ and eval_decls (decls: (vname * elexp) list) (String -> Sexp) -> (Int -> Sexp) -> (Float -> Sexp) -> (List Sexp -> Sexp) -> Sexp *) and sexp_dispatch loc depth args = - let eval a b = eval a b depth in - let sxp, nd, ctx_nd, - sym, ctx_sym, - str, ctx_str, - it, ctx_it, - flt, ctx_flt, - blk, ctx_blk = match args with - (* FIXME: Don't match against `Closure` to later use `eval`, instead - * pass the value to "funcall". *) - | [sxp; Closure(_, nd, ctx_nd); Closure(_, sym, ctx_sym); - Closure(_, str, ctx_str); Closure(_, it, ctx_it); - Closure(_, flt, ctx_flt); Closure(_, blk, ctx_blk)] -> - sxp, nd, ctx_nd, sym, ctx_sym, str, ctx_str, it, ctx_it, - flt, ctx_flt, blk, ctx_blk + let trace_dum = (Var ((loc, None), -1)) in + let eval_call a b = eval_call loc trace_dum depth a b in + let sxp, nd, sym, str, it, flt, blk = match args with + | [sxp; nd; sym; str; it; flt; blk] -> + sxp, nd, sym, str, it, flt, blk | _ -> error loc "sexp_dispatch expects 7 arguments" in let sxp = match sxp with @@ -573,34 +564,17 @@ and sexp_dispatch loc depth args = | _ -> value_fatal loc sxp "sexp_dispatch expects a Sexp as 1st arg" in match sxp with - | Node (op, s) ->( - let rctx = ctx_nd in - let rctx = add_rte_variable vdummy (Vsexp(op)) rctx in - let rctx = add_rte_variable vdummy (o2v_list s) rctx in - match eval nd rctx with - | Closure(_, nd, _) -> eval nd rctx - | _ -> error loc "Node has 2 arguments") - - | Symbol (_ , s) -> - let rctx = ctx_sym in - eval sym (add_rte_variable vdummy (Vstring s) rctx) - | String (_ , s) -> - let rctx = ctx_str in - eval str (add_rte_variable vdummy (Vstring s) rctx) - | Integer (_ , i) -> - let rctx = ctx_it in - eval it (add_rte_variable vdummy (Vinteger (BI.of_int i)) - rctx) - | Float (_ , f) -> - let rctx = ctx_flt in - eval flt (add_rte_variable vdummy (Vfloat f) rctx) + | Node (op, s) -> eval_call nd [Vsexp op; o2v_list s] + | Symbol (_ , s) -> eval_call sym [Vstring s] + | String (_ , s) -> eval_call str [Vstring s] + | Integer (_ , i) -> eval_call it [Vint i] + | Float (_ , f) -> eval_call flt [Vfloat f] | Block (_ , _, _) as b -> (* I think this code breaks what Blocks are. *) (* We delay parsing but parse with default_stt and default_grammar... *) (*let toks = Lexer.lex default_stt s in let s = sexp_parse_all_to_list default_grammar toks (Some ";") in*) - let rctx = ctx_blk in - eval blk (add_rte_variable vdummy (Vsexp b) rctx) + eval_call blk [Vsexp b] (* -------------------------------------------------------------------------- *) and print_eval_result i lxp = ===================================== src/inverse_subst.ml ===================================== @@ -293,7 +293,7 @@ and apply_inv_subst (e : lexp) (s : subst) : lexp = match e with L.rev ncase) cases in mkInductive (l, label, nargs, ncases) - | Cons (it, name) -> Cons (apply_inv_subst it s, name) + | Cons (it, name) -> mkCons (apply_inv_subst it s, name) | Case (l, e, ret, cases, default) -> mkCase (l, apply_inv_subst e s, apply_inv_subst ret s, SMap.map (fun (l, cargs, e) ===================================== src/lexp.ml ===================================== @@ -402,7 +402,7 @@ let rec push_susp e s = (* Push a suspension one level down. *) L.rev ncase) cases in mkInductive (l, label, nargs, ncases) - | Cons (it, name) -> Cons (mkSusp it s, name) + | Cons (it, name) -> mkCons (mkSusp it s, name) | Case (l, e, ret, cases, default) -> mkCase (l, mkSusp e s, mkSusp ret s, SMap.map (fun (l, cargs, e) ===================================== src/opslexp.ml ===================================== @@ -177,7 +177,10 @@ let lexp_whnf e (ctx : DB.lexp_context) : lexp = mkCase (l, e, rt, branches, default) in (match e' with | Cons (_, (_, name)) -> reduce name [] - | Call (Cons (_, (_, name)), aargs) -> reduce name aargs + | Call (f, aargs) -> + (match lexp_whnf f ctx with + | Cons (_, (_, name)) -> reduce name aargs + | _ -> mkCase (l, e, rt, branches, default)) | _ -> mkCase (l, e, rt, branches, default)) | Metavar (idx, s, _) -> (match metavar_lookup idx with View it on GitLab: https://gitlab.com/monnier/typer/-/compare/886a3589162b84e04cf6368423925505… -- View it on GitLab: https://gitlab.com/monnier/typer/-/compare/886a3589162b84e04cf6368423925505… You're receiving this email because of your account on gitlab.com.

1 0

[Git][monnier/typer][report/itd] 27 commits: Switch to ACM style for ICFP
by Stefan 09 May '20

09 May '20

Stefan pushed to branch report/itd at Stefan / Typer Commits: bf01fe80 by Stefan Monnier at 2019-02-27T22:35:16-05:00 Switch to ACM style for ICFP - - - - - a07ed911 by Stefan Monnier at 2019-03-25T17:54:36-04:00 - - - - - - 7a06cc13 by Stefan Monnier at 2019-03-27T19:59:59-04:00 Merge branch 'report/itd' of git+ssh://iro/~/var/git/typer into report/itd - - - - - 44dbb9fd by Stefan Monnier at 2019-03-27T23:51:10-04:00 - - - - - - c17ca441 by Stefan Monnier at 2019-03-28T17:56:29-04:00 - - - - - - eda0b211 by Stefan Monnier at 2019-05-07T22:40:31-04:00 - - - - - - cfb4a843 by Stefan Monnier at 2019-05-14T11:34:21-04:00 - - - - - - bb76755a by Stefan Monnier at 2019-05-14T18:05:11-04:00 - - - - - - c56cef92 by Stefan Monnier at 2019-05-15T16:55:42-04:00 - - - - - - df782827 by Stefan Monnier at 2019-05-17T16:22:17-04:00 - - - - - - 47898ed6 by Stefan Monnier at 2019-05-17T23:26:10-04:00 - - - - - - db0f594d by Stefan Monnier at 2019-05-18T09:30:00-04:00 - - - - - - b9bc5b90 by Stefan Monnier at 2019-05-19T10:15:28-04:00 - - - - - - df512359 by Stefan Monnier at 2019-05-19T13:49:57-04:00 - - - - - - 9e312c56 by Stefan Monnier at 2019-05-19T18:51:23-04:00 - - - - - - 36094205 by Stefan Monnier at 2019-05-20T03:35:43-04:00 TyDe submission - - - - - 2e8cab6c by Stefan Monnier at 2019-07-01T05:09:27-04:00 Final TyDe 2019 submission - - - - - f371f1cb by Stefan Monnier at 2019-07-10T17:12:36-04:00 - - - - - - 50eee2af by Stefan Monnier at 2019-07-10T18:11:35-04:00 Final final version for TyDe - - - - - 6568bbbc by Stefan Monnier at 2019-07-27T09:26:40-04:00 - - - - - - f468006e by Stefan Monnier at 2019-07-30T20:11:58-04:00 - - - - - - c7d59731 by Stefan Monnier at 2019-07-31T16:21:26-04:00 - - - - - - 38bbaf4a by Stefan Monnier at 2019-07-31T18:05:16-04:00 - - - - - - 010a4422 by Stefan Monnier at 2019-07-31T18:06:52-04:00 - - - - - - cee2ec13 by Stefan Monnier at 2019-08-17T04:23:56-04:00 - - - - - - 9016ae36 by Stefan Monnier at 2019-08-17T06:54:21-04:00 - - - - - - e7585482 by Stefan Monnier at 2019-08-17T19:25:28-04:00 - - - - - - 5 changed files: - + REVIEWS - + acmart.cls - paper.tex - refs.bib - + slides.tex Changes: ===================================== REVIEWS ===================================== @@ -0,0 +1,266 @@ +-*- outline -*- + +* Review #6A + +Overall merit +------------- +3. Weak accept + +Reviewer expertise +------------------ +4. Expert + +Paper summary +------------- +This paper introduces the Calculus of United Constructions (CUC), a dependently +typed calculus similar to the Calculus of Inductive Constructions (CIC), but +with special attention to implementation efficiency. +The paper first reviews several implementation inefficiencies with inductives +types a la CIC. +It then present CUC, feature by feature, motivating each feature with the +implementation inefficiency it solves. +The key idea in CUC is to encode inductive types via sums, products, and +recursive types, and pay special attention to eliminating sums and products +efficiently. +Finally, the paper concludes by giving a syntactic model of CUC in CIC, and a +partial model of CIC in CUC. + +Comments for author +------------------- +## High-level +I liked the paper a lot. +The usual presentation of inductive types is exceedingly and unnecessarily +complex, and does not lend itself to optimization. +Very little work has been presented studying simpler presentations. +This paper does a nice job of analyzing a simpler presentation and, informally, +its performance characterization. + +However, the discussion of performance is pretty informal, all at the level of +intuition and comparison to C-like statements. +It's not immediately clear to me that the Coq -> OCaml -> x86 compiler doesn't +do something incredibly clever to optimize many of these cases some of the time. +In fact, the paper points out that there are known ways to do solve some of +these inefficiencies. +This raises the question "if compilers are smart enough, why bother with all +this?". +I'd like to see some *evidence* (e.g., benchmark comparison CUC vs CIC?) that +this calculus will pay off, but there's no hint of that in the paper. + +My intuition, of course, is that the compiler isn't always smart enough, so this +is worthwhile, and I still feel pretty positive about the paper. + +The writing could use some work. +The transitions are a little sudden at times. +This makes it a little difficult to figure out the precise motivation and whether I'm completely following the author's train of thought. +E.g.: +- there is no abstract +- the intro starts with Typer (a somewhat unfamiliar language; usually one moves + from old, familiar information to new, unfamiliar) +- the intro jumps from the design ideas of Typer to CoC, without any transition. + +And there are a few imprecise or unnecessary words in various places. +This makes it difficult to figure out what claims precisely are, and evaluate them. +E.g.: +- in the intro: "... single-constructor datatypes is not *really* problematic + in terms ...", could omit "really" +- still in intro: "... it becomes *annoying* when extracting data out of those tuples ...", + what does annoying mean here? +- bottom of page 2: "*Arguably* one could change Coq such that default + branches get additional ...". One could or could not change Coq; it's only + "arguably" a good idea. + +## $\Pi\Sigma$ +CUC is quite similar to the language ΠΣ by Altenkirch et al. +While I agree with the one comment the paper makes about their work, I would +appreciate a detailed comparison, and you have space for it. +E.g., your `switch` statement looks pretty similar to their `case`, even in +terms of performance (intuitively). + +## Projection `e.i` +It was unclear to me until late in the paper that the projection syntax `e.i` +was mere syntactic sugar, and not an expression missing from your presentation +of CUC. +I would use a different symbol than $\equiv$ to indicate that this definition is +syntactic sugar. + +But actually, it seems to me that you can remove this syntax very easily, by +writing the typing rule for tuple elimination as follows: + +> ... +> +> ————-———-———-———-———-———-——- +> +> $\Gamma \vdash_U +> let\,\,\vec{x}\mathrel{=}e_1\mathrel{in}e\mathrel{:}let\,\,\vec{x}\mathrel{=}e_1\mathrel{in}\tau$ + +It's not immediately obvious that this is well-founded, but it is since the type +of $\tau$ cannot be dependent. + +## CUC to CIC +Regarding the translation from CUC to CIC (Section 5.3), the first sentence +needs to be rephrased. +It reads "... translating *any* type derivation of CIC to an equivalent expression in CUC ...". +You later point out that, actually, this doesn't always work due issues with the +universe hierarchy, so it is not true that *any* type derivation can be translated. + +(Also, "translating *type derivations* into *expressions*"?) + +However, isn't this problem solved by adding cumulativity to CUC? + + + +* Review #6B +=========================================================================== + +Overall merit +------------- +4. Accept + +Reviewer expertise +------------------ +4. Expert + +Paper summary +------------- +This paper presents the calculus of united constructions (CUC), a variant of +the calculus of inductive constructions (CiC) where the notion of inductive +family has been split up into labeled records, non-disjoint unions, equality +types, and inductive fixpoints. The main objective of this calculus is to +provide a type theory that can easily be compiled to efficient code, and can +serve as a core language for a reflection-based surface language. The paper +further provides two translations: a translation by erasing type annotations +to obtain efficient code, and a translation from CiC showing conservativity +and (relative) consistency. + +Comments for author +------------------- +I really enjoyed reading this paper since it provides careful and detailed +motivation for all of its design decisions, and in particular pays attention +to the often-neglected subject of efficiency and compilation of type +theoretic languages. The primitive 'switch' operator is especially +interesting since it allows the implementation of catchall cases without +losing any information from the branches that were not taken, which is +a common complaint among users of other languages. + +However, the second half of the paper feels very cramped and would probably +benefit by removing some parts to expand others. For example, the +translation from CIC to CUC feel like it didn't add much, so it could be +removed to make more space for the (more important) translation in the +opposite direction. + +I also felt that many claims about the supposed impact of design decisions +on the efficiency are rather vague and are not backed by any evidence (see +for example the remark about garbage collection at the end of section 2.1), +so the effective impact of these decisions remains at the level of an +educated guess. + +Nevertheless, I found there were a lot of new insights in this paper that +the TyDe audience in particular would find very interesting, so I gladly +recommend it for acceptance. + +Questions for the authors: +- Some of the type annotations in the syntax (e.g. the Δ in the tuple +constructor and the τ and p in the fold constructor) look like they are +redundant information. Even though they are erased at runtime, they could +still cause at typechecking time, so wouldn't it be better to remove them +from the syntax completely? +- The paper makes no mention of eta-equality for function or record +types. Since this is quite an important property in practice, I was +wondering whether this would be easy to add. +- A potential pitfall to the language design where datatypes are encoded in +terms of smaller components is that it makes it very hard to print good +error messages to the user of the system. Do you know of a solution to this +problem in the case of CUC? +- How does CUC compare to the core language of the Lean proof assistant? +This would be interesting since like CUC, Lean focuses on efficiency +and reflection. +- A technical question: the typing rule for 'let fold' (the third rule in +Figure 7) brings the parameters of the inductive type into scope for the +body e2, but the corresponding computation rule throws away the parameters +(i.e. it doesn't substitute anything for the variables 'z'). How do you +ensure that these parameters are not used? + +Minor remarks and typos: +- The standard reference for Agda is Ulf Norell's thesis (Towards +a practical programming language based on dependent types) +- The title of section 2 is not very accurate, something like "Problem +description" would be clearer. +- The last paragraph of section 2.2 seems to be out of its intended context, +I would suggest rewording it. +- In the first sentence of section 3.2, "inductive types" should be replaced +by "non-recursive types" since the μ type has not been introduced yet at +this point. +- The first typing rule in Figure 7 is confusing since it is formulated for +an arbitrary type τ, whereas it is only used for types of the form (x1 : A1) +... (xn : An) -> Set_l. +- In the first sentence of section 4, "castto" should be "cast to" + + + +* Review #6C +=========================================================================== + +Overall merit +------------- +5. Strong accept + +Reviewer expertise +------------------ +3. Knowledgeable + +Paper summary +------------- +The paper describes the calculus of united constructions (CUC), a new +foundational calculus for dependently-typed programming. CUC partitions +datatype representations into tuples, unions, equality constraints, and +recursive types, rather than supporting these all through a single idea of +inductive type definition. The resulting system, while having more forms +than CIC, also admits more efficient implementation, and refines the typing +of case branches. + +Comments for author +------------------- +This is an excellent paper. I found it well-motivated and easy to read; the +proposed formalisms are intuitive and expressive. I strongly recommend +its acceptance. + +Some detailed comments: + +- The typing rule for `let` in Fig. 2 seems to include some implicit +subtyping, in the |x| < |\Delta| case. Is this intentional, and is it +useful? It's not discussed in the text. + +- First sentence of section 4: "castto" -> "cast to" + + + +* Review #6D +=========================================================================== + +Overall merit +------------- +3. Weak accept + +Reviewer expertise +------------------ +3. Knowledgeable + +Comments for author +------------------- +## Minor points + +- You'll need an abstract. + +- p2: "an value" + +- p2: "the fact the" + +- p11: "be compiling them" + +- p12: "Conor" has one "n" + + + +(This is not a formal review, but only comment by Jeremy Gibbons.) + + ===================================== acmart.cls ===================================== @@ -0,0 +1,2851 @@ +%% +%% This is file `acmart.cls', +%% generated with the docstrip utility. +%% +%% The original source files were: +%% +%% acmart.dtx (with options: `class') +%% +%% IMPORTANT NOTICE: +%% +%% For the copyright see the source file. +%% +%% Any modified versions of this file must be renamed +%% with new filenames distinct from acmart.cls. +%% +%% For distribution of the original source see the terms +%% for copying and modification in the file acmart.dtx. +%% +%% This generated file may be distributed as long as the +%% original source files, as listed above, are part of the +%% same distribution. (The sources need not necessarily be +%% in the same archive or directory.) +%% \CharacterTable +%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z +%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z +%% Digits \0\1\2\3\4\5\6\7\8\9 +%% Exclamation \! Double quote \" Hash (number) \# +%% Dollar \$ Percent \% Ampersand \& +%% Acute accent \' Left paren $ Right paren $ +%% Asterisk \* Plus \+ Comma \, +%% Minus \- Point \. Solidus \/ +%% Colon \: Semicolon \; Less than \< +%% Equals \= Greater than \> Question mark \? +%% Commercial at \@ Left bracket \[ Backslash \\ +%% Right bracket \] Circumflex \^ Underscore \_ +%% Grave accent \` Left brace \{ Vertical bar \| +%% Right brace \} Tilde \~} +\label{sec:ug_topmatter} +\NeedsTeXFormat{LaTeX2e} +\ProvidesClass{acmart} +[2019/05/27 v1.61 Typesetting articles for the Association for +Computing Machinery] +\def\@classname{acmart} +\InputIfFileExists{acmart-preload-hook.tex}{% + \ClassWarning{\@classname}{% + I am loading acmart-preload-hook.tex. You are fully responsible + for any problems from now on.}}{} +\RequirePackage{xkeyval} +\RequirePackage{xstring} +\define@choicekey*+{acmart.cls}{format}[\ACM@format\ACM@format@nr]{% + manuscript, acmsmall, acmlarge, acmtog, sigconf, siggraph, + sigplan, sigchi, sigchi-a}[manuscript]{}{% + \ClassError{\@classname}{The option format must be manuscript, + acmsmall, acmlarge, acmtog, sigconf, siggraph, + sigplan, sigchi or sigchi-a}} +\def\@DeclareACMFormat#1{\DeclareOptionX{#1}{\setkeys{acmart.cls}{format=#1}}} +\@DeclareACMFormat{manuscript} +\@DeclareACMFormat{acmsmall} +\@DeclareACMFormat{acmlarge} +\@DeclareACMFormat{acmtog} +\@DeclareACMFormat{sigconf} +\@DeclareACMFormat{siggraph} +\@DeclareACMFormat{sigplan} +\@DeclareACMFormat{sigchi} +\@DeclareACMFormat{sigchi-a} +\ExecuteOptionsX{format} +\define@boolkey+{acmart.cls}[@ACM@]{screen}[true]{% + \if@ACM@screen + \PackageInfo{\@classname}{Using screen mode}% + \else + \PackageInfo{\@classname}{Not using screen mode}% + \fi}{\PackageError{\@classname}{The option screen can be either true or + false}} +\ExecuteOptionsX{screen=false} +\define@boolkey+{acmart.cls}[@ACM@]{urlbreakonhyphens}[true]{% + \if@ACM@urlbreakonhyphens + \PackageInfo{\@classname}{Using breaking urls on hyphens}% + \else + \PackageInfo{\@classname}{Not breaking urls on hyphens}% + \fi}{\PackageError{\@classname}{The option urlbreakonhyphens can be either true or + false}} +\ExecuteOptionsX{urlbreakonhyphens=true} +\define@boolkey+{acmart.cls}[@ACM@]{acmthm}[true]{% + \if@ACM@acmthm + \PackageInfo{\@classname}{Requiring acmthm}% + \else + \PackageInfo{\@classname}{Suppressing acmthm}% + \fi}{\PackageError{\@classname}{The option acmthm can be either true or + false}} +\ExecuteOptionsX{acmthm=true} +\define@boolkey+{acmart.cls}[@ACM@]{review}[true]{% + \if@ACM@review + \PackageInfo{\@classname}{Using review mode}% + \AtBeginDocument{\@ACM@printfoliostrue}% + \else + \PackageInfo{\@classname}{Not using review mode}% + \fi}{\PackageError{\@classname}{The option review can be either true or + false}} +\ExecuteOptionsX{review=false} +\define@boolkey+{acmart.cls}[@ACM@]{authorversion}[true]{% + \if@ACM@authorversion + \PackageInfo{\@classname}{Using authorversion mode}% + \else + \PackageInfo{\@classname}{Not using authorversion mode}% + \fi}{\PackageError{\@classname}{The option authorversion can be either true or + false}} +\ExecuteOptionsX{authorversion=false} +\define@boolkey+{acmart.cls}[@ACM@]{nonacm}[true]{% + \if@ACM@nonacm + \PackageInfo{\@classname}{Using nonacm mode}% + \AtBeginDocument{\@ACM@printacmreffalse}% + % in 'nonacm' mode we disable the "ACM Reference Format" + % printing by default, but this can be re-enabled by the + % user using \settopmatter{printacmref=true} + \else + \PackageInfo{\@classname}{Not using nonacm mode}% + \fi}{\PackageError{\@classname}{The option nonacm can be either true or + false}} +\ExecuteOptionsX{nonacm=false} +\define@boolkey+{acmart.cls}[@ACM@]{balance}[true]{}{% + \PackageError{\@classname}{The option balance can be either true or + false}} +\ExecuteOptionsX{balance} +\define@boolkey+{acmart.cls}[@ACM@]{natbib}[true]{% + \if@ACM@natbib + \PackageInfo{\@classname}{Explicitly selecting natbib mode}% + \else + \PackageInfo{\@classname}{Explicitly deselecting natbib mode}% + \fi}{\PackageError{\@classname}{The option natbib can be either true or + false}} +\ExecuteOptionsX{natbib=true} +\define@boolkey+{acmart.cls}[@ACM@]{anonymous}[true]{% + \if@ACM@anonymous + \PackageInfo{\@classname}{Using anonymous mode}% + \else + \PackageInfo{\@classname}{Not using anonymous mode}% + \fi}{\PackageError{\@classname}{The option anonymous can be either true or + false}} +\ExecuteOptionsX{anonymous=false} +\define@boolkey+{acmart.cls}[@ACM@]{timestamp}[true]{% + \if@ACM@timestamp + \PackageInfo{\@classname}{Using timestamp mode}% + \else + \PackageInfo{\@classname}{Not using timestamp mode}% + \fi}{\PackageError{\@classname}{The option timestamp can be either true or + false}} +\ExecuteOptionsX{timestamp=false} +\define@boolkey+{acmart.cls}[@ACM@]{authordraft}[true]{% + \if@ACM@authordraft + \PackageInfo{\@classname}{Using authordraft mode}% + \@ACM@timestamptrue + \@ACM@reviewtrue + \else + \PackageInfo{\@classname}{Not using authordraft mode}% + \fi}{\PackageError{\@classname}{The option authordraft can be either true or + false}} +\ExecuteOptionsX{authordraft=false} +\def\ACM@fontsize{} +\DeclareOptionX{9pt}{\edef\ACM@fontsize{\CurrentOption}} +\DeclareOptionX{10pt}{\edef\ACM@fontsize{\CurrentOption}} +\DeclareOptionX{11pt}{\edef\ACM@fontsize{\CurrentOption}} +\DeclareOptionX{12pt}{\edef\ACM@fontsize{\CurrentOption}} +\DeclareOptionX{draft}{\PassOptionsToClass{\CurrentOption}{amsart}} +\DeclareOptionX{*}{\PassOptionsToClass{\CurrentOption}{amsart}} +\ProcessOptionsX +\ClassInfo{\@classname}{Using format \ACM@format, number \ACM@format@nr} +\newif\if@ACM@manuscript +\newif\if@ACM@journal +\newif\if@ACM@journal@bibstrip +\newif\if@ACM@sigchiamode +\ifnum\ACM@format@nr=5\relax % siggraph + \ClassWarning{\@classname}{The format siggraph is now obsolete. + I am switching to sigconf.} + \setkeys{acmart.cls}{format=sigconf} +\fi +\ifnum\ACM@format@nr=0\relax + \@ACM@manuscripttrue +\else + \@ACM@manuscriptfalse +\fi +\@ACM@sigchiamodefalse +\ifcase\ACM@format@nr +\relax % manuscript + \@ACM@journaltrue +\or % acmsmall + \@ACM@journaltrue +\or % acmlarge + \@ACM@journaltrue +\or % acmtog + \@ACM@journaltrue +\or % sigconf + \@ACM@journalfalse +\or % siggraph + \@ACM@journalfalse + \or % sigplan + \@ACM@journalfalse + \or % sigchi + \@ACM@journalfalse +\or % sigchi-a + \@ACM@journalfalse + \@ACM@sigchiamodetrue +\fi +\if@ACM@journal + \@ACM@journal@bibstriptrue +\else + \@ACM@journal@bibstripfalse +\fi +\ifx\ACM@fontsize\@empty + \ifcase\ACM@format@nr + \relax % manuscript + \def\ACM@fontsize{9pt}% + \or % acmsmall + \def\ACM@fontsize{10pt}% + \or % acmlarge + \def\ACM@fontsize{10pt}% + \or % acmtog + \def\ACM@fontsize{9pt}% + \or % sigconf + \def\ACM@fontsize{9pt}% + \or % siggraph + \def\ACM@fontsize{9pt}% + \or % sigplan + \def\ACM@fontsize{10pt}% + \or % sigchi + \def\ACM@fontsize{10pt}% + \or % sigchi-a + \def\ACM@fontsize{10pt}% + \fi +\fi +\ClassInfo{\@classname}{Using fontsize \ACM@fontsize} +\LoadClass[\ACM@fontsize, reqno]{amsart} +\RequirePackage{microtype} +\RequirePackage{etoolbox} +\RequirePackage{booktabs} +\RequirePackage{refcount} +\RequirePackage{totpages} +\RequirePackage{environ} +\if@ACM@manuscript +\RequirePackage{setspace} +\onehalfspacing +\fi +\RequirePackage{textcase} +\if@ACM@natbib + \RequirePackage{natbib} + \renewcommand{\bibsection}{% + \section*{\refname}% + \phantomsection\addcontentsline{toc}{section}{\refname}% + } + \renewcommand{\bibfont}{\bibliofont} + \renewcommand\setcitestyle[1]{ + \@for\@tempa:=#1\do + {\def\@tempb{round}\ifx\@tempa\@tempb + \renewcommand\NAT@open{(}\renewcommand\NAT@close{)}\fi + \def\@tempb{square}\ifx\@tempa\@tempb + \renewcommand\NAT@open{[}\renewcommand\NAT@close{]}\fi + \def\@tempb{angle}\ifx\@tempa\@tempb + \renewcommand\NAT@open{$<$}\renewcommand\NAT@close{$>$}\fi + \def\@tempb{curly}\ifx\@tempa\@tempb + \renewcommand\NAT@open{\{}\renewcommand\NAT@close{\}}\fi + \def\@tempb{semicolon}\ifx\@tempa\@tempb + \renewcommand\NAT@sep{;}\fi + \def\@tempb{colon}\ifx\@tempa\@tempb + \renewcommand\NAT@sep{;}\fi + \def\@tempb{comma}\ifx\@tempa\@tempb + \renewcommand\NAT@sep{,}\fi + \def\@tempb{authoryear}\ifx\@tempa\@tempb + \NAT@numbersfalse\fi + \def\@tempb{numbers}\ifx\@tempa\@tempb + \NAT@numberstrue\NAT@superfalse\fi + \def\@tempb{super}\ifx\@tempa\@tempb + \NAT@numberstrue\NAT@supertrue\fi + \def\@tempb{nobibstyle}\ifx\@tempa\@tempb + \let\bibstyle=\@gobble\fi + \def\@tempb{bibstyle}\ifx\@tempa\@tempb + \let\bibstyle=\@citestyle\fi + \def\@tempb{sort}\ifx\@tempa\@tempb + \def\NAT@sort{\@ne}\fi + \def\@tempb{nosort}\ifx\@tempa\@tempb + \def\NAT@sort{\z@}\fi + \def\@tempb{compress}\ifx\@tempa\@tempb + \def\NAT@cmprs{\@ne}\fi + \def\@tempb{nocompress}\ifx\@tempa\@tempb + \def\NAT@cmprs{\z@}\fi + \def\@tempb{sort&compress}\ifx\@tempa\@tempb + \def\NAT@sort{\@ne}\def\NAT@cmprs{\@ne}\fi + \def\@tempb{mcite}\ifx\@tempa\@tempb + \let\NAT@merge\@ne\fi + \def\@tempb{merge}\ifx\@tempa\@tempb + \@ifnum{\NAT@merge<\tw@}{\let\NAT@merge\tw@}{}\fi + \def\@tempb{elide}\ifx\@tempa\@tempb + \@ifnum{\NAT@merge<\thr@@}{\let\NAT@merge\thr@@}{}\fi + \def\@tempb{longnamesfirst}\ifx\@tempa\@tempb + \NAT@longnamestrue\fi + \def\@tempb{nonamebreak}\ifx\@tempa\@tempb + \def\NAT@nmfmt#1{\mbox{\NAT@up#1}}\fi + \expandafter\NAT@find@eq\@tempa=\relax\@nil + \if\@tempc\relax\else + \expandafter\NAT@rem@eq\@tempc + \def\@tempb{open}\ifx\@tempa\@tempb + \xdef\NAT@open{\@tempc}\fi + \def\@tempb{close}\ifx\@tempa\@tempb + \xdef\NAT@close{\@tempc}\fi + \def\@tempb{aysep}\ifx\@tempa\@tempb + \xdef\NAT@aysep{\@tempc}\fi + \def\@tempb{yysep}\ifx\@tempa\@tempb + \xdef\NAT@yrsep{\@tempc}\fi + \def\@tempb{notesep}\ifx\@tempa\@tempb + \xdef\NAT@cmt{\@tempc}\fi + \def\@tempb{citesep}\ifx\@tempa\@tempb + \xdef\NAT@sep{\@tempc}\fi + \fi + }% + \NAT@@setcites + } + \renewcommand\citestyle[1]{% + \ifcsname bibstyle@#1\endcsname% + \csname bibstyle@#1\endcsname\let\bibstyle\@gobble% + \else% + \@latex@error{Undefined `#1' citestyle}% + \fi + }% +\fi +\newcommand{\bibstyle@acmauthoryear}{% + \setcitestyle{% + authoryear,% + open={[},close={]},citesep={;},% + aysep={},yysep={,},% + notesep={, }}} +\newcommand{\bibstyle@acmnumeric}{% + \setcitestyle{% + numbers,sort&compress,% + open={[},close={]},citesep={,},% + notesep={, }}} +\if@ACM@natbib +\citestyle{acmnumeric} +\fi +\def\@startsection#1#2#3#4#5#6{% + \if@noskipsec \leavevmode \fi + \par + \@tempskipa #4\relax + \@afterindenttrue + \ifdim \@tempskipa <\z@ + \@tempskipa -\@tempskipa \@afterindentfalse + \fi + \if@nobreak + \everypar{}% + \else + \addpenalty\@secpenalty\addvspace\@tempskipa + \fi + \@ifstar + {\@ssect{#3}{#4}{#5}{#6}}% + {\@dblarg{\@sect{#1}{#2}{#3}{#4}{#5}{#6}}}} +\def\@sect#1#2#3#4#5#6[#7]#8{% + \edef\@toclevel{\ifnum#2=\@m 0\else\number#2\fi}% + \ifnum #2>\c@secnumdepth + \let\@svsec\@empty + \else + \refstepcounter{#1}% + \protected@edef\@svsec{\@seccntformat{#1}\relax}% + \fi + \@tempskipa #5\relax + \ifdim \@tempskipa>\z@ + \begingroup + #6{% + \@hangfrom{\hskip #3\relax\@svsec}% + \interlinepenalty \@M #8\@@par}% + \endgroup + \csname #1mark\endcsname{#7}% + \ifnum #2>\c@secnumdepth \else + \@tochangmeasure{\csname the#1\endcsname}% + \fi + \addcontentsline{toc}{#1}{% + \ifnum #2>\c@secnumdepth \else + \protect\numberline{\csname the#1\endcsname}% + \fi + #7}% + \else + \def\@svsechd{% + #6{\hskip #3\relax + \@svsec #8}% + \csname #1mark\endcsname{#7}% + \ifnum #2>\c@secnumdepth \else + \@tochangmeasure{\csname the#1\endcsname\space}% + \fi + \addcontentsline{toc}{#1}{% + \ifnum #2>\c@secnumdepth \else + \protect\numberline{\csname the#1\endcsname}% + \fi + #7}}% + \fi + \@xsect{#5}} +\def\@xsect#1{% + \@tempskipa #1\relax + \ifdim \@tempskipa>\z@ + \par \nobreak + \vskip \@tempskipa + \@afterheading + \else + \@nobreakfalse + \global\@noskipsectrue + \everypar{% + \if@noskipsec + \global\@noskipsecfalse + {\setbox\z@\lastbox}% + \clubpenalty\@M + \begingroup \@svsechd \endgroup + \unskip + \@tempskipa #1\relax + \hskip -\@tempskipa + \else + \clubpenalty \@clubpenalty + \everypar{}% + \fi}% + \fi + \ignorespaces} +\def\@seccntformat#1{\csname the#1\endcsname\quad} +\def\@ssect#1#2#3#4#5{% + \@tempskipa #3\relax + \ifdim \@tempskipa>\z@ + \begingroup + #4{% + \@hangfrom{\hskip #1}% + \interlinepenalty \@M #5\@@par}% + \endgroup + \else + \def\@svsechd{#4{\hskip #1\relax #5}}% + \fi + \@xsect{#3}} +\def\@starttoc#1#2{\begingroup\makeatletter + \setTrue{#1}% + \par\removelastskip\vskip\z@skip + \@startsection{section}\@M\z@{\linespacing\@plus\linespacing}% + {.5\linespacing}{\centering\contentsnamefont}{#2}% + \(a)input{\jobname.#1}% + \if@filesw + \@xp\newwrite\csname tf@#1\endcsname + \immediate\@xp\openout\csname tf@#1\endcsname \jobname.#1\relax + \fi + \global\@nobreakfalse \endgroup + \addvspace{32\p@\@plus14\p@}% +} +\def\l@section{\@tocline{1}{0pt}{1pc}{2pc}{}} +\def\l@subsection{\@tocline{2}{0pt}{1pc}{3pc}{}} +\def\l@subsubsection{\@tocline{2}{0pt}{1pc}{5pc}{}} +\def\@makefntext{\noindent\@makefnmark} +\if@ACM@sigchiamode +\long\def\@footnotetext#1{\marginpar{% + \reset@font\small + \interlinepenalty\interfootnotelinepenalty + \protected@edef\@currentlabel{% + \csname p@footnote\endcsname\@thefnmark + }% + \color@begingroup + \@makefntext{% + \rule\z@\footnotesep\ignorespaces#1\@finalstrut\strutbox}% + \color@endgroup}}% +\fi +\long\def\@mpfootnotetext#1{% + \global\setbox\@mpfootins\vbox{% + \unvbox\@mpfootins + \reset@font\footnotesize + \hsize\columnwidth + \@parboxrestore + \protected@edef\@currentlabel + {\csname p@mpfootnote\endcsname\@thefnmark}% + \color@begingroup\centering + \@makefntext{% + \rule\z@\footnotesep\ignorespaces#1\@finalstrut\strutbox}% + \color@endgroup}} +\def\@makefnmark{\hbox{\@textsuperscript{\normalfont\@thefnmark}}} +\let\@footnotemark@nolink\@footnotemark +\let\@footnotetext@nolink\@footnotetext +\RequirePackage[bookmarksnumbered,unicode]{hyperref} +\pdfstringdefDisableCommands{% + \def\addtocounter#1#2{}% + \def\unskip{}% + \def\textbullet{- }% + \def\textrightarrow{ -> }% + \def\footnotemark{}% +} +\urlstyle{rm} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall +\or % acmlarge +\or % acmtog +\or % sigconf +\or % siggraph +\or % sigplan + \urlstyle{sf} +\or % sigchi +\or % sigchi-a + \urlstyle{sf} +\fi +\AtEndPreamble{% + \if@ACM@urlbreakonhyphens + \def\do@url@hyp{\do\-}% + \fi + \if@ACM@screen + \hypersetup{colorlinks, + linkcolor=ACMPurple, + citecolor=ACMPurple, + urlcolor=ACMDarkBlue, + filecolor=ACMDarkBlue} + \else + \hypersetup{hidelinks} + \fi + \hypersetup{pdflang={en}, + pdfdisplaydoctitle}} +\if@ACM@natbib + \let\citeN\cite + \let\cite\citep + \let\citeANP\citeauthor + \let\citeNN\citeyearpar + \let\citeyearNP\citeyear + \let\citeNP\citealt + \DeclareRobustCommand\citeA + {\begingroup\NAT@swafalse + \let\NAT@ctype\@ne\NAT@partrue\NAT@fullfalse\NAT@open\NAT@citetp}% + \providecommand\newblock{}% +\else + \AtBeginDocument{% + \let\shortcite\cite% + \providecommand\citename[1]{#1}} +\fi +\newcommand\shortcite[2][]{% + \ifNAT@numbers\cite[#1]{#2}\else\citeyearpar[#1]{#2}\fi} +\def\bibliographystyle#1{% + \ifx\@begindocumenthook\@undefined\else + \expandafter\AtBeginDocument + \fi + {\if@filesw + \immediate\write\@auxout{\string\bibstyle{#1}}% + \fi}} +\RequirePackage{graphicx} +\RequirePackage[prologue]{xcolor} +\definecolor[named]{ACMBlue}{cmyk}{1,0.1,0,0.1} +\definecolor[named]{ACMYellow}{cmyk}{0,0.16,1,0} +\definecolor[named]{ACMOrange}{cmyk}{0,0.42,1,0.01} +\definecolor[named]{ACMRed}{cmyk}{0,0.90,0.86,0} +\definecolor[named]{ACMLightBlue}{cmyk}{0.49,0.01,0,0} +\definecolor[named]{ACMGreen}{cmyk}{0.20,0,1,0.19} +\definecolor[named]{ACMPurple}{cmyk}{0.55,1,0,0.15} +\definecolor[named]{ACMDarkBlue}{cmyk}{1,0.58,0,0.21} +\if@ACM@authordraft + \RequirePackage{draftwatermark} + \SetWatermarkFontSize{0.5in} + \SetWatermarkColor[gray]{.9} + \SetWatermarkText{\parbox{12em}{\centering + Unpublished working draft.\\ + Not for distribution.}} +\fi +\RequirePackage{geometry} +\ifcase\ACM@format@nr +\relax % manuscript + \geometry{letterpaper,head=13pt, + marginparwidth=6pc,heightrounded}% +\or % acmsmall + \geometry{twoside=true, + includeheadfoot, head=13pt, foot=2pc, + paperwidth=6.75in, paperheight=10in, + top=58pt, bottom=44pt, inner=46pt, outer=46pt, + marginparwidth=2pc,heightrounded + }% +\or % acmlarge + \geometry{twoside=true, head=13pt, foot=2pc, + paperwidth=8.5in, paperheight=11in, + includeheadfoot, + top=78pt, bottom=114pt, inner=81pt, outer=81pt, + marginparwidth=4pc,heightrounded + }% +\or % acmtog + \geometry{twoside=true, head=13pt, foot=2pc, + paperwidth=8.5in, paperheight=11in, + includeheadfoot, columnsep=24pt, + top=52pt, bottom=75pt, inner=52pt, outer=52pt, + marginparwidth=2pc,heightrounded + }% +\or % sigconf + \geometry{twoside=true, head=13pt, + paperwidth=8.5in, paperheight=11in, + includeheadfoot, columnsep=2pc, + top=57pt, bottom=73pt, inner=54pt, outer=54pt, + marginparwidth=2pc,heightrounded + }% +\or % siggraph + \geometry{twoside=true, head=13pt, + paperwidth=8.5in, paperheight=11in, + includeheadfoot, columnsep=2pc, + top=57pt, bottom=73pt, inner=54pt, outer=54pt, + marginparwidth=2pc,heightrounded + }% +\or % sigplan + \geometry{twoside=true, head=13pt, + paperwidth=8.5in, paperheight=11in, + includeheadfoot=false, columnsep=2pc, + top=1in, bottom=1in, inner=0.75in, outer=0.75in, + marginparwidth=2pc,heightrounded + }% +\or % sigchi + \geometry{twoside=true, head=13pt, + paperwidth=8.5in, paperheight=11in, + includeheadfoot, columnsep=2pc, + top=66pt, bottom=73pt, inner=54pt, outer=54pt, + marginparwidth=2pc,heightrounded + }% +\or % sigchi-a + \geometry{twoside=false, head=13pt, + paperwidth=11in, paperheight=8.5in, + includeheadfoot, marginparsep=72pt, + marginparwidth=170pt, columnsep=20pt, + top=72pt, bottom=72pt, left=314pt, right=72pt + }% + \@mparswitchfalse + \reversemarginpar +\fi +\setlength\parindent{10\p@} +\setlength\parskip{\z@} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall +\or % acmlarge +\or % acmtog + \setlength\parindent{9\p@}% +\or % sigconf +\or % siggraph +\or % sigplan +\or % sigchi +\or % sigchi-a +\fi +\setlength\normalparindent{\parindent} +\def\copyrightpermissionfootnoterule{\kern-3\p@ + \hrule \@width \columnwidth \kern 2.6\p@} +\RequirePackage{manyfoot} +\SelectFootnoteRule[2]{copyrightpermission} +\DeclareNewFootnote{authorsaddresses} +\SelectFootnoteRule[2]{copyrightpermission} +\DeclareNewFootnote{copyrightpermission} +\def\footnoterule{\kern-3\p@ + \hrule \@width 4pc \kern 2.6\p@} +\def\endminipage{% + \par + \unskip + \ifvoid\@mpfootins\else + \vskip\skip\@mpfootins + \normalcolor + \unvbox\@mpfootins + \fi + \@minipagefalse + \color@endgroup + \egroup + \expandafter\@iiiparbox\@mpargs{\unvbox\@tempboxa}} +\def\@textbottom{\vskip \z@ \@plus 1pt} +\let\@texttop\relax +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall +\or % acmlarge +\or % acmtog + \flushbottom +\or % sigconf + \flushbottom +\or % siggraph + \flushbottom +\or % sigplan + \flushbottom +\or % sigchi + \flushbottom +\or % sigchi-a +\fi +\RequirePackage{iftex} +\ifPDFTeX +\input{glyphtounicode} +\pdfglyphtounicode{f_f}{FB00} +\pdfglyphtounicode{f_f_i}{FB03} +\pdfglyphtounicode{f_f_l}{FB04} +\pdfglyphtounicode{f_i}{FB01} +\pdfglyphtounicode{t_t}{0074 0074} +\pdfglyphtounicode{f_t}{0066 0074} +\pdfglyphtounicode{T_h}{0054 0068} +\pdfgentounicode=1 +\fi +\RequirePackage{cmap} +\newif\if@ACM@newfonts +\@ACM@newfontstrue +\IfFileExists{libertine.sty}{}{\ClassWarning{\@classname}{You do not + have the libertine package installed. Please upgrade your + TeX}\@ACM@newfontsfalse} +\IfFileExists{zi4.sty}{}{\ClassWarning{\@classname}{You do not + have the zi4 package installed. Please upgrade your + TeX}\@ACM@newfontsfalse} +\IfFileExists{newtxmath.sty}{}{\ClassWarning{\@classname}{You do not + have the newtxmath package installed. Please upgrade your + TeX}\@ACM@newfontsfalse} +\if@ACM@newfonts + \RequirePackage[T1]{fontenc} +\ifxetex + \RequirePackage[tt=false]{libertine} + \setmonofont{inconsolata} +\else + \RequirePackage[tt=false, type1=true]{libertine} +\fi +\RequirePackage[varqu]{zi4} +\RequirePackage[libertine]{newtxmath} +\fi +\let\liningnums\@undefined +\AtEndPreamble{% + \DeclareTextFontCommand{\liningnums}{\libertineLF}} +\if@ACM@sigchiamode + \renewcommand{\familydefault}{\sfdefault} +\fi +\newif\if@Description@present +\@Description@presenttrue +\newif\if@undescribed@images +\@undescribed@imagesfalse +\newcommand\Description[2][]{\global\@Description@presenttrue\ignorespaces} +\AtEndDocument{\if@undescribed@images + \ClassWarningNoLine{\@classname}{Some images may lack descriptions}\fi} +\AtBeginEnvironment{figure}{\@Description@presentfalse + \let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig} +\AtBeginEnvironment{figure*}{\@Description@presentfalse + \let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig} +\AtEndEnvironment{figure}{\if@Description@present\else + \global\@undescribed@imagestrue + \ClassWarning{\@classname}{A possible image without description}\fi} +\AtEndEnvironment{figure*}{\if@Description@present\else + \global\@undescribed@imagestrue + \ClassWarning{\@classname}{A possible image without description}\fi} +\AtBeginEnvironment{table}{\let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig} +\AtBeginEnvironment{table*}{\let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig} +\RequirePackage{caption, float} +\captionsetup[table]{position=top} +\if@ACM@journal + \captionsetup{labelfont={sf, small}, + textfont={sf, small}, margin=\z@} + \captionsetup[figure]{name={Fig.}} +\else + \captionsetup{labelfont={bf}, + textfont={bf}, labelsep=colon, margin=\z@} + \ifcase\ACM@format@nr + \relax % manuscript + \or % acmsmall + \or % acmlarge + \or % acmtog + \or % sigconf + \or % siggraph + \captionsetup{textfont={it}} + \or % sigplan + \captionsetup{labelfont={bf}, + textfont={normalfont}, labelsep=period, margin=\z@} + \or % sigchi + \captionsetup[figure]{labelfont={bf, small}, + textfont={bf, small}} + \captionsetup[table]{labelfont={bf, small}, + textfont={bf, small}} + \or % sigchi-a + \captionsetup[figure]{labelfont={bf, small}, + textfont={bf, small}} + \captionsetup[table]{labelfont={bf, small}, + textfont={bf, small}} + \fi +\fi +\newfloat{sidebar}{}{sbar} +\floatname{sidebar}{Sidebar} +\renewenvironment{sidebar}{\Collect@Body\@sidebar}{} +\long\def\@sidebar#1{\bgroup\let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig\captionsetup{type=sidebar}% + \marginpar{\small#1}\egroup} +\newenvironment{marginfigure}{\Collect@Body\@marginfigure}{} +\long\def\@marginfigure#1{\bgroup + \let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig + \captionsetup{type=figure}% + \marginpar{\@Description@presentfalse\centering + \small#1\if@Description@present\else + \global\@undescribed@imagestrue + \ClassWarning{\@classname}{A possible image without description} + \fi}% + \egroup} +\newenvironment{margintable}{\Collect@Body\@margintable}{} +\long\def\@margintable#1{\bgroup\let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig\captionsetup{type=table}% + \marginpar{\centering\small#1}\egroup} +\newdimen\fulltextwidth +\fulltextwidth=\dimexpr(\textwidth+\marginparwidth+\marginparsep) +\if@ACM@sigchiamode +\def\@dblfloat{\bgroup\let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig\columnwidth=\fulltextwidth + \let\@endfloatbox\@endwidefloatbox + \def\@fpsadddefault{\def\@fps{tp}}% + \@float} +\fi +\if@ACM@sigchiamode +\def\end@dblfloat{% + \end@float\egroup} +\fi +\def\@endwidefloatbox{% + \par\vskip\z@skip + \@minipagefalse + \outer@nobreak + \egroup + \color@endbox + \global\setbox\@currbox=\vbox{\moveleft + \dimexpr(\fulltextwidth-\textwidth)\box\@currbox}% + \wd\@currbox=\textwidth +} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall +\or % acmlarge +\or % acmtog +\or % sigconf +\or % siggraph +\or % sigplan +\def\labelenumi{\theenumi.} +\def\labelenumii{\theenumii.} +\def\labelenumiii{\theenumiii.} +\def\labelenumiv{\theenumiv.} +\or % sigchi +\or % sigchi-a +\fi +\newdimen\@ACM@labelwidth +\AtBeginDocument{% + \setlength\labelsep{4pt} + \setlength{\@ACM@labelwidth}{6.5pt} + + %% First-level list: when beginning after the first line of an + %% indented paragraph or ending before an indented paragraph, labels + %% should not hang to the left of the preceding/following text. + \setlength\leftmargini{\z@} + \addtolength\leftmargini{\parindent} + \addtolength\leftmargini{2\labelsep} + \addtolength\leftmargini{\@ACM@labelwidth} + + %% Second-level and higher lists. + \setlength\leftmarginii{\z@} + \addtolength\leftmarginii{0.5\labelsep} + \addtolength\leftmarginii{\@ACM@labelwidth} + \setlength\leftmarginiii{\leftmarginii} + \setlength\leftmarginiv{\leftmarginiii} + \setlength\leftmarginv{\leftmarginiv} + \setlength\leftmarginvi{\leftmarginv} + \@listi} +\newskip\listisep +\listisep\smallskipamount +\def\@listI{\leftmargin\leftmargini + \labelwidth\leftmargini \advance\labelwidth-\labelsep + \listparindent\z@ + \topsep\listisep} +\let\@listi\@listI +\def\@listii{\leftmargin\leftmarginii + \labelwidth\leftmarginii \advance\labelwidth-\labelsep + \topsep\z@skip} +\def\@listiii{\leftmargin\leftmarginiii + \labelwidth\leftmarginiii \advance\labelwidth-\labelsep} +\def\@listiv{\leftmargin\leftmarginiv + \labelwidth\leftmarginiv \advance\labelwidth-\labelsep} +\def\@listv{\leftmargin\leftmarginv + \labelwidth\leftmarginv \advance\labelwidth-\labelsep} +\def\@listvi{\leftmargin\leftmarginvi + \labelwidth\leftmarginvi \advance\labelwidth-\labelsep} +\renewcommand{\descriptionlabel}[1]{\upshape\bfseries #1} +\renewenvironment{description}{\list{}{% + \labelwidth\@ACM@labelwidth + \let\makelabel\descriptionlabel}% +}{ + \endlist +} +\let\enddescription=\endlist % for efficiency +\define@choicekey*+{ACM}{acmJournal}[\@journalCode\@journalCode@nr]{% + CIE,% + CSUR,% + DTRAP,% + HEALTH,% + IMWUT,% + JACM,% + JDIQ,% + JEA,% + JERIC,% + JETC,% + JOCCH,% + PACMCGIT,% + PACMHCI,% + PACMPL,% + POMACS,% + TAAS,% + TACCESS,% + TACO,% + TALG,% + TALLIP,% + TAP,% + TCPS,% + TDS,% + TEAC,% + TECS,% + THRI,% + TIIS,% + TIOT,% + TISSEC,% + TIST,% + TKDD,% + TMIS,% + TOCE,% + TOCHI,% + TOCL,% + TOCS,% + TOCT,% + TODAES,% + TODS,% + TOG,% + TOIS,% + TOIT,% + TOMACS,% + TOMM,% + TOMPECS,% + TOMS,% + TOPC,% + TOPS,% + TOPLAS,% + TOS,% + TOSEM,% + TOSN,% + TRETS,% + TSAS,% + TSC,% + TSLP,% + TWEB% +}{% +\ifcase\@journalCode@nr +\relax % CIE + \def\@journalName{ACM Computers in Entertainment}% + \def\@journalNameShort{ACM Comput. Entertain.}% + \def\@permissionCodeOne{1544-3574}% +\or % CSUR + \def\@journalName{ACM Computing Surveys}% + \def\@journalNameShort{ACM Comput. Surv.}% + \def\@permissionCodeOne{0360-0300}% +\or % DTRAP + \def\@journalName{Digital Threats: Research and Practice}% + \def\@journalNameShort{Digit. Threat. Res. Pract.}% + \def\@permissionCodeOne{2576-5337}% +\or % HEALTH + \def\@journalName{ACM Transactions on Computing for Healthcare}% + \def\@journalNameShort{ACM Trans. Comput. Healthcare}% + \def\@permissionCodeOne{2637-8051}% +\or % IMWUT + \def\@journalName{Proceedings of the ACM on Interactive, Mobile, + Wearable and Ubiquitous Technologies}% + \def\@journalNameShort{Proc. ACM Interact. Mob. Wearable Ubiquitous Technol.}% + \def\@permissionCodeOne{2474-9567}% + \@ACM@screentrue + \PackageInfo{\@classname}{Using screen mode due to \@journalCode}% +\or % JACM + \def\@journalName{Journal of the ACM}% + \def\@journalNameShort{J. ACM}% + \def\@permissionCodeOne{0004-5411}% +\or % JDIQ + \def\@journalName{ACM Journal of Data and Information Quality}% + \def\@journalNameShort{ACM J. Data Inform. Quality}% + \def\@permissionCodeOne{1936-1955}% +\or % JEA + \def\@journalName{ACM Journal of Experimental Algorithmics}% + \def\@journalNameShort{ACM J. Exp. Algor.}% + \def\@permissionCodeOne{1084-6654}% +\or % JERIC + \def\@journalName{ACM Journal of Educational Resources in Computing}% + \def\@journalNameShort{ACM J. Edu. Resources in Comput.}% + \def\@permissionCodeOne{1073-0516}% +\or % JETC + \def\@journalName{ACM Journal on Emerging Technologies in Computing Systems}% + \def\@journalNameShort{ACM J. Emerg. Technol. Comput. Syst.}% + \def\@permissionCodeOne{1550-4832}% +\or % JOCCH + \def\@journalName{ACM Journal on Computing and Cultural Heritage}% + \def\@journalNameShort{ACM J. Comput. Cult. Herit.}% +\or % PACMCGIT + \def\@journalName{Proceedings of the ACM on Computer Graphics and Interactive Techniques}% + \def\@journalNameShort{Proc. ACM Comput. Graph. Interact. Tech.}% + \def\@permissionCodeOne{2577-6193}% + \@ACM@screentrue + \PackageInfo{\@classname}{Using screen mode due to \@journalCode}% +\or % PACMHCI + \def\@journalName{Proceedings of the ACM on Human-Computer Interaction}% + \def\@journalNameShort{Proc. ACM Hum.-Comput. Interact.}% + \def\@permissionCodeOne{2573-0142}% + \@ACM@screentrue + \PackageInfo{\@classname}{Using screen mode due to \@journalCode}% +\or % PACMPL + \def\@journalName{Proceedings of the ACM on Programming Languages}% + \def\@journalNameShort{Proc. ACM Program. Lang.}% + \def\@permissionCodeOne{2475-1421}% + \@ACM@screentrue + \PackageInfo{\@classname}{Using screen mode due to \@journalCode}% +\or % POMACS + \def\@journalName{Proceedings of the ACM on Measurement and Analysis of Computing Systems}% + \def\@journalNameShort{Proc. ACM Meas. Anal. Comput. Syst.}% + \def\@permissionCodeOne{2476-1249}% + \@ACM@screentrue + \PackageInfo{\@classname}{Using screen mode due to \@journalCode}% +\or % TAAS + \def\@journalName{ACM Transactions on Autonomous and Adaptive Systems}% + \def\@journalNameShort{ACM Trans. Autonom. Adapt. Syst.}% + \def\@permissionCodeOne{1556-4665}% +\or % TACCESS + \def\@journalName{ACM Transactions on Accessible Computing}% + \def\@journalNameShort{ACM Trans. Access. Comput.}% + \def\@permissionCodeOne{1936-7228}% +\or % TACO + \def\@journalName{ACM Transactions on Architecture and Code Optimization}% + \def\@journalNameShort{ACM Trans. Arch. Code Optim.}% +\or % TALG + \def\@journalName{ACM Transactions on Algorithms}% + \def\@journalNameShort{ACM Trans. Algor.}% + \def\@permissionCodeOne{1549-6325}% +\or % TALLIP + \def\@journalName{ACM Transactions on Asian and Low-Resource Language Information Processing}% + \def\@journalNameShort{ACM Trans. Asian Low-Resour. Lang. Inf. Process.}% + \def\@permissionCodeOne{2375-4699}% +\or % TAP + \def\@journalName{ACM Transactions on Applied Perception}% +\or % TCPS + \def\@journalName{ACM Transactions on Cyber-Physical Systems}% +\or % TDS + \def\@journalName{ACM Transactions on Data Science}% + \def\@journalNameShort{ACM Trans. Data Sci.}% + \def\@permissionCodeOne{2577-3224}% +\or % TEAC + \def\@journalName{ACM Transactions on Economics and Computation}% +\or % TECS + \def\@journalName{ACM Transactions on Embedded Computing Systems}% + \def\@journalNameShort{ACM Trans. Embedd. Comput. Syst.}% + \def\@permissionCodeOne{1539-9087}% +\or % THRI + \def\@journalName{ACM Transactions on Human-Robot Interaction}% + \def\@journalNameShort{ACM Trans. Hum.-Robot Interact.}% + \def\@permissionCodeOne{2573-9522}% +\or % TIIS + \def\@journalName{ACM Transactions on Interactive Intelligent Systems}% + \def\@journalNameShort{ACM Trans. Interact. Intell. Syst.}% + \def\@permissionCodeOne{2160-6455}% +\or % TIOT + \def\@journalName{ACM Transactions on Internet of Things}% + \def\@journalNameShort{ACM Trans. Internet Things}% + \def\@permissionCodeOne{2577-6207}% +\or % TISSEC + \def\@journalName{ACM Transactions on Information and System Security}% + \def\@journalNameShort{ACM Trans. Info. Syst. Sec.}% + \def\@permissionCodeOne{1094-9224}% +\or % TIST + \def\@journalName{ACM Transactions on Intelligent Systems and Technology}% + \def\@journalNameShort{ACM Trans. Intell. Syst. Technol.}% + \def\@permissionCodeOne{2157-6904}% +\or % TKDD + \def\@journalName{ACM Transactions on Knowledge Discovery from Data}% + \def\@journalNameShort{ACM Trans. Knowl. Discov. Data.}% + \def\@permissionCodeOne{1556-4681}% +\or % TMIS + \def\@journalName{ACM Transactions on Management Information Systems}% + \def\@journalNameShort{ACM Trans. Manag. Inform. Syst.}% + \def\@permissionCodeOne{2158-656X}% +\or % TOCE + \def\@journalName{ACM Transactions on Computing Education}% + \def\@journalNameShort{ACM Trans. Comput. Educ.}% + \def\@permissionCodeOne{1946-6226}% +\or % TOCHI + \def\@journalName{ACM Transactions on Computer-Human Interaction}% + \def\@journalNameShort{ACM Trans. Comput.-Hum. Interact.}% + \def\@permissionCodeOne{1073-0516}% +\or % TOCL + \def\@journalName{ACM Transactions on Computational Logic}% + \def\@journalNameShort{ACM Trans. Comput. Logic}% + \def\@permissionCodeOne{1529-3785}% +\or % TOCS + \def\@journalName{ACM Transactions on Computer Systems}% + \def\@journalNameShort{ACM Trans. Comput. Syst.}% + \def\@permissionCodeOne{0734-2071}% +\or % TOCT + \def\@journalName{ACM Transactions on Computation Theory}% + \def\@journalNameShort{ACM Trans. Comput. Theory}% + \def\@permissionCodeOne{1942-3454}% +\or % TODAES + \def\@journalName{ACM Transactions on Design Automation of Electronic Systems}% + \def\@journalNameShort{ACM Trans. Des. Autom. Electron. Syst.}% + \def\@permissionCodeOne{1084-4309}% +\or % TODS + \def\@journalName{ACM Transactions on Database Systems}% + \def\@journalNameShort{ACM Trans. Datab. Syst.}% + \def\@permissionCodeOne{0362-5915}% +\or % TOG + \def\@journalName{ACM Transactions on Graphics}% + \def\@journalNameShort{ACM Trans. Graph.}% + \def\@permissionCodeOne{0730-0301} +\or % TOIS + \def\@journalName{ACM Transactions on Information Systems}% + \def\@permissionCodeOne{1046-8188}% +\or % TOIT + \def\@journalName{ACM Transactions on Internet Technology}% + \def\@journalNameShort{ACM Trans. Internet Technol.}% + \def\@permissionCodeOne{1533-5399}% +\or % TOMACS + \def\@journalName{ACM Transactions on Modeling and Computer Simulation}% + \def\@journalNameShort{ACM Trans. Model. Comput. Simul.}% +\or % TOMM + \def\@journalName{ACM Transactions on Multimedia Computing, Communications and Applications}% + \def\@journalNameShort{ACM Trans. Multimedia Comput. Commun. Appl.}% + \def\@permissionCodeOne{1551-6857}% + \def\@permissionCodeTwo{0100}% +\or % TOMPECS + \def\@journalName{ACM Transactions on Modeling and Performance Evaluation of Computing Systems}% + \def\@journalNameShort{ACM Trans. Model. Perform. Eval. Comput. Syst.}% + \def\@permissionCodeOne{2376-3639}% +\or % TOMS + \def\@journalName{ACM Transactions on Mathematical Software}% + \def\@journalNameShort{ACM Trans. Math. Softw.}% + \def\@permissionCodeOne{0098-3500}% +\or % TOPC + \def\@journalName{ACM Transactions on Parallel Computing}% + \def\@journalNameShort{ACM Trans. Parallel Comput.}% + \def\@permissionCodeOne{1539-9087}% +\or % TOPS + \def\@journalName{ACM Transactions on Privacy and Security}% + \def\@journalNameShort{ACM Trans. Priv. Sec.}% + \def\@permissionCodeOne{2471-2566}% +\or % TOPLAS + \def\@journalName{ACM Transactions on Programming Languages and Systems}% + \def\@journalNameShort{ACM Trans. Program. Lang. Syst.}% + \def\@permissionCodeOne{0164-0925}% +\or % TOS + \def\@journalName{ACM Transactions on Storage}% + \def\@journalNameShort{ACM Trans. Storage}% + \def\@permissionCodeOne{1553-3077}% +\or % TOSEM + \def\@journalName{ACM Transactions on Software Engineering and Methodology}% + \def\@journalNameShort{ACM Trans. Softw. Eng. Methodol.}% + \def\@permissionCodeOne{1049-331X}% +\or % TOSN + \def\@journalName{ACM Transactions on Sensor Networks}% + \def\@journalNameShort{ACM Trans. Sensor Netw.}% + \def\@permissionCodeOne{1550-4859}% +\or % TRETS + \def\@journalName{ACM Transactions on Reconfigurable Technology and Systems}% + \def\@journalNameShort{ACM Trans. Reconfig. Technol. Syst.}% + \def\@permissionCodeOne{1936-7406}% +\or % TSAS + \def\@journalName{ACM Transactions on Spatial Algorithms and Systems}% + \def\@journalNameShort{ACM Trans. Spatial Algorithms Syst.}% + \def\@permissionCodeOne{2374-0353}% +\or % TSC + \def\@journalName{ACM Transactions on Social Computing}% + \def\@journalNameShort{ACM Trans. Soc. Comput.}% + \def\@permissionCodeOne{2469-7818}% +\or % TSLP + \def\@journalName{ACM Transactions on Speech and Language Processing}% + \def\@journalNameShort{ACM Trans. Speech Lang. Process.}% + \def\@permissionCodeOne{1550-4875}% +\or % TWEB + \def\@journalName{ACM Transactions on the Web}% + \def\@journalNameShort{ACM Trans. Web}% + \def\@permissionCodeOne{1559-1131}% +\fi +\ClassInfo{\@classname}{Using journal code \@journalCode}% +}{% + \ClassError{\@classname}{Incorrect journal #1}% +}% +\def\acmJournal#1{\setkeys{ACM}{acmJournal=#1}% + \global\@ACM@journal@bibstriptrue} +\def\@journalCode@nr{0} +\def\@journalName{}% +\def\@journalNameShort{\@journalName}% +\def\@permissionCodeOne{XXXX-XXXX}% +\def\@permissionCodeTwo{}% +\newcommand\acmConference[4][]{% + \gdef\acmConference@shortname{#1}% + \gdef\acmConference@name{#2}% + \gdef\acmConference@date{#3}% + \gdef\acmConference@venue{#4}% + \ifx\acmConference@shortname\@empty + \gdef\acmConference@shortname{#2}% + \fi + \global\@ACM@journal@bibstripfalse +} +\if@ACM@journal\else +\acmConference[Conference'17]{ACM Conference}{July 2017}{Washington, + DC, USA}% +\fi +\def\acmBooktitle#1{\gdef\@acmBooktitle{#1}} +\acmBooktitle{Proceedings of \acmConference@name + \ifx\acmConference@name\acmConference@shortname\else + \ (\acmConference@shortname)\fi} +\def\(a)editorsAbbrev{(Ed.)} +\def\@acmEditors{} +\def\editor#1{\ifx\@acmEditors\@empty + \gdef\@acmEditors{#1}% + \else + \gdef\(a)editorsAbbrev{(Eds.)}% + \g@addto@macro\@acmEditors{\and#1}% +\fi} +\def\subtitle#1{\def\@subtitle{#1}} +\subtitle{} +\newcount\num@authorgroups +\num@authorgroups=0\relax +\newcount\num@authors +\num@authors=0\relax +\newif\if@insideauthorgroup +\@insideauthorgroupfalse +\renewcommand\author[2][]{% + \IfSubStr{#2}{,}{\ClassWarning{\@classname}{Do not put several + authors in the same \string\author\space macro!}}{}% + \global\advance\num@authors by 1\relax + \if@insideauthorgroup\else + \global\advance\num@authorgroups by 1\relax + \global\@insideauthorgrouptrue + \fi + \ifx\addresses\@empty + \if@ACM@anonymous + \gdef\addresses{\@author{Anonymous Author(s)% + \ifx\@acmSubmissionID\@empty\else\\Submission Id: + \@acmSubmissionID\fi}}% + \gdef\authors{Anonymous Author(s)}% + \else + \gdef\addresses{\@author{#2}}% + \gdef\authors{#2}% + \fi + \else + \if@ACM@anonymous\else + \g@addto@macro\addresses{\and\@author{#2}}% + \g@addto@macro\authors{\and#2}% + \fi + \fi + \if@ACM@anonymous + \ifx\shortauthors\@empty + \gdef\shortauthors{Anon. + \ifx\@acmSubmissionID\@empty\else Submission Id: + \@acmSubmissionID\fi}% + \fi + \else + \def\@tempa{#1}% + \ifx\@tempa\@empty + \ifx\shortauthors\@empty + \gdef\shortauthors{#2}% + \else + \g@addto@macro\shortauthors{\and#2}% + \fi + \else + \ifx\shortauthors\@empty + \gdef\shortauthors{#1}% + \else + \g@addto@macro\shortauthors{\and#1}% + \fi + \fi + \fi} +\newcommand{\affiliation}[2][]{% + \global\@insideauthorgroupfalse + \if@ACM@anonymous\else + \g@addto@macro\addresses{\affiliation{#1}{#2}}% + \fi} +\define@boolkey+{@ACM@affiliation@}[@ACM@affiliation@]{obeypunctuation}% +[true]{}{\ClassError{\@classname}{The option obeypunctuation can be either true or false}} +\def\additionalaffiliation#1{\authornote{\@additionalaffiliation{#1}}} +\def\@additionalaffiliation#1{\bgroup + \def\position##1{\ignorespaces}% + \def\institution##1{##1\ignorespaces}% + \def\department{\@ifnextchar[{\@department}{\@department[]}}% + \def\@department[##1]##2{\unskip, ##2\ignorespaces}% + \let\streetaddress\position + \let\city\position + \let\state\position + \let\postcode\position + \let\country\position + Also with #1\unskip.\egroup} +\renewcommand{\email}[2][]{% + \IfSubStr{#2}{,}{\ClassWarning{\@classname}{Do not put several + addresses in the same \string\email\space macro!}}{}% + \if@ACM@anonymous\else + \g@addto@macro\addresses{\email{#1}{#2}}% + \fi} +\def\orcid#1{\unskip\ignorespaces} +\def\authorsaddresses#1{\def\@authorsaddresses{#1}} +\authorsaddresses{\@mkauthorsaddresses} +\def\@titlenotes{} +\def\titlenote#1{% + \g@addto@macro\@title{\footnotemark}% + \if@ACM@anonymous + \g@addto@macro\@titlenotes{% + \stepcounter{footnote}\footnotetext{Title note}}% + \else + \g@addto@macro\@titlenotes{\stepcounter{footnote}\footnotetext{#1}}% + \fi} +\def\@subtitlenotes{} +\def\subtitlenote#1{% + \g@addto@macro\@subtitle{\footnotemark}% + \if@ACM@anonymous + \g@addto@macro\@subtitlenotes{% + \stepcounter{footnote}\footnotetext{Subtitle note}}% + \else + \g@addto@macro\@subtitlenotes{% + \stepcounter{footnote}\footnotetext{#1}}% + \fi} +\def\@authornotes{} +\def\authornote#1{% + \if@ACM@anonymous\else + \g@addto@macro\addresses{\@authornotemark}% + \g@addto@macro\@authornotes{% + \stepcounter{footnote}\footnotetext{#1}}% + \fi} +\newcommand\authornotemark[1][\relax]{% + \ifx#1\relax\relax\relax + \g@addto@macro\addresses{\@authornotemark}% + \else + \g@addto@macro\addresses{\@@authornotemark{#1}}% + \fi} +\def\acmVolume#1{\def\@acmVolume{#1}} +\acmVolume{1} +\def\acmNumber#1{\def\@acmNumber{#1}} +\acmNumber{1} +\def\acmArticle#1{\def\@acmArticle{#1}} +\acmArticle{} +\def\acmArticleSeq#1{\def\@acmArticleSeq{#1}} +\acmArticleSeq{\@acmArticle} +\def\acmYear#1{\def\@acmYear{#1}} +\acmYear{\the\year} +\def\acmMonth#1{\def\@acmMonth{#1}} +\acmMonth{\the\month} +\def\@acmPubDate{\ifcase\@acmMonth\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or + December\fi~\@acmYear} +\def\acmPrice#1{\def\@acmPrice{#1}} +\acmPrice{15.00} +\def\acmSubmissionID#1{\def\@acmSubmissionID{#1}} +\acmSubmissionID{} +\def\acmISBN#1{\def\@acmISBN{#1}} +\acmISBN{978-x-xxxx-xxxx-x/YY/MM} +\def\acmDOI#1{\def\@acmDOI{#1}} +\acmDOI{10.1145/nnnnnnn.nnnnnnn} +\newif\if@ACM@badge +\@ACM@badgefalse +\newlength\@ACM@badge@width +\setlength\@ACM@badge@width{5pc} +\newlength\@ACM@title@width +\newlength\@ACM@badge@skip +\setlength\@ACM@badge@skip{1pc} +\newcommand\acmBadgeR[2][]{\@ACM@badgetrue + \def\@acmBadgeR@url{#1}% + \def\@acmBadgeR@image{#2}} +\def\@acmBadgeR@url{} +\def\@acmBadgeR@image{} +\newcommand\acmBadgeL[2][]{\@ACM@badgetrue + \def\@acmBadgeL@url{#1}% + \def\@acmBadgeL@image{#2}} +\def\@acmBadgeL@url{} +\def\@acmBadgeL@image{} +\def\startPage#1{\def\@startPage{#1}} +\startPage{} +\def\terms#1{\ClassWarning{\@classname}{The command \string\terms{} is + obsolete. I am going to ignore it}} +\def\keywords#1{\def\@keywords{#1}} +\keywords{} +\renewenvironment{abstract}{\Collect@Body\@saveabstract}{} +\long\def\@saveabstract#1{\long\gdef\@abstract{#1}} +\@saveabstract{} +\long\def\@lempty{} +\define@boolkey+{@ACM@topmatter@}[@ACM@]{printccs}[true]{% + \if@ACM@printccs + \ClassInfo{\@classname}{Printing CCS}% + \else + \ClassInfo{\@classname}{Suppressing CCS}% + \fi}{\ClassError{\@classname}{The option printccs can be either true or false}} +\define@boolkey+{@ACM@topmatter@}[@ACM@]{printacmref}[true]{% + \if@ACM@printacmref + \ClassInfo{\@classname}{Printing bibformat}% + \else + \ClassInfo{\@classname}{Suppressing bibformat}% + \fi}{\ClassError{\@classname}{The option printacmref can be either true or false}} +\define@boolkey+{@ACM@topmatter@}[@ACM@]{printfolios}[true]{% + \if@ACM@printfolios + \ClassInfo{\@classname}{Printing folios}% + \else + \ClassInfo{\@classname}{Suppressing folios}% + \fi}{\ClassError{\@classname}{The option printfolios can be either true or false}} +\define@cmdkey{@ACM@topmatter@}[@ACM@]{authorsperrow}[0]{% + \IfInteger{#1}{\ClassInfo{\@classname}{Setting authorsperrow to + #1}}{\ClassWarning{\@classname}{The parameter authorsperrow must be + numerical. Ignoring the input #1}\gdef\@ACM@authorsperrow{0}}} +\def\settopmatter#1{\setkeys{@ACM@topmatter@}{#1}} +\settopmatter{printccs=true, printacmref=true} +\if@ACM@manuscript + \settopmatter{printfolios=true} +\else + \if@ACM@journal + \settopmatter{printfolios=true} + \else + \settopmatter{printfolios=false} + \fi +\fi +\settopmatter{authorsperrow=0} +\def\@received{} +\newcommand\received[2][]{\def\@tempa{#1}% + \ifx\@tempa\@empty + \ifx\@received\@empty + \gdef\@received{Received #2}% + \else + \g@addto@macro{\@received}{; revised #2}% + \fi + \else + \ifx\@received\@empty + \gdef\@received{#1 #2}% + \else + \g@addto@macro{\@received}{; #1 #2}% + \fi + \fi} +\AtEndDocument{% + \ifx\@received\@empty\else + \par\bigskip\noindent\small\normalfont\@received\par + \fi} +\RequirePackage{comment} +\excludecomment{CCSXML} +\let\@concepts\@empty +\newcounter{@concepts} +\newcommand\ccsdesc[2][100]{% + \ccsdesc@parse#1~#2~~\ccsdesc@parse@end} +\RequirePackage{textcomp} +\def\ccsdesc@parse#1~#2~#3~{% + \stepcounter{@concepts}% + \expandafter\ifx\csname CCS@General@#2\endcsname\relax + \expandafter\gdef\csname CCS@General@#2\endcsname{\textbullet\ + \textbf{#2}}% + \expandafter\gdef\csname CCS@Punctuation@#2\endcsname{; }% + \expandafter\gdef\csname CCS@Specific@#2\endcsname{}% + \g@addto@macro{\@concepts}{\csname CCS@General@#2\endcsname + \csname CCS@Punctuation@#2\endcsname + \csname CCS@Specific@#2\endcsname}% + \fi + \ifx#3\relax\relax\else + \expandafter\gdef\csname CCS@Punctuation@#2\endcsname{ + \textrightarrow\ }% + \expandafter\g@addto@macro\expandafter{\csname CCS@Specific@#2\endcsname}{% + \addtocounter{@concepts}{-1}% + \ifnum#1>499\textbf{#3}\else + \ifnum#1>299\textit{#3}\else + #3\fi\fi\ifnum\value{(a)concepts}=0.\else; \fi}% + \fi +\ccsdesc@parse@finish} +\def\ccsdesc@parse@finish#1\ccsdesc@parse@end{} +\newif\if@printcopyright +\@printcopyrighttrue +\newif\if@printpermission +\@printpermissiontrue +\newif\if@acmowned +\@acmownedtrue +\define@choicekey*{ACM@}{acmcopyrightmode}[% + \acm@copyrightinput\acm@copyrightmode]{none,% + acmcopyright,acmlicensed,rightsretained,% + usgov,usgovmixed,cagov,cagovmixed,licensedusgovmixed,% + licensedcagov,licensedcagovmixed,othergov,licensedothergov,% + iw3c2w3,iw3c2w3g}{% + \@printpermissiontrue + \@printcopyrighttrue + \@acmownedtrue + \ifnum\acm@copyrightmode=0\relax % none + \@printpermissionfalse + \@printcopyrightfalse + \@acmownedfalse + \fi + \ifnum\acm@copyrightmode=2\relax % acmlicensed + \@acmownedfalse + \fi + \ifnum\acm@copyrightmode=3\relax % rightsretained + \@acmownedfalse + \AtBeginDocument{\acmPrice{}}% + \fi + \ifnum\acm@copyrightmode=4\relax % usgov + \@printpermissiontrue + \@printcopyrightfalse + \@acmownedfalse + \AtBeginDocument{\acmPrice{}}% + \fi + \ifnum\acm@copyrightmode=6\relax % cagov + \@acmownedfalse + \fi + \ifnum\acm@copyrightmode=8\relax % licensedusgovmixed + \@acmownedfalse + \fi + \ifnum\acm@copyrightmode=9\relax % licensedcagov + \@acmownedfalse + \fi + \ifnum\acm@copyrightmode=10\relax % licensedcagovmixed + \@acmownedfalse + \fi + \ifnum\acm@copyrightmode=11\relax % othergov + \@acmownedtrue + \fi + \ifnum\acm@copyrightmode=12\relax % licensedothergov + \@acmownedfalse + \fi + \ifnum\acm@copyrightmode=13\relax % iw3c2w3 + \@acmownedfalse + \AtBeginDocument{\acmPrice{}}% + \fi + \ifnum\acm@copyrightmode=14\relax % iw3c2w3g + \@acmownedfalse + \AtBeginDocument{\acmPrice{}}% + \fi} +\def\setcopyright#1{\setkeys{ACM@}{acmcopyrightmode=#1}} +\setcopyright{acmcopyright} +\def\@copyrightowner{% + \ifcase\acm@copyrightmode\relax % none + \or % acmcopyright + Association for Computing Machinery. + \or % acmlicensed + Copyright held by the owner/author(s). Publication rights licensed to + ACM\@. + \or % rightsretained + Copyright held by the owner/author(s). + \or % usgov + \or % usgovmixed + Association for Computing Machinery. + \or % cagov + Crown in Right of Canada. + \or %cagovmixed + Association for Computing Machinery. + \or %licensedusgovmixed + Copyright held by the owner/author(s). Publication rights licensed to + ACM\@. + \or % licensedcagov + Crown in Right of Canada. Publication rights licensed to + ACM\@. + \or %licensedcagovmixed + Copyright held by the owner/author(s). Publication rights licensed to + ACM\@. + \or % othergov + Association for Computing Machinery. + \or % licensedothergov + Copyright held by the owner/author(s). Publication rights licensed to + ACM\@. + \or % ic2w3www + IW3C2 (International World Wide Web Conference Committee), published + under Creative Commons CC-BY~4.0 License. + \or % ic2w3wwwgoogle + IW3C2 (International World Wide Web Conference Committee), published + under Creative Commons CC-BY-NC-ND~4.0 License. + \fi} +\def\@formatdoi#1{\url{https://doi.org/#1}} +\def\@copyrightpermission{% + \ifcase\acm@copyrightmode\relax % none + \or % acmcopyright + Permission to make digital or hard copies of all or part of this + work for personal or classroom use is granted without fee provided + that copies are not made or distributed for profit or commercial + advantage and that copies bear this notice and the full citation on + the first page. Copyrights for components of this work owned by + others than ACM must be honored. Abstracting with credit is + permitted. To copy otherwise, or republish, to post on servers or to + redistribute to lists, requires prior specific permission + and\hspace*{.5pt}/or a fee. Request permissions from + permissions(a)acm.org. + \or % acmlicensed + Permission to make digital or hard copies of all or part of this + work for personal or classroom use is granted without fee provided + that copies are not made or distributed for profit or commercial + advantage and that copies bear this notice and the full citation on + the first page. Copyrights for components of this work owned by + others than the author(s) must be honored. Abstracting with credit + is permitted. To copy otherwise, or republish, to post on servers + or to redistribute to lists, requires prior specific permission + and\hspace*{.5pt}/or a fee. Request permissions from + permissions(a)acm.org. + \or % rightsretained + Permission to make digital or hard copies of part or all of this work + for personal or classroom use is granted without fee provided that + copies are not made or distributed for profit or commercial advantage + and that copies bear this notice and the full citation on the first + page. Copyrights for third-party components of this work must be + honored. For all other uses, contact the + owner\hspace*{.5pt}/author(s). + \or % usgov + This paper is authored by an employee(s) of the United States + Government and is in the public domain. Non-exclusive copying or + redistribution is allowed, provided that the article citation is + given and the authors and agency are clearly identified as its + source. + \or % usgovmixed + ACM acknowledges that this contribution was authored or co-authored + by an employee, contractor, or affiliate of the United States government. As such, + the United States government retains a nonexclusive, royalty-free right to + publish or reproduce this article, or to allow others to do so, for + government purposes only. + \or % cagov + This article was authored by employees of the Government of Canada. + As such, the Canadian government retains all interest in the + copyright to this work and grants to ACM a nonexclusive, + royalty-free right to publish or reproduce this article, or to allow + others to do so, provided that clear attribution is given both to + the authors and the Canadian government agency employing them. + Permission to make digital or hard copies for personal or classroom + use is granted. Copies must bear this notice and the full citation + on the first page. Copyrights for components of this work owned by + others than the Canadian Government must be honored. To copy + otherwise, distribute, republish, or post, requires prior specific + permission and\hspace*{.5pt}/or a fee. Request permissions from + permissions(a)acm.org. + \or % cagovmixed + ACM acknowledges that this contribution was co-authored by an + affiliate of the national government of Canada. As such, the Crown + in Right of Canada retains an equal interest in the copyright. + Reprints must include clear attribution to ACM and the author's + government agency affiliation. Permission to make digital or hard + copies for personal or classroom use is granted. Copies must bear + this notice and the full citation on the first page. Copyrights for + components of this work owned by others than ACM must be honored. + To copy otherwise, distribute, republish, or post, requires prior + specific permission and\hspace*{.5pt}/or a fee. Request permissions + from permissions(a)acm.org. + \or % licensedusgovmixed + Publication rights licensed to ACM\@. ACM acknowledges that this + contribution was authored or co-authored by an employee, contractor + or affiliate of the United States government. As such, the + Government retains a nonexclusive, royalty-free right to publish or + reproduce this article, or to allow others to do so, for Government + purposes only. + \or % licensedcagov + This article was authored by employees of the Government of Canada. + As such, the Canadian government retains all interest in the + copyright to this work and grants to ACM a nonexclusive, + royalty-free right to publish or reproduce this article, or to allow + others to do so, provided that clear attribution is given both to + the authors and the Canadian government agency employing them. + Permission to make digital or hard copies for personal or classroom + use is granted. Copies must bear this notice and the full citation + on the first page. Copyrights for components of this work owned by + others than the Canadian Government must be honored. To copy + otherwise, distribute, republish, or post, requires prior specific + permission and\hspace*{.5pt}/or a fee. Request permissions from + permissions(a)acm.org. + \or % licensedcagovmixed + Publication rights licensed to ACM\@. ACM acknowledges that this + contribution was authored or co-authored by an employee, contractor + or affiliate of the national government of Canada. As such, the + Government retains a nonexclusive, royalty-free right to publish or + reproduce this article, or to allow others to do so, for Government + purposes only. + \or % othergov + ACM acknowledges that this contribution was authored or co-authored + by an employee, contractor or affiliate of a national government. As + such, the Government retains a nonexclusive, royalty-free right to + publish or reproduce this article, or to allow others to do so, for + Government purposes only. + \or % licensedothergov + Publication rights licensed to ACM\@. ACM acknowledges that this + contribution was authored or co-authored by an employee, contractor + or affiliate of a national government. As such, the Government + retains a nonexclusive, royalty-free right to publish or reproduce + this article, or to allow others to do so, for Government purposes + only. + \or % iw3c2w3 + This paper is published under the Creative Commons Attribution~4.0 + International (CC-BY~4.0) license. Authors reserve their rights to + disseminate the work on their personal and corporate Web sites with + the appropriate attribution. + \or % iw3c2w3g + This paper is published under the Creative Commons + Attribution-NonCommercial-NoDerivs~4.0 International + (CC-BY-NC-ND~4.0) license. Authors reserve their rights to + disseminate the work on their personal and corporate Web sites with + the appropriate attribution. + \fi} +\def\copyrightyear#1{\def\@copyrightyear{#1}} +\copyrightyear{\@acmYear} +\def\@teaserfigures{} +\newenvironment{teaserfigure}{\Collect@Body\@saveteaser}{} +\long\def\@saveteaser#1{\g@addto@macro\@teaserfigures{\@teaser{#1}}} +\renewcommand{\thanks}[1]{% + \@ifnotempty{#1}{% + \if@ACM@anonymous + \g@addto@macro\thankses{\thanks{A note}}% + \else + \g@addto@macro\thankses{\thanks{#1}}% + \fi}} +\newbox\mktitle@bx +\def\maketitle{% + \if@ACM@anonymous + % Anonymize omission of \author-s + \ifnum\num@authorgroups=0\author{}\fi + \fi + \begingroup + \let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig + \let\@footnotemark\@footnotemark@nolink + \let\@footnotetext\@footnotetext@nolink + \renewcommand\thefootnote{\@fnsymbol\c@footnote}% + \hsize=\textwidth + \def\@makefnmark{\hbox{\@textsuperscript{\@thefnmark}}}% + \@mktitle\if@ACM@sigchiamode\else\@mkauthors\fi\@mkteasers + \@printtopmatter + \if@ACM@sigchiamode\@mkauthors\fi + \setcounter{footnote}{0}% + \def\@makefnmark{\hbox{\@textsuperscript{\normalfont\@thefnmark}}}% + \@titlenotes + \@subtitlenotes + \@authornotes + \let\@makefnmark\relax + \let\@thefnmark\relax + \let\@makefntext\noindent + \ifx\@empty\thankses\else + \footnotetextauthorsaddresses{% + \def\par{\let\par\@par}\parindent\z@\@setthanks}% + \fi + \ifx\@empty\@authorsaddresses\else + \if@ACM@anonymous\else + \if@ACM@journal@bibstrip + \footnotetextauthorsaddresses{% + \def\par{\let\par\@par}\parindent\z@\@setauthorsaddresses}% + \fi + \fi + \fi + \if@ACM@nonacm\else\footnotetextcopyrightpermission{% + \if@ACM@authordraft + \raisebox{-2ex}[\z@][\z@]{\makebox[0pt][l]{\large\bfseries + Unpublished working draft. Not for distribution.}}% + \color[gray]{0.9}% + \fi + \parindent\z(a)\parskip0.1\baselineskip + \if@ACM@authorversion\else + \if@printpermission\@copyrightpermission\par\fi + \fi + \if@ACM@manuscript\else + \if@ACM@journal@bibstrip\else % Print the conference information + {\itshape \acmConference@shortname, \acmConference@date, \acmConference@venue}\par + \fi + \fi + \if@printcopyright + \copyright\ \@copyrightyear\ \@copyrightowner\\ + \else + \(a)copyrightyear.\ + \fi + \if@ACM@manuscript + Manuscript submitted to ACM\\ + \else + \if@ACM@authorversion + This is the author's version of the work. It is posted here for + your personal use. Not for redistribution. The definitive Version + of Record was published in + \if@ACM@journal@bibstrip + \emph{\@journalName}% + \else + \emph{\@acmBooktitle}% + \fi + \ifx\@acmDOI\@empty + . + \else + , \@formatdoi{\@acmDOI}. + \fi\\ + \else + \if@ACM@nonacm\else + \if@ACM@journal@bibstrip + \@permissionCodeOne/\@acmYear/\@acmMonth-ART\@acmArticle + \ifx\@acmPrice\@empty\else\ \$\@acmPrice\fi\\ + \@formatdoi{\@acmDOI}% + \else % Conference + \ifx\@acmISBN\@empty\else ACM~ISBN~\@acmISBN + \ifx\@acmPrice\@empty.\else\dots\$\@acmPrice\fi\\\fi + \ifx\@acmDOI\@empty\else\@formatdoi{\@acmDOI}\fi% + \fi + \fi + \fi + \fi} + \fi + \endgroup + \setcounter{footnote}{0}% + \@mkabstract + \if@ACM@printccs + \ifx\@concepts\@empty\else\bgroup + {\@specialsection{CCS Concepts}% + \@concepts\par}\egroup + \fi + \fi + \ifx\@keywords\@empty\else\bgroup + {\if@ACM@journal + \@specialsection{Additional Key Words and Phrases}% + \else + \@specialsection{Keywords}% + \fi + \@keywords}\par\egroup + \fi + \andify\authors + \andify\shortauthors + \global\let\authors=\authors + \global\let\shortauthors=\shortauthors + \if@ACM@printacmref + \@mkbibcitation + \fi + \hypersetup{% + pdfauthor={\authors}, + pdftitle={\@title}, + pdfsubject={\@concepts}, + pdfkeywords={\@keywords}, + pdfcreator={LaTeX with acmart + \csname ver(a)acmart.cls\endcsname\space + and hyperref + \csname ver(a)hyperref.sty\endcsname}}% + \global\@topnum\z@ % this prevents floats from falling + % at the top of page 1 + \global\@botnum\z@ % we do not want them to be on the bottom either + \@printendtopmatter + \@afterindentfalse + \@afterheading +} +\def\@specialsection#1{% + \ifcase\ACM@format@nr + \relax % manuscript + \par\medskip\small\noindent#1: % + \or % acmsmall + \par\medskip\small\noindent#1: % + \or % acmlarge + \par\medskip\small\noindent#1: % + \or % acmtog + \par\medskip\small\noindent#1: % + \or % sigconf + \section*{#1}% + \or % siggraph + \section*{#1}% + \or % sigplan + \paragraph*{#1}% + \or % sigchi + \section*{#1}% + \or % sigchi-a + \section*{#1}% + \fi} +\def\@printtopmatter{% + \ifx\@startPage\@empty + \gdef\@startPage{1}% + \else + \setcounter{page}{\@startPage}% + \fi + \thispagestyle{firstpagestyle}% + \noindent + \ifcase\ACM@format@nr + \relax % manuscript + \box\mktitle@bx\par + \or % acmsmall + \box\mktitle@bx\par + \or % acmlarge + \box\mktitle@bx\par + \or % acmtog + \twocolumn[\box\mktitle@bx]% + \or % sigconf + \twocolumn[\box\mktitle@bx]% + \or % siggraph + \twocolumn[\box\mktitle@bx]% + \or % sigplan + \twocolumn[\box\mktitle@bx]% + \or % sigchi + \twocolumn[\box\mktitle@bx]% + \or % sigchi-a + \par\box\mktitle@bx\par\bigskip + \if@ACM@badge + \marginpar{\noindent + \ifx\@acmBadgeL@image\@empty\else + \href{\@acmBadgeL@url}{% + \includegraphics[width=\@ACM@badge@width]{\@acmBadgeL@image}}% + \hskip\@ACM@badge@skip + \fi + \ifx\@acmBadgeR@image\@empty\else + \href{\@acmBadgeR@url}{% + \includegraphics[width=\@ACM@badge@width]{\@acmBadgeR@image}}% + \fi}% + \fi + \fi +} +\def\@mktitle{% + \ifcase\ACM@format@nr + \relax % manuscript + \@mktitle@i + \or % acmsmall + \@mktitle@i + \or % acmlarge + \@mktitle@i + \or % acmtog + \@mktitle@i + \or % sigconf + \@mktitle@iii + \or % siggraph + \@mktitle@iii + \or % sigplan + \@mktitle@iii + \or % sigchi + \@mktitle@iii + \or % sigchi-a + \@mktitle@iv + \fi +} +\def\@titlefont{% + \ifcase\ACM@format@nr + \relax % manuscript + \LARGE\sffamily\bfseries + \or % acmsmall + \LARGE\sffamily\bfseries + \or % acmlarge + \LARGE\sffamily\bfseries + \or % acmtog + \Huge\sffamily + \or % sigconf + \Huge\sffamily\bfseries + \or % siggraph + \Huge\sffamily\bfseries + \or % sigplan + \Huge\bfseries + \or % sigchi + \Huge\sffamily\bfseries + \or % sigchi-a + \Huge\bfseries + \fi} +\def\@subtitlefont{\normalsize + \ifcase\ACM@format@nr + \relax % manuscript + \mdseries + \or % acmsmall + \mdseries + \or % acmlarge + \mdseries + \or % acmtog + \LARGE + \or % sigconf + \LARGE\mdseries + \or % siggraph + \LARGE\mdseries + \or % sigplan + \LARGE\mdseries + \or % sigchi + \LARGE\mdseries + \or % sigchi-a + \mdseries + \fi} +\def\@mktitle@i{\hsize=\textwidth + \@ACM@title@width=\hsize + \ifx\@acmBadgeL@image\@empty\else + \advance\@ACM@title@width by -\@ACM@badge@width + \advance\@ACM@title@width by -\@ACM@badge@skip + \fi + \ifx\@acmBadgeR@image\@empty\else + \advance\@ACM@title@width by -\@ACM@badge@width + \advance\@ACM@title@width by -\@ACM@badge@skip + \fi + \setbox\mktitle@bx=\vbox{\noindent\@titlefont + \ifx\@acmBadgeL@image\@empty\else + \raisebox{-.5\baselineskip}[\z@][\z@]{\href{\@acmBadgeL@url}{% + \includegraphics[width=\@ACM@badge@width]{\@acmBadgeL@image}}}% + \hskip\@ACM@badge@skip + \fi + \parbox[t]{\@ACM@title@width}{\raggedright + \@titlefont\noindent + \@title + \ifx\@subtitle\@empty\else + \par\noindent{\@subtitlefont\@subtitle} + \fi}% + \ifx\@acmBadgeR@image\@empty\else + \hskip\@ACM@badge@skip + \raisebox{-.5\baselineskip}[\z@][\z@]{\href{\@acmBadgeR@url}{% + \includegraphics[width=\@ACM@badge@width]{\@acmBadgeR@image}}}% + \fi + \par\bigskip}}% +\def\@mktitle@iii{\hsize=\textwidth + \setbox\mktitle@bx=\vbox{\@titlefont\centering + \@ACM@title@width=\hsize + \if@ACM@badge + \advance\@ACM@title@width by -2\@ACM@badge@width + \advance\@ACM@title@width by -2\@ACM@badge@skip + \parbox[b]{\@ACM@badge@width}{\strut + \ifx\@acmBadgeL@image\@empty\else + \raisebox{-.5\baselineskip}[\z@][\z@]{\href{\@acmBadgeL@url}{% + \includegraphics[width=\@ACM@badge@width]{\@acmBadgeL@image}}}% + \fi}% + \hskip\@ACM@badge@skip + \fi + \parbox[t]{\@ACM@title@width}{\centering\@titlefont + \@title + \ifx\@subtitle\@empty\else + \par\noindent{\@subtitlefont\@subtitle} + \fi + }% + \if@ACM@badge + \hskip\@ACM@badge@skip + \parbox[b]{\@ACM@badge@width}{\strut + \ifx\@acmBadgeR@image\@empty\else + \raisebox{-.5\baselineskip}[\z@][\z@]{\href{\@acmBadgeR@url}{% + \includegraphics[width=\@ACM@badge@width]{\@acmBadgeR@image}}}% + \fi}% + \fi + \par\bigskip}}% +\def\@mktitle@iv{\hsize=\textwidth + \setbox\mktitle@bx=\vbox{\raggedright\leftskip5pc\@titlefont + \noindent\leavevmode\leaders\hrule height 2pt\hfill\kern0pt\par + \noindent\@title + \ifx\@subtitle\@empty\else + \par\noindent\@subtitlefont\@subtitle + \fi + \par\bigskip}}% +\newbox\@ACM@commabox +\def\@ACM@addtoaddress#1{% + \ifvmode\else + \if@ACM@affiliation@obeypunctuation\else + \setbox\@ACM@commabox=\hbox{, }% + \unskip\cleaders\copy\@ACM@commabox\hskip\wd\@ACM@commabox + \fi\fi + #1} +\def\streetaddress#1{\unskip\ignorespaces} +\def\postcode#1{\unskip\ignorespaces} +\if@ACM@journal + \def\position#1{\unskip\ignorespaces} + \def\institution#1{\unskip~#1\ignorespaces} + \def\city#1{\unskip\ignorespaces} + \def\state#1{\unskip\ignorespaces} + \newcommand\department[2][0]{\unskip\ignorespaces} + \def\country#1{\if@ACM@affiliation@obeypunctuation\else, \fi#1\ignorespaces} +\else + \def\position#1{\if@ACM@affiliation@obeypunctuation#1\else#1\par\fi}% + \def\institution#1{\if@ACM@affiliation@obeypunctuation#1\else#1\par\fi}% + \newcommand\department[2][0]{\if@ACM@affiliation@obeypunctuation + #2\else#2\par\fi}% + \let\city\@ACM@addtoaddress + \let\state\@ACM@addtoaddress + \let\country\@ACM@addtoaddress +\fi +\def\@mkauthors{\begingroup + \hsize=\textwidth + \ifcase\ACM@format@nr + \relax % manuscript + \@mkauthors@i + \or % acmsmall + \@mkauthors@i + \or % acmlarge + \@mkauthors@i + \or % acmtog + \@mkauthors@i + \or % sigconf + \@mkauthors@iii + \or % siggraph + \@mkauthors@iii + \or % sigplan + \@mkauthors@iii + \or % sigchi + \@mkauthors@iii + \or % sigchi-a + \@mkauthors@iv + \fi + \endgroup +} +\def\@authorfont{\Large\sffamily} +\def\@affiliationfont{\normalsize\normalfont} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall + \def\@authorfont{\large\sffamily} + \def\@affiliationfont{\small\normalfont} +\or % acmlarge +\or % acmtog + \def\@authorfont{\LARGE\sffamily} + \def\@affiliationfont{\large} +\or % sigconf + \def\@authorfont{\LARGE} + \def\@affiliationfont{\large} +\or % siggraph + \def\@authorfont{\normalsize\normalfont} + \def\@affiliationfont{\normalsize\normalfont} +\or % sigplan + \def\@authorfont{\Large\normalfont} + \def\@affiliationfont{\normalsize\normalfont} +\or % sigchi + \def\@authorfont{\bfseries} + \def\@affiliationfont{\mdseries} +\or % sigchi-a + \def\@authorfont{\bfseries} + \def\@affiliationfont{\mdseries} +\fi +\def\@typeset@author@line{% + \andify\@currentauthors\par\noindent + \@currentauthors\def\@currentauthors{}% + \ifx\@currentaffiliations\@empty\else + \andify\@currentaffiliations + \unskip, {\@currentaffiliations}\par + \fi + \def\@currentaffiliations{}} +\def\@mkauthors@i{% + \def\@currentauthors{}% + \def\@currentaffiliations{}% + \global\let\and\@typeset@author@line + \def\@author##1{% + \ifx\@currentauthors\@empty + \gdef\@currentauthors{\@authorfont\MakeTextUppercase{##1}}% + \else + \g@addto@macro{\@currentauthors}{\and\MakeTextUppercase{##1}}% + \fi + \gdef\and{}}% + \def\email##1##2{}% + \def\affiliation##1##2{% + \def\@tempa{##2}\ifx\@tempa\@empty\else + \ifx\@currentaffiliations\@empty + \gdef\@currentaffiliations{% + \setkeys{@ACM@affiliation@}{obeypunctuation=false}% + \setkeys{@ACM@affiliation@}{##1}% + \@affiliationfont##2}% + \else + \g@addto@macro{\@currentaffiliations}{\and + \setkeys{@ACM@affiliation@}{obeypunctuation=false}% + \setkeys{@ACM@affiliation@}{##1}##2}% + \fi + \fi + \global\let\and\@typeset@author@line}% + \global\setbox\mktitle@bx=\vbox{\noindent\box\mktitle@bx\par\medskip + \noindent\addresses\@typeset@author@line + \par\medskip}% +} +\newbox\author@bx +\newdimen\author@bx@wd +\newskip\author@bx@sep +\author@bx@sep=1pc\relax +\def\@typeset@author@bx{\bgroup\hsize=\author@bx@wd + \def\and{\par}\normalbaselines + \global\setbox\author@bx=\vtop{\if@ACM@sigchiamode\else\centering\fi + \@authorfont\@currentauthors\par\@affiliationfont + \@currentaffiliation}\egroup + \box\author@bx\hspace{\author@bx@sep}% + \gdef\@currentauthors{}% + \gdef\@currentaffiliation{}} +\def\@mkauthors@iii{% + \author@bx@wd=\textwidth\relax + \advance\author@bx@wd by -\author@bx@sep\relax + \ifnum\@ACM@authorsperrow>0\relax + \divide\author@bx@wd by \@ACM@authorsperrow\relax + \else + \ifcase\num@authorgroups + \relax % 0? + \or % 1=one author per row + \or % 2=two authors per row + \divide\author@bx@wd by \num@authorgroups\relax + \or % 3=three authors per row + \divide\author@bx@wd by \num@authorgroups\relax + \or % 4=two authors per row (!) + \divide\author@bx@wd by 2\relax + \else % three authors per row + \divide\author@bx@wd by 3\relax + \fi + \fi + \advance\author@bx@wd by -\author@bx@sep\relax + \gdef\@currentauthors{}% + \gdef\@currentaffiliation{}% + \def\@author##1{\ifx\@currentauthors\@empty + \gdef\@currentauthors{\par##1}% + \else + \g@addto@macro\@currentauthors{\par##1}% + \fi + \gdef\and{}}% + \def\email##1##2{\ifx\@currentaffiliation\@empty + \gdef\@currentaffiliation{\bgroup + \mathchardef\UrlBreakPenalty=10000\nolinkurl{##2}\egroup}% + \else + \g@addto@macro\@currentaffiliation{\par\bgroup + \mathchardef\UrlBreakPenalty=10000\nolinkurl{##2}\egroup}% + \fi}% + \def\affiliation##1##2{\ifx\@currentaffiliation\@empty + \gdef\@currentaffiliation{% + \setkeys{@ACM@affiliation@}{obeypunctuation=false}% + \setkeys{@ACM@affiliation@}{##1}##2}% + \else + \g@addto@macro\@currentaffiliation{\par + \setkeys{@ACM@affiliation@}{obeypunctuation=false}% + \setkeys{@ACM@affiliation@}{##1}##2}% + \fi + \global\let\and\@typeset@author@bx +}% + \hsize=\textwidth + \global\setbox\mktitle@bx=\vbox{\noindent + \box\mktitle@bx\par\medskip\leavevmode + \lineskip=1pc\relax\centering\hspace*{-1em}% + \addresses\let\and\@typeset@author@bx\and\par\bigskip}} +\def\@mkauthors@iv{% + \author@bx@wd=\columnwidth\relax + \advance\author@bx@wd by -\author@bx@sep\relax + \ifnum\@ACM@authorsperrow>0\relax + \divide\author@bx@wd by \@ACM@authorsperrow\relax + \else + \ifcase\num@authorgroups + \relax % 0? + \or % 1=one author per row + \else % 2=two authors per row + \divide\author@bx@wd by 2\relax + \fi + \fi + \advance\author@bx@wd by -\author@bx@sep\relax + \gdef\@currentauthors{}% + \gdef\@currentaffiliation{}% + \def\@author##1{\ifx\@currentauthors\@empty + \gdef\@currentauthors{\par##1}% + \else + \g@addto@macro\@currentauthors{\par##1}% + \fi + \gdef\and{}}% + \def\email##1##2{\ifx\@currentaffiliation\@empty + \gdef\@currentaffiliation{\nolinkurl{##2}}% + \else + \g@addto@macro\@currentaffiliation{\par\nolinkurl{##2}}% + \fi}% + \def\affiliation##1##2{\ifx\@currentaffiliation\@empty + \gdef\@currentaffiliation{% + \setkeys{@ACM@affiliation@}{obeypunctuation=false}% + \setkeys{@ACM@affiliation@}{##1}##2}% + \else + \g@addto@macro\@currentaffiliation{\par + \setkeys{@ACM@affiliation@}{obeypunctuation=false}% + \setkeys{@ACM@affiliation@}{##1}##2}% + \fi + \global\let\and\@typeset@author@bx}% + \bgroup\hsize=\columnwidth + \par\raggedright\leftskip=\z@ + \lineskip=1pc\noindent + \addresses\let\and\@typeset@author@bx\and\par\bigskip\egroup} +\def\@mkauthorsaddresses{% + \ifnum\num@authors>1\relax + Authors' \else Author's \fi + \ifnum\num@authorgroups>1\relax + addresses: \else address: \fi + \bgroup + \def\streetaddress##1{\unskip\@addpunct, ##1}% + \def\postcode##1{\unskip\@addpunct, ##1}% + \def\position##1{\unskip\ignorespaces}% + \def\institution##1{\unskip\@addpunct, ##1}% + \def\city##1{\unskip\@addpunct, ##1}% + \def\state##1{\unskip\@addpunct, ##1}% + \renewcommand\department[2][0]{\unskip\@addpunct, ##2}% + \def\country##1{\unskip\@addpunct, ##1}% + \def\and{\unskip\@addpunct; }% + \def\@author##1{##1}% + \def\email##1##2{\unskip\@addpunct, \nolinkurl{##2}}% + \addresses + \egroup} +\def\@setaddresses{} +\def\@authornotemark{\g@addto@macro\@currentauthors{\footnotemark\relax}} +\def\@@authornotemark#1{\g@addto@macro\@currentauthors{\footnotemark[#1]}} +\def\@mkteasers{% + \ifx\@teaserfigures\@empty\else + \def\@teaser##1{\par\bigskip\bgroup + \captionsetup{type=figure}##1\egroup\par} + \global\setbox\mktitle@bx=\vbox{\noindent\box\mktitle@bx\par + \noindent\@Description@presentfalse + \@teaserfigures\par\if@Description@present\else + \global\@undescribed@imagestrue + \ClassWarning{\@classname}{A possible image without + description}\fi + \medskip}% + \fi} +\def\@mkabstract{\bgroup + \ifx\@abstract\@lempty\else + {\phantomsection\addcontentsline{toc}{section}{Abstract}% + \if@ACM@journal + \everypar{\setbox\z@\lastbox\everypar{}}\small + \else + \section*{\abstractname}% + \fi + \ignorespaces\@abstract\par}% + \fi\egroup} +\def\@mkbibcitation{\bgroup + \let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig + \def\@pages@word{\ifnum\getrefnumber{TotPages}=1\relax page\else pages\fi}% + \def\footnotemark{}% + \def\\{\unskip{} \ignorespaces}% + \def\footnote{\ClassError{\@classname}{Please do not use footnotes + inside a \string\title{} or \string\author{} command! Use + \string\titlenote{} or \string\authornote{} instead!}}% + \def\@article@string{\ifx\@acmArticle\@empty{\ }\else, + Article~\@acmArticle\ \fi}% + \par\medskip\small\noindent{\bfseries ACM Reference Format:}\par\nobreak + \noindent\bgroup + \def\\{\unskip{}, \ignorespaces}\authors\egroup. \@acmYear. \@title + \ifx\@subtitle\@empty. \else: \@subtitle. \fi + \if@ACM@nonacm\else + % The 'nonacm' option disables 'printacmref' by default, + % and the present \@mkbibcitation definition is never used + % in this case. The conditional remains useful if the user + % explicitly sets \settopmatter{printacmref=true}. + \if@ACM@journal@bibstrip + \textit{\@journalNameShort} + \@acmVolume, \@acmNumber \@article@string (\@acmPubDate), + \ref{TotPages}~\@pages@word. + \else + In \textit{\@acmBooktitle}% + \ifx\@acmEditors\@empty\textit{.}\else + \andify\@acmEditors\textit{, }\@acmEditors~\@editorsAbbrev.% + \fi\ + ACM, New York, NY, USA% + \@article@string\unskip, \ref{TotPages}~\@pages@word. + \fi + \fi + \ifx\@acmDOI\@empty\else\@formatdoi{\@acmDOI}\fi +\par\egroup} +\def\@printendtopmatter{\bgroup + \let\@vspace\@vspace@orig + \let\@vspacer\@vspacer@orig + \par\bigskip + \egroup} +\def\@setthanks{\long\def\thanks##1{\par##1\@addpunct.}\thankses} +\def\@setauthorsaddresses{\@authorsaddresses\unskip\@addpunct.} +\RequirePackage{fancyhdr} +\let\ACM@ps@plain\ps@plain +\let\ACM@ps@myheadings\ps@myheadings +\let\ACM@ps@headings\ps@headings +\def\ACM@restore@pagestyle{% + \let\ps@plain\ACM@ps@plain + \let\ps@myheadings\ACM@ps@myheadings + \let\ps@headings\ACM@ps@headings} +\AtBeginDocument{\ACM@restore@pagestyle} +\if@ACM@review + \newsavebox{\ACM@linecount@bx} + \newlength\ACM@linecount@bxht + \newcount\ACM@linecount + \ACM@linecount\@ne\relax + \def\ACM@mk@linecount{% + \savebox{\ACM@linecount@bx}[4em][t]{\parbox[t]{4em}{% + \setlength{\ACM@linecount@bxht}{0pt}% + \loop{\color{red}\scriptsize\the\ACM@linecount}\\ + \global\advance\ACM@linecount by \@ne + \addtolength{\ACM@linecount@bxht}{\baselineskip}% + \ifdim\ACM@linecount@bxht<\textheight\repeat + {\color{red}\scriptsize\the\ACM@linecount}\hfill + \global\advance\ACM@linecount by \@ne}}} +\fi +\def\ACM@linecountL{% + \if@ACM@review + \ACM@mk@linecount + \begin{picture}(0,0)% + \put(-26,-22){\usebox{\ACM@linecount@bx}}% + \end{picture}% + \fi} +\def\ACM@linecountR{% + \if@ACM@review + \ACM@mk@linecount + \begin{picture}(0,0)% + \put(20,-22){\usebox{\ACM@linecount@bx}}% + \end{picture}% + \fi} +\if@ACM@timestamp + % Subtracting 30 from \time gives us the effect of rounding down despite + % \numexpr rounding to nearest + \newcounter{ACM@time@hours} + \setcounter{ACM@time@hours}{\numexpr (\time - 30) / 60 \relax} + \newcounter{ACM@time@minutes} + \setcounter{ACM@time@minutes}{\numexpr \time - \theACM@time@hours * 60 \relax} + \newcommand\ACM@timestamp{% + \footnotesize% + \ifx\@acmSubmissionID\@empty\relax\else + Submission ID: \(a)acmSubmissionID.{ }% + \fi + \the\year-\two@digits{\the\month}-\two@digits{\the\day}{ }% + \two@digits{\theACM@time@hours}:\two@digits{\theACM@time@minutes}{. }% + Page \thepage\ of \(a)startPage--\pageref*{TotPages}.% + } +\fi +\def\@shortauthors{% + \if@ACM@anonymous + Anon. + \ifx\@acmSubmissionID\@empty\else Submission Id: \@acmSubmissionID\fi + \else\shortauthors\fi} +\def\@headfootfont{\sffamily\footnotesize} +\AtBeginDocument{% +\fancypagestyle{standardpagestyle}{% + \fancyhf{}% + \renewcommand{\headrulewidth}{\z@}% + \renewcommand{\footrulewidth}{\z@}% + \def\@acmArticlePage{% + \ifx\@acmArticle\empty% + \if@ACM@printfolios\thepage\fi% + \else% + \@acmArticle\if@ACM@printfolios:\thepage\fi% + \fi% + }% + \if@ACM@journal@bibstrip + \ifcase\ACM@format@nr + \relax % manuscript + \fancyhead[LE]{\ACM@linecountL\if@ACM@printfolios\thepage\fi}% + \fancyhead[RO]{\if@ACM@printfolios\thepage\fi}% + \fancyhead[RE]{\@shortauthors}% + \fancyhead[LO]{\ACM@linecountL\shorttitle}% + \if@ACM@nonacm\else% + \fancyfoot[RO,LE]{\footnotesize Manuscript submitted to ACM} + \fi% + \or % acmsmall + \fancyhead[LE]{\ACM@linecountL\@headfootfont\@acmArticlePage}% + \fancyhead[RO]{\@headfootfont\@acmArticlePage}% + \fancyhead[RE]{\@headfootfont\@shortauthors}% + \fancyhead[LO]{\ACM@linecountL\@headfootfont\shorttitle}% + \if@ACM@nonacm\else% + \fancyfoot[RO,LE]{\footnotesize \@journalNameShort, Vol. \@acmVolume, No. + \@acmNumber, Article \@acmArticle. Publication date: \(a)acmPubDate.}% + \fi + \or % acmlarge + \fancyhead[LE]{\ACM@linecountL\@headfootfont + \@acmArticlePage\quad\textbullet\quad\@shortauthors}% + \fancyhead[LO]{\ACM@linecountL}% + \fancyhead[RO]{\@headfootfont + \shorttitle\quad\textbullet\quad\@acmArticlePage}% + \if@ACM@nonacm\else% + \fancyfoot[RO,LE]{\footnotesize \@journalNameShort, Vol. \@acmVolume, No. + \@acmNumber, Article \@acmArticle. Publication date: \(a)acmPubDate.}% + \fi + \or % acmtog + \fancyhead[LE]{\ACM@linecountL\@headfootfont + \@acmArticlePage\quad\textbullet\quad\@shortauthors}% + \fancyhead[LO]{\ACM@linecountL}% + \fancyhead[RE]{\ACM@linecountR}% + \fancyhead[RO]{\@headfootfont + \shorttitle\quad\textbullet\quad\@acmArticlePage\ACM@linecountR}% + \if@ACM@nonacm\else% + \fancyfoot[RO,LE]{\footnotesize \@journalNameShort, Vol. \@acmVolume, No. + \@acmNumber, Article \@acmArticle. Publication date: \(a)acmPubDate.}% + \fi + \else % Proceedings + \fancyfoot[C]{\if@ACM@printfolios\footnotesize\thepage\fi}% + \fancyhead[LO]{\ACM@linecountL\@headfootfont\shorttitle}% + \fancyhead[RE]{\@headfootfont\@shortauthors\ACM@linecountR}% + \if@ACM@nonacm\else% + \fancyhead[LE]{\ACM@linecountL\@headfootfont\footnotesize + \acmConference@shortname, + \acmConference@date, \acmConference@venue}% + \fancyhead[RO]{\@headfootfont + \acmConference@shortname, + \acmConference@date, \acmConference@venue\ACM@linecountR}% + \fi + \fi + \else % Proceedings + \fancyfoot[C]{\if@ACM@printfolios\footnotesize\thepage\fi}% + \fancyhead[LO]{\ACM@linecountL\@headfootfont\shorttitle}% + \fancyhead[RE]{\@headfootfont\@shortauthors\ACM@linecountR}% + \if@ACM@nonacm\else% + \fancyhead[LE]{\ACM@linecountL\@headfootfont + \acmConference@shortname, + \acmConference@date, \acmConference@venue}% + \fancyhead[RO]{\@headfootfont + \acmConference@shortname, + \acmConference@date, \acmConference@venue\ACM@linecountR}% + \fi + \fi + \if@ACM@sigchiamode + \fancyheadoffset[L]{\dimexpr(\marginparsep+\marginparwidth)}% + \fi + \if@ACM@timestamp + \fancyfoot[LO,RE]{\ACM@timestamp} + \fi +}% +\pagestyle{standardpagestyle} +} +\newdimen\@folio@wd +\@folio@wd=\z@ +\newdimen\@folio@ht +\@folio@ht=\z@ +\newdimen\@folio@voffset +\@folio@voffset=\z@ +\def\@folio@max{1} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall + \@folio@wd=45.75pt\relax + \@folio@ht=1.25in\relax + \@folio@voffset=.2in\relax + \def\@folio@max{8} +\or % acmlarge + \@folio@wd=43.25pt\relax + \@folio@ht=79pt\relax + \@folio@voffset=.55in\relax + \def\@folio@max{10} +\fi +\def\@folioblob{\@tempcnta=0\@acmArticleSeq\relax + \ifnum\@tempcnta=0\relax\else + \loop + \ifnum\@tempcnta>\@folio@max\relax + \advance\@tempcnta by - \@folio@max + \repeat + \advance\@tempcnta by -1\relax + \@tempdima=\@folio@ht\relax + \multiply\@tempdima by \the\@tempcnta\relax + \advance\@tempdima by -\@folio@voffset\relax + \begin{picture}(0,0) + \makebox[\z@]{\raisebox{-\@tempdima}{% + \rlap{% + \raisebox{-0.45\@folio@ht}[\z@][\z@]{% + \rule{\@folio@wd}{\@folio@ht}}}% + \parbox{\@folio@wd}{% + \centering + \textcolor{white}{\LARGE\sffamily\bfseries\@acmArticle}}}} + \end{picture}\fi} + +\AtBeginDocument{% +\fancypagestyle{firstpagestyle}{% + \fancyhf{}% + \renewcommand{\headrulewidth}{\z@}% + \renewcommand{\footrulewidth}{\z@}% + \if@ACM@journal@bibstrip + \ifcase\ACM@format@nr + \relax % manuscript + \fancyhead[L]{\ACM@linecountL}% + \fancyfoot[RO,LE]{\if@ACM@printfolios\small\thepage\fi}% + \if@ACM@nonacm\else% + \fancyfoot[RE,LO]{\footnotesize Manuscript submitted to ACM}% + \fi% + \or % acmsmall + \if@ACM@nonacm\else% + \fancyfoot[RO,LE]{\footnotesize \@journalNameShort, Vol. \@acmVolume, No. + \@acmNumber, Article \@acmArticle. Publication date: + \(a)acmPubDate.}% + \fi% + \fancyhead[LE]{\ACM@linecountL\@folioblob}% + \fancyhead[LO]{\ACM@linecountL}% + \fancyhead[RO]{\@folioblob}% + \fancyheadoffset[RO,LE]{0.6\@folio@wd}% + \or % acmlarge + \if@ACM@nonacm\else% + \fancyfoot[RO,LE]{\footnotesize \@journalNameShort, Vol. \@acmVolume, No. + \@acmNumber, Article \@acmArticle. Publication date: + \(a)acmPubDate.}% + \fi% + \fancyhead[RO]{\@folioblob}% + \fancyhead[LE]{\ACM@linecountL\@folioblob}% + \fancyhead[LO]{\ACM@linecountL}% + \fancyheadoffset[RO,LE]{1.4\@folio@wd}% + \or % acmtog + \if@ACM@nonacm\else% + \fancyfoot[RO,LE]{\footnotesize \@journalNameShort, Vol. \@acmVolume, No. + \@acmNumber, Article \@acmArticle. Publication date: + \(a)acmPubDate.}% + \fi% + \fancyhead[L]{\ACM@linecountL}% + \fancyhead[R]{\ACM@linecountR}% + \else % Conference proceedings + \fancyhead[L]{\ACM@linecountL}% + \fancyhead[R]{\ACM@linecountR}% + \fancyfoot[C]{\if@ACM@printfolios\footnotesize\thepage\fi}% + \fi + \else + \fancyhead[L]{\ACM@linecountL}% + \fancyhead[R]{\ACM@linecountR}% + \fancyfoot[C]{\if@ACM@printfolios\footnotesize\thepage\fi}% + \fi + \if@ACM@timestamp + \ifnum\ACM@format@nr=0\relax % Manuscript + \fancyfoot[LO,RE]{\ACM@timestamp\quad + \if@ACM@nonacm\else + \footnotesize Manuscript submitted to ACM + \fi} + \else + \fancyfoot[LO,RE]{\ACM@timestamp} + \fi + \fi +}} +\def\ACM@NRadjust#1{% + \begingroup + \expandafter\ifx\csname Sectionformat\endcsname\relax + % do nothing when \Sectionformat is unknown + \def\next{\endgroup #1}% + \else + \def\next{\endgroup + \let\realSectionformat\Sectionformat + \def\ACM@sect@format@{#1}% + \let\Sectionformat\ACM@NR@adjustedSectionformat + %% next lines added 2018-06-17 to ensure section number is styled + \let\real@adddotafter\@adddotafter + \let\@adddotafter\ACM@adddotafter + #1{}% imposes the styles, but nullifies \MakeUppercase + \let\@adddotafter\real@adddotafter + }% + \fi \next +} +\def\ACM@NR@adjustedSectionformat#1#2{% + \realSectionformat{\ACM@sect@format{#1}}{#2}% + \let\Sectionformat\realSectionformat} +\DeclareRobustCommand{\ACM@sect@format}{\ACM@sect@format@} +\def\ACM@sect@format@null#1{#1} +\let\ACM@sect@format@\ACM@sect@format@null +\AtBeginDocument{% + \expandafter\ifx\csname LTX@adddotafter\endcsname\relax + \let\LTX@adddotafter\@adddotafter + \fi +} +\def\ACM@adddotafter#1{\ifx\relax#1\relax\else\LTX@adddotafter{#1}\fi} +\renewcommand\section{\@startsection{section}{1}{\z@}% + {-.75\baselineskip \@plus -2\p@ \@minus -.2\p@}% + {.25\baselineskip}% + {\ACM@NRadjust\@secfont}} +\renewcommand\subsection{\@startsection{subsection}{2}{\z@}% + {-.75\baselineskip \@plus -2\p@ \@minus -.2\p@}% + {.25\baselineskip}% + {\ACM@NRadjust\@subsecfont}} +\renewcommand\subsubsection{\@startsection{subsubsection}{3}{\z@}% + {-.5\baselineskip \@plus -2\p@ \@minus -.2\p@}% + {-3.5\p@}% + {\ACM@NRadjust{\@subsubsecfont\@adddotafter}}} +\renewcommand\paragraph{\@startsection{paragraph}{4}{\parindent}% + {-.5\baselineskip \@plus -2\p@ \@minus -.2\p@}% + {-3.5\p@}% + {\ACM@NRadjust{\@parfont\@adddotafter}}} +\renewcommand\part{\@startsection{part}{9}{\z@}% + {-10\p@ \@plus -4\p@ \@minus -2\p@}% + {4\p@}% + {\ACM@NRadjust\@parfont}} +\def\section@raggedright{\@rightskip\@flushglue + \rightskip\@rightskip + \leftskip\z@skip + \parindent\z@} +\def\@secfont{\sffamily\bfseries\section@raggedright\MakeTextUppercase} +\def\@subsecfont{\sffamily\bfseries\section@raggedright} +\def\@subsubsecfont{\sffamily\itshape} +\def\@parfont{\itshape} +\setcounter{secnumdepth}{3} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall +\or % acmlarge + \def\@secfont{\sffamily\large\section@raggedright\MakeTextUppercase} + \def\@subsecfont{\sffamily\large\section@raggedright} +\or % acmtog + \def\@secfont{\sffamily\large\section@raggedright\MakeTextUppercase} + \def\@subsecfont{\sffamily\large\section@raggedright} +\or % sigconf + \def\@secfont{\bfseries\Large\section@raggedright\MakeTextUppercase} + \def\@subsecfont{\bfseries\Large\section@raggedright} +\or % siggraph + \def\@secfont{\sffamily\bfseries\Large\section@raggedright\MakeTextUppercase} + \def\@subsecfont{\sffamily\bfseries\Large\section@raggedright} +\or % sigplan + \def\@secfont{\bfseries\Large\section@raggedright} + \def\@subsecfont{\bfseries\section@raggedright} + \renewcommand\subsubsection{\@startsection{subsubsection}{3}{\z@}% + {-.75\baselineskip \@plus -2\p@ \@minus -.2\p@}% + {.25\baselineskip}% + {\@subsubsecfont}} + \def\@subsubsecfont{\bfseries\section@raggedright} + \renewcommand\paragraph{\@startsection{paragraph}{4}{\z@}% + {-.5\baselineskip \@plus -2\p@ \@minus -.2\p@}% + {-3.5\p@}% + {\@parfont\@addspaceafter}} + \def\@parfont{\bfseries\itshape} + \renewcommand\subparagraph{\@startsection{subparagraph}{5}{\z@}% + {-.5\baselineskip \@plus -2\p@ \@minus -.2\p@}% + {-3.5\p@}% + {\@subparfont\@addspaceafter}} + \def\@subparfont{\itshape} +\or % sigchi + \setcounter{secnumdepth}{1} + \def\@secfont{\sffamily\bfseries\section@raggedright\MakeTextUppercase} + \def\@subsecfont{\sffamily\bfseries\section@raggedright} +\or % sigchi-a + \setcounter{secnumdepth}{0} + \def\@secfont{\sffamily\bfseries\section@raggedright\MakeTextUppercase} + \def\@subsecfont{\sffamily\bfseries\section@raggedright} +\fi +\def\@adddotafter#1{#1\@addpunct{.}} +\def\@addspaceafter#1{#1\@addpunct{\enspace}} +\providecommand*\(a)dotsep{4.5} +\def\@acmplainbodyfont{\itshape} +\def\@acmplainindent{\parindent} +\def\@acmplainheadfont{\scshape} +\def\@acmplainnotefont{\@empty} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall +\or % acmlarge +\or % acmtog +\or % sigconf +\or % siggraph +\or % sigplan + \def\@acmplainbodyfont{\itshape} + \def\@acmplainindent{\z@} + \def\@acmplainheadfont{\bfseries} + \def\@acmplainnotefont{\normalfont} +\or % sigchi +\or % sigchi-a +\fi +\newtheoremstyle{acmplain}% + {.5\baselineskip\(a)plus.2\baselineskip + \(a)minus.2\baselineskip}% space above + {.5\baselineskip\(a)plus.2\baselineskip + \(a)minus.2\baselineskip}% space below + {\@acmplainbodyfont}% body font + {\@acmplainindent}% indent amount + {\@acmplainheadfont}% head font + {.}% punctuation after head + {.5em}% spacing after head + {\thmname{#1}\thmnumber{ #2}\thmnote{ {\@acmplainnotefont(#3)}}}% head spec +\def\@acmdefinitionbodyfont{\normalfont} +\def\@acmdefinitionindent{\parindent} +\def\@acmdefinitionheadfont{\itshape} +\def\@acmdefinitionnotefont{\@empty} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall +\or % acmlarge +\or % acmtog +\or % sigconf +\or % siggraph +\or % sigplan + \def\@acmdefinitionbodyfont{\normalfont} + \def\@acmdefinitionindent{\z@} + \def\@acmdefinitionheadfont{\bfseries} + \def\@acmdefinitionnotefont{\normalfont} +\or % sigchi +\or % sigchi-a +\fi +\newtheoremstyle{acmdefinition}% + {.5\baselineskip\(a)plus.2\baselineskip + \(a)minus.2\baselineskip}% space above + {.5\baselineskip\(a)plus.2\baselineskip + \(a)minus.2\baselineskip}% space below + {\@acmdefinitionbodyfont}% body font + {\@acmdefinitionindent}% indent amount + {\@acmdefinitionheadfont}% head font + {.}% punctuation after head + {.5em}% spacing after head + {\thmname{#1}\thmnumber{ #2}\thmnote{ {\@acmdefinitionnotefont(#3)}}}% head spec +\theoremstyle{acmplain} +\AtEndPreamble{% + \if@ACM@acmthm + \theoremstyle{acmplain} + \@ifundefined{theorem}{% + \newtheorem{theorem}{Theorem}[section] + }{} + \@ifundefined{conjecture}{% + \newtheorem{conjecture}[theorem]{Conjecture} + }{} + \@ifundefined{proposition}{% + \newtheorem{proposition}[theorem]{Proposition} + }{} + \@ifundefined{lemma}{% + \newtheorem{lemma}[theorem]{Lemma} + }{} + \@ifundefined{corollary}{% + \newtheorem{corollary}[theorem]{Corollary} + }{} + \theoremstyle{acmdefinition} + \@ifundefined{example}{% + \newtheorem{example}[theorem]{Example} + }{} + \@ifundefined{definition}{% + \newtheorem{definition}[theorem]{Definition} + }{} + \fi + \theoremstyle{acmplain} +} +\def\@proofnamefont{\scshape} +\def\@proofindent{\indent} +\ifcase\ACM@format@nr +\relax % manuscript +\or % acmsmall +\or % acmlarge +\or % acmtog +\or % sigconf +\or % siggraph +\or % sigplan + \def\@proofnamefont{\itshape} + \def\@proofindent{\noindent} +\or % sigchi +\or % sigchi-a +\fi +\renewenvironment{proof}[1][\proofname]{\par + \pushQED{\qed}% + \normalfont \topsep6\p@\@plus6\p@\relax + \trivlist + \item[\@proofindent\hskip\labelsep + {\@proofnamefont #1\(a)addpunct{.}}]\ignorespaces +}{% + \popQED\endtrivlist\@endpefalse +} +\AtEndPreamble{% + \if@ACM@balance + \ifcase\ACM@format@nr + \relax % manuscript + \global\@ACM@balancefalse + \or % acmsmall + \global\@ACM@balancefalse + \or % acmlarge + \global\@ACM@balancefalse + \or % acmtog + \RequirePackage{balance}% + \or % sigconf + \RequirePackage{balance}% + \or % siggraph + \RequirePackage{balance}% + \or % sigplan + \RequirePackage{balance}% + \or % sigchi + \RequirePackage{balance}% + \or % sigchi-a + \global\@ACM@balancefalse + \fi + \fi +} +\AtEndDocument{% + \if@ACM@balance + \if@twocolumn + \balance + \fi\fi} +\newcommand\acksname{Acknowledgments} +\specialcomment{acks}{% + \begingroup + \section*{\acksname} + \phantomsection\addcontentsline{toc}{section}{\acksname} +}{% + \endgroup +} +\def\grantsponsor#1#2#3{#2} +\newcommand\grantnum[3][]{#3% + \def\@tempa{#1}\ifx\@tempa\@empty\else\space(\url{#1})\fi} +\AtEndPreamble{% +\if@ACM@screen + \includecomment{screenonly} + \excludecomment{printonly} +\else + \excludecomment{screenonly} + \includecomment{printonly} +\fi +\if@ACM@anonymous + \excludecomment{anonsuppress} + \excludecomment{acks} +\else + \includecomment{anonsuppress} +\fi} +\newcommand\showeprint[2][arxiv]{% + \def\@tempa{#1}% + \ifx\@tempa\@empty\def\@tempa{arxiv}\fi + \def\@tempb{arxiv}% + \ifx\@tempa\@tempb + arXiv:\href{http://arxiv.org/abs/#2}{#2}\else arXiv:#2% + \fi} +\let\@vspace@orig=\@vspace +\let\@vspacer@orig=\@vspacer +\apptocmd{\@vspace}{\ClassWarning{\@classname}{\string\vspace\space should + only be used to provide space above/below surrounding + objects}}{}{} +\apptocmd{\@vspacer}{\ClassWarning{\@classname}{\string\vspace\space should + only be used to provide space above/below surrounding + objects}}{}{} +\let\ACM@origbaselinestretch\baselinestretch +\AtEndDocument{\ifx\baselinestretch\ACM@origbaselinestretch\else + \ClassError{\@classname}{An attempt to redefine + \string\baselinestretch\space detected. Please do not do this for + ACM submissions!}\fi} +\normalsize\normalfont\frenchspacing +\endinput +%% +%% End of file `acmart.cls'. ===================================== paper.tex ===================================== The diff for this file was not included because it is too large. ===================================== refs.bib ===================================== @@ -1,12 +1,12 @@ -@techreport{Monnier19a, +@inproceedings{Monnier19, author = {Stefan Monnier}, + booktitle = {Journées Francophones des Langages Applicatifs}, institution = {Université de Montréal - DIRO}, + pages = {193-208}, title = {Typer: {ML} boosted with type theory and {S}cheme}, year = {2019}, - url = {https://www.iro.umontreal.ca/\~{}monnier/typer-overview- - 2019.pdf}, } @misc{Coq00, @@ -18,32 +18,12 @@ year = {2000}, } -@inproceedings{Bove09, - author = {Ana Bove and Peter Dybjer and Ulf Norell}, - booktitle = {International Conference on Theorem Proving in - Higher-Order Logics}, - key = {TPHOLs09}, - month = aug, - pages = {73-78}, - series = {Lecture Notes in Computer Science}, - title = {A Brief Overview of {A}gda – A Functional Language - with Dependent Types}, - volume = {5674}, - year = {2009}, - abstract = {We give an overview of Agda, the latest in a series - of dependently typed programming languages developed - in Gothenburg. Agda is based on Martin-Löf’s - intuitionistic type theory but extends it with - numerous programming language features. It supports a - wide range of inductive data types, including - inductive families and inductive-recursive types, - with associated flexible pattern-matching. Unlike - other proof assistants, Agda is not tactic-based. - Instead it has an Emacs-based interface which allows - programming by gradual refinement of incomplete - type-correct terms.}, - url = {http://www.cse.chalmers.se/\~{}ulfn/papers/tphols09/ - tutorial.pdf}, +@phdthesis{Norell07, + author = {Ulf Norell}, + school = {Chalmers university}, + title = {Towards a Practical Programming Language Based on + Dependent Type Theory}, + year = {2007}, } @article{Brady13, @@ -74,7 +54,6 @@ Furthermore, I show how this method facilitates the implementation of new high-level language constructs.}, - url = {https://eb.host.cs.st-andrews.ac.uk/drafts/impldtp.pdf}, } @inproceedings{Swamy16, @@ -132,7 +111,6 @@ combination of SMT automation and constructive proofs, enabling a tactic-free style of programming and proving at a relatively large scale.}, - url = {https://dl.acm.org/citation.cfm?id=2837655}, } @inproceedings{Casinghino14, @@ -165,7 +143,6 @@ programmers to work with total and partial functions uniformly, providing a smooth path from functional programming to dependently-typed programming.}, - url = {https://dl.acm.org/citation.cfm?id=2535883}, } @inproceedings{Paulin93, @@ -180,8 +157,6 @@ title = {Inductive definitions in the system {Coq}---rules and properties}, year = {1993}, - url = {ftp://ftp.ens-lyon.fr/pub/LIP/Rapports/RR/RR1992/RR1992- - 49.ps.Z}, } @techreport{Gimenez94, @@ -211,8 +186,6 @@ different reduction rules from the ones used in [5] in order to obtain a decidable conversion relation for the system.}, - url = {ftp://ftp.ens-lyon.fr/pub/LIP/Rapports/RR/RR1995/RR1995- - 07.ps.Z}, } @book{Milner97, @@ -297,7 +270,6 @@ systems. In that way the well-known propositions-as-types interpretation obtains a nice canonical form.}, - url = {http://www.jeremyherve.net/bar91.pdf}, } @inproceedings{Luo89, @@ -309,6 +281,29 @@ year = {1989}, } +@inproceedings{Sulzmann07, + address = {Nice, France}, + author = {Martin Sulzmann and Manuel M. T. Chakravarty and + Simon {Peyton Jones} and Kevin Donnelly}, + booktitle = {Types in Language Design and Implementation}, + key = {{TLDI}'07}, + month = jan, + pages = {53-66}, + title = {System F with Type Equality Coercions}, + year = {2007}, + abstract = {We introduce System F_C , which extends System F with + support for non-syntactic type equality. There are + two main extensions: (i) explicit witnesses for type + equalities, and (ii) open, non-parametric type + functions, given meaning by top-level equality + axioms. Unlike System F, F_C is expressive enough to + serve as a target for several different + source-language features, including Haskell's + newtype, generalised algebraic data types, associated + types, functional dependencies, and perhaps more + besides.}, +} + @inproceedings{Coquand92, author = {Thierry Coquand}, booktitle = {Workshop on Types for Proofs and Programs}, @@ -317,6 +312,132 @@ year = {1992}, } +@inproceedings{Miquel01, + author = {Alexandre Miquel}, + booktitle = {International conference on Typed Lambda Calculi and + Applications}, + key = {TLCA'01}, + pages = {344-359}, + title = {The implicit calculus of constructions: extending + pure type systems with an intersection type binder + and subtyping}, + year = {2001}, + abstract = {In this paper, we introduce a new type system, the + Implicit Calculus of Constructions, which is a + Curry-style variant of the Calculus of Constructions + that we extend by adding an intersection type + binder-called the implicit dependent product. Unlike + the usual approach of Type Assignment Systems, the + implicit product can be used at every place in the + universe hierarchy. We study syntactical properties + of this calculus such as the βη-subject reduction + property, and we show that the implicit product + induces a rich subtyping relation over the type + system in a natural way. We also illustrate the + specificities of this calculus by revisiting the + impredicative encodings of the Calculus of + Constructions, and we show that their translation + into the implicit calculus helps to reflect the + computational meaning of the underlying terms in a + more accurate way.}, +} + +@inproceedings{Barras08, + address = {Budapest, Hungary}, + author = {Bruno Barras and Bruno Bernardo}, + booktitle = {Conference on Foundations of Software Science and + Computation Structures}, + month = apr, + series = {Lecture Notes in Computer Science}, + title = {Implicit Calculus of Constructions as a Programming + Language with Dependent Types}, + volume = {4962}, + year = {2008}, + abstract = {In this paper, we show how Miquel’s Implicit + Calculus of Constructions (ICC) can be used as a + programming language featuring dependent types. Since + this system has an undecidable type-checking, we + introduce a more verbose variant, called ICC∗ which + fixes this issue. Datatypes and program + specifications are enriched with logical assertions + (such as preconditions, postconditions, invariants) + and programs are decorated with proofs of those + assertions. The point of using ICC∗ rather than the + Calculus of Constructions (the core formalism of the + Coq proof assistant) is that all of the static + information (types and proof objects) is transparent, + in the sense that it does not affect the + computational behavior. This is concretized by a + built-in extraction procedure that removes this + static information. We also illustrate the main + features of ICC∗ on classical examples of + dependently typed programs.}, +} + +@inproceedings{MishraLinger08, + address = {Budapest, Hungary}, + author = {Nathan Mishra-Linger and Tim Sheard}, + booktitle = {Conference on Foundations of Software Science and + Computation Structures}, + month = apr, + pages = {350-364}, + series = {Lecture Notes in Computer Science}, + title = {Erasure and Polymorphism in Pure Type Systems}, + volume = {4962}, + year = {2008}, + abstract = {We introduce Erasure Pure Type Systems, an extension + to Pure Type Systems with an erasure semantics + centered around a type constructor indicating + parametric polymorphism. The erasure phase is guided + by lightweight program annotations. The typing rules + guarantee that well-typed programs obey a phase + distinction between erasable (compile-time) and + non-erasable (run-time) terms. The erasability of an + expression depends only on how its value is used in + the rest of the program. Despite this simple + observation, most languages treat erasability as an + intrinsic property of expressions, leading to code + duplication problems. Our approach overcomes this + deficiency by treating erasability extrinsically. + Because the execution model of EPTS generalizes the + familiar notions of type erasure and parametric + polymorphism, we believe functional programmers will + find it quite natural to program in such a setting.}, +} + +@inproceedings{Castagna16, + author = {Giuseppe Castagna and Tommaso Petrucciani and + Kim Nguyên}, + booktitle = {International Conference on Functional Programming}, + key = {ICFP'16}, + month = sep, + pages = {378-391}, + title = {Set-theoretic types for polymorphic variants}, + year = {2016}, + abstract = {Polymorphic variants are a useful feature of the + OCaml language whose current definition and + implementation rely on kinding constraints to + simulate a subtyping relation via unification. This + yields an awkward formalization and results in a type + system whose behaviour is in some cases unintuitive + and/or unduly restrictive. In this work, we present + an alternative formalization of polymorphic variants, + based on set-theoretic types and subtyping, that + yields a cleaner and more streamlined system. Our + formalization is more expressive than the current one + (it types more programs while preserving type + safety), it can internalize some meta-theoretic + properties, and it removes some pathological cases of + the current implementation resulting in a more + intuitive and, thus, predictable type system. More + generally, this work shows how to add full-fledged + union types to functional languages of the ML family + that usually rely on the Hindley-Milner type system. + As an aside, our system also improves the theory of + semantic subtyping, notably by proving completeness + for the type reconstruction algorithm.}, +} + @inproceedings{Blume06, address = {Portland, Oregon}, author = {Matthias Blume and Umut A. Acar and Wonseok Chae}, @@ -353,47 +474,57 @@ (currently for PowerPC) and optimizes the representation of sums by eliminating closures generated by the dual construction.}, - url = {https://dl.acm.org/citation.cfm?id=1159836}, } -@inproceedings{Castagna16, - author = {Giuseppe Castagna and Tommaso Petrucciani and - Kim Nguyên}, - booktitle = {International Conference on Functional Programming}, - key = {ICFP'16}, +@inproceedings{Monnier07, + address = {Freiburg, Germany}, + author = {Stefan Monnier}, + booktitle = {Programming Languages meets Program Verification}, + key = {PLPV'07}, month = sep, - pages = {378-391}, - title = {Set-theoretic types for polymorphic variants}, - year = {2016}, - abstract = {Polymorphic variants are a useful feature of the - OCaml language whose current definition and - implementation rely on kinding constraints to - simulate a subtyping relation via unification. This - yields an awkward formalization and results in a type - system whose behaviour is in some cases unintuitive - and/or unduly restrictive. In this work, we present - an alternative formalization of polymorphic variants, - based on set-theoretic types and subtyping, that - yields a cleaner and more streamlined system. Our - formalization is more expressive than the current one - (it types more programs while preserving type - safety), it can internalize some meta-theoretic - properties, and it removes some pathological cases of - the current implementation resulting in a more - intuitive and, thus, predictable type system. More - generally, this work shows how to add full-fledged - union types to functional languages of the ML family - that usually rely on the Hindley-Milner type system. - As an aside, our system also improves the theory of - semantic subtyping, notably by proving completeness - for the type reconstruction algorithm.}, - url = {https://dl.acm.org/citation.cfm?id=2951928}, + pages = {33-40}, + publisher = {ACM Press}, + title = {The {S}wiss Coercion}, + year = {2007}, + abstract = {Recent type systems allow the programmer to use types + that describe more precisely the invariants on which + the program relies. But in order to satisfy the type + system, it often becomes necessary to help the type + checker with extra annotations that justify why a + piece of code is indeed well-formed. Such annotations + take the form of term-level type manipulations, such + as type abstractions, type applications, existential + package packing and opening, as well as + \emph{coercions}, or \emph{casts}. While those + operations have no direct runtime cost, they tend to + introduce extra runtime operations equivalent to + $\eta$-redexes or even empty loops in order to get to + the point where we can apply that supposedly free + operation. We show a coercion that is like a pacific + Swiss army knife of coercions: it cannot cut but it + can instantiate, open, pack, abstract, analyze, or do + any combination thereof, reducing the need for extra + surrounding runtime operations. And all that, of + course, for the price of a single coercion, which + still costs absolutely nothing at runtime. This new + coercion is derived from Karl Crary's coercion + calculus~\cite{Crary00}, but can also replace Crary + and Weirich's \kw{vcase}~\cite{Weirich99}. It + additionally happens to come in handy to work around + some limitations of value polymorphism. It is + presented in the context of Shao et al.'s Type System + for Certified Binaries~\cite{Shao02}. Other than the + coercion itself, another interesting aspect of this + work is a slightly unusual proof technique to show + soundness of the type erasure using a pure type + assignment language, making the no-op nature of our + \kw{cast} more obvious.}, } @inproceedings{Chapman10, address = {Baltimore, MD}, author = {James Chapman and Pierre-{\'E}variste Dagand and - Connor McBride and Peter Morris}, + Conor McBride and Peter Morris}, booktitle = {International Conference on Functional Programming}, key = {ICFP'10}, month = sep, @@ -416,59 +547,21 @@ or infinite regress.}, } -@inproceedings{Christiansen16, - author = {David Christiansen and Edwin Brady}, - booktitle = {International Conference on Functional Programming}, - key = {ICFP'16}, - month = sep, - pages = {284-297}, - title = {Elaborator Reflection: Extending {I}dris in {I}dris}, - year = {2016}, - abstract = {Many programming languages and proof assistants are - defined by elaboration from a high-level language - with a great deal of implicit information to a highly - explicit core language. In many advanced languages, - these elaboration facilities contain powerful tools - for program construction, but these tools are rarely - designed to be repurposed by users. We describe - elaborator reflection, a paradigm for metaprogramming - in which the elaboration machinery is made directly - available to metaprograms, as well as a concrete - realization of elaborator reflection in Idris, a - functional language with full dependent types. We - demonstrate the applicability of Idris’s reflected - elaboration framework to a number of realistic - problems, we discuss the motivation for the specific - features of its design, and we explore the broader - meaning of elaborator reflection as it can relate to - other languages.}, - url = {https://eb.host.cs.st-andrews.ac.uk/drafts/elab- - reflection.pdf}, -} - -@inproceedings{Firsov18, - author = {Denis Firsov and Aaron Stump}, - booktitle = {Certified Programs and Proofs}, - pages = {215-227}, - title = {Generic Derivation of Induction for Impredicative - Encodings in Cedille}, - year = {2018}, - abstract = {This paper presents generic derivations of induction - for impredicatively typed lambda-encoded datatypes, - in the Cedille type theory. Cedille is a pure type - theory extending the Curry-style Calculus of - Constructions with implicit products, primitive - heterogeneous equality, and dependent intersections. - All data erase to pure lambda terms, and there is no - built-in notion of datatype. The derivations are - generic in the sense that we derive induction for any - datatype which arises as the least fixed point of a - signature functor. We consider Church-style and - Mendler-style lambda-encodings. Moreover, the - isomorphism of these encodings is proved. Also, we - formalize Lambek's lemma as a consequence of expected - laws of cancellation, reflection, and fusion.}, - url = {http://doi.acm.org/10.1145/3167087}, +@inproceedings{Odersky97, + author = {Martin Odersky and Philip Wadler}, + booktitle = {Symposium on Principles of Programming Languages}, + key = {POPL'97}, + month = jan, + title = {Pizza into Java: Translating Theory into Practice}, + year = {1997}, + abstract = {Pizza is a strict superset of Java that incorporates + three ideas from the academic community: parametric + polymorphism, higher-order functions, and algebraic + data types. Pizza is defined by translation into Java + and compiles into the Java Virtual Machine, + requirements which strongly constrain the design + space. Nonetheless, Pizza fits smoothly to Java, with + only a few rough edges.}, } @inproceedings{Altenkirch10, @@ -501,7 +594,30 @@ translating several high-level constructions, that ΠΣ is suitable as a core language for dependently typed programming.}, - url = {http://www.cs.nott.ac.uk/\~{}psztxa/publ/pisigma-new.pdf}, +} + +@inproceedings{Firsov18, + author = {Denis Firsov and Aaron Stump}, + booktitle = {Certified Programs and Proofs}, + pages = {215-227}, + title = {Generic Derivation of Induction for Impredicative + Encodings in Cedille}, + year = {2018}, + abstract = {This paper presents generic derivations of induction + for impredicatively typed lambda-encoded datatypes, + in the Cedille type theory. Cedille is a pure type + theory extending the Curry-style Calculus of + Constructions with implicit products, primitive + heterogeneous equality, and dependent intersections. + All data erase to pure lambda terms, and there is no + built-in notion of datatype. The derivations are + generic in the sense that we derive induction for any + datatype which arises as the least fixed point of a + signature functor. We consider Church-style and + Mendler-style lambda-encodings. Moreover, the + isomorphism of these encodings is proved. Also, we + formalize Lambek's lemma as a consequence of expected + laws of cancellation, reflection, and fusion.}, } @proceedings{FLOPS10, @@ -513,6 +629,18 @@ year = {2010}, } +@proceedings{FOSSACS08, + address = {Budapest, Hungary}, + booktitle = {Conference on Foundations of Software Science and + Computation Structures}, + month = apr, + series = {Lecture Notes in Computer Science}, + title = {Conference on Foundations of Software Science and + Computation Structures}, + volume = {4962}, + year = {2008}, +} + @proceedings{ICFP06, address = {Portland, Oregon}, booktitle = {International Conference on Functional Programming}, @@ -522,18 +650,6 @@ year = {2006}, } -@proceedings{TPHOLs09, - booktitle = {International Conference on Theorem Proving in - Higher-Order Logics}, - key = {TPHOLs09}, - month = aug, - series = {Lecture Notes in Computer Science}, - title = {International Conference on Theorem Proving in - Higher-Order Logics}, - volume = {5674}, - year = {2009}, -} - @proceedings{POPL14, booktitle = {Symposium on Principles of Programming Languages}, key = {POPL'14}, @@ -594,6 +710,33 @@ year = {1989}, } +@proceedings{TLCA01, + booktitle = {International conference on Typed Lambda Calculi and + Applications}, + key = {TLCA'01}, + title = {International conference on Typed Lambda Calculi and + Applications}, + year = {2001}, +} + +@proceedings{PLPV07, + address = {Freiburg, Germany}, + booktitle = {Programming Languages meets Program Verification}, + key = {PLPV'07}, + month = sep, + publisher = {ACM Press}, + title = {Programming Languages meets Program Verification}, + year = {2007}, +} + +@proceedings{POPL97, + booktitle = {Symposium on Principles of Programming Languages}, + key = {POPL'97}, + month = jan, + title = {Symposium on Principles of Programming Languages}, + year = {1997}, +} + @proceedings{TLCA93, booktitle = {International conference on Typed Lambda Calculi and Applications}, @@ -615,6 +758,15 @@ year = {1997}, } +@proceedings{TLDI07, + address = {Nice, France}, + booktitle = {Types in Language Design and Implementation}, + key = {{TLDI}'07}, + month = jan, + title = {Types in Language Design and Implementation}, + year = {2007}, +} + @proceedings{POPL16, booktitle = {Symposium on Principles of Programming Languages}, key = {POPL'16}, ===================================== slides.tex ===================================== @@ -0,0 +1,614 @@ +\documentclass[display,semhelv]{seminar} +%% \documentclass{slides} + +\newcommand \CourseName {~~~~~~~~CUC} +\input{../../myslides} +\usepackage{mathpartir} +\usepackage{amsthm} + +\newtheorem{theorem}{Theorem}[section] +\newtheorem{lemma}[theorem]{Lemma} + +\newcommand \Subst[3] {#1[#2/#3]} + +\newcommand \Infer[1][] {\inferrule*[right=#1]} +\newcommand \Rname[1] {#1} + +\newcommand \Ferase[1] {{#1*}} +\newcommand \Fforget[1] {\lfloor#1\rfloor} + +\newcommand \Jtype[2][\Gamma] {#1 \vdash #2~:~} +\newcommand \Jcic \Jtype +\newcommand \Jcon[2][x;y] {#1 \vdash #2\;\;\kw{con}} +\newcommand \Jsmall[2][\Gamma] {#1 \vdash #2\;\;\kw{small}} + +\newcommand \Type[1] {\kw{Type}_{#1}} +\newcommand \Tmax[1] {#1~\sqcup~} + +\newcommand \TEarw[1][\ensuremath{k}] {\stackrel{\kw{#1}}{\to}} +\newcommand \TEapp[2][\ensuremath{k}] {#2@^{\kw{#1}}} + +\newcommand \Lam[3][\ensuremath{k}] {\lambda #2 \: #3 \TEarw[#1]} +\newcommand \Arw[3][\ensuremath{k}] {(#2 \: #3) \TEarw[#1]} +\newcommand \ArwS[2][\ensuremath{k}] {#2 \TEarw[#1]} +\newcommand \App \TEapp + +\newcommand \Ind[3] {\kw{Ind}(#1\:#2)\langle#3\rangle} +\newcommand \Con[2] {\kw{Con}(#1,#2)} +\newcommand \Case[3] {\langle#1\rangle\kw{Case}~#2 ~\kw{of}~\langle#3\rangle} +\newcommand \Fix[3] {\kw{Fix}_{#1}~#2:#3~=~} +\newcommand \ArwM[3][\ensuremath{k}] {\overrightarrow{(#2\:#3)\TEarw[#1]}\,} +\newcommand \LamM[3][\ensuremath{k}] {\lambda\overrightarrow{#2\:#3\TEarw[#1]}\,} +\newcommand \AppM[3][\ensuremath{k}] {#2~\overrightarrow{\TEapp[#1]{}#3}} + +\newcommand \IndE[2] {\kw{Ind}(#1)\langle#2\rangle} +\newcommand \ConE[1] {\kw{Con}(#1)} +\newcommand \CaseE[2] {\kw{Case}~#1 ~\kw{of}~\langle#2\rangle} +\newcommand \FixE[1] {\kw{Fix}~#1~=~} + +\begin{document} + +\renewcommand \thepagetail {/87\hspace{-5pt}} + +\begin{myslide}{} %Title page + + \begin{center} + \vfill + + {\huge + Inductive Types Deconstructed \medskip \\ + The Calculus of \smallskip \\ United Constructions + } + + \vfill \vfill + + Stefan Monnier \\ \texttt{monnier(a)iro.umontreal.ca} \\ + Université de Montréal + + \vfill + \end{center} + +\end{myslide} + +\renewcommand \righthead {Introduction} + +\renewcommand{\CancelColor}{\color{red}} + +%% - Inductive/data types: big and bloated. +%% - Inefficient projection from tuples. +%% - Impossibility to project separately from a case-test. +%% - why not do it like SML? +%% - No type refinement in default branches. +%% - Done here for CIC but usable elsewhere +%% - Give a bit of Typer context (can't throw away types yet!) +%% +%% - Decomposition into: tuples, unions, recursion, equality +%% - tagged tuples +%% - equality +%% - unions +%% boolean blindness +%% - recursion +%% - erasure +%% - consistency + +%% Union themes: +%% - wage +%% - grievance procedure +%% - representation +%% - union organizer +%% - rights! +%% - right to organize +%% - bargaining power +%% - negotiation +%% - contract negotiation +%% - go on strike +%% - lockout +%% - labor dispute +%% - capital +%% - exploitation +%% - unfair labor practice +%% - scab + +\begin{myslide}{Inductive types} + \hfill Inductive types \hfill||\hfill GADTs \hfill||\hfill Datatypes + \hfill\mbox{} + + \vfill + + \SMCenterLine{Swiss army knives of data types:} + + \SMCenterLine{Sum types + Product types (+ Recursive types + Indexed types)} + + \vfill + + Love/hate relationship: + \begin{itemize} + \item[${+}$] Handy packaging of all those constructs + \item[${-}$] Big and bulky: can't always fit in my pockets + \end{itemize} + + \vfill + %% \SMCenterLine{The calculus of United Constructions} + \SMCenterLine{¡ Here's how to break them {down into their constituents }!} +\end{myslide} + +\newcommand \RedStep [1] {% + \switch[][\boolean{firstactivation}]{#1}{{\color{red}{#1}}}% +} +\newcommand \RedReStep [2] {% + \reswitch[\value{step}=#1][\boolean{firstactivation}]{#2}{{\color{red}{#2}}}% +} + +\begin{myslide}{Sample definition} + %% \vfill + \stepwise{ + \vspace{-15pt} + %% \vfill + \begin{displaymath} + \MAlign{ + \kw{type}~~\id{NList}~\RedReStep 5 \alpha~\RedReStep 4 n \\[-3pt] + ~~\begin{array}{l@{~}l@{~}l} + \mid \id{\RedReStep 1 {nil}} & + : & + \id{NList}~\RedReStep 5 \alpha~\RedReStep 4 0 \\[-3pt] + \mid \id{\RedReStep 1 {cons}} & + : \RedReStep 2 {\alpha} \to \RedReStep 2 {\id{\RedReStep 3 {NList}}~\RedReStep + 5 \alpha~\RedReStep 4{n'}} \to & \id{NList}~\RedReStep 5 \alpha~\RedReStep 4{(S~n')} + \end{array} + } + \end{displaymath} + \vfill + %% + Canonical example using all the features: + \vfill + \begin{center} + \begin{tabular}{cl} + \texttt{\RedStep {nil | cons}} & + Sum type \\ + \texttt{\RedStep {cons~x~xs}} & Product type \\ + \texttt{\RedStep {NList}} & Recursive type \\ + $\color{black}\RedStep{n}$ & Indexed type \\ + $\color{black}\RedStep{\alpha}$ & Parameterized type \\ + \end{tabular} + \end{center} + \RedStep {} %FIXME: For some reason, the last step is skipped otherwise! + \vfill %Helps vertical alignment! + } +\end{myslide} + +\begin{myslide}{Sample use} + \stepwise{ + %% \vspace{-10pt} + %% \switch[\value{step}=3]{\mbox{}%% \newline + %% \mbox{}}{} + Constructors and destructors: + {\small + \begin{displaymath} + \MAlign{ + \id{map} : (?\alpha \to~?\beta) \to \id{NList}~~?\alpha~~\RedReStep 4 {?n} + \to \id{NList}~~?\beta~~\RedReStep 4 {?n}; \\[-3pt] + \id{map}~~f~~xs = \kw{case}~~\RedReStep 3 {xs} \\[-3pt] + ~~\begin{array}{l@{~}l} + \mid \id{\RedReStep 1 {cons}}~~\RedReStep 2 {y~~ys} & + \Rightarrow \id{cons}~(f~y)~(\id{map}~f~ys) \\[-3pt] + \mid \id{\RedReStep 1 {\_}} & \Rightarrow \id{nil} + \end{array} + } + \end{displaymath}} + %% \begin{center} + %% \begin{tabular}{ll} + %% \texttt{cons (f x) (map f xs)} & Constructor \\ + %% \texttt{nil} & Constructor \\ + %% \texttt{case} & \TAlign{Does-it-all Destructor!} + %% \end{tabular} + %% \end{center} + %% + \texttt{case} destructor does it all: + \vfill + \begin{itemize} + \item \RedStep{Select} the right branch (Sum type) + \item \RedStep{Extract} the fields (Product type) + \item \RedStep{Unfold} the type (Recursive type) + \item \RedStep{Refine} the type within branches (Indexed type) + \end{itemize} + \vfill %Helps vertical alignment! + } +\end{myslide} + +\renewcommand \righthead {Apertizer} + +\begin{myslide}{Grievances from Product types} + Extraction of a single tuple field + \hfill$\Rightarrow$\hfill \kw{case} expression of size $\color{black}O(N)$ + %% + \begin{displaymath} + x.1 ~~~~~⇒~~~~~ + \texttt{case}~~x~~|~~\texttt{tuple}~x_1~x_2~...~x_n\texttt{~=>~}x_1 + \end{displaymath} + + Can't extract fields separately from a constructor test + \begin{displaymath} + \MAlign{\texttt{case}~~x \\ + ~~|~\texttt{cons}~\_~\_\texttt{~=>~} + ~...~ + \MAlign{\texttt{case}~~x \\ + ~~|~\texttt{cons}~~y~~ys\texttt{~=>~} ... \\ + ~~|~~?\texttt{~=>~}? + } + } + \end{displaymath} + Fine for high-level language, limiting for low-level language +\end{myslide} + +\begin{myslide}{First rejected offer} + \SMCenterLine{¿ Promise to increase the wage of the optimizer ?} + + \begin{itemize} + \item Live with suboptimal source code + \item Hope later optimization phases will generate the better code + \end{itemize} + + \vfill \pause \vfill + + \SMCenterLine{¡ Not good enough !} + + Working on Typer, an ML/Haskell with dependent types and macros + + We need to type check the lower-level code: + + \SMCenterLine{We want to implement such optimizations via metaprogramming} +\end{myslide} + +\begin{myslide}{Second rejected offer} + %% \SMCenterLine{¿ Do it like Standard ML ?} + \SMCenterLine{¿ Standard ML:~~tuples + disjoint sums ?} + \begin{itemize} + \item Each datatype constructor takes exactly one argument + \item Add separate Tuple types + \end{itemize} + + \vfill\pause\vfill + + \SMCenterLine{¡ Not good enough !} + + Now $\id{cons}(x,y)$ uses up 2 heap objects: + + \begin{center} + \begin{picture}(200,15) + \put(30,0){\fbox{$~\id{cons}~$ ${\color{black}\mid}$ \hspace{3em}}} + \put(130,0){\fbox{${~~~~x~~~~}$ ${\color{black}\mid}$ ${~~~~y~~~~}$}} + \thicklines + \put(75,3){\vector(1,0){50}} + \end{picture} + \end{center} + \vfill + + %% \SMCenterLine + {Don't want to rely on optimizer to merge them back (see 1st offer)} +\end{myslide} + +\begin{myslide}{Grievances from Sum types} + {\small + \begin{displaymath} + \MAlign{ + \id{map} : (?\alpha \to~?\beta) \to \id{NList}~~?\alpha~~?n \to \id{NList}~~?\beta~~?n; \\[-3pt] + \id{map}~~f~~xs = \kw{case}~~xs \\[-3pt] + ~~ + \begin{array}{l@{~}l} + \mid \id{cons}~~y~~ys & \Rightarrow \id{cons}~(f~y)~(\id{map}~f~ys) \\[-3pt] + \mid \_ & \Rightarrow \id{nil} + \end{array} + } + \end{displaymath} + } + \vfill + \SMCenterLine{¡ doesn't type check !} + \vfill + \vfill + + \SMCenterLine{ + The default branch does not know that $xs$ is $\id{nil}$} + \vfill +\end{myslide} + +%% FIXME!! +%% \begin{myslide}{The case for unionization} +%% Inductive types alienate the constructs they employ +%% +%% Sum, Product, Recursive, and Indexed types deserve more respect +%% +%% End the oppression of inductive types +%% +%% Let its constituents negotiate their own contract +%% \end{myslide} + +\renewcommand \righthead {Main dish} + +\begin{myslide}{The Calculus of United Constructions (CUC)} + Lower-level definition for the Calculus of Inductive Constructions (CIC) + + Deconstruct inductive types into: + \begin{center} + \begin{tabular}{l@{~~⇒~~}l} + Product types & \emph{Labeled} tuples \\ + Sum types & \emph{Non-disjoint} union types \\ + Recursion & Good old ${\color{black}\mu}$-types \\ + Indexed typed & Equality types \\ + \end{tabular} + + \vfill + ¡ Put the labels on the products rather than the sums ! + + Same approach applicable to other settings, e.g.\ GADTs, datatypes + \end{center} +\end{myslide} + +\newcommand \EmptyCtx {\bullet} +\newcommand \Ttagvar {l} +\newcommand \Tuple[2][\Ttagvar] {\kw{Tuple}_{#1}~#2} +\newcommand \tuple[2][\Ttagvar] {\kw{tuple}_{#1}~}%% ~{#2} +%% \newcommand \tuple[3][\Ttagvar] {\{ #3 : #2 \}_{#1}} +\newcommand \TLabel {\id{Label}} +\newcommand \Let[2] {\kw{let}~#1 = #2~\kw{in}~} +\newcommand \Tproj[1] {#1.} + +\begin{myslide}{Labeled tuples} + \vspace{-10pt} + %% + {\small \begin{displaymath} + \color{mathgreen} + \texttt{cons 7 nil} + ~~{\color{black}\Rightarrow}~~ + \tuple[\color{red}\textsf{cons}] \Delta {(7,\texttt{nil})} + ~~{\color{black}:}~~ + \Tuple[\color{red}\textsf{cons}] + {(\textsf{Int}, \texttt{NList}~\textsf{Int}~0)} + \end{displaymath}} + Good Old Tuples Types™ plus label annotation and dependent types + %% + \begin{displaymath} + %% \begin{array}{l@{\;:\;}l} + %% \TLabel & \Type 0; \\ + %% `Tcons Int Tnil : Types 0` comparable to `cons Int nil : list Type₀` + %% `list Int : Type₀` and `list Type₀ : Type₁` so `Types 0 : Type₁`! + %% \id{Types}_\ell & \Type {\ell+1}; \\ + %% \id{Tnil}_\ell & \id{Types}_\ell; \\ + %% \id{Tcons} & + %% \MAlign{\Tarw{t}{\Type{\ell_1}} + %% {\Tsarw{(\Tsarw{t}{\id{Types}_{\ell_2}})} + %% {}} \\ + %% \;\;\id{Types}_{(\Tmax{\ell_1}{\ell_2});}} \medskip \\ + %% \id{Values}_\ell & \Tsarw{\id{Types}_\ell}{\Type {\ell}}; \\ + %% \id{Vnil}_\ell & \id{Values}_\ell~{\id{Tnil}_\ell}; \\ + %% \id{Vcons}_\ell & + %% \MAlign{ + %% \Tarw{x}{\tau}{\Tsarw{\id{Values}_\ell~{(f~x)}}{}} \\ + %% \;\; \id{Values}_\ell~{(\id{Tcons}~\tau~f)}; + %% } \medskip \\ + %% \Tuple[]{} & \TLabel \to \id{Types}_\ell \to \Type \ell; \\ + %% \end{array} + \begin{array}{lc@{\;\;}c@{\;\;}l@{}} + %% \textsl{(label)} & l &\in& \mathcal{L} \\ + %% \textsl{(index)} & i &\in& \mathbb{N} \\ + \textsl{(ctxt)} & \Delta &::=& \EmptyCtx ~|~ \Delta,x\:\tau \\ + \textsl{(term)} & e,\tau &::=& + ... \MAlign{~|~ \Tuple[{\color{red}\Ttagvar}] \Delta + ~|~ \tuple[{\color{red}\Ttagvar}] \Delta {\vec e} + %% ~|~ \Tproj e i + ~|~ {\Let {\vec x} {e_1} {e_2}}} \\ + \textsl{(sugar)} & {\Tproj e i} &\equiv& \Let {\vec x} {e} {x_i} + \end{array} + \end{displaymath} + Labels on tuples are cheap + %% FIXME: BiBoP + \begin{itemize} + \item Can often be stashed in a pre-existing heap object header + \item At worst, adds a single word to heap objects (or use BiBoP) + \end{itemize} +\end{myslide} + +\newcommand \Teq[1] {#1 \equiv} +\newcommand \Trefl {\kw{refl}~} +\newcommand \TJ[2] {\kw{J}~#1~#2~} + +\begin{myslide}{Equality type} + (Labeled) Tuples let us build \emph{non-indexed} single constructor types + + To support \emph{indexing}, CUC provides an Equality type: + \begin{displaymath} + \begin{array}{lc@{\;\;}c@{\;\;}l} + \textsl{(term)} & e,\tau &::=& + ... ~|~ \Teq{e_1}{e_2} ~|~ \Trefl{e} ~|~ \TJ{e_\equiv}{e_f}{e} + \end{array} + \end{displaymath} + + \texttt{NList} can be (re)defined without indexing: + \vspace{-5pt} + \begin{displaymath} + \MAlign{\kw{type}~~\id{NList}~\alpha~n \\[-3pt] + ~~ + \begin{array}{ll@{~~}l} + \mid & \id{nil} & (n \equiv 0) \\[-3pt] + \mid &\id{cons} & \alpha~~(\id{NList}~\alpha~n')~~(n \equiv S~n') + \end{array} + } + \end{displaymath} + So \texttt{nil} returns $\tuple[\textsl{nil}]{Δ}{(\Trefl 0)}$ + + Saves us from the \emph{convoy pattern} + %% + and + %% Eliminates the need for + Coq's + $\color{mathgreen}\texttt{in}~\tau_1~\texttt{return}~\tau_2$ + %% in \texttt{case} +\end{myslide} + +\newcommand \TUnion[1] {#1~\cup~} +\newcommand \TUnionSmart[1] {#1~\cup'~} +%% Note: The first arg is not needed for type-checking, but it is +%% needed for the reduction rules (so a cast from \tau to \tau can be dropped). +\newcommand \TUcast[2] {\kw{cast}~#1{\subseteq}#2~} +\newcommand \TUcase[6] { + \kw{switch}~#1~|~#2~#3~#3_\equiv\Rightarrow #4~|~#5~#5_\equiv\Rightarrow #6} + +\begin{myslide}{Non-disjoint union types} + Using labeled tuples and union types, we can (re)define \texttt{NList}: + \begin{displaymath} + \MAlign{ + \kw{type}~\id{NList}~\alpha~n \\ + ~~=~\MAlign{ + \Tuple[\textsl{nil}]{(\Teq{n}{0})} \\ + \cup~\Tuple[\textsl{cons}]{(n' : \textsl{Nat}, \alpha, \id{NList}~\alpha~n', \Teq{n}{S~n'})} + } + } + %% = (tuple) + %% | nil (n ≡ 0) + %% | cons α (NList α n') (n ≡ S n'} + \end{displaymath} + \SMCenterLine{¡ Union types have no run-time representation/cost !} + + But \texttt{nil}'s $\tuple[\textsl{nil}]{Δ}{(\Trefl 0)}$ doesn't have type + $\id{NList}~\alpha~0$: + \begin{itemize} + \item We need a weakening constructor to coerce from $\tau_1$ to + $\TUnion{\tau_1}{\tau_2}$ + \end{itemize} + + We also need a strengthening construct, which tests the labels +\end{myslide} + +\renewcommand \righthead {Dessert} + +\begin{myslide}{Union types's constructs} + \vspace{-15pt} + \begin{displaymath} + \begin{array}{lc@{\;\;}c@{\;\;}l} + \textsl{(term)} & e,\tau &::=& + ... ~\MAlign{ + |~ \TUnion{\tau_1}{\tau_2} \\ + |~ \TUcast{\tau_1}{\tau_2}e \\ + |~ {\MAlign{\TUcase {e %% \\ + } {\Ttagvar}{x}{e_\Ttagvar %% \\ + }{y}{e_d}}} + } + \end{array} + \end{displaymath} + $\color{mathgreen}\TUcast{\tau_1}{\tau_2}e$ weakens $e$ from ${\tau_1}$ to ${\tau_2}$ + \begin{itemize} + \item Turns into a no-op after type erasure + \end{itemize} + $\color{mathgreen}\kw{switch}$ jumps to either $e_\Ttagvar$ or $e_d$ + according to the label on tuple $e$ + \begin{itemize} + \item $e_d$ is a catch-all case; can be chained for multiple branches + \item No \emph{boolean blindness}: $x$, $x_\equiv$, $y$, $y_\equiv$ remember the + test's result + \end{itemize} + \SMCenterLine{¡ Builds on labeled tuples and equality types !} +\end{myslide} + +\begin{myslide}{Details of \kw{switch}} + \vspace{-10pt} + \begin{displaymath} + {\MAlign{\TUcase {e %% \\ + } {\Ttagvar}{x}{e_\Ttagvar %% \\ + }{y}{e_d}}} + \end{displaymath} + $e$ has to have a union type where all alternatives are (labeled) tuples + + $x$ and $y$ are bound to $e$ but with a refined type + \begin{itemize} + \item $x$ keeps alternatives with label $\Ttagvar$ and $y$ only keeps the + others + \item For $e : \texttt{NList}~\alpha~n$, if $\Ttagvar$ is $\textsl{nil}$, + $x$ has type $\Tuple[\textsl{nil}](\Teq{n}{0})$ + \item The default branch is not left in the cold: + $y : \Tuple[\textsl{cons}](...)$ + \item The typing rule encodes the usual coverage check + \end{itemize} + + $x_\equiv$ (resp $y_\equiv$) is bound to a proof that $x$ (resp $y$) is equal to $e$ + \begin{itemize} + \item Needed for dependent elimination + \end{itemize} +\end{myslide} + +\newcommand \Tmu[4][] {\mu_{#1} #2\:#3 . #4} +\newcommand \Tfold[1][\tau~{\vec p}] {\kw{fold}~}%% ~#1 +\newcommand \Tunfold[1][\tau~{\vec p}] {\kw{unfold}~}%% ~#1 +\newcommand \Tletfold[3][\tau~{\vec p}] {\Let{\Tfold[#1]{#2}}{#3}} + +\renewcommand \righthead {Coffee} + +\begin{myslide}{Recursion} + Support for recursive types and recursive functions + \begin{displaymath} + \begin{array}{lc@{\;\;}c@{\;\;}l@{}} + %% \textsl{(index)} & i &\in& \mathbb{N} \\ + \textsl{(term)} & e,\tau%% ,p + &::=& + ... ~\MAlign{ + |~ \Tmu[i]{x}{\tau}{e} + ~|~ \Tmu{x}{\tau}{e} \\ + |~ \Tfold{e} + %% ~|~ \Tunfold{e} + ~|~ \Tletfold{x}{e_1}{e_2} + } \\ + \end{array} + \end{displaymath} + In principle, these are standard fixpoint constructs + + For the purpose of proving consistency by translation to CIC: + \begin{itemize} + \item $\color{mathgreen}\Tmu[i]{x}{\tau}{e}$ mimics CIC's recursive functions + ($i$ is induction argument) + \item $\color{mathgreen}\Tmu{x}{\tau}{e}$ mimics CIC's positivity check + \item $\color{mathgreen}\Tletfold{x}{e_1}{e_2}$ is preferred over + $\color{mathgreen}\Tunfold{e}$ + \end{itemize} +\end{myslide} + +\begin{myslide}{Polymorphic variants comparison} + Restrictive form of polymorphic variants: + \begin{itemize} + \item Labels kept abstract: could be small integers + \item No polymorphic \kw{case} analysis + \item Upcasts need to be explicit + \end{itemize} + In return we get simple integration into existing PTS + \begin{itemize} + \item Easily bolted on the side of CC, CCω, ... + \end{itemize} +\end{myslide} + +\renewcommand \righthead {The bill} + +\begin{myslide}{Conclusion} + Defined the Calculus of United Constructions + \begin{itemize} + \item a lower-level alternative to the Calculus of Inductive Constructions + \end{itemize} + + Separates each ingredient of inductive types + + Lends itself to a simple and efficient implementation + + Refines the types even in the default branch of \texttt{switch} + + Proved consistent by translation to the CIC +\end{myslide} + +\begin{myslide}{Future work} + Translate all of CIC to CUC + \begin{itemize} + \item The ingredients are there, but the details still need to be worked out + \end{itemize} + + Levitation: Use inductive types to define $\tau_1 \subseteq \tau_2$ and friends + \begin{itemize} + \item See title of the slide + \end{itemize} +\end{myslide} + +\end{document} View it on GitLab: https://gitlab.com/monnier/typer/-/compare/bece7c8f563acd68ead00ade2bd9d6fd… -- View it on GitLab: https://gitlab.com/monnier/typer/-/compare/bece7c8f563acd68ead00ade2bd9d6fd… You're receiving this email because of your account on gitlab.com.

1 0