Michelson: enforce case sensitivity.

src/client/embedded/bootstrap/client_proto_programs.ml

@@ -121,10 +121,10 @@ let unexpand_macros type_map program =
   let open Script in
   let rec caddr type_map acc = function
     | [] -> Some (List.rev acc)
-    | Prim (loc, "car" , []) :: rest when List.mem_assoc loc type_map ->
+    | Prim (loc, "CAR" , []) :: rest when List.mem_assoc loc type_map ->
-        caddr type_map ((loc, "a") :: acc) rest
+        caddr type_map ((loc, "A") :: acc) rest
-    | Prim (loc, "cdr" , []) :: rest when List.mem_assoc loc type_map ->
+    | Prim (loc, "CDR" , []) :: rest when List.mem_assoc loc type_map ->
-        caddr type_map ((loc, "d") :: acc) rest
+        caddr type_map ((loc, "D") :: acc) rest
     | _ -> None in
   let rec unexpand type_map node =
     match node with
@@ -141,7 +141,7 @@ let unexpand_macros type_map program =
               type_map, Seq (loc, List.rev l)
           | Some l ->
               let locs, steps = List.split l in
-              let name = "c" ^ String.concat "" steps ^ "r" in
+              let name = "C" ^ String.concat "" steps ^ "R" in
               let first, last = List.hd locs, List.hd (List.rev locs) in
               let (before, _) = List.assoc first type_map in
               let (_, after) = List.assoc last type_map in
@@ -256,14 +256,13 @@ let commands () =
              let type_map, program = unexpand_macros type_map program in
              cctxt.message "Well typed" >>= fun () ->
              if !show_types then begin
-               print_program
+               cctxt.message "%a"
-                 (fun l -> List.mem_assoc l type_map)
+                 (print_program (fun l -> List.mem_assoc l type_map))
-                 Format.std_formatter program ;
+                 program >>= fun () ->
-               cctxt.message "@." >>= fun () ->
                Lwt_list.iter_s
                  (fun (loc, (before, after)) ->
                     cctxt.message
-                      "%3d@[<v 0> : [ @[<v 0>%a ]@]@,-> [ @[<v 0>%a ]@]@]@."
+                      "%3d@[<v 0> : [ @[<v 0>%a ]@]@,-> [ @[<v 0>%a ]@]@]"
                       loc
                       (Format.pp_print_list (print_ir (fun _ -> false)))
                       before

src/client/embedded/bootstrap/concrete_lexer.mll

@@ -306,7 +306,7 @@ and raw_token st = parse
 | ";" { SEMICOLON }
 
 | firstidentchar identchar *
-    { PRIM (String.lowercase_ascii (Lexing.lexeme lexbuf)) }
+    { PRIM (Lexing.lexeme lexbuf) }
 
 | int_literal
     { INT (Lexing.lexeme lexbuf) }

src/client/embedded/bootstrap/concrete_parser.mly

@@ -25,15 +25,15 @@ open Script_located_ir
 let expand_caddadr loc str =
   let len = String.length str in
   if len > 3
-  && String.get str 0 = 'c'
+  && String.get str 0 = 'C'
-  && String.get str (len - 1) = 'r' then
+  && String.get str (len - 1) = 'R' then
     let rec parse i acc =
       if i = 0 then
         Some (Seq (loc, acc))
       else
         match String.get str i with
-        | 'a' -> parse (i - 1) (Prim (loc, "car", []) :: acc)
+        | 'A' -> parse (i - 1) (Prim (loc, "CAR", []) :: acc)
-        | 'd' -> parse (i - 1) (Prim (loc, "cdr", []) :: acc)
+        | 'D' -> parse (i - 1) (Prim (loc, "CDR", []) :: acc)
         | _ -> None in
     parse (len - 2) []
   else
@@ -48,13 +48,13 @@ let decimal_of_roman roman =
   for i = (String.length roman) - 1 downto 0 do
     let n =
       match roman.[i] with
-      | 'm' -> 1000
+      | 'M' -> 1000
-      | 'd' -> 500
+      | 'D' -> 500
-      | 'c' -> 100
+      | 'C' -> 100
-      | 'l' -> 50
+      | 'L' -> 50
-      | 'x' -> 10
+      | 'X' -> 10
-      | 'v' -> 5
+      | 'V' -> 5
-      | 'i' -> 1
+      | 'I' -> 1
       | _ -> raise Not_a_roman
     in
     if Compare.Int.(n < !lastval)
@@ -67,8 +67,8 @@ let decimal_of_roman roman =
 let expand_dxiiivp loc str arg =
   let len = String.length str in
   if len > 3
-  && String.get str 0 = 'd'
+  && String.get str 0 = 'D'
-  && String.get str (len - 1) = 'p' then
+  && String.get str (len - 1) = 'P' then
     try
       let depth = decimal_of_roman (String.sub str 1 (len - 2)) in
       let rec make i =
@@ -76,7 +76,7 @@ let expand_dxiiivp loc str arg =
           arg
         else
           let sub = make (i - 1) in
-          Prim (loc, "dip", [ sub ]) in
+          Prim (loc, "DIP", [ Seq (loc, [ sub ]) ]) in
       Some (make depth)
     with Not_a_roman -> None
   else None
@@ -86,19 +86,19 @@ exception Not_a_pair
 let expand_paaiair loc str =
   let len = String.length str in
   if len > 4
-  && String.get str 0 = 'p'
+  && String.get str 0 = 'P'
-  && String.get str (len - 1) = 'r' then
+  && String.get str (len - 1) = 'R' then
     try
       let rec parse i acc =
-        if String.get str i = 'i'
+        if String.get str i = 'I'
-        && String.get str (i - 1) = 'a' then
+        && String.get str (i - 1) = 'A' then
-          parse (i - 2) (Prim (loc, "pair", []) :: acc)
+          parse (i - 2) (Prim (loc, "PAIR", []) :: acc)
-        else if String.get str i = 'a' then
+        else if String.get str i = 'A' then
           match acc with
           | [] ->
               raise Not_a_pair
           | acc :: accs ->
-              parse (i - 1) (Prim (loc, "dip", [ acc ]) :: accs)
+              parse (i - 1) (Prim (loc, "DIP", [ acc ]) :: accs)
         else
           raise Not_a_pair in
       Some (Seq (loc, parse (len - 2) []))