Re: [Typer] [Git][monnier/typer][alice] 2 commits: remove susbt hash table

Bonjour Alice,

Pourrais-tu préparer un commit sur une branche séparée, avec un "commit message" qui décrit ce que font les changements? Généralement, le commit message devrait commencer pour une ligne qui donne le "titre" du changement, puis un (ou deux) paragraphes qui expliquent l'idée générale, suivi par une description détaillée des différents changement (pour cette partie-là il est utile de regarder le "diff", pour s'assurer qu'on explique bien tous les changements; il est pas nécessaire de décrire le code que tu introduits (ces descriptions si nécessaires devraient être des commentaires dans le code à la place), mais plutôt d'indiquer quel code on ajoute/enlève et (si ça ne peut pas se mettre comme un commentaire) pourquoi)).

Entre temps, tu peux voir ci-dessous mes commentaires sur le "diff" entre ta branch et "trunk" (qui devrait donc correspondre plus ou moins au patch que tu entends installer sur `master`).

Pour après, je pense qu'on devra(it) faire la chose suivante: - éliminer tous les usages de `lexp_whnf` et les remplacer par des usages de `lexp'_whnf`. Suite à ça, renommer `lexp'_whnf` à `lexp_whnf`. Dans pas mal de cas, ça va signifier qu'on réutilise la forme non-"whnf" (parce qu'on a besoin d'un `lexp` plutôt que d'un `lexp'`) et donc qu'on risque de refaire le `lexp_whnf` une deuxième fois. Il faudra donc mesurer l'impact en performance. - dans un deuxième temps, il faudrait changer `lexp` en un triplet `int * lexp' * lexp' option ref` et modifier `lexp_whnf` de manière à ce qu'il stocke le résultat de son calcul dans ce 3e champs (et de manière à ne pas refaire le calcul si ce champs est déjà rempli). La encore, on voudra mesurer l'impact en performance. - finalement, une alternative à l'ajout d'un troisième champs serait de sauvegarder le résultat de `lexp_whnf` non pas dans un champ de `lexp` mais dans une table de hachage séparée.

Stefan

diff --git a/.gitignore b/.gitignore index 46bc4da..f235bee 100644 --- a/.gitignore +++ b/.gitignore @@ -34,8 +34,12 @@ _tags # Files generated by profilers gmon.out ocamlprof.dump +profiling

Si je comprends bien, `profiling` est le nom que t'as choisi pour un répertoire où tu installes les fichiers générés, i.e. comme `build` mais pour le cas où on fait du profiling?

Je pense qu'on pourrait le mettre dans `build`, dans ce cas.

# Files auto-generated for ELPA packaging and other Emacs stuff emacs/*-autoloads.el emacs/*-pkg.el emacs/*.elc

+# Dependencies +.depend

Même chose pour `.depend`.

SRC_FILES := $(wildcard ./src/*.ml) -CPL_FILES := $(wildcard ./$(BUILDDIR)/src/*.cmo)

Pour le "commit message" tu pourrais décrire cette partie comme "(CPL_FILES): Remove, unused".

-OBFLAGS = -tag debug -tag profile -lib str -build-dir $(BUILDDIR) -pkg zarith +OBFLAGS = -tag debug -tag e -lib str -build-dir $(BUILDDIR) -pkg zarith

Il faudrait expliquer pourquoi tu changes `profile` à `e`.

• $(OCAMLBUILD) src/REPL.$(COMPILE_MODE) -I src $(OBFLAGS)

• $(OCAMLBUILD) src/REPL.$(COMPILE_MODE) -I src $(OBFLAGS)

Pas besoin d'expliquer ça par contre.

+test:

• $(OCAMLBUILD) tests/lexp_test.$(COMPILE_MODE) -I src $(OBFLAGS)
• @$(OCAMLBUILD) tests/utest_main.$(COMPILE_MODE) -I src $(OBFLAGS)
• @$(MV) $(BUILDDIR)/tests/utest_main.$(COMPILE_MODE) \

•    $(BUILDDIR)/tests/utests
  

• @./$(BUILDDIR)/tests/utests --verbose= 3

Un commentaire pour expliquer la différence avec `tests` est indispensable.

+profiling-cp:

• # ============================
• # profiling bytecode
• # ============================
• ocamlfind $(OCAMLCP) -o profiling -linkpkg -package zarith -package unix \
• -I src str.cma -P f $(DEPSORT_FILES)

+profiling-optp:

• # ============================
• # profiling native
• # ============================
• ocamlfind $(OCAMLOPTP) -o profiling -linkpkg -package zarith -package unix \
• -I src str.cmxa -P f $(DEPSORT_FILES)

Ajoute quelques commentaires ici qui expliquent comment ça s'utilise.

+# Clean up +clean-profiling:

• -rm -rf profiling
• -rm -rf src/*.cm[iox] src/*.o

Hmm... si ça places des fichiers genre `.cm[iox]` et `.o` directement dans `src`, je mettrais un commentaire "FIXME" pour mentionner qu'il faudrait changer tout ça pour mettre ces fichiers qqe part sous `build`.

+# Dependencies +depend:

• $(OCAMLDEP) -sort $(OCAMLFLAGS) src/*.ml > .depend

Ce commentaire n'apporte rien. Tu pourrais par contre le remplacer par un commentaire qui explique pourquoi t'as besoin de ces dépendances.

--- a/src/REPL.ml +++ b/src/REPL.ml @@ -44,6 +44,7 @@ open Prelexer open Lexer open Sexp open Pexp

open Lexp

Hmmm... évite ces changements cosmétiques (c'est normal qu'ils apparaissent de temps à autre comme résultat d'autres changements pendant le développement, mais il vaut mieux les renlever dans le résultat final). Ils ont tendance sinon à créer des conflits pas nécessaires.

Il y en a plusieurs autres, je te laisse vérifier ça.

@@ -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.

Celui-ci est aussi un changement cosmétique, mais dans la mesure où on n'aime pas les "trailing whitespace", tu peux le garder.

@@ -994,17 +1002,21 @@ 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))
  

•                             ->
  

•                                hc (Arrow (ak, n, t, dummy_location, aa)))
  

Pourquoi mettre le `hc` sur une autre ligne?

                             acc impossible in
              let g = generalize nctx altacc in
              let altacc' = g (fun _ne vname t l e

•                              -> Arrow (Aerasable, vname, t, l, e))
  

•                              ->
  

•                              hc (Arrow (Aerasable, vname, t, l, e)))
  

Même chose ici?

• let map, attr_type = match OL.lexp_whnf table (ectx_to_lctx ctx) with

• let map, attr_type =
• 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

• | lxp -> lexp_fatal loc lp "get-attribute expects a table as first argument" in

Hmm... en fait, je pense que passer `table` à `lexp_fatal` est préférable (c'est plus "proche" du code source). [ Je vois bien que tu ne fais que reproduire l'ancien comportement, mais ici on peut en profiter pour l'améliorer. ]

@@ -484,7 +485,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, hc (Var (vdummy, -1)))])) | _ -> value_fatal loc f "Trying to call a non-function!"

Pourrais-tu ajouter un commentaire qui explique pourquoi on utilise pas `mkVar`?

@@ -738,10 +739,10 @@ 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
  

•  match OL.lexp'_whnf (mkVar ((dummy_location, Some name), idx))
  

•    (ectx_to_lctx ectx) with
  

•    | Cons _ -> true           (* It's indeed a constructor!  *)
  

•    | _ -> false
  

L'indentation du `(ectx_to_lctx ectx)` est incorrecte.

@@ -753,10 +754,10 @@ 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)) ->
  

• match OL.lexp'_whnf (mkVar ((dummy_location, Some name), idx))
• (ectx_to_lctx ectx) with

Même chose ici

•  | Cons ((Var v, _), _) -> (  match (env_lookup_expr ectx v) with
  

•                            | Some (Inductive (_, _, _, ctors), _) ->
  

Ici aussi il y a un problème d'indentation et un peu partout dans le reste de ce fichier.

@@ -68,23 +70,23 @@ 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) ->

• | Cons ((Var _ as v, h), s, o) ->

Ici ton code dépend de la représentation de `lexp`. As-tu fait le teste de changer cette représentation pour détecter ces problèmes?

• and lexp =

• and lexp = int * lexp'
• and lexp' =

Ajoute un commentaire ici qui explique la différence entre `lexp` and `lexp'` et ce que fait ce `int`.

+(* hash lexp using combine_hash (lxor) with hash of sub-lexp *)

Assures-toi que tes commentaires suivent les règles habituelles, e.g. commencer les phrases par une majuscule, finir les phrases avec une ponctuation.

• -> U.combine_hash 2

•  (match l with
  

L'indentation ici aussi (et dans le reste de la fonction) est bizarre.

• | Let (l, ds, e)

• -> U.combine_hash 6 (U.combine_hash (Hashtbl.hash l)
  

•      (U.combine_hash (U.combine_hashes (List.map (fun e -> let (n, lp, lt) = e in
  

Ici (et dans le reste de la fonction) tu dépasses les 80 colonnes.

•        (U.combine_hash (Hashtbl.hash n) (U.combine_hash (lexp_hash lp) (lexp_hash lt))))
  

•          ds)) (lexp_hash e)))
  

^^^^^^^^^^^^^ Cet argument `(lexp_hash e)` devrait être sur une ligne séparée sinon il semble être un "enfant" de la ligne précédente, alors qu'il en est un frère/sœur.

•      (U.combine_hash (Hashtbl.hash n) (lexp_hash lt)))) a))
  

