diff --git a/emacs/michelson-mode.el b/emacs/michelson-mode.el
new file mode 100644
index 000000000..3bc741ee5
--- /dev/null
+++ b/emacs/michelson-mode.el
@@ -0,0 +1,379 @@
+;; Major mode for editing Michelson smart contracts.
+
+(defvar michelson-mode-hook nil)
+
+(defgroup michelson nil
+  "Major mode for editing Michelson smart contracts."
+  :prefix "michelson-"
+  :group 'languages)
+
+(defgroup michelson-options nil
+  "General options for Michelson mode."
+  :prefix "michelson-"
+  :group 'michelson)
+
+(defcustom michelson-mode-client-command "tezos-client"
+  "Path to the `tezos-client' binary."
+  :type 'string
+  :group 'michelson-options)
+
+(defgroup michelson-faces nil
+  "Font lock faces for Michelson mode."
+  :prefix "michelson-"
+  :group 'michelson
+  :group 'faces)
+
+(defvar michelson-face-instruction
+  'michelson-face-instruction
+  "Face name for Michelson instructions.")
+(defface michelson-face-instruction
+  '((t (:inherit 'font-lock-keyword-face)))
+  "Face for Michelson instructions."
+  :group 'michelson-faces)
+
+(defvar michelson-face-type
+  'michelson-face-type
+  "Face name for Michelson types.")
+(defface michelson-face-type
+   '((t (:inherit 'font-lock-type-face)))
+   "Face for Michelson types."
+   :group 'michelson-faces)
+
+(defvar michelson-face-constant
+  'michelson-face-constant
+  "Face name for Michelson constants.")
+(defface michelson-face-constant
+   '((t (:inherit 'font-lock-constant-face)))
+   "Face for Michelson constants."
+   :group 'michelson-faces)
+
+(defvar michelson-face-instruction
+  'michelson-face-instruction
+  "Face name for Michelson instructions.")
+(defface michelson-face-annotation
+   '((t (:inherit 'font-lock-string-face)))
+   "Face for Michelson annotations."
+   :group 'michelson-faces)
+
+(defvar michelson-face-comment
+  'michelson-face-comment
+  "Face name for Michelson comments.")
+(defface michelson-face-comment
+   '((t (:inherit 'font-lock-comment-face)))
+   "Face for Michelson comments."
+   :group 'michelson-faces)
+
+(defvar michelson-face-error
+  'michelson-face-error
+  "Face name for Michelson comments.")
+(defface michelson-face-error
+  '(( ((class color) (background light)) (:background "MistyRose") )
+    ( ((class color) (background dark)) (:background "DarkRed") ))
+   "Face for Michelson annotations."
+   :group 'michelson-faces)
+
+(defun michelson-customize-options ()
+  "Open the general customization group for Michelson mode."
+  (interactive)
+  (customize-group-other-window `michelson-options))
+
+(defun michelson-customize-faces ()
+  "Open the face customization group for Michelson mode."
+  (interactive)
+  (customize-group-other-window `michelson-faces))
+
+(defconst michelson-mode-map
+  (let ((michelson-mode-map (make-sparse-keymap)))
+    ;; menu
+    (define-key michelson-mode-map
+      [menu-bar michelson-menu]
+      (cons "Michelson" (make-sparse-keymap "michelson-menu")))
+    (define-key michelson-mode-map
+      [menu-bar michelson-menu faces]
+      (cons "Display options group" 'michelson-customize-faces))
+    (define-key michelson-mode-map
+      [menu-bar michelson-menu options]
+      (cons "General options group" 'michelson-customize-options))
+    (define-key michelson-mode-map
+      [menu-bar michelson-menu separator]
+      '(menu-item "--"))
+    (define-key michelson-mode-map
+      [menu-bar michelson-menu what]
+      (cons "What's under the cursor?" 'michelson-type-at-point))
+    ;; keys
+    (define-key michelson-mode-map
+      (kbd "C-j") 'newline-and-indent)
+    (define-key michelson-mode-map
+      (kbd "TAB") 'indent-for-tab-command)
+    (define-key michelson-mode-map
+      (kbd "<f1>") 'michelson-type-at-point)
+    michelson-mode-map))
+
+(defun michelson-font-lock-syntactic-face-function (s)
+  (cond ((nth 3 s) 'font-lock-constant-face)
+        (t 'michelson-face-comment)))
+
+(defconst michelson-font-lock-defaults
+  (list
+   (list
+    '("\\<[0-9]+\\>" . michelson-face-constant)
+    '("\\<[A-Z][a-z_0-9]+\\>" . michelson-face-constant)
+    '("\\<[A-Z][A-Z_0-9]*\\>" . michelson-face-instruction)
+    '("\\<\$[A-Za-z-_0-9]*\\>" . michelson-face-annotation)
+    '("\\<[a-z][a-z_0-9]*\\>" . michelson-face-type))
+   nil nil nil nil
+   '(font-lock-syntactic-face-function . michelson-font-lock-syntactic-face-function)))
+
+(defconst michelson-mode-syntax-table
+  (let ((michelson-mode-syntax-table (make-syntax-table)))
+    (modify-syntax-entry ?_ "w" michelson-mode-syntax-table)
+    (modify-syntax-entry ?/ ". 1n4" michelson-mode-syntax-table)
+    (modify-syntax-entry ?* ". 23" michelson-mode-syntax-table)
+    (modify-syntax-entry ?# "<b" michelson-mode-syntax-table)
+    (modify-syntax-entry ?\n ">b" michelson-mode-syntax-table)
+    michelson-mode-syntax-table))
+
+(defun in-space ()
+  (or (looking-at "[[:space:]\n]")
+      (equal (get-text-property (point) 'face)
+             'michelson-face-comment)))
+
+(defun michelson-goto-previous-token ()
+  (interactive)
+  (if (bobp)
+      (cons 0 nil)
+    (progn
+      (backward-char 1)
+      (while (and (not (bobp)) (in-space)) (backward-char 1))
+      (let ((token-face (get-text-property (point) 'face)))
+        (forward-char 1)
+        (let ((end-of-token (point)))
+          (backward-char 1)
+          (unless (looking-at "[{()};]")
+            (while (and (not (bobp))
+                        (equal (get-text-property (point) 'face) token-face))
+              (backward-char 1))
+            (when (not (equal (get-text-property (point) 'face) token-face))
+              (forward-char 1)))
+          (cons (point) (buffer-substring-no-properties (point) end-of-token)))))))
+
+(defun michelson-goto-next-token ()
+  (interactive)
+  (if (eobp)
+      (cons (point) nil)
+    (progn
+      (while (and (not (eobp)) (in-space)) (forward-char 1))
+      (let ((token-face (get-text-property (point) 'face)))
+        (let ((start-of-token (point)))
+          (if (looking-at "[{()};]")
+              (forward-char 1)
+            (progn
+              (while (and (not (eobp))
+                          (equal (get-text-property (point) 'face) token-face))
+                (forward-char 1))))
+          (cons start-of-token (buffer-substring-no-properties start-of-token (point))))))))
+
+(defun michelson-goto-opener ()
+  (interactive)
+  (let ((paren-level 0))
+    (while (and (not (bobp))
+                (or (> paren-level 0)
+                    (not (looking-at "[{(]"))))
+      (cond ((looking-at "[{(]")
+             (setq paren-level (- paren-level 1)))
+            ((looking-at "[})]")
+             (setq paren-level (+ paren-level 1))))
+      (michelson-goto-previous-token))
+    (cons (point)
+          (when (looking-at "[{(]")
+            (buffer-substring-no-properties (point) (+ (point) 1))))))
+
+(defun michelson-goto-closer ()
+  (interactive)
+  (let ((paren-level 0) (last-token ""))
+    (while (and (not (eobp))
+                (or (> paren-level 0)
+                    (not (string-match "[)}]" last-token))))
+      (cond ((looking-at "[{(]")
+             (setq paren-level (+ paren-level 1)))
+            ((looking-at "[})]")
+             (setq paren-level (- paren-level 1))))
+      (setq last-token (cdr (michelson-goto-next-token))))
+    (cons (point)
+          (when (looking-at "[)}]")
+            (buffer-substring-no-properties (point) (+ (point) 1))))))
+
+(defun michelson-goto-previous-application-start ()
+  (interactive)
+  (let ((paren-level 0) (application-start 0))
+    (while (and (not (bobp))
+                (or (> paren-level 0)
+                    (not (looking-at "[{(;]"))))
+      (cond ((looking-at "[{(]")
+             (setq paren-level (- paren-level 1)))
+            ((looking-at "[})]")
+             (setq paren-level (+ paren-level 1))))
+      (setq application-start (point))
+      (michelson-goto-previous-token))
+    (cons application-start (goto-char application-start))))
+
+(defun michelson-indent ()
+  "Indent current line of Michelson code."
+  (interactive)
+  (let ((new-indentation 0)
+        (previous-indentation (current-indentation))
+        (previous-column (current-column))
+        (current-token
+         (save-excursion
+           (beginning-of-line 1)
+           (michelson-goto-next-token))))
+    (save-excursion
+      (end-of-line 0)
+      (let ((previous-token
+             (save-excursion (michelson-goto-previous-token)))
+            (previous-opener
+             (save-excursion (michelson-goto-opener))))
+        (cond ((and (not (cdr previous-opener))
+                    (not (cdr previous-token)))
+               (setq new-indentation 0))
+              ((and (not (cdr previous-opener))
+                    (equal (cdr previous-token) ";"))
+               (setq new-indentation 0))
+              ((not (cdr previous-opener))
+               (setq new-indentation 2))
+              ((and (equal (cdr current-token) "}")
+                    (equal (cdr previous-opener) "{"))
+               (goto-char (car previous-opener))
+               (setq new-indentation (current-column)))
+              ((and (or (equal (cdr previous-token) ";")
+                        (equal (cdr previous-token) "{"))
+                    (equal (cdr previous-opener) "{"))
+               (goto-char (car previous-opener))
+               (setq new-indentation (+ (current-column) 2)))
+              ((equal (cdr previous-opener) "{")
+               (progn
+                 (michelson-goto-previous-application-start)
+                 (let ((default-param-indentation
+                         (+ (current-column) 2))
+                       (first-param-point
+                        (save-excursion
+                          (michelson-goto-next-token)
+                          (car (michelson-goto-next-token)))))
+                   (if (= first-param-point (car current-token))
+                       (setq new-indentation default-param-indentation)
+                     (progn
+                       (goto-char first-param-point)
+                       (setq new-indentation (current-column)))))))
+              ((and (equal (cdr current-token) ")")
+                    (equal (cdr previous-opener) "("))
+               (goto-char (car previous-opener))
+               (setq new-indentation (current-column)))
+              ((equal (cdr previous-token) "(")
+               (goto-char (car previous-token))
+               (setq new-indentation (+ (current-column) 1)))
+              ((equal (cdr previous-opener) "(")
+               (goto-char (car previous-opener))
+               (setq new-indentation (+ (current-column) 3))))))
+    (indent-line-to new-indentation)
+    (beginning-of-line)
+    (forward-char
+     (+ (- previous-column previous-indentation) new-indentation))
+    (when (< (current-column) new-indentation)
+      (beginning-of-line)
+      (forward-char new-indentation))))
+
+(defun michelson-token-at-point ()
+  "Display the token closest to the cursor."
+  (interactive)
+  (let ((message
+         (cdr (save-excursion
+                (michelson-goto-next-token)
+                (michelson-goto-previous-token)))))
+    (display-message-or-buffer message "*Michelson*")))
+
+(defun michelson-type-at-point ()
+  "Display the type of the expression under the cursor."
+  (interactive)
+  (let ((tmp-file (concat buffer-file-name ".emacs")))
+    (write-region (point-min) (point-max) tmp-file nil 'no-message)
+    (let* ((stdout
+            (shell-command-to-string
+             (concat
+              michelson-mode-client-command
+              " typecheck program "
+              tmp-file
+              " -details -emacs")))
+           (record
+            (car (read-from-string stdout)))
+           (errors
+            (cdr (assoc 'errors record)))
+           (types
+            (cdr (assoc 'types record)))
+           (message ""))
+      (delete-file tmp-file)
+      (remove-overlays)
+      (setq message "")
+      (dolist (elt types)
+        (if (and (<= (car elt) (point)) (<= (point) (cadr elt))
+                 (equal (get-text-property (point) 'face)
+                        'michelson-face-instruction))
+            (setq message (cadr (cdr elt)))))
+      (dolist (elt errors)
+        (overlay-put (make-overlay (car elt) (cadr elt)) 'face 'michelson-face-error)
+        (if (and (<= (car elt) (point)) (<= (point) (cadr elt)))
+            (progn
+              (if (string= "" message)
+                  nil
+                (setq message (concat message "\n")))
+              (setq message (concat message (cadr (cdr elt)))))))
+      (display-message-or-buffer message "*Michelson*"))))
+
+(defun michelson-update-minibuffer-info ()
+  (when (nth 2 michelson-state) (cancel-timer (nth 2 michelson-state)))
+  (setf
+   (nth 2 michelson-state)
+   (run-at-time
+    "0.3 sec" nil
+    (lambda (buffer)
+      (with-current-buffer buffer
+        (setf (nth 2 michelson-state) nil)
+        (when (not (= (nth 0 michelson-state) (point)))
+          (setf (nth 0 michelson-state) (point))
+          (michelson-type-at-point))))
+    (current-buffer))))
+
+(define-derived-mode michelson-mode prog-mode "Michelson"
+  "Major mode for editing Michelson smart contracts."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map michelson-mode-map)
+  (set-syntax-table michelson-mode-syntax-table)
+  (set
+   (make-local-variable 'font-lock-defaults)
+   michelson-font-lock-defaults)
+  (set
+   (make-local-variable 'indent-line-function)
+   'michelson-indent)
+  (set
+   (make-local-variable 'indent-for-tab-command)
+   'michelson-indent)
+  (set
+   (make-local-variable 'michelson-state)
+   (list 0 0 nil))
+  (add-to-list
+   (make-local-variable 'pre-command-hook)
+   'michelson-update-minibuffer-info)
+  (add-to-list
+   (make-local-variable 'focus-in-hook)
+   'michelson-update-minibuffer-info)
+  (setq major-mode 'michelson-mode)
+  (setq mode-name "Michelson")
+  (setq indent-tabs-mode nil)
+  (setq show-trailing-whitespace t)
+  (setq buffer-file-coding-system 'utf-8-unix)
+  (run-hooks 'michelson-mode-hook))
+
+(add-to-list 'auto-mode-alist '("\\.tz\\'" . michelson-mode))
+(add-to-list 'auto-mode-alist '("\\.tez\\'" . michelson-mode))
+
+(provide 'michelson-mode)
diff --git a/src/client/embedded/alpha/client_proto_context.ml b/src/client/embedded/alpha/client_proto_context.ml
index 14a09c3fe..b22c3daab 100644
--- a/src/client/embedded/alpha/client_proto_context.ml
+++ b/src/client/embedded/alpha/client_proto_context.ml
@@ -45,7 +45,7 @@ let transfer rpc_config
   begin match arg with
     | Some arg ->
         Client_proto_programs.parse_data arg >>=? fun arg ->
-        return (Some arg)
+        return (Some arg.ast)
     | None -> return None
   end >>=? fun parameters ->
   Client_proto_rpcs.Context.Contract.counter
@@ -105,7 +105,7 @@ let originate_contract rpc_config
     ~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
     ~(code:Script.code) ~init ~fee () =
   Client_proto_programs.parse_data init >>=? fun storage ->
-  let storage = Script.{ storage ; storage_type = code.storage_type } in
+  let storage = Script.{ storage=storage.ast ; storage_type = code.storage_type } in
   Client_proto_rpcs.Context.Contract.counter
     rpc_config block source >>=? fun pcounter ->
   let counter = Int32.succ pcounter in
@@ -357,7 +357,7 @@ let commands () =
         ~name:"prg" ~desc: "script of the account\n\
                             combine with -init if the storage type is not unit"
       @@ stop
-    end begin fun neu (_, manager) balance (_, source) code cctxt ->
+    end begin fun neu (_, manager) balance (_, source) { ast = code } cctxt ->
       check_contract cctxt neu >>=? fun () ->
       get_delegate_pkh cctxt !delegate >>=? fun delegate ->
       get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
diff --git a/src/client/embedded/alpha/client_proto_programs.ml b/src/client/embedded/alpha/client_proto_programs.ml
index 3338ae1b6..75850f6c6 100644
--- a/src/client/embedded/alpha/client_proto_programs.ml
+++ b/src/client/embedded/alpha/client_proto_programs.ml
@@ -13,20 +13,20 @@ open Client_proto_args
 let report_parse_error _prefix exn _lexbuf =
   let open Lexing in
   let open Script_located_ir in
-  let print_loc ppf ((sl, sc), (el, ec)) =
-    if sl = el then
-      if sc = ec then
-      Format.fprintf ppf
-        "at line %d character %d"
-        sl sc
+  let print_loc ppf (s, e) =
+    if s.line = e.line then
+      if s.column = e.column then
+        Format.fprintf ppf
+          "at line %d character %d"
+          s.line s.column
       else
-      Format.fprintf ppf
-        "at line %d characters %d to %d"
-        sl sc ec
+        Format.fprintf ppf
+          "at line %d characters %d to %d"
+          s.line s.column e.column
     else
       Format.fprintf ppf
         "from line %d character %d to line %d character %d"
-        sl sc el ec in
+        s.line s.column e.line e.column in
   match exn with
   | Missing_program_field n ->
       failwith "missing script %s" n
@@ -83,15 +83,16 @@ and print_expr locations ppf = function
       Format.fprintf ppf "(%a)" (print_expr_unwrapped locations) expr
   | expr -> print_expr_unwrapped locations ppf expr
 
+let print_stack ppf = function
+  | [] -> Format.fprintf ppf "[]"
+  | more ->
+      Format.fprintf ppf "@[<hov 2>[ %a ]@]"
+        (Format.pp_print_list
+           ~pp_sep: (fun ppf () -> Format.fprintf ppf " :@ ")
+           (print_expr_unwrapped no_locations))
+        more
+
 let print_typed_code locations ppf (expr, type_map) =
-  let print_stack ppf = function
-    | [] -> Format.fprintf ppf "[]"
-    | more ->
-        Format.fprintf ppf "@[<hov 2>[ %a ]@]"
-          (Format.pp_print_list
-             ~pp_sep: (fun ppf () -> Format.fprintf ppf " :@ ")
-             (print_expr_unwrapped no_locations))
-          more in
   let rec print_typed_code_unwrapped ppf expr =
     match expr with
     | Script.Prim (loc, name, []) ->
@@ -178,6 +179,34 @@ let print_program locations ppf ((c : Script.code), type_map) =
     (print_expr no_locations) c.ret_type
     (print_typed_code locations) (c.code, type_map)
 
+let collect_error_locations errs =
+  let open Script_typed_ir in
+  let open Script_ir_translator in
+  let rec collect acc = function
+    | (Ill_typed_data (_, _, _)
+      | Ill_formed_type (_, _)
+      | Ill_typed_contract (_, _, _, _, _)) :: _
+    | [] -> acc
+    | (Invalid_arity (loc, _, _, _)
+      | Invalid_namespace (loc, _, _, _)
+      | Invalid_primitive (loc, _, _)
+      | Invalid_case (loc, _)
+      | Invalid_kind (loc, _, _)
+      | Fail_not_in_tail_position loc
+      | Undefined_cast (loc, _, _)
+      | Undefined_binop (loc, _, _, _)
+      | Undefined_unop (loc, _, _)
+      | Bad_return (loc, _, _)
+      | Bad_stack (loc, _, _, _)
+      | Unmatched_branches (loc, _, _)
+      | Transfer_in_lambda loc
+      | Invalid_constant (loc, _, _)
+      | Invalid_contract (loc, _)
+      | Comparable_type_expected (loc, _)) :: rest ->
+        collect (loc :: acc) rest
+    | _ :: rest -> collect acc rest in
+  collect [] errs
+
 let report_typechecking_errors ?show_types cctxt errs =
   let open Client_commands in
   let open Script_typed_ir in
@@ -214,38 +243,6 @@ let report_typechecking_errors ?show_types cctxt errs =
         Format.fprintf ppf "%a,@ %a"
           Format.pp_print_text first print_enumeration rest
     | [] -> assert false in
-  let rec collect_locations acc = function
-    | (Ill_typed_data (_, _, _)
-      | Ill_formed_type (_, _)
-      | Ill_typed_contract (_, _, _, _, _)) :: _
-    | [] ->
-        let assoc, _ =
-          List.fold_left
-            (fun (acc, i) l ->
-               if List.mem_assoc l acc then
-                 (acc, i)
-               else
-                 ((l, i) :: acc, i + 1))
-            ([], 1) acc in
-        (fun l -> try Some (List.assoc l assoc) with Not_found -> None)
-    | (Invalid_arity (loc, _, _, _)
-      | Invalid_namespace (loc, _, _, _)
-      | Invalid_primitive (loc, _, _)
-      | Invalid_case (loc, _)
-      | Invalid_kind (loc, _, _)
-      | Fail_not_in_tail_position loc
-      | Undefined_cast (loc, _, _)
-      | Undefined_binop (loc, _, _, _)
-      | Undefined_unop (loc, _, _)
-      | Bad_return (loc, _, _)
-      | Bad_stack (loc, _, _, _)
-      | Unmatched_branches (loc, _, _)
-      | Transfer_in_lambda loc
-      | Invalid_constant (loc, _, _)
-      | Invalid_contract (loc, _)
-      | Comparable_type_expected (loc, _)) :: rest ->
-        collect_locations (loc :: acc) rest
-    | _ :: rest -> collect_locations acc rest in
   let print_typechecking_error locations err =
     let print_loc ppf loc =
       match locations loc with
@@ -424,7 +421,17 @@ let report_typechecking_errors ?show_types cctxt errs =
       | (Ill_typed_data (_, _, _)
         | Ill_formed_type (_, _)
         | Ill_typed_contract (_, _, _, _, _)) :: rest ->
-          collect_locations [] rest
+          let collected =
+            collect_error_locations rest in
+          let assoc, _ =
+            List.fold_left
+              (fun (acc, i) l ->
+                 if List.mem_assoc l acc then
+                   (acc, i)
+                 else
+                   ((l, i) :: acc, i + 1))
+              ([], 1) collected in
+          (fun l -> try Some (List.assoc l assoc) with Not_found -> None)
       | _ -> locations in
     match errs with
     | [] -> Lwt.return ()
@@ -438,38 +445,58 @@ let report_typechecking_errors ?show_types cctxt errs =
       | err -> cctxt.warning "%a" pp_print_error [ err ])
     errs
 
-let parse_program s =
-  let lexbuf = Lexing.from_string s in
+type 'a parsed =
+  { ast : 'a ;
+    source : string ;
+    loc_table : (string * (int * Script_located_ir.location) list) list }
+
+let parse_program source =
+  let lexbuf = Lexing.from_string source in
   try
     return
-      (Concrete_parser.tree Concrete_lexer.(token (init_state ())) lexbuf |>
-       List.map Script_located_ir.strip_locations |> fun fields ->
+      (Concrete_parser.tree Concrete_lexer.(token (init_state ())) lexbuf |> fun fields ->
        let rec get_field n = function
-         | Script.Prim (_, pn, [ ctns ]) :: _ when n = pn -> ctns
+         | Script_located_ir.Prim (_, pn, [ ctns ]) :: _ when n = pn -> ctns
          | _ :: rest -> get_field n rest
          | [] -> raise (Script_located_ir.Missing_program_field n) in
-       Script.{ code = get_field "code" fields ;
-                arg_type = get_field "parameter" fields ;
-                ret_type = get_field "return" fields ;
-                storage_type = get_field "storage" fields }
-      )
+       let code, code_loc_table =
+         Script_located_ir.strip_locations (get_field "code" fields) in
+       let arg_type, parameter_loc_table =
+         Script_located_ir.strip_locations (get_field "parameter" fields) in
+       let ret_type, return_loc_table =
+         Script_located_ir.strip_locations (get_field "return" fields) in
+       let storage_type, storage_loc_table =
+         Script_located_ir.strip_locations (get_field "storage" fields) in
+       let ast = Script.{ code ; arg_type ; ret_type ; storage_type } in
+       let loc_table =
+         [ "code", code_loc_table ;
+           "parameter", parameter_loc_table ;
+           "return", return_loc_table ;
+           "storage", storage_loc_table ] in
+       { ast ; source ; loc_table })
   with
   | exn -> report_parse_error "program: " exn lexbuf
 
-let parse_data s =
-  let lexbuf = Lexing.from_string s in
+let parse_data source =
+  let lexbuf = Lexing.from_string source in
   try
     match Concrete_parser.tree Concrete_lexer.(token (init_state ())) lexbuf with
-    | [node] -> return (Script_located_ir.strip_locations node)
+    | [node] ->
+        let ast, loc_table = Script_located_ir.strip_locations node in
+        let loc_table = [ "data", loc_table ] in
+        return { ast ; source ; loc_table }
     | _ -> failwith "single data expression expected"
   with
   | exn -> report_parse_error "data: " exn lexbuf
 
-let parse_data_type s =
-  let lexbuf = Lexing.from_string s in
+let parse_data_type source =
+  let lexbuf = Lexing.from_string source in
   try
     match Concrete_parser.tree Concrete_lexer.(token (init_state ())) lexbuf with
-    | [node] -> return (Script_located_ir.strip_locations node)
+    | [node] ->
+        let ast, loc_table = Script_located_ir.strip_locations node in
+        let loc_table = [ "data", loc_table ] in
+        return { ast ; source ; loc_table }
     | _ -> failwith "single type expression expected"
   with
   | exn -> report_parse_error "data_type: " exn lexbuf
@@ -514,11 +541,20 @@ let unexpand_macros type_map (program : Script.code) =
   type_map, { program with code }
 
 module Program = Client_aliases.Alias (struct
-    type t = Script.code
-    let encoding = Script.code_encoding
+    type t = Script.code parsed
+    let encoding =
+      let open Data_encoding in
+      let loc_table_encoding =
+        assoc (list (tup2 uint16 Script_located_ir.location_encoding)) in
+      conv
+        (fun { ast ; source ; loc_table } -> (ast, source, loc_table))
+        (fun (ast, source, loc_table) -> { ast ; source ; loc_table })
+        (obj3
+           (req "ast" Script.code_encoding)
+           (req "source" string)
+           (req "loc_table" loc_table_encoding))
     let of_source _cctxt s = parse_program s
-    let to_source _ p =
-      return (Format.asprintf "%a" (print_program no_locations) (p, []))
+    let to_source _ { source } = return source
     let name = "program"
   end)
 
@@ -533,6 +569,11 @@ let commands () =
     "-details",
     Arg.Set show_types,
     "Show the types of each instruction" in
+  let emacs_mode = ref false in
+  let emacs_mode_arg =
+    "-emacs",
+    Arg.Set emacs_mode,
+    "Output in michelson-mode.el compatible format" in
   let trace_stack = ref false in
   let trace_stack_arg =
     "-trace-stack",
@@ -589,7 +630,7 @@ let commands () =
          let open Data_encoding in
          if !trace_stack then
            Client_proto_rpcs.Helpers.trace_code cctxt.rpc_config
-             cctxt.config.block program (storage, input, !amount) >>= function
+             cctxt.config.block program.ast (storage.ast, input.ast, !amount) >>= function
            | Ok (storage, output, trace) ->
                cctxt.message
                  "@[<v 0>@[<v 2>storage@,%a@]@,\
@@ -600,7 +641,7 @@ let commands () =
                     (fun ppf (loc, gas, stack) ->
                        Format.fprintf ppf
                          "- @[<v 0>location: %d (remaining gas: %d)@,\
-                            [ @[<v 0>%a ]@]@]"
+                          [ @[<v 0>%a ]@]@]"
                          loc gas
                          (Format.pp_print_list (print_expr no_locations))
                          stack))
@@ -612,7 +653,7 @@ let commands () =
                return ()
          else
            Client_proto_rpcs.Helpers.run_code cctxt.rpc_config
-             cctxt.config.block program (storage, input, !amount) >>= function
+             cctxt.config.block program.ast (storage.ast, input.ast, !amount) >>= function
            | Ok (storage, output) ->
                cctxt.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
                  (print_expr no_locations) storage
@@ -624,24 +665,77 @@ let commands () =
                return ()) ;
 
     command ~group ~desc: "ask the node to typecheck a program"
-      ~args: [ show_types_arg ]
+      ~args: [ show_types_arg ; emacs_mode_arg ]
       (prefixes [ "typecheck" ; "program" ]
        @@ Program.source_param
        @@ stop)
       (fun program cctxt ->
          let open Data_encoding in
-         Client_proto_rpcs.Helpers.typecheck_code cctxt.rpc_config cctxt.config.block program >>= function
-         | Ok type_map ->
-             let type_map, program = unexpand_macros type_map program in
-             cctxt.message "Well typed" >>= fun () ->
-             if !show_types then
-               cctxt.message "%a" (print_program no_locations) (program, type_map) >>= fun () ->
-               return ()
-             else return ()
-         | Error errs ->
-             report_typechecking_errors
-               ?show_types:(if !show_types then Some program else None) cctxt errs >>= fun () ->
-             failwith "ill-typed program") ;
+         Client_proto_rpcs.Helpers.typecheck_code
+           cctxt.rpc_config cctxt.config.block program.ast >>= fun res ->
+         if !emacs_mode then
+           let emacs_type_map type_map =
+             (Utils.filter_map
+                (fun (n, loc) ->
+                   try
+                     let bef, aft = List.assoc (n + 1) type_map in
+                     Some (loc, bef, aft)
+                   with
+                     Not_found -> None)
+                (List.assoc "code" program.loc_table),
+              []) in
+           begin match res with
+             | Ok type_map ->
+                 Lwt.return (emacs_type_map type_map)
+             | Error errs ->
+                 let msg = Buffer.create 5000 in
+                 let cctxt = Client_commands.make_context
+                     (fun _ t -> Buffer.add_string msg t ; Buffer.add_char msg '\n' ; Lwt.return ()) in
+                 match errs with
+                 | Ecoproto_error (Script_ir_translator.Ill_formed_type
+                                     (Some ("return" | "parameter" | "storage" as field), _) :: errs) :: _ ->
+                     report_typechecking_errors cctxt [ Ecoproto_error errs ] >>= fun () ->
+                     Lwt.return ([], [ List.assoc 0 (List.assoc field program.loc_table), Buffer.contents msg ])
+                 | Ecoproto_error (Script_ir_translator.Ill_typed_contract (_, _, _, _, type_map) :: errs) :: _ ->
+                     (report_typechecking_errors cctxt [ Ecoproto_error errs ]  >>= fun () ->
+                      let (types, _) = emacs_type_map type_map in
+                      let loc = match collect_error_locations errs with
+                        | hd :: _ -> hd - 1
+                        | [] -> 0 in
+                      Lwt.return (types, [ List.assoc loc (List.assoc "code" program.loc_table), Buffer.contents msg ]))
+                 | _ -> Lwt.return ([], [])
+           end >>= fun (types, errors) ->
+           cctxt.message
+             "(@[<v 0>(types . (@[<v 0>%a@]))@,\
+              (errors . (@[<v 0>%a@])))@]"
+             (Format.pp_print_list
+                (fun ppf (({ Script_located_ir.point = s },
+                           { Script_located_ir.point = e }),
+                          bef, aft) ->
+                  Format.fprintf ppf "(%d %d \"%s\")" (s + 1) (e + 1)
+                    (Format.asprintf "@[<v 0>%a@, \\u2B87@,%a@]"
+                       print_stack bef print_stack aft)))
+             types
+             (Format.pp_print_list
+                (fun ppf (({ Script_located_ir.point = s },
+                           { Script_located_ir.point = e }),
+                          err) ->
+                  Format.fprintf ppf "(%d %d %S)" (s + 1) (e + 1) err))
+             errors >>= fun () ->
+           return ()
+         else
+           match res with
+           | Ok type_map ->
+               let type_map, program = unexpand_macros type_map program.ast in
+               cctxt.message "Well typed" >>= fun () ->
+               if !show_types then
+                 cctxt.message "%a" (print_program no_locations) (program, type_map) >>= fun () ->
+                 return ()
+               else return ()
+           | Error errs ->
+               report_typechecking_errors
+                 ?show_types:(if !show_types then Some program.ast else None) cctxt errs >>= fun () ->
+               failwith "ill-typed program") ;
 
     command ~group ~desc: "ask the node to typecheck a data expression"
       (prefixes [ "typecheck" ; "data" ]
@@ -654,7 +748,7 @@ let commands () =
       (fun data exp_ty cctxt ->
          let open Data_encoding in
          Client_proto_rpcs.Helpers.typecheck_data cctxt.Client_commands.rpc_config
-           cctxt.config.block (data, exp_ty) >>= function
+           cctxt.config.block (data.ast, exp_ty.ast) >>= function
          | Ok () ->
              cctxt.message "Well typed" >>= fun () ->
              return ()
@@ -672,7 +766,7 @@ let commands () =
       (fun data cctxt ->
          let open Data_encoding in
          Client_proto_rpcs.Helpers.hash_data cctxt.Client_commands.rpc_config
-           cctxt.config.block data >>= function
+           cctxt.config.block (data.ast) >>= function
          | Ok hash ->
              cctxt.message "%S" hash >>= fun () ->
              return ()
@@ -694,7 +788,7 @@ let commands () =
       (fun data (_, key) cctxt ->
          let open Data_encoding in
          Client_proto_rpcs.Helpers.hash_data cctxt.rpc_config
-           cctxt.config.block data >>= function
+           cctxt.config.block (data.ast) >>= function
          | Ok hash ->
              let signature = Ed25519.sign key (MBytes.of_string hash) in
              cctxt.message "Hash: %S@.Signature: %S"
diff --git a/src/client/embedded/alpha/client_proto_programs.mli b/src/client/embedded/alpha/client_proto_programs.mli
index eacca02fc..9fecea669 100644
--- a/src/client/embedded/alpha/client_proto_programs.mli
+++ b/src/client/embedded/alpha/client_proto_programs.mli
@@ -7,10 +7,15 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val parse_program: string -> Script.code tzresult Lwt.t
-val parse_data: string -> Script.expr tzresult Lwt.t
-val parse_data_type: string -> Script.expr tzresult Lwt.t
+type 'a parsed =
+  { ast : 'a ;
+    source : string ;
+    loc_table : (string * (int * Script_located_ir.location) list) list }
 
-module Program : Client_aliases.Alias with type t = Script.code
+val parse_program: string -> Script.code parsed tzresult Lwt.t
+val parse_data: string -> Script.expr parsed tzresult Lwt.t
+val parse_data_type: string -> Script.expr parsed tzresult Lwt.t
+
+module Program : Client_aliases.Alias with type t = Script.code parsed
 
 val commands: unit -> Client_commands.command list
diff --git a/src/client/embedded/alpha/concrete_lexer.mll b/src/client/embedded/alpha/concrete_lexer.mll
index f330757aa..ef5dd8e63 100644
--- a/src/client/embedded/alpha/concrete_lexer.mll
+++ b/src/client/embedded/alpha/concrete_lexer.mll
@@ -38,7 +38,9 @@ let curr_location lexbuf =
   lexbuf.Lexing.lex_start_p, lexbuf.Lexing.lex_curr_p
 
 let pos pos =
-  Lexing.(pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
+  { line = pos.Lexing.pos_lnum ;
+    column = pos.Lexing.pos_cnum - pos.Lexing.pos_bol ;
+    point = pos.Lexing.pos_cnum }
 
 let pos2 (start, stop) =
   pos start, pos stop
diff --git a/src/client/embedded/alpha/concrete_parser.mly b/src/client/embedded/alpha/concrete_parser.mly
index b57b9293f..bc77ea902 100644
--- a/src/client/embedded/alpha/concrete_parser.mly
+++ b/src/client/embedded/alpha/concrete_parser.mly
@@ -225,9 +225,13 @@ let expand original =
       expand_duuuuup ;
       expand_compare ]
 
+let loc = function
+  | Prim (loc, _, _) | Int (loc, _) | String (loc, _) | Seq (loc, _) -> loc
+
 let apply node arg =
   match node with
-  | Prim (loc, n, args) -> Prim (loc, n, args @ [arg])
+  | Prim ((sloc, _), n, args) ->
+     Prim ((sloc, snd (loc arg)), n, args @ [arg])
   | Int _ | String _ | Seq _ as _node ->
       raise (Invalid_application (node_location arg))
 
@@ -236,8 +240,12 @@ let rec apply_seq node = function
   | n1 :: n2 -> apply_seq (apply node n1) n2
 
 let pos p1 p2 =
-  Lexing.((p1.pos_lnum, p1.pos_cnum - p1.pos_bol),
-          (p2.pos_lnum, p2.pos_cnum - p2.pos_bol))
+  ({ line = p1.Lexing.pos_lnum ;
+    column = p1.Lexing.pos_cnum - p1.Lexing.pos_bol ;
+    point = p1.Lexing.pos_cnum },
+   { line = p2.Lexing.pos_lnum ;
+     column = p2.Lexing.pos_cnum - p2.Lexing.pos_bol ;
+     point = p2.Lexing.pos_cnum })
 
 %}
 
diff --git a/src/client/embedded/alpha/script_located_ir.ml b/src/client/embedded/alpha/script_located_ir.ml
index b3b123249..40e25f885 100644
--- a/src/client/embedded/alpha/script_located_ir.ml
+++ b/src/client/embedded/alpha/script_located_ir.ml
@@ -8,11 +8,27 @@
 (**************************************************************************)
 
 type point =
-  int * int
+  { line : int ;
+    column : int ;
+    point : int }
 
 type location =
   point * point
 
+let location_encoding =
+  let open Data_encoding in
+  let point_encoding =
+    conv
+      (fun { line ; column ; point } -> (line, column, point))
+      (fun (line, column, point) -> { line ; column ; point })
+      (obj3
+         (req "line" uint16)
+         (req "column" uint16)
+         (req "point" uint16)) in
+  obj2
+    (req "start" point_encoding)
+    (req "stop" point_encoding)
+
 type node =
   | Int of location * string
   | String of location * string
@@ -50,15 +66,21 @@ exception Missing_program_field of string
 
 let strip_locations root =
   let id = let id = ref (-1) in fun () -> incr id ; !id in
+  let loc_table = ref [] in
   let rec strip_locations l =
     let id = id () in
     match l with
-    | Int (_, v) ->
+    | Int (loc, v) ->
+        loc_table := (id, loc) :: !loc_table ;
         Script.Int (id, v)
-    | String (_, v) ->
+    | String (loc, v) ->
+        loc_table := (id, loc) :: !loc_table ;
         Script.String (id, v)
-    | Seq (_, seq) ->
+    | Seq (loc, seq) ->
+        loc_table := (id, loc) :: !loc_table ;
         Script.Seq (id, List.map strip_locations seq)
-    | Prim (_, name, seq) ->
+    | Prim (loc, name, seq) ->
+        loc_table := (id, loc) :: !loc_table ;
         Script.Prim (id, name, List.map strip_locations seq) in
-  strip_locations root
+  let stripped = strip_locations root in
+  stripped, List.rev !loc_table