Jagna/parser.ml

open Printf
open Tokenizer
open Location

type value = | Atom of string | List of value list
type located_value = | Atom of string * location | List of located_value list * location

let consume (stream : 'a Stream.t) : 'a option = match Stream.peek stream with
  | None -> None
  | Some x -> Stream.junk stream; Some x

type parse_result = | Ok of located_value | UnexpectedEof | ValueAfterEnd | UnexpectedClosedParen of location                      

let rec parse_list (tokens: located_token Stream.t) (lst : located_value list) (start_pos: position): parse_result =
  match consume tokens with
    Some (x, loc) -> begin
      match x with
      | Lpar ->
         begin
           match parse_list tokens [] (start_position loc) with
           | Ok res -> parse_list tokens (res :: lst) start_pos
           | err -> err          
         end
      | Rpar -> Ok (List ((List.rev lst) , Range (start_pos, end_position loc)))
      | Str s -> parse_list tokens ((Atom (s, loc)) :: lst) start_pos
    end
  | None -> UnexpectedEof
          
          
let parse_toplevel (tokens :  located_token Stream.t) : parse_result =
  let res = match consume tokens with
    | None -> UnexpectedEof
    | Some ((Str str), loc) ->  Ok (Atom (str, loc))
    | Some (Lpar, loc) -> parse_list tokens [] (start_position loc)
    | Some (Rpar, loc) -> UnexpectedClosedParen loc
  in match consume tokens with
     | None -> res
     | Some (q,w) -> printf "COO %s %s [[]]" (sprintf_token q) (sprintf_location w);ValueAfterEnd

let sprintf_located_value value =
  let spaces i = String.make i ' ' in
  let rec inner value identiation_level = match value with
    | Atom (str, loc) -> sprintf "%s%s: %s\n" (spaces identiation_level) (sprintf_location loc) str
    (* zostawwiam to tak i idę spać, do ulepszenia kiedy indziej *)
    | List (value, loc) -> sprintf "%s%s: (\n%s%s)\n" (spaces identiation_level) (sprintf_location loc) ( List.fold_left (fun a b -> a ^ b)  "" (List.map (function q -> inner q (identiation_level+1)) value)) (spaces identiation_level)
      in inner value 0