| 24594 |      1 | (*  Title:      Pure/ML/ml_parse.ML
 | 
|  |      2 |     Author:     Makarius
 | 
|  |      3 | 
 | 
|  |      4 | Minimal parsing for SML -- fixing integer numerals.
 | 
|  |      5 | *)
 | 
|  |      6 | 
 | 
|  |      7 | signature ML_PARSE =
 | 
|  |      8 | sig
 | 
|  |      9 |   val fix_ints: string -> string
 | 
|  |     10 | end;
 | 
|  |     11 | 
 | 
|  |     12 | structure ML_Parse: ML_PARSE =
 | 
|  |     13 | struct
 | 
|  |     14 | 
 | 
|  |     15 | structure T = ML_Lex;
 | 
|  |     16 | 
 | 
|  |     17 | 
 | 
|  |     18 | (** error handling **)
 | 
|  |     19 | 
 | 
|  |     20 | fun !!! scan =
 | 
|  |     21 |   let
 | 
|  |     22 |     fun get_pos [] = " (past end-of-file!)"
 | 
|  |     23 |       | get_pos (tok :: _) = T.pos_of tok;
 | 
|  |     24 | 
 | 
|  |     25 |     fun err (toks, NONE) = "SML syntax error" ^ get_pos toks
 | 
|  |     26 |       | err (toks, SOME msg) = "SML syntax error" ^ get_pos toks ^ ": " ^ msg;
 | 
|  |     27 |   in Scan.!! err scan end;
 | 
|  |     28 | 
 | 
|  |     29 | fun bad_input x =
 | 
|  |     30 |   (Scan.some (fn tok => (case T.kind_of tok of T.Error msg => SOME msg | _ => NONE)) :|--
 | 
|  |     31 |     (fn msg => Scan.fail_with (K msg))) x;
 | 
|  |     32 | 
 | 
|  |     33 | 
 | 
|  |     34 | (** basic parsers **)
 | 
|  |     35 | 
 | 
| 27817 |     36 | fun $$$ x =
 | 
|  |     37 |   Scan.one (fn tok => T.kind_of tok = T.Keyword andalso T.content_of tok = x) >> T.content_of;
 | 
|  |     38 | val int = Scan.one (fn tok => T.kind_of tok = T.Int) >> T.content_of;
 | 
| 24594 |     39 | 
 | 
| 27817 |     40 | val regular = Scan.one T.is_regular >> T.content_of;
 | 
|  |     41 | val improper = Scan.one T.is_improper >> T.content_of;
 | 
| 24594 |     42 | 
 | 
|  |     43 | val blanks = Scan.repeat improper >> implode;
 | 
|  |     44 | 
 | 
|  |     45 | 
 | 
|  |     46 | (* fix_ints *)
 | 
|  |     47 | 
 | 
|  |     48 | (*approximation only -- corrupts numeric record field patterns *)
 | 
|  |     49 | val fix_int =
 | 
|  |     50 |   $$$ "#" ^^ blanks ^^ int ||
 | 
|  |     51 |   ($$$ "infix" || $$$ "infixr") ^^ blanks ^^ int ||
 | 
|  |     52 |   int >> (fn x => "(" ^ x ^ ":int)") ||
 | 
|  |     53 |   regular ||
 | 
|  |     54 |   bad_input;
 | 
|  |     55 | 
 | 
|  |     56 | fun do_fix_ints s =
 | 
|  |     57 |   Source.of_string s
 | 
|  |     58 |   |> T.source
 | 
|  |     59 |   |> Source.source T.stopper (Scan.bulk (!!! fix_int)) NONE
 | 
|  |     60 |   |> Source.exhaust
 | 
|  |     61 |   |> implode;
 | 
|  |     62 | 
 | 
|  |     63 | val fix_ints = if ml_system_fix_ints then do_fix_ints else I;
 | 
|  |     64 | 
 | 
|  |     65 | end;
 |