TP-automates/TP3/SyntaxMonad.ml

open Lex

type parseResult =
  | Success of inputStream
  | Failure
;;

(*
  LL(1)
  #01 - E0 -> function ident -> E0
  #02 - E0 -> let ident = E0 in E0
  #03 - E0 -> letrec ident = E0 in E0
  #04 - E0 -> if E0 then E0 else E0
  #05 - E0 -> F TY EY EX
  #06 - EX -> = F TY EY EX
  #07 - EX -> 
  #08 - EY -> + F TY EY
  #09 - EY -> - F TY EY
  #10 - EY -> 
  #11 - TY -> * F TY
  #12 - TY -> / F TY
  #13 - TY -> 
  #14 - F  -> - F
  #15 - F  -> ( E0 ) FX
  #16 - F  -> ident FX
  #17 - F  -> true
  #18 - F  -> false
  #19 - F  -> number
  #20 - FX -> ( E0 )
  #21 - FX -> 
*)

(* 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) ->
      (print_endline (string_of_token token)); (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
    | (IdentToken _) -> (Success (advanceInStream stream))
    | _ -> Failure
;;

(* acceptNumber : inputStream -> parseResult *)
(* Vérifie que le premier token du flux d'entrée est bien un nombre *)
(* et avance dans l'analyse si c'est le cas *)
let acceptNumber stream =
  match (peekAtFirstToken stream) with
    | (NumberToken _) -> (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
;;


(* parseE0 : inputStream -> parseResult *)
(* Analyse du non terminal E0 *)
let rec parseE0 stream =
  (*
    (print_endline (string_of_stream stream));
  *)
  (print_endline "E0");
  (match (peekAtFirstToken stream) with
    (* regle #1 *)
    | FunctionToken ->
        inject stream >>=
        accept FunctionToken >>=
        acceptIdent >>=
        accept BodyToken >>=
        parseE0 
    (* regle #2 *)
    | LetToken ->
        inject stream >>=
        accept LetToken >>=
        acceptIdent >>=
        accept EqualToken >>=
        parseE0 >>=
        accept InToken >>=
        parseE0
    (* regle #3 *)
    | RecToken ->
        inject stream >>=
        accept RecToken >>=
        acceptIdent >>=
        accept EqualToken >>=
        parseE0 >>=
        accept InToken >>=
        parseE0
    (* regle #4 if E then E else E *)
    | IfToken ->
        inject stream >>=
        accept IfToken >>=
        parseE0 >>=
        accept ThenToken >>=
        parseE0 >>=
        accept ElseToken >>=
        parseE0
    (* regle #5 *)
    | ((IdentToken _) | (NumberToken _) | TrueToken | FalseToken | MinusToken | LeftParenthesisToken ) ->
        inject stream >>=
        parseF >>=
        parseTY >>=
        parseEY >>=
        parseEX
    | _ -> Failure)

(* parseEX : inputStream -> parseResult *)
(* Analyse du non terminal EX *)
and parseE stream =
  (print_endline "EX");
  (match (peekAtFirstToken stream) with
    (* regle #6 *)
    | EqualToken ->
        inject stream >>=
        accept EqualToken >>=
        parseF >>=
        parseTY >>=
        parseEY >>=
        parseEX
    (* regle #7 *)
    | (RightParenthesisToken | ElseToken | ThenToken | InToken) ->
        inject stream
    | EOSToken ->
        inject stream
    | _ -> Failure)

(* parseER : inputStream -> parseResult *)
(* Analyse du non terminal ER *)
and parseER stream =
  (print_endline "ER");
  (match (peekAtFirstToken stream) with
    (* regle #8 *)
    | ((IdentToken _) | (NumberToken _) | TrueToken | FalseToken | MinusToken | LeftParenthesisToken) ->
        inject stream >>=
        parseT >>=
        parseTX
    | _ -> Failure)

(* parseTX : inputStream -> parseResult *)
(* Analyse du non terminal TX *)
and parseTX stream =
  (print_endline "TX");
  (match (peekAtFirstToken stream) with
    (* regle 9 *)
    | PlusToken ->
        inject stream >>=
        accept PlusToken >>=
        parseT >>=
        parseTX
    (* regle 10 *)
    | MinusToken ->
        inject stream >>=
        accept MinusToken >>=
        parseT >>=
        parseTX
    (* regle 11 *)
    | (RightParenthesisToken | EqualToken | ElseToken | ThenToken | InToken) -> inject stream
    | EOSToken -> inject stream
    | _ -> Failure)

(* parseT : inputStream -> parseResult *)
(* Analyse du non terminal T *)
and parseT stream =
  (print_endline "T");
  (match (peekAtFirstToken stream) with
    (* regle 12 *)
    | ((IdentToken _) | (NumberToken _) | TrueToken | FalseToken | MinusToken | LeftParenthesisToken) ->
        inject stream >>=
        parseF >>=
        parseFX
    | _ -> Failure)

(* parseFX : inputStream -> parseResult *)
(* Analyse du non terminal FX *)
and parseFX stream =
  (print_endline "FX");
  (match (peekAtFirstToken stream) with
    (* regle 13 *)
    | TimesToken ->
        inject stream >>=
        accept TimesToken >>=
        parseF >>=
        parseFX
    (* regle 14 *)
    | DivideToken ->
        inject stream >>=
        accept DivideToken >>=
        parseF >>=
        parseFX
    (* regle 15 *)
    | (RightParenthesisToken | EqualToken | PlusToken | MinusToken | ElseToken | ThenToken | InToken) ->
        inject stream
    | EOSToken -> inject stream
    | _ -> Failure)

(* parseF : inputStream -> parseResult *)
(* Analyse du non terminal F *)
and parseF stream =
  (print_endline "F");
  (match (peekAtFirstToken stream) with
    (* regle 16 *)
    | MinusToken ->
        inject stream >>=
        accept MinusToken >>=
        parseF
    (* regle 17 *)
    | (NumberToken _) ->
        inject stream >>=
        acceptNumber
    (* regle 20 *)
    | ((IdentToken _) | LeftParenthesisToken) ->
        inject stream >>=
        parseFF >>=
        parseARG
    (* regle 21 *)
    | TrueToken ->
        inject stream >>=
        accept TrueToken
    (* regle 22 *)
    | FalseToken ->
        inject stream >>=
        accept FalseToken
    | _ -> Failure)

(* parseFF : inputStream -> parseResult *)
(* Analyse du non terminal FF *)
and parseFF stream =
  (print_endline "FF");
  (match (peekAtFirstToken stream) with
    (* regle 23 ( E ) *)
    | LeftParenthesisToken ->
        inject stream >>=
        accept LeftParenthesisToken >>=
        parseE >>=
        accept RightParenthesisToken
    (* regle 24 *)
    | IdentToken _ ->
        inject stream >>=
        acceptIdent
    | _ -> Failure)

(* parseARG : inputStream -> parseResult *)
(* Analyse du non terminal ARG *)
and parseARG stream =
  (print_endline "ARG");
  (match (peekAtFirstToken stream) with
    (* regle 25 - ARG -> ( E ) *)
    | LeftParenthesisToken ->
      inject stream >>=
      accept LeftParenthesisToken >>=
      parseE >>=
      accept RightParenthesisToken
    (* regle 26 - ARG -> *)
    | (RightParenthesisToken | EqualToken | PlusToken | MinusToken | ElseToken | ThenToken | InToken | TimesToken | DivideToken ) ->
        inject stream
    | EOSToken ->
        inject stream
    | _ -> Failure)
;;