^^^ Même chose ici pour ce `a`...

•        (U.combine_hash (Hashtbl.hash ak) (lexp_hash lp))) args)))
  

^^^^ ...et ce `args`...

+let hc_eq e1 e2 =

• e1 == e2 ||
• match (lexp_lexp' e1, lexp_lexp' e2) with

As-tu vérifié si ce `e1 == e2` renvoie `true`? J'ai l'impression que `hc_eq` ne va jamais être appelé avec `e1 == e2`. Après tout, si `e1 == e2` ça signifie que le "nouveau" `lexp` existait déjà, mais si on ne fait `hc` qu'après l'usage d'un constructeur ça ne devrait pas être possible (sauf pour les constructeurs constants).

Donc cette optimisation pourrait bien être une pessimisation.

•        (fun (ak1, _, e1) (ak2, _, e2) -> ak1 = ak2 && e1 == e2)) cases1 cases2
  

...et ces `cases1 cases2`...

•        (fun (ak1, _) (ak2, _) -> ak1 = ak2) fields1 fields2) cases1 cases2
  

...et ceux-ci aussi.

+let hc (s : lexp') : lexp =

• let lp = (s, lexp'_hash s) in
• WHC.merge hc_table lp

Pas besoin du `let` ici.

De plus je remarque qqch d'étrange: tu construis ici

(s, lexp'_hash s)

mais plus haut, tu as défini

and lexp = int * lexp'

Autre chose: pourquoi `s`?

• = match f, es with
• | Call (f', es'), _ -> hc (Call (f', es' @ es))
• | _, [] -> f
• | _ -> hc (Call (f, es))

• = let f' = lexp_lexp' f in
• match f', es with
• | Call (f'', es'), _ -> hc (Call (f'', es' @ es))

Tu n'as pas besoin du `let` (et ça t'évitera de renommer f' à f''). Tu as ajouté un tel `let` à beaucoup d'endroits. C'est pas vraiment un problème, mais souvent le code serait un peu allégé en plaçant le lexp_lexp' directement dans le `match` plutôt que dans un `let` séparé.

let rec mkSusp e s =

• 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:
  • it just seemed like a good idea to do it eagerly when it's easy. *)

• match e with

• match e' with

Pourquoi appeler `lexp_lexp'` avant de faire le `if`?

@@ -468,7 +594,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) -> 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)

