(*
 JungTaek Kim

 Copyright(c) 2000-2004 KAIST/SNU Research On Program Analysis System
 (National Creative Research Initiative Center 1998-2003)
 http://ropas.snu.ac.kr/n

 All rights reserved. This file is distributed under the terms of
 an Open Source License.
*)

signature SyntaxErrSig =
sig

type duplicate_type =
   DupTypeId | DupConId | DupVarId | DupLabel
 | DupStrId | DupFctId | DupSigId

type invalid_type =
   InvTypeId | InvTypeVar | InvConId | InvVarId | InvLabel
 | InvStrId | InvFctId | InvSigId
 | InvType | InvPat | InvAsPat | InvOrPat | InvExp | InvArrUpdate
 | InvDec | InvStrDec | InvRecBind | InvStrExp | InvSigExp
 | InvSpec | InvTopDec | InvTopDir

type msg_style = EngGentle | HanGentle | HanTough

type unmatched_type = Unclosed | DiffFunId

type error_kinds =
    Unmatched of unmatched_type * Location.t * string * Location.t * string
  | Duplicate of duplicate_type * Location.t * Location.t  * string
  | Invalid of invalid_type * Location.t
  | Predefined of Location.t * string
  | Missing of Location.t * string
  | Unknown of Location.t
  | Debug of Location.t * string
  (*
  | Orpaterr of Location.t
  *)

exception Error of error_kinds
exception Escape_error

val curmsg_style: msg_style ref
val report_error: error_kinds -> unit
end

structure NsyntaxErr : SyntaxErrSig = 
struct

open Format
open Location

type duplicate_type =
   DupTypeId | DupConId | DupVarId | DupLabel
 | DupStrId | DupFctId | DupSigId

type invalid_type =
   InvTypeId | InvTypeVar | InvConId | InvVarId | InvLabel
 | InvStrId | InvFctId | InvSigId
 | InvType | InvPat | InvAsPat | InvOrPat | InvExp | InvArrUpdate
 | InvDec | InvStrDec | InvRecBind | InvStrExp | InvSigExp
 | InvSpec | InvTopDec | InvTopDir

type msg_style = EngGentle | HanGentle | HanTough

type unmatched_type = Unclosed | DiffFunId

type error_kinds =
    Unmatched of unmatched_type * Location.t * string * Location.t * string
  | Duplicate of duplicate_type * Location.t * Location.t  * string
  | Invalid of invalid_type * Location.t
  | Predefined of Location.t * string
  | Missing of Location.t * string
  | Unknown of Location.t
  | Debug of Location.t * string
  (*
  | Orpaterr of Location.t
  *)

exception Error of error_kinds
exception Escape_error

val curmsg_style = ref HanGentle

fun print_loc x = Location.print Format.std_formatter x

fun duplicate_type_to_string x =
  let val (msg1, msg2, msg3) =
    case x of
      DupTypeId => ("type name", "ŸÀÔ À̸§", "ŸÀÔ À̸§")
    | DupConId => ("constructor name", "±¸¼ºÀÚ À̸§", "±¸¼ºÀÚ À̸§")
    | DupVarId => ("variable name", "º¯¼ö À̸§", "º¯¼ö À̸§")
    | DupLabel => ("record label", "·¹ÄÚµå Ç¥Áö", "·¹ÄÚµå Ç¥Áö")
    | DupStrId => ("structure name", "¸ðµâ À̸§", "¸ðµâ À̸§")
    | DupFctId => ("functor name", "ÆãÅÍ À̸§", "ÆãÅÍ À̸§")
    | DupSigId => ("signature name", "½Ã±×³Êó À̸§", "½Ã±×³Êó À̸§")
  in 
    case !curmsg_style of
      EngGentle => msg1
    | HanGentle => msg2
    | HanTough  => msg3
  end

fun invalid_type_to_string x =
  let val (msg1, msg2, msg3) =
    case x of
      InvTypeId => ("type name", "ŸÀÔ À̸§", "ŸÀÔ À̸§")
    | InvTypeVar => ("type variable", "ŸÀÔ º¯¼ö", "ŸÀÔ º¯¼ö")
    | InvConId => ("constructor name", "±¸¼ºÀÚ À̸§", "±¸¼ºÀÚ À̸§")
    | InvVarId => ("variable name", "º¯¼ö À̸§", "º¯¼ö À̸§")
    | InvLabel => ("record label", "·¹ÄÚµå Ç¥Áö", "·¹ÄÚµå Ç¥Áö")
    | InvStrId => ("structure name", "¸ðµâ À̸§", "¸ðµâ À̸§")
    | InvFctId => ("functor name", "ÆãÅÍ À̸§", "ÆãÅÍ À̸§")
    | InvSigId => ("signature name", "½Ã±×³Êó À̸§", "½Ã±×³Êó À̸§")
    | InvType => ("type", "ŸÀÔ", "ŸÀÔ")
    | InvAsPat => ("as pattern", "as ÆÐÅÏ", "as ÆÐÅÏ")
    | InvOrPat => ("or pattern", "or ÆÐÅÏ", "or ÆÐÅÏ")
    | InvPat => ("pattern", "ÆÐÅÏ", "ÆÐÅÏ")
    | InvExp => ("expression", "ÇÁ·Î±×·¥ Ç¥Çö", "ÇÁ·Î±×·¥ Ç¥Çö")
    | InvArrUpdate => ("array update", "¹è¿­ º¯°æ", "¹è¿­ º¯°æ")
    | InvDec => ("declaration", "ÇÁ·Î±×·¥ ¼±¾ð", "ÇÁ·Î±×·¥ ¼±¾ð")
    | InvStrDec => ("structure declaration", "¸ðµâ ¼±¾ð", "¸ðµâ ¼±¾ð")
    | InvRecBind => ("recursive binding", "Àç±ÍÀû ¼±¾ð", "Àç±ÍÀû ¼±¾ð")
    | InvStrExp => ("structure expression", "¸ðµâ Ç¥Çö", "¸ðµâ Ç¥Çö")
    | InvSigExp => ("signature expression", "½Ã±×³Êó Ç¥Çö", "½Ã±×³Êó Ç¥Çö")
    | InvSpec => ("specification", "Á¢¼Ó¹æ¾È", "Á¢¼Ó¹æ¾È")
    | InvTopDec => ("toplevel declaration", "ÃÖ»óÀ§ ¼±¾ð", "ÃÖ»óÀ§ ¼±¾ð")
    | InvTopDir => ("toplevel directive", "ÃÖ»óÀ§ ¸í·É", "ÃÖ»óÀ§ ¸í·É")
  in 
    case !curmsg_style of
      EngGentle => msg1
    | HanGentle => msg2
    | HanTough  => msg3
  end


