TP-automates/BE_2020_2021/descendant/Parser.ml

240 lines
5.9 KiB
OCaml
Raw Normal View History

2023-06-21 17:58:18 +00:00
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
;;
(* 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
;;
(****** Règles LL1 ******)
(* parseM : inputStream -> parseResult *)
let rec parseM stream =
(print_endline "M");
(match (peekAtFirstToken stream) with
(* 1. M -> machine ident { SC } *)
| UL_MACHINE ->
inject stream >>=
accept UL_MACHINE >>=
acceptIdent >>=
accept UL_ACCOUV >>=
parseSC >>=
accept UL_ACCFER
(* Failure *)
| _ -> Failure)
(* parseSC : inputStream -> parseResult *)
and parseSC stream =
(print_endline "SC");
(match (peekAtFirstToken stream) with
(* 2. SC -> Λ *)
| UL_ACCFER ->
inject stream
(* 3. SC -> C SC *)
| ( UL_EVENT | UL_FROM | UL_REGION ) ->
inject stream >>=
parseC >>=
parseSC
(* Failure *)
| _ -> Failure)
(* parseC : inputStream -> parseResult *)
and parseC stream =
(print_endline "C");
(match (peekAtFirstToken stream) with
(* 4. C -> event ident *)
| UL_EVENT ->
inject stream >>=
accept UL_EVENT >>=
acceptIdent
(* 5. C -> from NQ to NQ on ident *)
| UL_FROM ->
inject stream >>=
accept UL_FROM >>=
parseNQ >>=
accept UL_TO >>=
parseNQ >>=
accept UL_ON >>=
acceptIdent
(* 9. C -> R *)
| UL_REGION ->
inject stream >>=
parseR
(* Failure *)
| _ -> Failure)
(* parseNQ : inputStream -> parseResult *)
and parseNQ stream =
(print_endline "NQ");
(match (peekAtFirstToken stream) with
(* 6. NQ -> ident SQ *)
| (UL_IDENT _) ->
inject stream >>=
acceptIdent >>=
parseSQ
(* Failure *)
| _ -> Failure)
(* parseSQ : inputStream -> parseResult *)
and parseSQ stream =
(print_endline "SQ");
(match (peekAtFirstToken stream) with
(* 7. SQ -> Λ *)
| ( UL_TO | UL_ON ) ->
inject stream
(* 8. SQ -> . ident SQ *)
| UL_PT ->
inject stream >>=
accept UL_PT >>=
acceptIdent >>=
parseSQ
(* Failure *)
| _ -> Failure)
(* parseR : inputStream -> parseResult *)
and parseR stream =
(print_endline "R");
(match (peekAtFirstToken stream) with
(* 10. R -> region ident { E SE } *)
| UL_REGION ->
inject stream >>=
accept UL_REGION >>=
acceptIdent >>=
accept UL_ACCOUV >>=
parseE >>=
parseSE >>=
accept UL_ACCFER
(* Failure *)
| _ -> Failure)
(* parseSE : inputStream -> parseResult *)
and parseSE stream =
(print_endline "SE");
(match (peekAtFirstToken stream) with
(* 11. SE -> Λ *)
| UL_ACCFER ->
inject stream
(* 12. SE -> E SE *)
| UL_STATE ->
inject stream >>=
parseE >>=
parseSE
(* Failure *)
| _ -> Failure)
(* parseE : inputStream -> parseResult *)
and parseE stream =
(print_endline "E");
(match (peekAtFirstToken stream) with
(* 13. E -> state ident ES EE EC *)
| UL_STATE ->
inject stream >>=
accept UL_STATE >>=
acceptIdent >>=
parseES >>=
parseEE >>=
parseEC
(* Failure *)
| _ -> Failure)
(* parseES : inputStream -> parseResult *)
and parseES stream =
(print_endline "ES");
(match (peekAtFirstToken stream) with
(* 14. ES -> Λ *)
| ( UL_ENDS | UL_ACCOUV | UL_ACCFER | UL_STATE ) ->
inject stream
(* 15. ES -> starts *)
| UL_STARTS ->
inject stream >>=
accept UL_STARTS
(* Failure *)
| _ -> Failure)
(* parseEE : inputStream -> parseResult *)
and parseEE stream =
(print_endline "EE");
(match (peekAtFirstToken stream) with
(* 16. EE -> Λ *)
| ( UL_ACCOUV | UL_ACCFER | UL_STATE ) ->
inject stream
(* 17. EE -> ends *)
| UL_ENDS ->
inject stream >>=
accept UL_ENDS
(* Failure *)
| _ -> Failure)
(* parseEC : inputStream -> parseResult *)
and parseEC stream =
(print_endline "EC");
(match (peekAtFirstToken stream) with
(* 18. EC -> Λ *)
| ( UL_ACCFER | UL_STATE ) ->
inject stream
(* 19. EC -> { R SR } *)
| UL_ACCOUV ->
inject stream >>=
accept UL_ACCOUV >>=
parseR >>=
parseSR >>=
accept UL_ACCFER
(* Failure *)
| _ -> Failure)
(* parseSR : inputStream -> parseResult *)
and parseSR stream =
(print_endline "SR");
(match (peekAtFirstToken stream) with
(* 20. SR -> Λ *)
| UL_ACCFER ->
inject stream
(* 21. SR -> R SR *)
| UL_REGION ->
inject stream >>=
parseR >>=
parseSR
(* Failure *)
| _ -> Failure)