ligo/src/passes/1-parser/cameligo.ml

module AST      = Parser_cameligo.AST
module LexToken = Parser_cameligo.LexToken
module Lexer    = Lexer.Make(LexToken)
module Scoping  = Parser_cameligo.Scoping
module Region   = Simple_utils.Region
module ParErr   = Parser_cameligo.ParErr
module SSet     = Set.Make (String)

(* Mock IOs TODO: Fill them with CLI options *)

type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]

module SubIO =
  struct
    type options = <
      libs    : string list;
      verbose : SSet.t;
      offsets : bool;
      lang    : language;
      ext     : string;   (* ".mligo" *)
      mode    : [`Byte | `Point];
      cmd     : EvalOpt.command;
      mono    : bool
    >

    let options : options =
      object
        method libs    = []
        method verbose = SSet.empty
        method offsets = true
        method lang    = `CameLIGO
        method ext     = ".mligo"
        method mode    = `Point
        method cmd     = EvalOpt.Quiet
        method mono    = false
      end

    let make =
      EvalOpt.make ~libs:options#libs
                   ~verbose:options#verbose
                   ~offsets:options#offsets
                   ~lang:options#lang
                   ~ext:options#ext
                   ~mode:options#mode
                   ~cmd:options#cmd
                   ~mono:options#mono
  end

module Parser =
  struct
    type ast  = AST.t
    type expr = AST.expr
    include Parser_cameligo.Parser
  end

module ParserLog =
  struct
    type ast  = AST.t
    type expr = AST.expr
    include Parser_cameligo.ParserLog
  end

module Unit =
  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)

module Errors =
  struct
    let generic message =
      let title () = ""
      and message () = message.Region.value
      in Trace.error ~data:[] title message
  end

let apply parser =
  let local_fail error =
    Trace.fail
    @@ Errors.generic
    @@ Unit.format_error ~offsets:SubIO.options#offsets
                        SubIO.options#mode error in
  match parser () with
    Stdlib.Ok semantic_value -> Trace.ok semantic_value

  (* Lexing and parsing errors *)

  | Stdlib.Error error -> Trace.fail @@ Errors.generic error
  (* System errors *)

  | exception Sys_error msg ->
      Trace.fail @@ Errors.generic (Region.wrap_ghost msg)
  (* Scoping errors *)

  | exception Scoping.Error (Scoping.Reserved_name name) ->
      let token =
        Lexer.Token.mk_ident name.Region.value name.Region.region in
      (match token with
         Stdlib.Error LexToken.Reserved_name ->
           Trace.fail @@ Errors.generic @@ Region.wrap_ghost "Reserved name."
       | Ok invalid ->
          local_fail
            ("Reserved name.\nHint: Change the name.\n", None, invalid))

  | exception Scoping.Error (Scoping.Duplicate_variant name) ->
      let token =
        Lexer.Token.mk_constr name.Region.value name.Region.region
      in local_fail
           ("Duplicate constructor in this sum type declaration.\n\
             Hint: Change the constructor.\n", None, token)

  | exception Scoping.Error (Scoping.Non_linear_pattern var) ->
      let token =
        Lexer.Token.mk_ident var.Region.value var.Region.region in
      (match token with
         Stdlib.Error LexToken.Reserved_name ->
           Trace.fail @@ Errors.generic @@ Region.wrap_ghost "Reserved name."
       | Ok invalid ->
           local_fail ("Repeated variable in this pattern.\n\
                        Hint: Change the name.\n",
                       None, invalid))

  | exception Scoping.Error (Scoping.Duplicate_field name) ->
      let token =
        Lexer.Token.mk_ident name.Region.value name.Region.region in
      (match token with
         Stdlib.Error LexToken.Reserved_name ->
           Trace.fail @@ Errors.generic @@ Region.wrap_ghost "Reserved name."
       | Ok invalid ->
           local_fail
             ("Duplicate field name in this record declaration.\n\
               Hint: Change the name.\n",
              None, invalid))

(* Parsing a contract in a file *)

let parse_file source = apply (fun () -> Unit.contract_in_file source)

(* Parsing a contract in a string *)

let parse_string source = apply (fun () -> Unit.contract_in_string source)

(* Parsing an expression in a string *)

let parse_expression source = apply (fun () -> Unit.expr_in_string source)