Select Git revision
Kylian Fontaine authored
ast.ml 18.36 KiB
(*ROBOGRAM*)
type binop =
| Plus
| Minus
| Mult
| Div
| And
| Or
| Sup
| Inf
| Equal
| Diff
(*tail::head au lieu de head::tail pour optimisation mémoire, éviter les empilements inutiles
(((vide,x),y),z)
pour le set x,y,z*)
type 'a set =
| Vide
| Some of ('a set) * 'a
(*type pour l'utilisation de point avec obs, self, les package etc
type objet =
| Self
| Obs
| Geometry *)
type expr =
| None (*variable declaré mais non défini*)
| Bool of bool
| Cst of int
| Cstf of float
| BinOp of expr * binop * expr
| Not of expr
| Cond of expr * expr *expr
| Var of string (* est ce qu'on ratache un type a la variable?*)
| Let of string * expr * expr
| Fun of string * expr
| App of expr * expr
| Affectation of string * expr (* variable deja declaré avec let et on change sa valeur*)
| Set of expr set (* FIXME: Est ce qu'on veut vraiment un set d'expression? donc avoir des possibilités tel que : [Boucle(cond, e); Cst 1;....] *)
| LengthSet of expr (* lors de l'interpretation qu'on checkera que l'expression donné soit bien un set*)
| PushSet of expr * expr
| Point of string * string
| PatternMatching of expr * (expr * expr)list
| Cons of expr *expr
(*DESCRIPTION DE L'ENVIRONNEMENT*)
(** type syncho :
Fsync -> Full synchronisé
Ssync -> Semi synchronisé
Async -> Asynchronisé*)
type synchro =
| Fsync
| Ssync
| Async
(** type space :
R -> une ligne
Rm -> un millefeuille de ligne (convoie)
R2 -> un plan
R2m -> millefeuille de plan (simplification de R3)
ZnZ -> anneau prennant n -> positions congruantes
*)
type space = | R
| Rm
| R2
| R2m
| ZnZ of int
(* type range :
Full -> Full range
Limited -> range limité a un delta
K_rand -> range limité a un delta + capable de voir k robots au dela de delta choisie rand
K_enemy -> range limité a un delta + capable de voir k robots au dela de delta choisie par un ennemie*)
type range =
| Full
| Limited of expr
| K_rand of expr * expr
| K_enemy of expr * expr
(* type multiplicite :
No -> Pas de multiplicité
Weak -> Multiplicité faible : sait si 1 ou plusieurs robots mais pas combien de robot
Strong -> Multiplicité forte : connait le nombre de robot
Local -> robot ne connait que sur sa position
Global -> robot connait pour toute les positions observés
*)
type multiplicite =
| No
| Weak_Local
| Strong_Local
| Weak_Global
| Strong_Global
(* type light : Liste de couleurs
Intern -> Les lumieres vu par le robot lui meme
Extern -> Les lumieres vu par les robots autre que lui meme
All -> Les lumieres vu par tout les robots lui meme compris
Vaut mieux liste de string pour chaque couleurs ou autre chose, un simple int correspondant au nombre de lumiere ?
*)
(*type lumiere =
| Interne of int
| Externe of int
| All of int
*)
type color =
| Red
| Blue
| Yellow
| Green
| Purple
| Orange
type lights =
| Intern of color list
| Extern of color list
| All of color list
(* type memoire :
Oblivious -> memoire reset a chaque Look-Compute-Move
Finite -> memoire persistante entre deux Look-Compute-Move
Infinite -> se rappel de tout
*)
(*type memory =
| Oblivious
| Finite of int
| Infinite
*)
(* type opacity :
Opaque -> Les robots sont opaques
Transparant -> Les robots sont transparant
SemiOpaque n -> Transparant a partir d'une distance n ? (aucune idée des decomposition possible des probleme) *)
type opacity =
| Opaque
| Transparent
(*type rigidity :
Rigide -> les robots atteignent leur destination final, ils ne sont pas interrompu pendant leur mouvement
Flexible of float -> Les robots peuvent etre interrompu pendant leur mouvement, ils n'atteignent pas forcement leur
destinations final cependant il parcourt au minimum une distance delta
*)
type rigidity =
| Rigide
| Flexible of expr
(*type representant les fonction de degradation*)
type degrfunc =
| Str of string
| Fun of expr
(* type sensor : regroupement des capteurs des robots *)
type sensor =
| Range of range
| Opacity of opacity
| Multi of multiplicite
| Custom of string * degrfunc
(** type value : valeur pouvant etre utilisant dans les champs field*)
type value =
| Empty
| Int of int
| Float of float
| String of string
| Liste of value list
| Light of lights
(** type field : type correspondant au champs que l'utilisateur va renseigner pour le robot*)
type field =
| Private of (string * value)
| Public of (string * value)
type byzantine =
| Number of int
| Id of int list
type valretR =
| Location
| Direction
| Str of string
type share =
| Fullcompass
| Chirality
| DirectionShare
| OneAxisOrientation
type information =
| Sync of synchro
| Rigidity of rigidity
| Space of space
| Byzantines of byzantine
| Sensors of sensor list
| Robot of field list
| ActivelyUpdate of valretR list(*nom du champ*)
| Roles of (int * string) list
| Share of share
(* Une description c'est 1: description de l'environnement et des capacites des robot
2: robogram *)
type description = Description of ((information list) * (expr list))
(*FONCTION SUR LES SETS*)(** [length s] retourne la longueur du set [s]
@param [s] 'a set dont on veut la longueur
@return int la longueur du set*)
let rec length_set (s:'a set): int =
match s with
| Vide -> 0
| Some (s,_) -> 1 + (length_set s)
(*[push s e] ajoute un element e au set s
@param s de type 'a set
@param e de type 'a
@return un set correspondant au set s avec l'ajout de e *)
let push (s:'a set) (e : 'a) :'a set = Some(s,e)
(*CONVERTION EN STRING*)
let string_of_valretr (v : valretR) :string =
match v with
|Location -> "Location"
|Direction -> "Direction"
|Str s -> s
let rec string_of_set (s: 'a set) (f : 'a -> string) : string =
match s with
| Vide -> "Vide"
| Some (s',e) -> "("^ string_of_set s' f ^"," ^ f e ^")"
(** [string_of_expression e] Permet d'obtenir un string correspondant a l'expression [e]
@param [e] expression dont on souhaite le string
@return string correspondant a l'expression [e]
*)
let rec string_of_expression (e : expr) : string =
match e with
| None -> "None"
| Bool b -> string_of_bool b
| Cst i -> string_of_int i
| Cstf f -> string_of_float f
| BinOp(x,op ,y) -> (match op with
| Plus -> "("^string_of_expression(x)^ " + " ^ string_of_expression(y)^")"
| Minus -> "("^string_of_expression(x)^ " - " ^string_of_expression(y)^")"
| Mult -> "("^string_of_expression(x)^" * " ^string_of_expression(y)^")"
| Div -> "("^string_of_expression(x)^ " / " ^string_of_expression(y)^")"
| And -> string_of_expression(x) ^ " && " ^string_of_expression(y)
| Or -> string_of_expression(x) ^ " || " ^string_of_expression(y)
| Sup -> "("^string_of_expression(x) ^ " > "^string_of_expression(y)^")"
| Inf -> "("^string_of_expression(x) ^ " < " ^string_of_expression(y)^")"
| Equal -> string_of_expression(x) ^ " == " ^string_of_expression(y)
| Diff -> string_of_expression(x) ^ " != " ^string_of_expression(y)
)
| Not b -> "!("^string_of_expression b^")"
| Var v -> v
| Cond(c,e1,e2) -> "if (" ^string_of_expression c ^ ") then \n {" ^ string_of_expression e1 ^ "} \n else {" ^ string_of_expression e2 ^ "}"
| Affectation(v,e) -> v ^ " prend la valeur " ^ string_of_expression e
| Set s -> string_of_set s string_of_expression
| Let (v,e1,e2) -> "Déclaration de la variable " ^ v ^ " avec definition : " ^ string_of_expression e1 ^ " dans \n(" ^string_of_expression e2 ^")"
| Fun (s,e) -> "Fonction qui prend en parametre " ^ s ^ " et retourne (" ^ string_of_expression e ^")"
| App (f,arg) -> "("^ string_of_expression f ^") appliqué a (" ^ string_of_expression arg ^")"
| Point (k,v) -> "Valeur du champ " ^ v^ " de "^ k ^""
| LengthSet s -> (match s with
| Set s' -> "Taille de "^string_of_expression s ^ " : " ^ string_of_int (length_set s')
| Var _ -> "Taille du set "^string_of_expression s
| _ -> "Pas un set")
| PushSet (e,s)-> (match s with
| Set s' -> "Push "^string_of_expression e ^ " dans le set " ^ string_of_expression s ^ " : " ^ string_of_expression (Set(push s' e))
| Var _ -> "Push "^string_of_expression e ^ " dans le set " ^ string_of_expression s ^ " : "
| _ -> "Pas un set")
| PatternMatching (m,l) -> "match "^string_of_expression m^" with \n | "^ String.concat "\n | "(List.map (fun e -> match e with |
e1,e2 -> string_of_expression e1 ^" => "^string_of_expression e2 )
l)^ "\nend" | Cons (head,tail) -> string_of_expression head ^ " :: " ^ string_of_expression tail
let string_of_synchro (s:synchro) : string =
match s with
| Fsync -> "Full Synchro"
| Ssync -> "Semi Synchro"
| Async -> "Asynchro"
let string_of_espace (e:space) : string =
match e with
| R -> "R"
| Rm -> "Rm"
| R2 -> "R2"
| R2m ->"R2m"
| ZnZ n -> "Z/"^ string_of_int n ^"Z"
let string_of_color (c : color) : string =
match c with
| Red -> "Red"
| Blue -> "Blue"
| Yellow -> "Yellow"
| Green -> "Green"
| Purple -> "Purple"
| Orange -> "Orange"
let string_of_sensor (s : sensor) : string =
match s with
| Range r -> (match r with
| Full -> "Range Full"
| Limited x -> "Range Limité a : " ^ string_of_expression x
| K_rand(x,y) -> "Range K_rand limité a : " ^ string_of_expression x ^ " et k = " ^ string_of_expression y
| K_enemy(x,y) -> "Range K_enemy limité a : " ^ string_of_expression x ^ " et k = " ^ string_of_expression y)
| Multi m -> (match m with
| No -> "Multiplicity Aucune multiplicité"
| Weak_Local -> "Multiplicity Faible local"
| Strong_Local -> "Multiplicity Forte local"
| Weak_Global -> "Multiplicity Faible global"
| Strong_Global -> "Multiplicity Forte global")
| Opacity o -> (match o with
| Opaque -> "Opacity Opaque"
| Transparent -> "Opacity Transparent")
| Custom (s,f) -> "Fonction de degradation du champ " ^ s ^" : "^(match f with Str f' -> f'
| Fun f' -> string_of_expression f')
let rec string_of_value (v : value) : string =
match v with
| Empty -> "None"
| Int i -> string_of_int i
| String s -> s
| Float f -> string_of_float f
| Liste l -> "[" ^String.concat "; " (List.map string_of_value l) ^"]"
| Light l -> (match l with
| Intern c -> "Lumiere interne avec couleur :" ^ String.concat ", " (List.map string_of_color c)
| Extern c ->"Lumiere externe avec couleur :" ^ String.concat ", " (List.map string_of_color c)
| All c ->"Lumiere visible par tous avec couleur :" ^ String.concat ", " (List.map string_of_color c)
)
let string_of_field (f : field) : string =
match f with
| Private (s,v)-> "Private: "^s^"->"^ string_of_value v
| Public (s,v) -> "Public: "^s^"->"^ string_of_value v
let string_of_byzantine (b : byzantine) : string =
match b with
| Number n -> "Il y a n/" ^ string_of_int n ^ " Byzantin(s)"
| Id l -> "Liste des byzantins : [" ^ String.concat "; " (List.map string_of_int l) ^"]"
let string_of_role (r : int*string) : string=
match r with
| id,role -> "Le robot d'id " ^ string_of_int id ^" a comme role : " ^role
let string_of_rigidity (r: rigidity) : string = match r with
| Rigide -> "Rigide"
| Flexible _ -> "Flexible"
let rec string_of_description (desc:description) : string =
match desc with
| Description (infos,robogram) ->
"Description environnement:\n" ^String.concat "\n" (List.map string_of_information infos)
^"\nRobogram : \n " ^ String.concat "\n" (List.map string_of_expression robogram)
and string_of_information (info: information) : string =
match info with
| Sync s -> "Sync: " ^ (string_of_synchro s)
| Rigidity r ->(match r with
| Rigide -> "Rigidity: Rigide"
| Flexible d -> "Rigidity: Flexible d'une distance delta = " ^ string_of_expression d)
| Space e -> "Espace: " ^ (string_of_espace e)
| Byzantines b -> string_of_byzantine b
| Sensors s -> "Sensors: [" ^ String.concat "; " (List.map string_of_sensor s) ^ "] "
| Robot r -> "Robot : ["^ String.concat "; " (List.map string_of_field r) ^ "]"
| Roles r -> "Roles :" ^ String.concat "\n " (List.map string_of_role r)
| ActivelyUpdate a -> "Champ qui sont mise a jour par le robogram: " ^ String.concat ", " (List.map string_of_valretr a )
| Share s ->"Share : " ^ (match s with
|Fullcompass -> "Fullcompass"
|Chirality -> "Chirality"
|DirectionShare -> "Direction"
|OneAxisOrientation ->"1-axis orientation")
(** [info_sync i] verifie qu'une information est une information sur la synchronisation
@param i information
@return bool *)
let info_sync (i : information):bool =
match i with
| Sync _ -> true
| _ -> false
(** [info_espace i] verifie qu'une information est une information sur l'espace
@param i information
@return bool *)
let info_space (i : information):bool =
match i with
| Space _ -> true
| _ -> false
(** [check_description d] verifie que la description [d] possède bien les informations minimales
attendu pour une description et que chaque type d'information soit unique
(deux définition de l'espace le quel choisir ?...)
@param [d] description à vérifier
@return true si la description repond aux critères false sinon
TODO: A finir/ utilisation de valeur par defaut si non fourni? pourquoi pas
*)
let check_description (d : description) :bool =
let unique f d = List.length (List.filter f d) = 1
in
match d with
| Description (d',_) -> if not(unique info_sync d')
then (print_endline "Error: Problem of defining sync"; false)
else (
if not(unique info_space d')
then (print_endline "Error: Problem of defining space";false)
else true
) ;;
(**[get_sensors d] Renvoie la liste de sensors contenu dans la description [d]
@param description
@return [sensor list]
*)
let get_sensors (d : description) : sensor list =
match d with | Description(d', _) -> (match List.find_opt (fun x -> match x with Sensors _ -> true | _-> false) d' with
Some (Sensors s) -> s
| _ -> raise(Failure("Error: Not find Sensors")))
(**[get_robot d] Renvoie la liste des champs robot contenu dans la descritpion [d]
@param description
@return [field list]*)
let get_robot (Description(d', _) : description) : field list =
match List.find_opt (fun x -> match x with Robot _ -> true | _-> false) d' with
Some (Robot r) -> r
| _ -> raise(Failure("Error: Not find Robot"))
(**[get_activelyup d] Renvoie la liste des string correspondant aux champs mis à jour par le robogram
@param description
@return [string list] *)
let get_activelyup (d : description) : string list =
match d with
| Description(d', _) -> (match List.find_opt (fun x -> match x with ActivelyUpdate _ -> true | _-> false) d' with
Some (ActivelyUpdate a) -> List.map string_of_valretr a
| _ -> raise(Failure("Error: Not find ActivelyUpdate")))
(** [check_sensor s r] verifie qu'un sensor [s] soit bien déclarer dans le robot [r],ou alors qu'il soit pas un sensor custom
@param [s] sensor à verifié
@param [r] field list correspondant au robot dans le quel on verifie [s]
@return true si [s] n'est pas custom ou qu'il est custom et qu'il est contenu dans [r]
*)
let check_sensor (s: sensor) (r:field list):bool =
let only_public flist = List.filter (fun x -> match x with Public _ -> true| _-> false) flist in
let field_to_pair f = List.map(fun x -> match x with Public x -> x | Private x -> x) f in
match s with
| Custom (s',_)-> List.exists (fun (x,_) -> x = s') (field_to_pair (only_public r))
| _ -> true
(** [check_sensors_desc d] verifie que la liste de sensors de la description correspond a des sensors de robot
@param d description dans la quel on verifie sa liste de sensors avec sa déclaration de robot (field list)
@return [true] si les sensors sont custom et sont bien dans robot ou si il ne sont pas custom*)
let check_sensors_desc (d:description) :bool =
let res= List.find_opt (fun x -> not (check_sensor x (get_robot d))) (get_sensors d) in
match res with
| Some x -> print_endline("Error : " ^(match x with |Custom (x',_)-> x' | _->"")^" is not declared public in robot"); false
| _-> true
(**[check_activelyup d] verifie que les champs renseignés dans activelyupdate soient déclarés dans robot
@param d [description]
@return [bool]*)
let check_activelyup (d:description) :bool =
let field_to_pair f = List.map(fun x -> match x with Public x -> x | Private x -> x) f in
let aux s l = List.exists (fun (x,_) -> x = s) (field_to_pair l) in
let res = List.find_opt (fun x -> not (aux x (get_robot d))) (get_activelyup d) in
match res with
| Some x -> print_endline("Error : " ^x^" x is not declared in robot"); false
| _-> true
(**[check_light d] si il y a des lumiere intern on verifie qu'elle soit pas renseigné en public
et si extern pas dans private
@param description [d] description du monde
@return bool true si pas de lumiere intenre en public *)
let check_light d : bool =
let rec check flist = (
fun x -> match x with
| [] -> true
| Public (_,Light(Intern _))::_ -> false
| Private (_, Light(Extern _))::_ -> false
| _::t-> check t
) flist
in
check (get_robot d)