240 lines
5.9 KiB
OCaml
240 lines
5.9 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
|
||
|
;;
|
||
|
|
||
|
(* 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)
|