Source

ocaml-lib / syntax.ml

(* analyse lexicale générique *)

type t_stream = Token.t Stream.t

type t_list = Token.t list

open Token

let from_channel : in_channel -> t_stream =
  fun ch ->
    let lexbuf = Lexing.from_channel ch in
    Stream.from (fun _ ->
	match Lexer.token lexbuf with
	  EOL -> None
	| tok -> Some tok)

let from_string : string -> t_stream =
  fun s ->
    let lexbuf = Lexing.from_string s in
    Stream.from (fun _ ->
	match Lexer.token lexbuf with
	  EOL -> None
	| tok -> Some tok)

(* get the string representation of the token *)
type space_of_token = Sep | PonctL | PonctR | Op | Word

let string_of_token : Token.t -> string * space_of_token =
  function
    | EOL -> "\n", Sep
    | BackQuote -> "`", Sep
    | Tilda -> "~", Sep
    | Exclam -> "!", PonctR
    | At -> "@", Sep
    | Sharp -> "#", Sep
    | Dollar -> "$", Sep
    | Percent -> "%", Sep
    | Hat -> "^", Op
    | Et -> "&", Op
    | Star -> "*", Op
    | LeftPar -> "(", PonctL
    | RightPar -> ")", PonctR
    | Minus -> "-", Op
    | Plus -> "+", Op
    | Equal -> "=", Op
    | LeftAcc -> "{", PonctL
    | RightAcc -> "}", PonctR
    | LeftBra -> "[", PonctL
    | RightBra -> "]", PonctR
    | Pipe -> "|", Op
    | BackSlash -> "\\", Sep
    | Slash -> "/", Sep
    | Interro -> "?", PonctR
    | LT -> "<", Op
    | GT -> ">", Op
    | Comma -> ",", PonctR
    | Dot -> ".", PonctR
    | Colon -> ":", PonctR
    | SemiColon -> ";", PonctR
    | DoubleQuote -> "\"", Sep
    | Quote -> "'", Sep
    | Ident s -> s, Word
    | Int n -> string_of_int n, Word
    | Float f -> string_of_float f, Word
    | String s -> "\"" ^ String.escaped s ^ "\"", Word
    | Term s -> "'" ^ String.escaped s ^ "'", Word
    | Char c -> "`" ^ Char.escaped c ^ "`", Word

let rec stringizer : t_list -> string =
  function
      [] -> ""
    | tok::toks ->
	let buf = Buffer.create 100 in
	let s, t = string_of_token tok in
	Buffer.add_string buf s;
	stringizer2 buf t toks
and stringizer2 buf t0 = function
    [] -> Buffer.contents buf
  | tok::toks ->
      let s, t = string_of_token tok in
      ( match t0, t with
      |	Sep, Word -> ()
      |	t1, Sep when t1 <> PonctR -> ()
      |	t1, PonctR when t1 <> PonctR -> ()
      |	PonctL, t1 when t1 <> PonctL -> ()
      |	_, _ -> Buffer.add_char buf ' ');
      Buffer.add_string buf s;
      stringizer2 buf t toks


(* fonctions generiques pour le parsing *)


(* fonctions generiques pour le printing *)
(* ------------------------------------- *)

(* add parenthesis around the given t_list if op (precedence) is above the ctx (precedence) *)

let add_par : int -> int -> t_list -> t_list =
  fun ctx op l -> if op > ctx then LeftPar::(l @ [RightPar]) else l


(* messages d'erreur syntaxique *)

let error_RightPar = "Syntax error: a closing parenthesis is missing."
let error_RightBra = "Syntax error: a closing bracket is missing."