coollang/lib/driver.ml

(* v0 파이프라인.
   parse -> name resolution -> type check -> effect/capability check
   -> interface artifact + hash -> (cool run 시) 얇은 typed IR -> interpreter

   현재 구현된 단계: 어휘 분석, 구문 분석. *)

type error = { file : string; line : int; col : int; message : string }

let string_of_error { file; line; col; message } =
  Printf.sprintf "%s:%d:%d: %s" file line col message

let read_file file =
  try
    let ic = open_in_bin file in
    let n = in_channel_length ic in
    let s = really_input_string ic n in
    close_in ic;
    Ok s
  with Sys_error msg -> Error { file; line = 0; col = 0; message = msg }

let lex_file file =
  match read_file file with
  | Error e -> Error e
  | Ok src -> (
      match Lexer.lex_result src with
      | Ok tokens -> Ok tokens
      | Error { pos; msg } ->
          Error { file; line = pos.line; col = pos.col; message = msg })

let tokens (file : string) : (Token.t list, error list) result =
  match lex_file file with Ok ts -> Ok ts | Error e -> Error [ e ]

let parse_file file =
  match lex_file file with
  | Error e -> Error e
  | Ok tokens -> (
      match Parser.parse_result tokens with
      | Ok m -> Ok m
      | Error { pos; msg } ->
          Error { file; line = pos.line; col = pos.col; message = msg })

let ast (file : string) : (Ast.modul, error list) result =
  match parse_file file with Ok m -> Ok m | Error e -> Error [ e ]

let resolve (file : string) : (Resolve.info, error list) result =
  match parse_file file with
  | Error e -> Error [ e ]
  | Ok m -> (
      let info, errors = Resolve.resolve m in
      match errors with
      | [] -> Ok info
      | _ ->
          Error
            (List.map
               (fun (e : Resolve.error) ->
                 { file; line = e.pos.line; col = e.pos.col; message = e.msg })
               errors))

let typecheck (file : string) : (unit, error list) result =
  match parse_file file with
  | Error e -> Error [ e ]
  | Ok m -> (
      let _, rerrors = Resolve.resolve m in
      match rerrors with
      | _ :: _ ->
          Error
            (List.map
               (fun (e : Resolve.error) ->
                 { file; line = e.pos.line; col = e.pos.col; message = e.msg })
               rerrors)
      | [] -> (
          match Typecheck.check m with
          | [] -> Ok ()
          | terrors ->
              Error
                (List.map
                   (fun (e : Typecheck.error) ->
                     {
                       file;
                       line = e.pos.line;
                       col = e.pos.col;
                       message = e.msg;
                     })
                   terrors)))

let check (files : string list) : (unit, error list) result =
  match files with
  | [] ->
      Error [ { file = "<none>"; line = 0; col = 0; message = "검사할 파일이 없습니다" } ]
  | _ ->
      let errors =
        List.filter_map
          (fun f -> match typecheck f with Ok _ -> None | Error es -> Some es)
          files
        |> List.concat
      in
      if errors <> [] then Error errors
      else
        (* effect 검사까지는 통과했다. 통과했다고 말하지 않는다 — 파이프라인의
           나머지가 아직 없으므로 검사되지 않은 것이다. *)
        Error
          (List.map
             (fun f ->
               {
                 file = f;
                 line = 0;
                 col = 0;
                 message =
                   "effect/capability 검사까지 통과. move/affinity 검사가 아직 구현되지 않았습니다";
               })
             files)

let run (file : string) : (unit, error list) result =
  Error [ { file; line = 0; col = 0; message = "interpreter가 아직 구현되지 않았습니다" } ]