(*module Lexer = 
  struct
  *)


(***** parser abstract data data structure *****)
exception ParserError of string;;

type symbol = string;;
type defn = symbol * exp 
and exp = 
  | Bool of bool
  | Null
  | Num of int 
  | Id of symbol
  | Prim of symbol
  | Uop of symbol * exp
  | Biop of symbol * exp * exp
  | Map of symbol list * exp
  | App of exp * exp list
  | If of exp * exp * exp
  | Let of defn list * exp
  | Block of exp list
;;

let is_term = fun x -> match x with
  | Uop(a,b) -> true
  | App(a,b) -> true
  | Null     -> true
  | Num(i)   -> true
  | Bool(b)  -> true
  | _ -> false
;;
let is_exp = 
fun x -> (is_term x) or
  match x with
  | Biop(a,b,c) -> true
  | If(a,b,c)   -> true
  | Let(a,b)    -> true
  | Map(a,b)    -> true
  | _ -> false
;;

let rec string_of_exp = 
  fun e -> match e with
  | Bool(true) -> "true"
  | Bool(false) -> "false"
  | Null -> "null"
  | Num(n) -> string_of_int n
  | Id(s) -> s
  | Prim(s) -> s
  | Uop(s,e1) -> s^" "^ (string_of_exp e1)
  | Biop(s,e1,e2)-> "("^(string_of_exp e1) ^" " ^s^" "^ (string_of_exp e2)^")"
  | Map(l,e) -> "map "^ 
	(List.fold_left 
	   (fun s e -> 
	     if (String.length s) = 0 then e else s ^ "," ^ e
	   ) "" l) ^
      " to " ^ (string_of_exp e)
  | App(e,l) -> 
      let se = string_of_exp e in 
         (if (is_exp e) then "("^se^")" else se)^"(" ^
      (List.fold_left 
	 (fun s e -> 
	   let se = (string_of_exp e) in
	   if (String.length s) = 0 then se else s ^ ", " ^ se
	 ) "" l) ^ ")" 
  | If (a,b,c) -> "if " ^(string_of_exp a)^" then "^(string_of_exp b)^" else "^(string_of_exp c)
  | Let (l,exp) -> "let "^
      (List.fold_left 
	 (fun s d -> match d with 
	 | (v,e) ->
	     let se = v^" := "^(string_of_exp e)^";" in
	     if (String.length s) = 0 then se else s ^" "^ se
	 ) "" l) ^ " in " ^ (string_of_exp exp)
  | Block(l) -> "{"^ 
      (List.fold_left 
	 (fun s e -> 
	   let se = (string_of_exp e) in
	   if (String.length s) = 0 then se else s ^ "; " ^ se
	 ) "" l) ^"}"
;;

(*****************************************************)
  
let id = fun x -> x 


exception LexerError of string
let str = fun c ->
let s = String.create 1 in ((String.set s 0 c); s)
	
	
			    
    let primitiveList = ["number?";"function?";"arity";
			 "list?";"null?";"cons?";"cons";"first";"rest"]
    let keywordList = ["if";"then";"else";"map";"to";"let";"in";"null";"true";"false"]
    let operatorList = ['+';'-';'*';'/';'~';'=';'<';'>';'&';'|';':';'!']
    let delimiterList = ['(';')';'[';']';',';';']
    let whitespaceList = [' ';'\t';'\r';'\n']


    let digit = fun x ->
      (let i = int_of_char x in
      (i >= 48) & (i<=57))
    and
	alphanumeric= fun x->
	  let i = int_of_char x in
	  ((i>=48) & (i<=57)) or 
	  ((i>=65) & (i<=90)) or
	  ((i>=97) & (i<=122)) or
	  (i = (int_of_char '_')) or
	  (i = (int_of_char '?'))

  
    type token = 
	Keyword of string
      | Primitive of string
      | Delimiter of string
      | Operator of string
      | Number of int
      | Variable of string
      | EOF

    let string_of_token = fun x -> match x with
    | Keyword (s)  -> s
    | Primitive(s) -> s
    | Delimiter(s) -> s
    | Operator(s)  -> s
    | Number(n)    -> string_of_int n
    | Variable(s)  -> s
    | EOF          -> ""
	  
