TP-automates/BE_2021_2022/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
;;

(* 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)