gistfile1.ml

#light

let ( ||| ) p1 p2 s =
    match p1 s with
    | Some _ as v -> v
    | None -> p2 s

let ( ++ ) p1 p2 s =
    match p1 s with
    | None -> None
    | Some(e1, s) ->
        match p2 s with
        | None -> None
        | Some(e2, s) -> Some((e1, e2), s)

let rec many' p s =
    match p s with
    | None -> [], s
    | Some(e, s) ->
        let es, s = many' p s
        e::es, s

let many p s = Some(many' p s)

let ( >| ) p k i =
    match pi with
    | Some(e, s) -> Some(k e, s)
    | None -> None

let some p = function
    | h::t when p h -> Some(h, t)
    | _ -> None

let a x = some (( = ) x)

let fin = function
    | [] as t -> Some(0, t)
    | _ -> None

let several p = many (some p)

let digit c = '0' <= c && c <= '9'

let alpha c = 'a' <= c && c <= 'z' || 'A' <= c && c <= 'Z'

let alphanum c = digit c || alpha c

let space = function ' ' | '\t' | '\n' -> true | _ -> false

let collect(h, t) = String.concat "" (List.map ("") (h::t))

type token =
    | IDENTIFIER of string
    | KEYWORD of string
    | INTEGER of string

let rawident = some alpha ++ several alphanum >| (IDENTIFIER << collect)

let rawnumber = some digit ++ several digit >| (INTEGER << collect)

let rawkeyword =
    let p c = not(space c) && not(digit c)
    some p ++ several p >| (KEYWORD << collect)

let token =
    (rawident ||| rawnumber ||| rawkeyword) ++ several space >| fst

let tokens =
    (several space ++ many token) >| snd

let alltokens = (tokens ++ fin) >| fst

let lex s =
    List.of_seq s
    |> alltokens
    |> Option.map fst