fun print_head () = 
  (case !curmsg_style of
     EngGentle => print_string "Syntax error: "
   | HanGentle => print_string "¹®¹ý¿À·ù: "
   | HanTough  => print_string "¸ÛûÇÑ ½Ç¼ö: ")

fun print_msg (enggentle, hangentle, hantough) = 
  (case !curmsg_style of
     EngGentle => print_string enggentle
   | HanGentle => print_string hangentle
   | HanTough  => print_string hantough)
  
fun report_error(Unmatched(t, first_loc, first, second_loc, second)) =
      ((if not (String.length !Location.input_name = 0)
         || not (Location.highlight_locations first_loc second_loc)
      then (print_loc first_loc; print_loc second_loc));
      print_head();
      print_msg(second^" is not matched with "^first^".",
        second^"ÀÌ(°¡) "^first^"¿Í ¸ÂÁö ¾Ê½À´Ï´Ù.",
        second^"¶û "^first^"ÀÌ(°¡) ¸ÂÁö ¾Ê´Âµ¥."))
  | report_error(Duplicate(t, first_loc, second_loc, id)) =
      ((if not (String.length !Location.input_name = 0)
         || not (Location.highlight_locations first_loc second_loc)
      then (print_loc first_loc; print_loc second_loc));
      print_head();
      let val msg = duplicate_type_to_string t
       in print_msg(msg^" "^id^" are duplicated.",
            "Áߺ¹µÈ "^msg^" "^id^"ÀÌ(°¡) »ç¿ëµÇ¾ú½À´Ï´Ù.",
            msg^" "^id^"ÀÌ(°¡) ¼­·Î °ãÄ¡´Âµ¥.")
      end)
  | report_error(Invalid(t, loc)) =
      ((if not (String.length !Location.input_name = 0)
         || not (Location.highlight_locations loc loc)
      then print_loc loc);
      print_head();
      let val msg = invalid_type_to_string t
       in print_msg("invalid "^msg^" is used.",
            "À߸øµÈ "^msg^"ÀÌ(°¡) »ç¿ëµÇ¾ú½À´Ï´Ù.",
            msg^"ÀÌ(°¡) ÀÌ»óÇØ.")
      end)
  | report_error(Predefined(loc, id)) =
      ((if not (String.length !Location.input_name = 0)
         || not (Location.highlight_locations loc loc)
      then print_loc loc);
      print_head();
      print_msg("reserved name "^id^" is used.",
        "¹Ì¸® Á¤ÀÇµÈ À̸§ "^id^"ÀÌ(°¡) »ç¿ëµÇ¾ú½À´Ï´Ù.",
        id^"Àº(´Â) ÀÌ¹Ì ÂòÇصξúÀ¸´Ï ¾µ¼ö ¾ø¾î."))
  | report_error(Missing(loc, id)) =
      ((if not (String.length !Location.input_name = 0)
         || not (Location.highlight_locations loc loc)
      then print_loc loc);
      print_head();
      print_msg("'"^id^"' is missing.",
        "'"^id^"'ÀÌ(°¡) ºüÁ³½À´Ï´Ù.",
        "'"^id^"'Àº(´Â) ÀÌ¹Ì ÂòÇصξúÀ¸´Ï ¾µ¼ö ¾ø¾î."))
  | report_error(Unknown(loc)) =
      ((if not (String.length !Location.input_name = 0)
         || not (Location.highlight_locations loc loc)
      then print_loc loc);
      print_head();
      print_msg("unknown error.",
        "¾Ë¼ö ¾ø´Â ¿¡·¯.",
        "¸ð¸£´Â ¿¡·¯Àε¥."))
  | report_error(Debug(loc,s)) =
      ((if not (String.length !Location.input_name = 0)
         || not (Location.highlight_locations loc loc)
      then print_loc loc);
      print_head();
      print_msg("Debug:"^s,
        "Debug:"^s,
        "Debug:"^s))
end