src/ASM/Parser.ml

   1 open Util;;
   2 open BitVectors;;
   3 open ASM;;
   4
   5 let chars_of_string s =
   6  let len = String.length s in
   7  let rec aux n =
   8   if n < len then
   9    s.[n] :: aux (n + 1)
  10   else
  11    []
  12  in
  13   aux 0
  14 ;;
  15
  16 type 'a parser = char list -> ('a * char list) list
  17
  18 let return x =
  19   fun y -> [(x, y)]
  20
  21 let (>>=) f g =
  22   fun x ->
  23     let frst = f x in
  24       List.concat $ List.map (fun (a, x') -> (g a) x') frst
  25
  26 let prs_zero = fun _ -> []
  27 ;;
  28
  29 let prs_eof = function [] -> [(),[]] | _ -> [];;
  30
  31 let prs_predicate p =
  32   function
  33     hd::tl ->
  34       if p hd then
  35         [(hd, tl)]
  36       else
  37         []
  38   | [] -> []
  39 ;;
  40
  41 let (++) f g =
  42   fun x ->
  43     f x @ g x
  44 ;;
  45
  46 let (+++) f g =
  47   fun x ->
  48     match (f ++ g) x with
  49       [] -> []
  50     | hd::_ -> [hd]
  51 ;;
  52
  53 let rec prs_many p =
  54     prs_many1 p +++ return []
  55 and prs_many1 p =
  56          p           >>=
  57 fun a -> prs_many p  >>=
  58 fun b -> return $ a::b
  59 ;;
  60
  61 let rec prs_exact i p =
  62   if i = 0 then
  63     return []
  64   else
  65          p                   >>=
  66 fun a -> prs_exact (i - 1) p >>=
  67 fun b -> return $ a::b
  68
  69 let rec prs_sep_by p s =
  70   prs_sep_by1 p s +++ return []
  71 and prs_sep_by1 p s =
  72          p                             >>=
  73 fun a -> prs_many $ (s >>= fun _ -> p) >>=
  74 fun b -> return $ a::b
  75
  76
  77 let prs_char c = prs_predicate (fun x -> x = c)
  78 ;;
  79
  80 let prs_hex_digit =
  81   prs_predicate
  82     (fun x ->
  83        x = '0' || x = '1' || x = '2' || x = '3' ||
  84        x = '4' || x = '5' || x = '6' || x = '7' ||
  85        x = '8' || x = '9' || x = 'A' || x = 'B' ||
  86        x = 'C' || x = 'D' || x = 'E' || x = 'F' ||
  87        x = 'a' || x = 'b' || x = 'c' || x = 'd' ||
  88        x = 'e' || x = 'f')
  89