Yay! Un bug en moins! Mais ça serait mieux d'utiliser `mkCons`, non?

@@ -495,8 +621,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' = lexp_lexp' lxp in
• match lxp' with
• | Susp _ as e -> lexp_unparse (nosusp (hc e))

On sait que `hc e` est égal à `lxp`: pas besoin de ré-hasher.

•        str ^ nl ^ (make_indent 1) ^ elem ^ " ") h1 decls in
  

`h1 decls` sont cachés ici aussi: il faut les mettre sur une autre ligne. [ Je crois par contre qu'ici c'est un problème déjà présent dans le code d'origine ;-)]

•  -> eq e1 e2 && List.for_all2
  

•  (fun (_, e1, t1) (_, e2, t2) -> eq t1 t2 && eq e1 e2) defs1 defs2
  

Indentation incorrecte (affecte plusieurs lignes dans cette partie du code).

•      (fun (ak1, _, e1) (ak2, _, e2) -> ak1 = ak2 && eq e1 e2)) cases1 cases2
  

`cases1 cases2` sont cachés.

•    (fun (ak1, _) (ak2, _) -> ak1 = ak2) fields1 fields2) cases1 cases2
  

Et ici aussi.

• = assert (e1 == Lexp.hc e1);
• assert (e2 == Lexp.hc e2);

