gistfile1.ml

#light

module Char =
  open System
  
  let isAlpha = Char.IsLetter
  
  let isDigit = Char.IsDigit 
  
  let isHexDigit c =
    isDigit c || c >= 'A' && c <= 'F' ||
                 c >= 'a' && c <= 'f'
                 
  let digitToInt : char -> int = function
    | c when isDigit c            -> int c - int '0'
    | c when c >= 'a' && c <= 'f' -> int c - int 'a' + 10
    | c when c >= 'A' && c <= 'F' -> int c - int 'A' + 10
    | c                           -> failwith ("Char.digitToInt: not a digit " + (string c))
                                    
module ListMonad =  
  let bindM (l:'a list) (f:'a -> 'b list) = List.concat (List.map f l)
  let returnM (l:'a) : 'a list = [l]
  let mzero = []
  let mplus = (@)
  
  type ListBuilder() =
    member x.Bind(l, f) = bindM l f
    member x.Return(l) = returnM l
    member x.Delay(f) = f()   
    member x.Zero() = []
  let listM = new ListBuilder()
  
  let (>>=) l f = bindM l f
  
  let rec foldM (f:'a -> 'b -> 'a list) (a:'a) : 'b list -> 'a list = function
    | []    -> returnM a
    | x::xs -> f a x >>= (fun fax -> foldM f fax xs)

  /// we can parse three different types of terms
  type Parsed = 
    | Digit of int
    | Hex of int
    | Word of string
  
  /// attempts to add a character to the parsed representation of a hex digit
  let parseHexDigit (p:Parsed) (c:char) : Parsed list =
    listM { match p with
             | Hex n -> if Char.isHexDigit c then
                          return (Hex ((n * 16) + (int (Char.digitToInt c))))
                        else
                          return! mzero
             | _     -> return! mzero
          }
  
  /// attempts to add a character to the parsed representation of a decimal digit
  let parseDigit (p:Parsed) (c:char) : Parsed list =
    listM { match p with
             | Digit n -> if Char.isDigit c then
                            return (Digit ((n * 06) + (int (Char.digitToInt c))))
                          else
                            return! mzero
             | _       -> return! mzero
          }       
  
  /// attempts to add a character to the parsed representation of a word     
  let parseWord (p:Parsed) (c:char) : Parsed list =
    listM { match p with
             | Word s -> if Char.isDigit c then
                           return (Word (s + (string c)))
                         else
                           return! mzero
             | _      -> return! mzero
          }                  

  /// tries to parse the digit as a hex value, a decimal value and a word
  let parse (p:Parsed) (c:char) : Parsed list =
    (parseHexDigit p c) @ (parseDigit p c) @ (parseWord p c)

  /// parse an entire String and return a list of the possible parsed values
  let parseArg (s:string) : Parsed list =
    listM { let! init = (returnM (Hex 0)) @ (returnM (Digit 0)) @ (returnM (Word ""))
            return! foldM parse init (Seq.to_list s)
          }