[SCM] Lisaac program java2lisaac branch, master, updated. c05808f993982fac29074eaa3c48a9c986fdcf40
ontologiae
ontologiae at ordinateur-de-ontologiae.local
Thu Aug 27 18:07:09 UTC 2009
The following commit has been merged in the master branch:
commit c05808f993982fac29074eaa3c48a9c986fdcf40
Author: ontologiae <ontologiae at ordinateur-de-ontologiae.local>
Date: Thu Aug 27 20:06:08 2009 +0200
Able to transform expression in lisaac from java expression
diff --git a/Java2Lisaac.ml/ParserJava.ml b/Java2Lisaac.ml/ParserJava.ml
index 2f4d02a..f5968f6 100644
--- a/Java2Lisaac.ml/ParserJava.ml
+++ b/Java2Lisaac.ml/ParserJava.ml
@@ -1,6 +1,12 @@
+(*#use "topfind";;
+#require "xml-light";;
+#require "extlib";;
+*)
open Xml
open ExtLib
+
+
(* SLOT *)
type slot = Field of field | Constructor of constructor | Method of method_def
(*|StaticBlock ?;*)
@@ -79,6 +85,7 @@ and expression =
| OuBin of expression * expression
| EtLogic of expression * expression
| OuLogic of expression * expression
+| OuExclusif of expression * expression
| DecG of expression * expression
| DecD of expression * expression
@@ -114,36 +121,37 @@ and expression =
| EntreParenth of expression
| CastType of definition_typ * expression
-| NewClassName of string list
| Null
| Super
| This
| False
| True
+
+| NewClassName of definition_typ * definition_typ list * expression list
+(*Le type créé, sa liste de génériques, éventuel expression d'init associée*)
+| LiteralExpre of litteral_def
+| Message of string * expression * expression list (*Appel de méthode :
+ Nom, receveur, arguments *)
+| VarRef of definition_typ
+| ThisCall of expression
;;
-let x = Xml.parse_file "output2.xml";;
+
type xmls = Elem of (string * (string * string) list * xmls list);;
-let rec to_xmls = function
- | Element ( a , b , c ) -> Elem ( a , b , List.map to_xmls c )
- | PCData _ -> Elem ( "", [], []);;
+let hash_variables = Hashtbl.create 123456;;
-let typ = Def_typ ("UnType" , false , [] );;
-let champ = { name_f="jk" ; type_field=typ ; transient_f=false ; volatile_f= false ; static_f=false ; final_f=false ; visibility_f=Private ; litteral_def_f=LiteralBool(true) };;
-let ch = [("name", "UNE_VARIABLE");("visibility", "Private");("final","true");("static","true")];;
-let lit_int= Elem ("literal-number", [("kind","integer");("value","1")],[]) ;;
-let lit_str= Elem ("literal-string", [("kind","string");("value","truc")],[]) ;;
-let lit_ch= Elem ("literal-string", [("kind","string");("value","truc")],[]) ;;
+(* UTILITAIRES *)
-let var = Elem( "field" , [("name","ANGLE_315");("visibility","public");("final","true");("static","true")], [
- Elem( "type", [("primitive","true");("name","int")], []);
- Elem( "literal-number",[("kind","integer");("value","1680")], [])]);;
+
+let rec to_xmls = function
+ | Element ( a , b , c ) -> Elem ( a , b , List.map to_xmls c )
+ | PCData _ -> Elem ( "", [], []);;
let visibility_str_to_type = function
| "public" -> Public
@@ -167,12 +175,56 @@ let rec concat_couple = function
| [] -> "" ;;
-let erreur = function balis , balis_autorisee , lstNoeud -> "ERREUR DE
-GRAMMAIRE : Balise attendue ="^balis^" ; Balise autorisées : "^balis_autorisee^"
+
+let rep = [];;
+
+let erreur = function fonction, balis , balis_autorisee , lstNoeud -> "ERREUR DE
+GRAMMAIRE dans la fonction "^fonction^" : Balise obtenue = "^balis^" ; Balise autorisées : "^balis_autorisee^"
; Attributs du noeud courants ; "^(concat_couple lstNoeud);;
let children = function Elem( a ,b , f ) -> f;;
+let is_substring = function ch, rech -> try (String.find ch rech> -1 ) with
+ExtString.Invalid_string -> false;;
+
+let rec prend_balise = function
+ | Elem(n,i,f)::q, recherche -> if (is_substring (n,recherche)) then Elem(n,i,f) else
+ prend_balise (q, recherche)
+ | [], recherche -> Elem("FAUX",[],[]) ;;
+
+
+let ajoute_info = function contexte,name,typ -> Hashtbl.add hash_variables
+(contexte,name) typ;;
+
+(*Rajouter une exception : trouve pas la variable..*)
+let get_typ_info = function cpl -> Hashtbl.find hash_variables cpl;;
+
+(* /UTILITAIRES *)
+
+
+
+(* DEF VARIABLES POUR TESTS *)
+
+let x = Xml.parse_file "Exemples.xml";;
+let x = to_xmls x;;
+let bin_expr = List.nth (children x) 2;;
+
+let typ = Def_typ ("UnType" , false , [] );;
+let champ = { name_f="jk" ; type_field=typ ; transient_f=false ; volatile_f= false ; static_f=false ; final_f=false ; visibility_f=Private ; litteral_def_f=LiteralBool(true) };;
+
+let ch = [("name", "UNE_VARIABLE");("visibility", "Private");("final","true");("static","true")];;
+
+let lit_int= Elem ("literal-number", [("kind","integer");("value","1")],[]) ;;
+let lit_str= Elem ("literal-string", [("kind","string");("value","truc")],[]) ;;
+let lit_ch= Elem ("literal-string", [("kind","string");("value","truc")],[]) ;;
+
+let var = Elem( "field" , [("name","ANGLE_315");("visibility","public");("final","true");("static","true")], [
+ Elem( "type", [("primitive","true");("name","int")], []);
+ Elem( "literal-number",[("kind","integer");("value","1680")], [])]);;
+
+
+
+(*==================================================== REMPLISSAGE DE L'ARBRE ====================================================*)
let rec recup_info_literal = function
| Elem("literal-number", lst, children) -> let kind = key ("kind",lst) in
@@ -196,28 +248,33 @@ let rec recup_info_literal = function
| Elem("literal-bool", lst, children) -> let kind = key ("kind",lst) in
(match kind with "char" -> LiteralBool (is_true (key ("value", lst)))
| _ -> LiteralNull )
- | Elem ( b , t , chil) -> print_string (erreur (b, "literal", t)); LiteralNull;;
+ | Elem ( b , t , chil) -> print_string (erreur ("recup_info_literal", b, "literal", t)); LiteralNull;;
-let rec prend_balise = function
- | Elem(n,i,f)::q, recherche -> if String.find (n, recherche) then Elem(n,i,f) else
- prend_balise (q, recherche)
- | [], recherche -> Elem("FAUX",[],[]) ;;
-
+(*On verra après pour savoir
+ comment gérer les types génériques*)
let rec recup_info_type_field = function
- | Elem("type", infos, fils) -> Def_typ ( key("name",infos) , is_true (key("primitive",infos)) , [] ) (*On verra après pour savoir comment gérer les types génériques*)
- | Elem ( a , infos , fils) -> print_string "ERREUR de grammaire : balise type attendu..."; Def_typ ( "", false , [] );;
+ | Elem("type", infos, fils) -> let res = Def_typ ( key("name",infos) ,
+ is_true (key("primitive",infos)) , [] ) in Hashtbl.add hash_variables
+ ("class",(key("name",infos))) res ; res
+ | Elem ( a , infos , fils) -> print_string (erreur
+ ("recup_info_type_field", a,
+ "type", infos)); Def_typ ( "", false , [] );;
+
+
+
let rec match_field = function
- | Elem ( "field", infos, fils) -> { name_f = key("name",infos) ;
+ | Elem ( "field", infos, fils) -> let res ={ name_f = key("name",infos) ;
type_field = recup_info_type_field (prend_balise (fils,"type")) ;
transient_f =is_true (key("transient",infos)) ;
volatile_f = is_true (key("volatile",infos)) ;
static_f = is_true (key("static",infos)) ;
final_f = is_true (key("final",infos)) ;
visibility_f = visibility_str_to_type (key("visibility",infos)) ;
- litteral_def_f = recup_info_literal (prend_balise (fils, "literal-number"))} (* FAUX *)
+ litteral_def_f = recup_info_literal (prend_balise (fils, "literal"))} in
+ ajoute_info ("class", res.name_f,res.type_field); res (* FAUX *)
| Elem ( a , infos , fils) -> print_string "ERREUR de grammaire : balise field attendu...";
{ name_f = "" ; type_field = Def_typ ( "", false , [] ) ; transient_f = false ;
@@ -228,3 +285,123 @@ let rec match_field = function
litteral_def_f = LiteralNull};;
+(*TODO : Gestion de l'opérateur dans assignment-expr *)
+let rec match_expression = function
+ | Elem ("new", [] , type_info :: args :: [] ) -> NewClassName (
+ recup_info_type_field type_info , List.map recup_info_type_field
+ (children type_info), List.map match_expression (children args))
+ | Elem ("type-argument", [] , fils :: [] ) -> match_expression fils
+ | Elem("paren", infos , fils :: [] ) -> EntreParenth ( match_expression
+ fils)
+ | Elem("binary-expr", infos , fils ) -> match_expre_binaire
+ (Elem("binary-expr", infos , fils ))
+ | Elem("assignment-expr", ["op",op], lval :: rval :: [] ) -> Affect (
+ match_expression lval , match_expression rval )
+ | Elem("lvalue", [], value :: [] ) -> match_expression value
+ | Elem("send", [("message", method_name)], target :: arguments :: []) ->
+ Message (method_name, match_expression
+ (List.hd (children target)), List.map match_expression (children
+ arguments) )
+ | Elem("var-ref", infos, fils) -> VarRef (get_typ_info ("class",(key
+ ("name",infos))))
+ | Elem(a , infos, []) when is_substring (a,"literal") -> LiteralExpre ( recup_info_literal (Elem(a,infos,[])) )
+ | Elem("this-call", [], fils :: []) -> ThisCall (match_expression fils)
+ | Elem( a, i , f ) -> print_string (erreur ("match_expression",a, "new,
+type-argument, paren, binary-expr, send, var-ref, literal.+, this-call ", i)) ; Null
+
+and match_expre_binaire = function
+ | Elem ("binary-expr",["op","&"], elem1 :: elem2 :: [] )-> EtBin ( match_expression elem1 , match_expression elem2 )
+ | Elem ("binary-expr",["op",">"], elem1 :: elem2 :: [] )-> SupStrict
+ ( match_expression elem1 , match_expression elem2 )
+ | Elem ("binary-expr",["op","<"], elem1 :: elem2 :: [] )-> InfStrict
+ ( match_expression elem1 , match_expression elem2 )
+ | Elem ("binary-expr",["op","*"], elem1 :: elem2 :: [] )-> Mult ( match_expression elem1 , match_expression elem2 )
+ | Elem ("binary-expr",["op","+"], elem1 :: elem2 :: [] )-> Plus ( match_expression elem1 , match_expression elem2 )
+ | Elem ("binary-expr",["op","-"], elem1 :: elem2 :: [])-> Moins ( match_expression elem1 , match_expression elem2 )
+ | Elem ("binary-expr",["op","/"], elem1 :: elem2 :: [] )-> Div ( match_expression elem1 , match_expression elem2 )
+ | Elem ("binary-expr",["op","||"], elem1 :: elem2 :: [] )-> OuLogic ( match_expression elem1 , match_expression elem2 )
+
+ | Elem ( "binary-expr", ["op","%"] , elem1 :: elem2 :: [] ) -> Modulo ( match_expression elem1 , match_expression elem2 )
+
+ | Elem ( "binary-expr", ["op","&&"] , elem1 :: elem2 :: [] ) ->
+ EtLogic ( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op","|"] , elem1 :: elem2 :: [] ) -> OuBin ( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op",">>"] , elem1 :: elem2 :: [] ) ->
+ DecD( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op",">>>"] , elem1 :: elem2 :: [] )
+ -> DecDZ ( match_expression elem1 , match_expression elem2 )
+
+ | Elem ( "binary-expr", ["op","<<"] , elem1 :: elem2 :: [] ) ->
+ DecG( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op","<<<"] , elem1 :: elem2 :: [] )
+ -> DecGZ( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op","=="] , elem1 :: elem2 :: [] ) ->
+ EgalLogic ( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op","!="] , elem1 :: elem2 :: [] ) ->
+ Different ( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op","<="] , elem1 :: elem2 :: [] ) ->
+ InfEgal( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op",">="] , elem1 :: elem2 :: [] ) ->
+ SupEgal ( match_expression elem1 , match_expression elem2 )
+ | Elem ( "binary-expr", ["op","^"] , elem1 :: elem2 :: [] ) ->
+ OuExclusif (match_expression elem1 , match_expression
+ elem2 )
+ | Elem( a, i , f ) -> print_string (erreur ("match_expre_binaire", a, "binary-expr", i)); Null;;
+
+
+
+
+
+let rec bin_expre_to_lisaac = function
+ | Plus ( l , r) -> bin_expre_to_lisaac l ^" + "^bin_expre_to_lisaac r
+ | Moins ( l , r) -> bin_expre_to_lisaac l ^" - "^bin_expre_to_lisaac r
+ | Mult ( l , r) -> bin_expre_to_lisaac l ^" * "^bin_expre_to_lisaac r
+ | Div ( l , r) -> bin_expre_to_lisaac l ^" / "^bin_expre_to_lisaac r
+ | Modulo ( l , r) -> bin_expre_to_lisaac l ^" % "^bin_expre_to_lisaac r
+ | Puissance ( l , r) -> bin_expre_to_lisaac l ^" ** "^bin_expre_to_lisaac r
+ | EtBin ( l , r) -> bin_expre_to_lisaac l ^" & "^bin_expre_to_lisaac r
+ | OuBin ( l , r) -> bin_expre_to_lisaac l ^" | "^bin_expre_to_lisaac r
+ | EtLogic ( l , r) -> bin_expre_to_lisaac l ^" && "^bin_expre_to_lisaac r
+ | OuLogic ( l , r) -> bin_expre_to_lisaac l ^" || "^bin_expre_to_lisaac r
+ | OuExclusif ( l , r) -> bin_expre_to_lisaac l ^" ^ "^bin_expre_to_lisaac r
+
+ | DecG ( l , r) -> bin_expre_to_lisaac l ^" << "^bin_expre_to_lisaac r
+ | DecD ( l , r) -> bin_expre_to_lisaac l ^" >> "^bin_expre_to_lisaac r
+ | DecGZ ( l , r) -> bin_expre_to_lisaac l ^" <<< "^bin_expre_to_lisaac r
+ | DecDZ ( l , r) -> bin_expre_to_lisaac l ^" >>> "^bin_expre_to_lisaac r
+
+ | Affect ( l , r) -> bin_expre_to_lisaac l ^" := "^bin_expre_to_lisaac r
+ | SupEgal ( l , r) -> bin_expre_to_lisaac l ^" >= "^bin_expre_to_lisaac r
+ | SupStrict ( l , r) -> bin_expre_to_lisaac l ^" > "^bin_expre_to_lisaac r
+ | InfEgal ( l , r) -> bin_expre_to_lisaac l ^" <= "^bin_expre_to_lisaac r
+ | InfStrict ( l , r) -> bin_expre_to_lisaac l ^" < "^bin_expre_to_lisaac r
+ | EntreParenth ( l ) -> "( "^ bin_expre_to_lisaac l ^" ) "
+ | VarRef a -> (match a with Def_typ (n, m , c) -> n)
+ | Message (nom, receveur, arguments) -> bin_expre_to_lisaac receveur
+ ^"."^ nom ^"("^ (String.concat " " (List.map bin_expre_to_lisaac
+ arguments)) ^")"
+ | LiteralExpre (LiteralNombre a) -> a.value ;;
+
+
+(*let test_match_field = match_field var;;
+let test_substr = is_substring ("literal-number","literal");;
+let test_hash = ajoute_info ("class","test", typ);; *)
+
+#trace match_expre_binaire;;
+#trace match_expression;;
+(*#trace match_field;;
+#trace recup_info_type_field;;
+#trace recup_info_literal;;
+#trace get_typ_info;;
+#trace ajoute_info;;
+#trace bin_expre_to_lisaac;;
+*)
+
+ajoute_info ("class","ch", Def_typ ("ch" , false , [] ));;
+ajoute_info ("class","i", Def_typ ("i" , false , [] ));;
+ajoute_info ("class","str", Def_typ ("str" , false , [] ));;
+
+Hashtbl.find_all hash_variables ("class","ch");;
+
+let expre = match_expre_binaire bin_expr;;
+bin_expre_to_lisaac expre;;
--
Lisaac program java2lisaac
More information about the Lisaac-commits
mailing list