304 lines
7.5 KiB
OCaml
304 lines
7.5 KiB
OCaml
open Tokens
|
|
|
|
(* Type du résultat d'une analyse syntaxique *)
|
|
type parseResult =
|
|
| Success of inputStream
|
|
| Failure
|
|
;;
|
|
|
|
(* accept : token -> inputStream -> parseResult *)
|
|
(* Vérifie que le premier token du flux d'entrée est bien le token attendu *)
|
|
(* et avance dans l'analyse si c'est le cas *)
|
|
let accept expected stream =
|
|
match (peekAtFirstToken stream) with
|
|
| token when (token = expected) ->
|
|
(Success (advanceInStream stream))
|
|
| _ -> Failure
|
|
;;
|
|
|
|
(* acceptIdent : inputStream -> parseResult *)
|
|
(* Vérifie que le premier token du flux d'entrée est bien un identifiant *)
|
|
(* et avance dans l'analyse si c'est le cas *)
|
|
let acceptIdent stream =
|
|
match (peekAtFirstToken stream) with
|
|
| (UL_IDENT _) -> (Success (advanceInStream stream))
|
|
| _ -> Failure
|
|
;;
|
|
|
|
(* acceptPort : inputStream -> parseResult *)
|
|
(* Vérifie que le premier token du flux d'entrée est bien un port *)
|
|
(* et avance dans l'analyse si c'est le cas *)
|
|
let acceptPort stream =
|
|
match (peekAtFirstToken stream) with
|
|
| (UL_PORT _) -> (Success (advanceInStream stream))
|
|
| _ -> Failure
|
|
;;
|
|
|
|
(* acceptEntier : inputStream -> parseResult *)
|
|
(* Vérifie que le premier token du flux d'entrée est bien un entier *)
|
|
(* et avance dans l'analyse si c'est le cas *)
|
|
let acceptEntier stream =
|
|
match (peekAtFirstToken stream) with
|
|
| (UL_ENTIER _) -> (Success (advanceInStream stream))
|
|
| _ -> Failure
|
|
;;
|
|
|
|
(* Définition de la monade qui est composée de : *)
|
|
(* - le type de donnée monadique : parseResult *)
|
|
(* - la fonction : inject qui construit ce type à partir d'une liste de terminaux *)
|
|
(* - la fonction : bind (opérateur >>=) qui combine les fonctions d'analyse. *)
|
|
|
|
(* inject inputStream -> parseResult *)
|
|
(* Construit le type de la monade à partir d'une liste de terminaux *)
|
|
let inject s = Success s;;
|
|
|
|
(* bind : 'a m -> ('a -> 'b m) -> 'b m *)
|
|
(* bind (opérateur >>=) qui combine les fonctions d'analyse. *)
|
|
(* ici on utilise une version spécialisée de bind :
|
|
'b -> inputStream
|
|
'a -> inputStream
|
|
m -> parseResult
|
|
*)
|
|
(* >>= : parseResult -> (inputStream -> parseResult) -> parseResult *)
|
|
let (>>=) result f =
|
|
match result with
|
|
| Success next -> f next
|
|
| Failure -> Failure
|
|
;;
|
|
|
|
|
|
(* parseR : inputStream -> parseResult *)
|
|
(* Analyse du non terminal Programme *)
|
|
let rec parseR stream =
|
|
(print_string "R");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 1. R -> model Ident { SE } *)
|
|
| UL_MODEL ->
|
|
inject stream >>=
|
|
accept UL_MODEL >>=
|
|
acceptIdent >>=
|
|
accept UL_ACCOUV >>=
|
|
parseSE >>=
|
|
accept UL_ACCFER
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseSE : inputStream -> parseResult *)
|
|
and parseSE stream =
|
|
(print_endline "SE");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 2. SE -> Λ *)
|
|
| UL_ACCFER ->
|
|
inject stream
|
|
(* 3. SE -> E SE *)
|
|
| ( UL_BLOCK | UL_SYSTEM | UL_FLOW ) ->
|
|
inject stream >>=
|
|
parseE >>=
|
|
parseSE
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseE : inputStream -> parseResult *)
|
|
and parseE stream =
|
|
(print_endline "E");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 4. E -> block Ident P ; *)
|
|
| UL_BLOCK ->
|
|
inject stream >>=
|
|
accept UL_BLOCK >>=
|
|
acceptIdent >>=
|
|
parseP >>=
|
|
accept UL_PTV
|
|
(* 5. E -> system Ident P { SE } *)
|
|
| UL_SYSTEM ->
|
|
inject stream >>=
|
|
accept UL_SYSTEM >>=
|
|
acceptIdent >>=
|
|
parseP >>=
|
|
accept UL_ACCOUV >>=
|
|
parseSE >>=
|
|
accept UL_ACCFER
|
|
(* 6. E -> flow ident from NQ to LN ; *)
|
|
| UL_FLOW ->
|
|
inject stream >>=
|
|
accept UL_FLOW >>=
|
|
acceptPort >>=
|
|
accept UL_FROM >>=
|
|
parseNQ >>=
|
|
accept UL_TO >>=
|
|
parseLN >>=
|
|
accept UL_PTV
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseNQ : inputStream -> parseResult *)
|
|
and parseNQ stream =
|
|
(print_endline "NQ");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 7. NQ -> ident *)
|
|
| (UL_PORT _) ->
|
|
inject stream >>=
|
|
acceptPort
|
|
(* 8. NQ -> Ident . ident *)
|
|
| (UL_IDENT _) ->
|
|
inject stream >>=
|
|
acceptIdent >>=
|
|
accept UL_PT >>=
|
|
acceptPort
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseLN : inputStream -> parseResult *)
|
|
and parseLN stream =
|
|
(print_endline "LN");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 9. LN -> Λ *)
|
|
| UL_PTV ->
|
|
inject stream
|
|
(* 10. LN -> NQ SN *)
|
|
| ( (UL_IDENT _) | (UL_PORT _) ) ->
|
|
inject stream >>=
|
|
parseNQ >>=
|
|
parseSN
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseSN : inputStream -> parseResult *)
|
|
and parseSN stream =
|
|
(print_endline "SN");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 11. SN -> Λ *)
|
|
| UL_PTV ->
|
|
inject stream
|
|
(* 12. LN -> , NQ SN *)
|
|
| UL_VIRG ->
|
|
inject stream >>=
|
|
accept UL_VIRG >>=
|
|
parseNQ >>=
|
|
parseSN
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseP : inputStream -> parseResult *)
|
|
and parseP stream =
|
|
(print_endline "P");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 13. P -> ( LP ) *)
|
|
| UL_PAROUV ->
|
|
inject stream >>=
|
|
accept UL_PAROUV >>=
|
|
parseLP >>=
|
|
accept UL_PARFER
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseLP : inputStream -> parseResult *)
|
|
and parseLP stream =
|
|
(print_endline "LP");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 14. LP -> DP SP *)
|
|
| (UL_PORT _) ->
|
|
inject stream >>=
|
|
parseDP >>=
|
|
parseSP
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseSP : inputStream -> parseResult *)
|
|
and parseSP stream =
|
|
(print_endline "SP");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 15. SP -> Λ *)
|
|
| UL_PARFER ->
|
|
inject stream
|
|
(* 16. LN -> , DP SP *)
|
|
| UL_VIRG ->
|
|
inject stream >>=
|
|
accept UL_VIRG >>=
|
|
parseDP >>=
|
|
parseSP
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseDP : inputStream -> parseResult *)
|
|
and parseDP stream =
|
|
(print_endline "DP");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 17. LP -> ident : M T OT *)
|
|
| (UL_PORT _) ->
|
|
inject stream >>=
|
|
acceptPort >>=
|
|
accept UL_PT2 >>=
|
|
parseM >>=
|
|
parseT >>=
|
|
parseOT
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseM : inputStream -> parseResult *)
|
|
and parseM stream =
|
|
(print_endline "M");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 18. M -> in *)
|
|
| UL_IN ->
|
|
inject stream >>=
|
|
accept UL_IN
|
|
(* 19. M -> out *)
|
|
| UL_OUT ->
|
|
inject stream >>=
|
|
accept UL_OUT
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseT : inputStream -> parseResult *)
|
|
and parseT stream =
|
|
(print_endline "T");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 20. T -> int *)
|
|
| UL_INT ->
|
|
inject stream >>=
|
|
accept UL_INT
|
|
(* 21. M -> float *)
|
|
| UL_FLOAT ->
|
|
inject stream >>=
|
|
accept UL_FLOAT
|
|
(* 22. M -> boolean *)
|
|
| UL_BOOLEAN ->
|
|
inject stream >>=
|
|
accept UL_BOOLEAN
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseOT : inputStream -> parseResult *)
|
|
and parseOT stream =
|
|
(print_endline "OT");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 23. OT -> Λ *)
|
|
| ( UL_VIRG | UL_PARFER ) ->
|
|
inject stream
|
|
(* 24. OT -> [ entier SV ] *)
|
|
| UL_CROOUV ->
|
|
inject stream >>=
|
|
accept UL_CROOUV >>=
|
|
acceptEntier >>=
|
|
parseSV >>=
|
|
accept UL_CROFER
|
|
(* Failure *)
|
|
| _ -> Failure)
|
|
|
|
(* parseSV : inputStream -> parseResult *)
|
|
and parseSV stream =
|
|
(print_endline "SV");
|
|
(match (peekAtFirstToken stream) with
|
|
(* 25. OT -> Λ *)
|
|
| UL_CROFER ->
|
|
inject stream
|
|
(* 26. OT -> , entier SV *)
|
|
| UL_VIRG ->
|
|
inject stream >>=
|
|
accept UL_VIRG >>=
|
|
acceptEntier >>=
|
|
parseSV
|
|
(* Failure *)
|
|
| _ -> Failure)
|