global Init_Id_Chars, Id_Chars, Case_Exceptions

procedure Init_Char_Sets ()
   Init_Id_Chars := &letters ++ '_'
   Id_Chars := Init_Id_Chars ++ &digits
end

procedure Init_Case_Exceptions ()
   local s, id
   Case_Exceptions := table ()
   if s := Get_File_Contents ("case_except.txt") then
      every id := Find_Identifiers (s) do
         Case_Exceptions [Up_Case (id)] := id
end

procedure Get_File_Contents (filename)
   local f, r
   if f := open (filename, "r") then {
      r := "" &
      r := read (f) &
      while r ||:= '\n' || read (f)
      return r
   }
end

record Rich_Token (i, j, Parsed)

procedure Match_Pascal_Identifier (s, i)
   # если в позиции i начинается идентификатор, возвращает позицию конца идентификатора
   if /s then {
      s := &subject; i := &pos
   } else /i := 1
   return ((not any (Id_Chars, s [i - 1]),
            any (Init_Id_Chars, s[i]),
            (many (Id_Chars, s, i + 1) | i + 1)))
end

procedure Find_Identifiers (s, Arg_I)
   local id
   s ? {
      &pos := \Arg_I
      while
         (id := tab (Match_Pascal_Identifier ()), not suspend id) |
            tab (upto (Init_Id_Chars))
   }
end

procedure Up_Case (s)
   return map (s, &lcase, &ucase)
end

procedure Lo_Case (s)
   return map (s, &ucase, &lcase)
end

procedure Find_Chunks (Ident, Arg_I)
   local Chunk, j
   if /Ident then {
      Ident := &subject; Arg_I := &pos
   } else /Arg_I := 1

   Ident ? {
      &pos := Arg_I
      while
         if Chunk :=
           tab (many (&lcase)) |
           (tab (any (&ucase)) || tab (many (&lcase))) |
           tab ((j := many (&ucase),
                 if any (&lcase, &subject, j) then j - 1 else j )) |
           tab (many (&digits)) then not suspend Chunk
         else
           tab (many ('_'))
   }
end

procedure Chunk_To_Ada (Chunk)
   return \Case_Exceptions [Up_Case (Chunk)] |
     Up_Case (Chunk [1]) || Lo_Case (Chunk [2 : 0])
end

procedure Identifier_To_Ada (Ident)
   local Chunk, Result
   Result := ""
   every Chunk := Find_Chunks (Ident) do {
      * Result > 0 & Result ||:= '_';
      Result ||:= Chunk_To_Ada (Chunk)
   }
   return Result
end

procedure main ()
   local output
   local s, i, j
   Init_Char_Sets ()
   Init_Case_Exceptions ()
   s := Get_File_Contents ("test.txt") &
   output := open ("output.txt", "w") &
   {
      i := 1
      while i < *s do {
         if j := Match_Pascal_Identifier (s, i) then {
            writes (output, Identifier_To_Ada (s [i : j]))
            i := j
         } else {
            j := upto (Init_Id_Chars, s, i)
            writes (output, s [i : j])
            i := j
         }
      }
   }
end