• = assert (e1 == Lexp.hc (lexp_lexp' e1));
• assert (e2 == Lexp.hc (lexp_lexp' e2));

Si tu t'assures que le seul endroit où on construit un objet de type `lexp` c'est dans `hc`, alors ces deux `assert` peuvent être éliminés.

• match lxp with

•    | L.Imm(s)           -> E.Imm(s)
  

•    | L.Builtin(v, _, _) -> E.Builtin(v)
  

•    | L.Var(v)           -> E.Var(v)
  

•    | L.Cons(_, s)       -> E.Cons(s)
  

•    | L.Lambda (P.Aerasable, _, _, body) ->
  

+let rec erase_type (lxp: lexp): E.elexp =

• let lxp' = lexp_lexp' lxp in
• match lxp' with

•    | Imm(s)           -> E.Imm(s)
  

•    | Builtin(v, _, _) -> E.Builtin(v)
  

•    | Var(v)           -> E.Var(v)
  

•    | Cons(_, s)       -> E.Cons(s)
  

•    | Lambda (P.Aerasable, _, _, body) ->
  

[ La raison pour laquelle j'avais utilisé la forme "longue" `L.<foo>` au lieu de juste `<foo>` c'était pour que le code soit plus symétrique entre `L.` et `E.`. ]

•    Call (Cons (Inductive (loc, type_label, [],
  

•    hc (Call (hc (Cons (hc (Inductive (loc, type_label, [],
  

Yay! 3 bugs en moins! Mais ça serait mieux d'utiliser `mkCons`, `mkCall`, `mkInductive`, non?

•  -> Let (loc, [(name, mkSusp e (S.shift 1), t)],
  

•         mk_lets_and_tup blocs ((name, t) :: types))
  

•  -> hc (Let (loc, [(name, mkSusp e (S.shift 1), t)],
  

•         mk_lets_and_tup blocs ((name, t) :: types)))
  

Idem

 | (DB.CVfix (defs, _) :: blocs)

•  -> Let (loc, defs,
  

•  -> hc (Let (loc, defs,
  

[ Je te laisse deviner. ]

@@ -51,6 +51,8 @@ let loc_string loc =

let loc_print loc = print_string (loc_string loc)

+let time_process = ref false

Je ne vois pas où tu l'utilises.

+let combine_hash e1 e2 = (e1 * 31) lxor e2

Ajoute un commentaire sur le choix de `31`.

+let rec combine_hashes li =

• match li with
• | [] -> 31
• | e :: l -> combine_hash (e * 31) (combine_hashes l)

Même chose.