TP-automates/BE_2020_2021/descendant/Parser.ml

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)