src/Pure/ML/ml_parse.ML
author wenzelm
Thu Aug 02 12:36:54 2012 +0200 (2012-08-02)
changeset 48646 91281e9472d8
parent 43948 8f5add916a99
child 48911 5debc3e4fa81
permissions -rw-r--r--
more official command specifications, including source position;
wenzelm@24594
     1
(*  Title:      Pure/ML/ml_parse.ML
wenzelm@24594
     2
    Author:     Makarius
wenzelm@24594
     3
wenzelm@24594
     4
Minimal parsing for SML -- fixing integer numerals.
wenzelm@24594
     5
*)
wenzelm@24594
     6
wenzelm@24594
     7
signature ML_PARSE =
wenzelm@24594
     8
sig
wenzelm@24594
     9
  val fix_ints: string -> string
wenzelm@30672
    10
  val global_context: use_context
wenzelm@24594
    11
end;
wenzelm@24594
    12
wenzelm@24594
    13
structure ML_Parse: ML_PARSE =
wenzelm@24594
    14
struct
wenzelm@24594
    15
wenzelm@24594
    16
(** error handling **)
wenzelm@24594
    17
wenzelm@24594
    18
fun !!! scan =
wenzelm@24594
    19
  let
wenzelm@24594
    20
    fun get_pos [] = " (past end-of-file!)"
wenzelm@30682
    21
      | get_pos (tok :: _) = Position.str_of (ML_Lex.pos_of tok);
wenzelm@24594
    22
wenzelm@43947
    23
    fun err (toks, NONE) = (fn () => "SML syntax error" ^ get_pos toks)
wenzelm@43947
    24
      | err (toks, SOME msg) = (fn () => "SML syntax error" ^ get_pos toks ^ ": " ^ msg ());
wenzelm@24594
    25
  in Scan.!! err scan end;
wenzelm@24594
    26
wenzelm@24594
    27
fun bad_input x =
wenzelm@30682
    28
  (Scan.some (fn tok => (case ML_Lex.kind_of tok of ML_Lex.Error msg => SOME msg | _ => NONE)) :|--
wenzelm@43947
    29
    (fn msg => Scan.fail_with (K (fn () => msg)))) x;
wenzelm@24594
    30
wenzelm@24594
    31
wenzelm@24594
    32
(** basic parsers **)
wenzelm@24594
    33
wenzelm@27817
    34
fun $$$ x =
wenzelm@30682
    35
  Scan.one (fn tok => ML_Lex.kind_of tok = ML_Lex.Keyword andalso ML_Lex.content_of tok = x)
wenzelm@30682
    36
    >> ML_Lex.content_of;
wenzelm@24594
    37
wenzelm@30682
    38
val int = Scan.one (fn tok => ML_Lex.kind_of tok = ML_Lex.Int) >> ML_Lex.content_of;
wenzelm@30682
    39
wenzelm@30682
    40
val regular = Scan.one ML_Lex.is_regular >> ML_Lex.content_of;
wenzelm@30682
    41
val improper = Scan.one ML_Lex.is_improper >> ML_Lex.content_of;
wenzelm@24594
    42
wenzelm@24594
    43
val blanks = Scan.repeat improper >> implode;
wenzelm@24594
    44
wenzelm@24594
    45
wenzelm@24594
    46
(* fix_ints *)
wenzelm@24594
    47
wenzelm@24594
    48
(*approximation only -- corrupts numeric record field patterns *)
wenzelm@24594
    49
val fix_int =
wenzelm@24594
    50
  $$$ "#" ^^ blanks ^^ int ||
wenzelm@24594
    51
  ($$$ "infix" || $$$ "infixr") ^^ blanks ^^ int ||
wenzelm@24594
    52
  int >> (fn x => "(" ^ x ^ ":int)") ||
wenzelm@24594
    53
  regular ||
wenzelm@24594
    54
  bad_input;
wenzelm@24594
    55
wenzelm@43948
    56
val fix_ints =
wenzelm@43948
    57
  ML_System.is_smlnj ?
wenzelm@43948
    58
   (Source.of_string #>
wenzelm@43948
    59
    ML_Lex.source #>
wenzelm@43948
    60
    Source.source ML_Lex.stopper (Scan.bulk (!!! fix_int)) NONE #>
wenzelm@43948
    61
    Source.exhaust #>
wenzelm@43948
    62
    implode);
wenzelm@24594
    63
wenzelm@30672
    64
wenzelm@30672
    65
(* global use_context *)
wenzelm@30672
    66
wenzelm@30672
    67
val global_context: use_context =
wenzelm@30672
    68
 {tune_source = fix_ints,
wenzelm@30672
    69
  name_space = ML_Name_Space.global,
wenzelm@30672
    70
  str_of_pos = Position.str_of oo Position.line_file,
wenzelm@30672
    71
  print = writeln,
wenzelm@30672
    72
  error = error};
wenzelm@30672
    73
wenzelm@24594
    74
end;