(* makeLexer : ('a -> Scanf.Scanning.scanbuf) -> 'a -> 'b -> token = <fun> *)
	  
    let makeLexer = fun makeScanbuf -> fun input ->
      (* function temporary vars *)
      let rec scanbuf = (makeScanbuf input)  and
	  peek = ref ' '    and 
	  nextToken = ref EOF and 
	  updatePeek = (fun _->
	    if (Scanf.Scanning.end_of_input scanbuf) then
	      peek := char_of_int 0
	    else
	      peek := (Scanf.bscanf scanbuf "%c" id))
      in
      (* main looping function *)
      let rec loop = fun _ ->
	if !peek = (char_of_int 0) then EOF
	else if (List.mem !peek operatorList) then
	  let firstch = ref !peek in 
	  updatePeek();
	  if (List.mem !firstch [':';'!';'<';'>']) then
	    (if (!peek = '=') then
	      (* need to also add in '<', and '-' maybe *)
	      let x = Operator ( (str !firstch) ^ (str !peek) ) in (updatePeek(); x)
	    else if (List.mem !firstch ['!';':']) then
	      raise (LexerError ("invalid char '" ^ str !firstch ^"'"))
	    else Operator (str !firstch))
	  else if (!firstch = '/' & !peek ='/') then
	    (let restLine = (Scanf.bscanf scanbuf "%s@\n" id) in (updatePeek(); loop()))
	  else Operator (str !firstch)
	else if (List.mem !peek whitespaceList) then (updatePeek(); loop())
	else if (List.mem !peek delimiterList) then
	  (let ch = !peek in updatePeek(); Delimiter(str ch))
	else if (alphanumeric !peek) then
	  let firstch = ref !peek in 
	  let curr = ref "" in 
	  (while (alphanumeric !peek) do 
	    (curr := (!curr ^ str !peek); updatePeek())
	  done;
	   try 
	     let intValue = (int_of_string !curr) in Number (intValue)
	   with _ -> 
	     (if digit (! firstch) then
	       raise (LexerError ("invalid lead character "^ str !firstch ^" in identifier "))
	     else if (List.mem !curr primitiveList) then Primitive !curr
	     else if (List.mem !curr keywordList) then Keyword !curr
		 (* else if (!curr = 'ref') Operator !curr *)
	     else Variable !curr))
	else
	  raise (LexerError ("invalid char '"^ str !peek ^"'"))
      in (fun mode ->
	match (!nextToken, mode) with
	| (EOF, "peek")  -> (nextToken := loop(); !nextToken)
	| (EOF, y) -> loop()
	| (x  , "peek") -> !nextToken
	| (x  , y) -> (nextToken := EOF; x))
	

	
(* val make_file_lexer : string -> string -> token = <fun>  *)
(* val make_string_lexer : string -> string -> token = <fun> *)
let make_file_lexer = makeLexer (fun f -> Scanf.Scanning.from_file f)
let make_string_lexer = makeLexer (fun f -> Scanf.Scanning.from_string f)


let printToken = fun x -> match x with
| Keyword (s)  -> print_string ("K("^ s ^")")
| Primitive(s) -> print_string ("P("^ s ^")")
| Delimiter(s) -> print_string ("D("^ s ^")")
| Operator(s)  -> print_string ("O("^ s ^")")
| Number(n)    -> print_string ("N("^ (string_of_int n) ^")")
| Variable(s)  -> print_string ("V("^ s^")")
| EOF          -> print_string "EOF"

	  
(*  end;; *)
	 

(*

let x = make_file_lexer "tests/let.in";;



let last = ref (Number(0)) in
while not (!last =EOF) do 
  last := (x("pop")); 
  print_string ("found:"^ (string_of_token !last)^"\n")
done;;
print_string "\n\n";

*)