https://svn.lrde.epita.fr/svn/oln/trunk/static Index: ChangeLog from Roland Levillain &lt;roland(a)lrde.epita.fr&gt; More examples in doc/algorithms.ml. * doc/algorithms.ml (find_rec): Handle abstract delegatee. Add Olena-like examples. Aesthetic changes. * doc/algorithms.txt (Top-down approach): Document `find'. (Bottom-up approach): Move section at the end of the file. algorithms.ml | 178 ++++++++++++++++++++++------------ algorithms.txt | 292 +++++++++++++++++++++++++++++---------------------------- 2 files changed, 267 insertions(+), 203 deletions(-) Index: doc/algorithms.ml --- doc/algorithms.ml (revision 715) +++ doc/algorithms.ml (working copy) @@ -173,13 +173,12 @@ inheritance branch. Of course, the declarative nature of C++ templates will avoid this cost, but it remains inelegant, IMHO. *) - let delegatee = find_rec_in_supers source "delegatee_type" in let delegatee_res = - if delegatee = Stc_Not_found then - Stc_Not_found - else - find_rec delegatee target in + match delegatee with + | Stc_Not_found -> Stc_Not_found + | Stc_Abstract -> Stc_Not_found + | _ -> find_rec delegatee target in merge3 local_res super_res delegatee_res end @@ -223,7 +222,8 @@ vtype my_type = int; } *) -let a = Scoop_Class { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["my_type", Std_Int] } in assert (find a "my_type" = Std_Int);; @@ -247,11 +247,14 @@ vtype my_type = int; } *) -let a = Scoop_Class { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["my_type", Std_Int] } in -let b = Scoop_Class { super = a; +let b = + Scoop_Class { super = a; vtypes = create_vtypes ["my_type", Std_Float] } in -let c = Scoop_Class { super = b; +let c = + Scoop_Class { super = b; vtypes = create_vtypes ["my_type", Std_Int] } in assert (find c "my_type" = Std_Int);; @@ -270,9 +273,11 @@ vtype my_type = int; } *) -let a = Scoop_Class { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["my_type", Stc_Abstract] } in -let b = Scoop_Class { super = a; +let b = + Scoop_Class { super = a; vtypes = create_vtypes ["my_type", Std_Int] } in assert (find b "my_type" = Std_Int);; @@ -290,14 +295,15 @@ vtype my_type = 0; } *) -let a = Scoop_Class { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["my_type", Std_Int] } in -let b = Scoop_Class { super = a; +let b = + Scoop_Class { super = a; vtypes = create_vtypes ["my_type", Stc_Abstract] } in try ignore (find b "my_type") - with Scoop_exception "VT redefined abstract." -> () -;; +with Scoop_exception "VT redefined abstract." -> ();; (* ** Final virtual type @@ -311,9 +317,9 @@ final vtype my_type = int; } *) -let a = Scoop_Class { super = Stc_None; - vtypes = create_vtypes ["my_type", Stc_Final Std_Int] } -in +let a = + Scoop_Class { super = Stc_None; + vtypes = create_vtypes ["my_type", Stc_Final Std_Int] } in assert (find a "my_type" = Std_Int);; (* - A virtual type tagged as final in a class cannot be redefined in its @@ -347,20 +353,20 @@ final vtype my_type = float; } *) -let a = Scoop_Class - { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["my_type", Stc_Final Std_Int] } in -let b = Scoop_Class - { super = a; +let b = + Scoop_Class { super = a; vtypes = create_vtypes ["my_type", Std_Float] } in -let c = Scoop_Class - { super = a; +let c = + Scoop_Class { super = a; vtypes = create_vtypes ["my_type", Std_Int] } in -let d = Scoop_Class - { super = a; +let d = + Scoop_Class { super = a; vtypes = create_vtypes ["my_type", Stc_Final Std_Int] } in -let e = Scoop_Class - { super = a; +let e = + Scoop_Class { super = a; vtypes = create_vtypes ["my_type", Stc_Final Std_Float] } in assert (find a "my_type" = Std_Int); @@ -401,14 +407,14 @@ // I would say ``stc::not_found'', but I'm not sure (see intro.txt, too). type t = C#my_type; *) -let a = Scoop_Class - { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes [] } in -let d = Scoop_Class - { super = Stc_None; +let d = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["my_type", Stc_Abstract] } in -let c = Scoop_Class - { super = a; +let c = + Scoop_Class { super = a; vtypes = create_vtypes ["delegatee_type", d] } in assert (find c "my_type" = Stc_Not_found);; @@ -451,33 +457,33 @@ vtype bar = char; | } | *) -let a = Scoop_Class - { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes [] } in -let b = Scoop_Class - { super = a; +let b = + Scoop_Class { super = a; vtypes = create_vtypes ["foo", Stc_Abstract] } in -let x = Scoop_Class - { super = Stc_None; +let x = + Scoop_Class { super = Stc_None; vtypes = create_vtypes [("bar", Stc_Abstract); ("hop", Std_Int)] } in -let y = Scoop_Class - { super = x; +let y = + Scoop_Class { super = x; vtypes = create_vtypes [("bar", Std_Char); ("baz", Std_Short)] } in -let c = Scoop_Class - { super = b; +let c = + Scoop_Class { super = b; vtypes = create_vtypes [("delegatee_type", y); ("foo", Std_Int); ("baz", Stc_Not_delegated); ("hop", Stc_Not_delegated)] } in -let d = Scoop_Class - { super = c; +let d = + Scoop_Class { super = c; vtypes = create_vtypes [("quux", Std_Unsigned)] } in -let e = Scoop_Class - { super = d; +let e = + Scoop_Class { super = d; vtypes = create_vtypes [("baz", Std_Float)] } in assert (find e "foo" = Std_Int); @@ -503,20 +509,20 @@ { | } | *) -let a = Scoop_Class - { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["foo", Stc_Abstract] } in -let x = Scoop_Class - { super = Stc_None; +let x = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["foo", Std_Int] } in -let b = Scoop_Class - { super = a; +let b = + Scoop_Class { super = a; vtypes = create_vtypes [("delegatee_type", x); ("foo", Stc_Not_delegated)] } in -let c = Scoop_Class - { super = b; +let c = + Scoop_Class { super = b; vtypes = create_vtypes [] } in (* foo is abstract and tagged ``not delegated'' for B. *) @@ -544,20 +550,20 @@ vtype foo = 0 | } | *) -let a = Scoop_Class - { super = Stc_None; +let a = + Scoop_Class { super = Stc_None; vtypes = create_vtypes [] } in -let x = Scoop_Class - { super = Stc_None; +let x = + Scoop_Class { super = Stc_None; vtypes = create_vtypes ["foo", Std_Int] } in -let b = Scoop_Class - { super = a; +let b = + Scoop_Class { super = a; vtypes = create_vtypes [("delegatee_type", x); ("foo", Stc_Not_delegated)] } in -let c = Scoop_Class - { super = b; +let c = + Scoop_Class { super = b; vtypes = create_vtypes ["foo", Stc_Abstract] } in (* foo is abstract and tagged ``not delegated'' for B. *) @@ -565,3 +571,47 @@ (* Likewise for C. *) try ignore (find c "foo") with Scoop_exception "find: VT is abstract." -> () ;; + + +(* Olena-like examples. + + class /image_entry/ < stc::none + { + vtype value_type = 0; + } + + class image2d<int> < image_entry + { + vtypes value_type = int; + } + + class /value_morpher/ < image_entry + { + vtype delegatee_type = 0; + vtype value_type = stc::not_delegated; + } + + class value_cast<image2d<int>, float> < value_morpher + { + vtype delegatee_type = image2d<int>; + vtype value_type = float; + } +*) + +let image_entry = + Scoop_Class { super = Stc_None; + vtypes = create_vtypes ["value_type", Stc_Abstract] } in +let image2d_int = + Scoop_Class { super = image_entry; + vtypes = create_vtypes ["value_type", Std_Int] } in +let value_morpher = + Scoop_Class { super = image_entry; + vtypes = create_vtypes [("delegatee_type", Stc_Abstract); + ("value_type", Stc_Not_delegated)]} in +let value_cast__image2d_int__float = + Scoop_Class { super = value_morpher; + vtypes = create_vtypes [("delegatee_type", image2d_int); + ("value_type", Std_Float)] } in + +assert (find image2d_int "value_type" = Std_Int); +assert (find value_cast__image2d_int__float "value_type" = Std_Float);; Index: doc/algorithms.txt --- doc/algorithms.txt (revision 715) +++ doc/algorithms.txt (working copy) @@ -2,8 +2,160 @@ These algorithms are expressed in a pseudo-Caml like syntax. + +=========================================================================== +* Preamble + +Notes: + +- syntax: foo#super returns the type of the super class of foo. + +- syntax: 'foo_type' stands for the SCOOP virtual type named foo_type. + +- stc::none#super is an error, but calling `find (none, ...)' returns + stc::not_found. + + +=========================================================================== +* Top-down approach + +These algorithms have been prototyped in algorithms.ml. + +** find + +function find (source, target, string) = + let res = find_rec (source, target) in + match res with + | stc::abstract -> error "find: VT is abstract." + | stc::not_delegated_abstract -> error "find: VT is abstract." + | stc::not_delegated -> stc::not_found + | stc::final t -> t + | t -> t + + +** find_rec + +function find_rec (source, target) = + if (source = mlc::none) + stc::not_found + else + let local_res = find_local (source, target) in + + let super_res = find_rec (source#super, target) in + /* FIXME: This might not be efficient, since find_rec can be + called several times on the nodes of the delegation branch when + going down the inheritance branch. Of course, the declarative + nature of C++ templates will avoid this cost, but it might be + inelegant -- I'm not sure). */ + let delegatee = find_rec_in_supers (source, 'delegatee_type') in + let delegatee_res = + match delegatee with + | stc::not_found -> stc::not_found + | stc::abstract -> stc::not_found + | _ -> find_rec delegatee target in + + merge3 (local_res, super_res, delegatee_res) + + +// Like find_rec, but only search in the inheritance branch. +function find_rec_in_supers (source, target) = + if (source = mlc::none) + stc::not_found + else + let local_res = find_local (source, target) in + let super_res = find_rec (source#super, target) in + merge2 (local_res, super_res) + + +merge2 (local_res, super_res) = + match local_res, super_res with + + | stc::abstract, stc::not_found -> stc::abstract + | mlc::not_found, stc::not_found -> stc::not_found + | T, stc::not_found -> T + | stc::final<T>, stc::not_found -> stc::final<T> + + | mlc::not_found, stc::abstract -> stc::not_found + | stc::abstract, stc::abstract -> stc::abstract + | T, stc::abstract -> T + | stc::final<T>, stc::abstract -> stc::final<T> + + | stc::abstract, U -> error ("VT redefined abstract.") + | mlc::not_found, U -> U + | T, U -> T + | stc::final<T>, U -> stc::final<T> + + | stc::abstract, stc::final<U> -> error ("Final VT redefined abstract") + | mlc::not_found, stc::final<U> -> stc::final<U> + | T, stc::final<U> -> error ("Final VT redefined.") + | stc::final<T>, stc::final<U> -> error ("Final VT redefined final.") + + +merge3 (local_res, super_res, delegatee_res) = + match local_res, super_res, delegatee_res with + + // local_res == stc::not_found. + | mlc::not_found, stc::not_found, stc::not_found -> stc::not_found + | mlc::not_found, stc::not_found, stc::abstract -> stc::not_found + | mlc::not_found, stc::not_found, stc::final<V> -> stc::final<V> + | mlc::not_found, stc::not_found, V -> V + + | mlc::not_found, stc::abstract, stc::not_found -> stc::not_found + | mlc::not_found, stc::abstract, stc::abstract -> stc::abstract + | mlc::not_found, stc::abstract, stc::final<V> -> stc::final<V> + | mlc::not_found, stc::abstract, V -> V + + | mlc::not_found, stc::final<U>, _ -> stc::final<U> + | mlc::not_found, U, _ -> U + + + // local_res == stc::not_abstract. + | stc::abstract, stc::not_found, stc::not_found -> stc::abstract + | stc::abstract, stc::not_found, stc::abstract -> stc::abstract + | stc::abstract, stc::not_found, stc::final<V> -> stc::final<V> + | stc::abstract, stc::not_found, V -> V + + | stc::abstract, stc::abstract, stc::not_found -> stc::abstract + | stc::abstract, stc::abstract, stc::abstract -> stc::abstract + | stc::abstract, stc::abstract, stc::final<V> -> stc::final<V> + | stc::abstract, stc::abstract, V -> V + + | stc::abstract, stc::not_delegated_abstract, _ -> stc::not_delegated_abstract + | stc::abstract, stc::not_delegated, _ -> stc::not_delegated_abstract + + | stc::abstract, stc::final<U>, _ -> error ("Final VT " + "redefined abstract") + | stc::abstract, U, _ -> error ("VT redefined " + "abstract.") + // local_res == stc::not_delegated. + | stc::not_delegated, stc::not_found, _ -> stc::not_delegated + | stc::not_delegated, stc::abstract, _ -> stc::not_delegated_abstract + | stc::not_delegated, stc::not_delegated_abstract, _ -> stc::not_delegated_abstract + + // local_res == stc::not_delegated_abstract. + /* FIXME: Shouldn't we introduce a means to tag a vtype both + as abstract *and* not delegated? (Currently, the rule below + prevents this). */ + | stc::not_delegated_abstract, _, _ -> error ("Local " + "declaration of " + "not delegated " + "and abstract") + + // local_res == stc::final<T>. + | stc::final<T>, stc::final<U>, _ -> error ("Final VT " + "redefined final.") + | stc::final<T>, _, _ -> stc::final<T> + + // local_res == T. + | T, stc::final<U>, _ -> error ("Final VT " + "redefined.") + | T, _, _ -> T + + + + =========================================================================== -* Bottom-up approach (not finished) +* Bottom-up approach (FIXME: not finished, and old) This implementation doesn't handle stc::not_delegated properly. @@ -131,141 +283,3 @@ | stc::abstract, U -> U | T, _ -> T - - -Notes: - -- syntax: foo#super returns the type of the super class of foo. - -- syntax: 'foo_type' stands for the SCOOP virtual type named foo_type. - -- stc::none#super is an error, so calling `find (none, ...)' might be - an error ! - - -=========================================================================== -* Top-down approach - - -** find - -FIXME: To be written from algorithms.ml. - -** find_rec - -function find_rec (source, target) = - if (source = mlc::none) - stc::not_found - else - let local_res = find_local (source, target) in - - let super_res = find_rec (source#super, target) in - // FIXME: This might not be efficient, since find_rec can be - // called several times on the nodes of the delegation branch when - // going down the inheritance branch. Of course, the declarative - // nature of C++ templates will avoid this cost, but it remains - // inelegant, IMHO. - - let delegatee = find_rec_in_supers (source, 'delegatee_type') in - let delegatee_res = - if (delegatee = stc::not_found) - stc::not_found - else - find_rec (delegatee, target) in - - merge3 (local_res, super_res, delegatee_res) - - -// Like find_rec, but only search in the inheritance branch. -function find_rec_in_supers (source, target) = - if (source = mlc::none) - stc::not_found - else - let local_res = find_local (source, target) in - let super_res = find_rec (source#super, target) in - merge2 (local_res, super_res) - - -merge2 (local_res, super_res) = - match local_res, super_res with - - | stc::abstract, stc::not_found -> stc::abstract - | mlc::not_found, stc::not_found -> stc::not_found - | T, stc::not_found -> T - | stc::final<T>, stc::not_found -> stc::final<T> - - | mlc::not_found, stc::abstract -> stc::not_found - | stc::abstract, stc::abstract -> stc::abstract - | T, stc::abstract -> T - | stc::final<T>, stc::abstract -> stc::final<T> - - | stc::abstract, U -> error ("VT redefined abstract.") - | mlc::not_found, U -> U - | T, U -> T - | stc::final<T>, U -> stc::final<T> - - | stc::abstract, stc::final<U> -> error ("Final VT redefined abstract") - | mlc::not_found, stc::final<U> -> stc::final<U> - | T, stc::final<U> -> error ("Final VT redefined.") - | stc::final<T>, stc::final<U> -> error ("Final VT redefined final.") - - -merge3 (local_res, super_res, delegatee_res) = - match local_res, super_res, delegatee_res with - - // local_res == stc::not_found. - | mlc::not_found, stc::not_found, stc::not_found -> stc::not_found - | mlc::not_found, stc::not_found, stc::abstract -> stc::not_found - | mlc::not_found, stc::not_found, stc::final<V> -> stc::final<V> - | mlc::not_found, stc::not_found, V -> V - - | mlc::not_found, stc::abstract, stc::not_found -> stc::not_found - | mlc::not_found, stc::abstract, stc::abstract -> stc::abstract - | mlc::not_found, stc::abstract, stc::final<V> -> stc::final<V> - | mlc::not_found, stc::abstract, V -> V - - | mlc::not_found, stc::final<U>, _ -> stc::final<U> - | mlc::not_found, U, _ -> U - - - // local_res == stc::not_abstract. - | stc::abstract, stc::not_found, stc::not_found -> stc::abstract - | stc::abstract, stc::not_found, stc::abstract -> stc::abstract - | stc::abstract, stc::not_found, stc::final<V> -> stc::final<V> - | stc::abstract, stc::not_found, V -> V - - | stc::abstract, stc::abstract, stc::not_found -> stc::abstract - | stc::abstract, stc::abstract, stc::abstract -> stc::abstract - | stc::abstract, stc::abstract, stc::final<V> -> stc::final<V> - | stc::abstract, stc::abstract, V -> V - - | stc::abstract, stc::not_delegated_abstract, _ -> stc::not_delegated_abstract - | stc::abstract, stc::not_delegated, _ -> stc::not_delegated_abstract - - | stc::abstract, stc::final<U>, _ -> error ("Final VT " - "redefined abstract") - | stc::abstract, U, _ -> error ("VT redefined " - "abstract.") - // local_res == stc::not_delegated. - | stc::not_delegated, stc::not_found, _ -> stc::not_delegated - | stc::not_delegated, stc::abstract, _ -> stc::not_delegated_abstract - | stc::not_delegated, stc::not_delegated_abstract, _ -> stc::not_delegated_abstract - - // local_res == stc::not_delegated_abstract. - /* FIXME: Shouldn't we introduce a means to tag a vtype both - as abstract *and* not delegated? (Currently, the rule below - prevents this). */ - | stc::not_delegated_abstract, _, _ -> error ("Local " - "declaration of " - "not delegated " - "and abstract") - - // local_res == stc::final<T>. - | stc::final<T>, stc::final<U>, _ -> error ("Final VT " - "redefined final.") - | stc::final<T>, _, _ -> stc::final<T> - - // local_res == T. - | T, stc::final<U>, _ -> error ("Final VT " - "redefined.") - | T, _, _ -> T