diff --git a/bin/repl.ml b/bin/repl.ml
index 9a1b0f772..e65d5eefc 100644
--- a/bin/repl.ml
+++ b/bin/repl.ml
@@ -2,6 +2,7 @@ open Links_core
 open Utility
 open List
 open Sugartypes
+open CommonTypes
 
 module BS = Basicsettings
 
@@ -227,11 +228,11 @@ let evaluate_parse_result envs parse_result =
                   | Some (finfo, _, None, location) ->
                     let v =
                       match location with
-                      | `Server | `Unknown ->
+                      | Location.Server | Location.Unknown ->
                         `FunctionPtr (var, None)
-                      | `Client ->
+                      | Location.Client ->
                         `ClientFunction (Js.var_name_binder (var, finfo))
-                      | `Native -> assert false in
+                      | Location.Native -> assert false in
                     let t = Var.info_type finfo in v, t
                   | _ -> assert false
                 in
diff --git a/core/chaser.ml b/core/chaser.ml
index 3bc8fbb99..26606af8a 100644
--- a/core/chaser.ml
+++ b/core/chaser.ml
@@ -1,5 +1,6 @@
 open Utility
 open ModuleUtils
+open Sugartypes
 
 (* Helper functions *)
 (* Helper function: given top-level module name, maps to expected filename *)
@@ -37,7 +38,7 @@ object(self)
     {< shadow_table = shadow_table >}
 
   method! bindingnode = function
-    | `QualifiedImport ns ->
+    | QualifiedImport ns ->
         (* Try to resolve the import; if not, add to ICs list *)
         let lookup_ref = List.hd ns in
         (try
@@ -45,7 +46,7 @@ object(self)
            self
          with
            _ -> self#add_import_candidate lookup_ref)
-    | `Module (n, bs) ->
+    | Module (n, bs) ->
         let new_path = path @ [n] in
         let fqn = lst_to_path new_path in
         let o = self#bind_shadow n fqn in
@@ -71,7 +72,7 @@ let rec add_module_bindings deps dep_map =
     | [module_name]::ys ->
       (try
         let (bindings, _) = StringMap.find module_name dep_map in
-        Sugartypes.with_dummy_pos (`Module (module_name, bindings)) :: (add_module_bindings ys dep_map)
+        with_dummy_pos (Module (module_name, bindings)) :: (add_module_bindings ys dep_map)
       with Notfound.NotFound _ ->
         (failwith (Printf.sprintf "Trying to find %s in dep map containing keys: %s\n"
           module_name (print_list (List.map fst (StringMap.bindings dep_map))))));
@@ -109,7 +110,7 @@ let add_dependencies module_prog =
   let sorted_deps = Graph.topo_sort_sccs deps in
   (* Each entry should be *precisely* one element (otherwise we have cycles) *)
   assert_no_cycles sorted_deps;
-  (* Now, build up binding list where each opened dependency is mapped to a `Module containing
+  (* Now, build up binding list where each opened dependency is mapped to a Module containing
    * its list of inner bindings. *)
   (* FIXME: This isn't reassigning positions! What we'll want is to retain the positions, but modify
    * the position data type to keep track of the module filename we're importing from. *)
diff --git a/core/checkXmlQuasiquotes.ml b/core/checkXmlQuasiquotes.ml
index 95541b656..2cfc92042 100644
--- a/core/checkXmlQuasiquotes.ml
+++ b/core/checkXmlQuasiquotes.ml
@@ -16,19 +16,19 @@ let check mode pos e =
 
       method! phrase = fun ({node=e; pos} as phrase) ->
         match e with
-        | `Xml (_, _, _, children) ->
+        | Xml (_, _, _, children) ->
           o#list (fun o -> o#phrase) children
-        | `FormBinding _ ->
+        | FormBinding _ ->
           if mode <> `Formlet then
             {< error = Some (`FormletBinding, pos) >}
           else
             super#phrase phrase
-        | `FormletPlacement _ ->
+        | FormletPlacement _ ->
           if mode <> `Page then
             {< error = Some (`FormletPlacement, pos) >}
           else
             super#phrase phrase
-        | `PagePlacement _ ->
+        | PagePlacement _ ->
           if mode <> `Page then
             {< error = Some (`PagePlacement, pos) >}
           else
@@ -72,18 +72,18 @@ object (o)
 
   method! phrase = fun ({node=e; pos} as phrase) ->
     match e with
-    | `Xml _ when mode = `Quasi ->
+    | Xml _ when mode = `Quasi ->
       super#phrase phrase
-    | `Xml _ when mode = `Exp ->
+    | Xml _ when mode = `Exp ->
       check `Xml pos e;
       o#phrase_with `Quasi phrase
-    | `Formlet (body, yields) when mode = `Exp ->
+    | Formlet (body, yields) when mode = `Exp ->
       check `Formlet pos body.node;
       (o#phrase_with `Quasi body)#phrase yields
-    | `Page body when mode = `Exp ->
+    | Page body when mode = `Exp ->
       check `Page pos body.node;
       o#phrase_with `Quasi body
-    | (`Formlet _ | `Page _) when mode = `Quasi ->
+    | (Formlet _ | Page _) when mode = `Quasi ->
       (* The parser should prevent this from ever happening *)
       raise (Errors.SugarError (pos, "Malformed quasiquote (internal error)"))
     | _ when mode = `Quasi ->
diff --git a/core/closures.ml b/core/closures.ml
index 480863761..35e31a451 100644
--- a/core/closures.ml
+++ b/core/closures.ml
@@ -1,4 +1,5 @@
 open Utility
+open CommonTypes
 
 type freevars = {termvars: (Ir.binder list) ; typevars: Types.quantifier list} [@@deriving show]
 type fenv = freevars IntMap.t [@@deriving show]
@@ -585,15 +586,15 @@ struct
           let newvar = Types.fresh_raw_variable () in
           let make_new_type_variable () = Unionfind.fresh (`Var (newvar, subkind, `Rigid)) in
           let new_meta_var, updated_maps = match primary_kind with
-            | `Type ->
+            | PrimaryKind.Type ->
               let new_type_variable = make_new_type_variable () in
               let t = `MetaTypeVar new_type_variable in
               (`Type new_type_variable, (IntMap.add typevar t type_map, row_map, presence_map))
-            | `Row ->
+            | PrimaryKind.Row ->
               let new_type_variable = make_new_type_variable () in
               let r = (Types.empty_field_env, new_type_variable, false) in
               (`Row new_type_variable, (type_map, IntMap.add typevar r row_map, presence_map))
-            | `Presence ->
+            | PrimaryKind.Presence ->
               let new_type_variable = make_new_type_variable () in
               let p = `Var new_type_variable in
               (`Presence new_type_variable, (type_map, row_map, IntMap.add typevar p presence_map)) in
diff --git a/core/commonTypes.ml b/core/commonTypes.ml
new file mode 100644
index 000000000..3e1d6ac30
--- /dev/null
+++ b/core/commonTypes.ml
@@ -0,0 +1,125 @@
+module Linearity = struct
+  type t = Any | Unl
+    [@@deriving eq,show]
+
+  let is_any = function
+    | Any -> true
+    | _   -> false
+
+  let is_nonlinear = function
+    | Unl -> true
+    | _   -> false
+
+  let to_string = function
+    | Any -> "Any"
+    | Unl -> "Unl"
+end
+
+(* Convenient aliases for constructing values *)
+let lin_any = Linearity.Any
+let lin_unl = Linearity.Unl
+
+module DeclaredLinearity = struct
+  type t = Lin | Unl
+    [@@deriving show]
+
+  let is_linear = function
+    | Lin -> true
+    | _   -> false
+
+  let is_nonlinear = function
+    | Unl -> true
+    | _   -> false
+end
+
+(* Convenient aliases for constructing values *)
+let dl_lin = DeclaredLinearity.Lin
+let dl_unl = DeclaredLinearity.Unl
+
+module Restriction = struct
+  type t =
+    | Any
+    | Base
+    | Session
+    | Effect
+    [@@deriving eq,show]
+
+  let is_any = function
+    | Any -> true
+    | _   -> false
+
+  let is_base = function
+    | Base -> true
+    | _    -> false
+
+  let is_session = function
+    | Session -> true
+    | _       -> false
+
+  let is_effect = function
+    | Effect -> true
+    | _      -> false
+
+  let to_string = function
+    | Any     -> "Any"
+    | Base    -> "Base"
+    | Session -> "Session"
+    | Effect  -> "Eff"
+end
+
+(* Convenient aliases for constructing values *)
+let res_any     = Restriction.Any
+let res_base    = Restriction.Base
+let res_session = Restriction.Session
+let res_effect  = Restriction.Effect
+
+module PrimaryKind = struct
+  type t =
+    | Type
+    | Row
+    | Presence
+    [@@deriving show,eq]
+
+  let to_string = function
+    | Type     -> "Type"
+    | Row      -> "Row"
+    | Presence -> "Presence"
+end
+
+(* Convenient aliases for constructing values *)
+let pk_type     = PrimaryKind.Type
+let pk_row      = PrimaryKind.Row
+let pk_presence = PrimaryKind.Presence
+
+module Location = struct
+  type t = Client | Server | Native | Unknown
+    [@@deriving show]
+
+  let is_client = function
+    | Client -> true
+    | _      -> false
+
+  let is_server = function
+    | Server -> true
+    | _      -> false
+
+  let is_native = function
+    | Native -> true
+    | _      -> false
+
+  let is_unknown = function
+    | Unknown -> true
+    | _      -> false
+
+  let to_string = function
+    | Client -> "client"
+    | Server -> "server"
+    | Native -> "native"
+    | Unknown -> "unknown"
+end
+
+(* Convenient aliases for constructing values *)
+let loc_client  = Location.Client
+let loc_server  = Location.Server
+let loc_native  = Location.Native
+let loc_unknown = Location.Unknown
diff --git a/core/compilePatterns.ml b/core/compilePatterns.ml
index b152ad105..e891f9758 100644
--- a/core/compilePatterns.ml
+++ b/core/compilePatterns.ml
@@ -8,6 +8,7 @@
   to adjust our intermediate language.
 *)
 
+open CommonTypes
 open Utility
 open Ir
 
@@ -74,10 +75,10 @@ let lookup_name name (nenv, _tenv, _eff, _penv) =
 
 let lookup_effects (_nenv, _tenv, eff, _penv) = eff
 
-let rec desugar_pattern : Ir.scope -> Sugartypes.pattern -> pattern * raw_env =
+let rec desugar_pattern : Ir.scope -> Sugartypes.Pattern.with_pos -> pattern * raw_env =
   fun scope {Sugartypes.node=p; Sugartypes.pos} ->
-    let pp = desugar_pattern scope in
-    let empty = (NEnv.empty, TEnv.empty, Types.make_empty_open_row (`Any, `Any)) in
+    let desugar_pat = desugar_pattern scope in
+    let empty = (NEnv.empty, TEnv.empty, Types.make_empty_open_row (lin_any, res_any)) in
     let (++) (nenv, tenv, _) (nenv', tenv', eff') = (NEnv.extend nenv nenv', TEnv.extend tenv tenv', eff') in
     let fresh_binder (nenv, tenv, eff) bndr =
       assert (Sugartypes.binder_has_type bndr);
@@ -86,38 +87,39 @@ let rec desugar_pattern : Ir.scope -> Sugartypes.pattern -> pattern * raw_env =
       let xb, x = Var.fresh_var (t, name, scope) in
       xb, (NEnv.bind nenv (name, x), TEnv.bind tenv (x, t), eff)
     in
+      let open Sugartypes.Pattern in
       match p with
-        | `Any -> `Any, empty
-        | `Nil -> `Nil, empty
-        | `Cons (p, ps) ->
-            let p, env = pp p in
-            let ps, env' = pp ps in
+        | Any -> `Any, empty
+        | Nil -> `Nil, empty
+        | Cons (p, ps) ->
+            let p, env = desugar_pat p in
+            let ps, env' = desugar_pat ps in
               `Cons (p, ps), env ++ env'
-        | `List [] -> pp (Sugartypes.with_pos pos `Nil)
-        | `List (p::ps) ->
-            let p, env = pp p in
-            let ps, env' = pp (Sugartypes.with_pos pos (`List ps)) in
+        | List [] -> desugar_pat (Sugartypes.with_pos pos Nil)
+        | List (p::ps) ->
+            let p, env = desugar_pat p in
+            let ps, env' = desugar_pat (Sugartypes.with_pos pos (List ps)) in
               `Cons (p, ps), env ++ env'
-        | `Variant (name, None) -> `Variant (name, `Any), empty
-        | `Variant (name, Some p) ->
-            let p, env = pp p in
+        | Variant (name, None) -> `Variant (name, `Any), empty
+        | Variant (name, Some p) ->
+            let p, env = desugar_pat p in
             `Variant (name, p), env
-        | `Effect (name, ps, k) ->
+        | Effect (name, ps, k) ->
            let ps, env =
              List.fold_right
                (fun p (ps, env) ->
-                 let p', env' = pp p in
+                 let p', env' = desugar_pat p in
                  (p' :: ps, env ++ env'))
                ps ([], empty)
            in
-           let k, env' = pp k in
+           let k, env' = desugar_pat k in
            `Effect (name, ps, k), env ++ env'
-        | `Negative names -> `Negative (StringSet.from_list names), empty
-        | `Record (bs, p) ->
+        | Negative names -> `Negative (StringSet.from_list names), empty
+        | Record (bs, p) ->
             let bs, env =
               List.fold_right
                 (fun (name, p) (bs, env) ->
-                   let p, env' = pp p in
+                   let p, env' = desugar_pat p in
                      StringMap.add name p bs, env ++ env')
                 bs
                 (StringMap.empty, empty) in
@@ -125,26 +127,26 @@ let rec desugar_pattern : Ir.scope -> Sugartypes.pattern -> pattern * raw_env =
               match p with
                 | None -> None, env
                 | Some p ->
-                    let p, env' = pp p in
+                    let p, env' = desugar_pat p in
                       Some p, env ++ env'
             in
               `Record (bs, p), env
-        | `Tuple ps ->
+        | Tuple ps ->
             let bs = mapIndex (fun p i -> (string_of_int (i+1), p)) ps in
-              pp (Sugartypes.with_pos pos (`Record (bs, None)))
-        | `Constant constant ->
+              desugar_pat (Sugartypes.with_pos pos (Record (bs, None)))
+        | Constant constant ->
             `Constant constant, empty
-        | `Variable b ->
+        | Variable b ->
             let xb, env = fresh_binder empty b in
               `Variable xb, env
-        | `As (b, p) ->
+        | As (b, p) ->
             let xb, env = fresh_binder empty b in
-            let p, env' = pp p in
+            let p, env' = desugar_pat p in
               `As (xb, p), env ++ env'
-        | `HasType (p, (_, Some t)) ->
-            let p, env = pp p in
+        | HasType (p, (_, Some t)) ->
+            let p, env = desugar_pat p in
               `HasType (p, t), env
-        | `HasType (_, (_, None)) -> assert false
+        | HasType (_, (_, None)) -> assert false
 
 type raw_bound_computation = raw_env -> computation
 type bound_computation = env -> computation
diff --git a/core/desugarAlienBlocks.ml b/core/desugarAlienBlocks.ml
index 5f67b87ff..9a820265a 100644
--- a/core/desugarAlienBlocks.ml
+++ b/core/desugarAlienBlocks.ml
@@ -19,13 +19,13 @@ object(self)
   inherit SugarTraversals.map as super
 
   method! phrasenode : phrasenode -> phrasenode = function
-    | `Block (bs, phr) ->
+    | Block (bs, phr) ->
         let flattened_bindings =
           List.concat (
             List.map (fun b -> ((flatten_bindings ())#binding b)#get_bindings) bs
           ) in
         let flattened_phrase = self#phrase phr in
-        `Block (flattened_bindings, flattened_phrase)
+        Block (flattened_bindings, flattened_phrase)
     | x -> super#phrasenode x
 end
 and flatten_bindings = fun () ->
@@ -37,16 +37,16 @@ object(self)
   method get_bindings = List.rev bindings
 
   method! binding = function
-    | {node=`AlienBlock (lang, lib, decls); _} ->
+    | {node=AlienBlock (lang, lib, decls); _} ->
         self#list (fun o ((bnd, dt)) ->
           let name = name_of_binder bnd in
-          o#add_binding (with_dummy_pos (`Foreign (bnd, name, lang, lib, dt)))) decls
-    | {node=`Module (name, bindings); _} ->
+          o#add_binding (with_dummy_pos (Foreign (bnd, name, lang, lib, dt)))) decls
+    | {node=Module (name, bindings); _} ->
         let flattened_bindings =
           List.concat (
             List.map (fun b -> ((flatten_bindings ())#binding b)#get_bindings) bindings
           ) in
-        self#add_binding (with_dummy_pos (`Module (name, flattened_bindings)))
+        self#add_binding (with_dummy_pos (Module (name, flattened_bindings)))
     | b -> self#add_binding ((flatten_simple ())#binding b)
 
   method! program = function
diff --git a/core/desugarCP.ml b/core/desugarCP.ml
index 3d60b262b..cfc04b36b 100644
--- a/core/desugarCP.ml
+++ b/core/desugarCP.ml
@@ -19,21 +19,21 @@ object (o : 'self_type)
   inherit (TransformSugar.transform env) as super
 
   method! phrasenode = function
-    | `CP p ->
+    | CP p ->
        let rec desugar_cp = fun o {node = p; _} ->
          match p with
-         | Unquote (bs, e) ->
+         | CPUnquote (bs, e) ->
             let envs = o#backup_envs in
             let (o, bs) = TransformSugar.listu o (fun o -> o#binding) bs in
             let (o, e, t) = o#phrase e in
             let o = o#restore_envs envs in
             o, block_node (bs, e), t
-         | Grab ((c, _), None, p) ->
+         | CPGrab ((c, _), None, p) ->
             let (o, e, t) = desugar_cp o p in
             o, block_node
                 ([val_binding (any_pat dp) (fn_appl_var wait_str c)],
                  with_dummy_pos e), t
-         | Grab ((c, Some (`Input (_a, s), grab_tyargs)), Some {node=x, Some u; _}, p) -> (* FYI: a = u *)
+         | CPGrab ((c, Some (`Input (_a, s), grab_tyargs)), Some {node=x, Some u; _}, p) -> (* FYI: a = u *)
             let envs = o#backup_envs in
             let venv = TyEnv.bind (TyEnv.bind (o#get_var_env ()) (x, u))
                                   (c, s) in
@@ -41,16 +41,17 @@ object (o : 'self_type)
             let (o, e, t) = desugar_cp o p in
             let o = o#restore_envs envs in
             o, block_node
-                ([val_binding (with_dummy_pos (`Record ([("1", variable_pat ~ty:u x);
-                                                         ("2", variable_pat ~ty:s c)], None)))
+                 ([val_binding (with_dummy_pos (
+                                    Pattern.Record ([("1", variable_pat ~ty:u x);
+                                                     ("2", variable_pat ~ty:s c)], None)))
                                (fn_appl receive_str grab_tyargs [var c])],
                  with_dummy_pos e), t
-         | Give ((c, _), None, p) ->
+         | CPGive ((c, _), None, p) ->
             let (o, e, t) = desugar_cp o p in
             o, block_node
                 ([val_binding (any_pat dp) (fn_appl_var close_str c)],
                  with_dummy_pos e), t
-         | Give ((c, Some (`Output (_t, s), give_tyargs)), Some e, p) ->
+         | CPGive ((c, Some (`Output (_t, s), give_tyargs)), Some e, p) ->
             let envs = o#backup_envs in
             let o = {< var_env = TyEnv.bind (o#get_var_env ()) (c, s) >} in
             let (o, e, _typ) = o#phrase e in
@@ -60,35 +61,35 @@ object (o : 'self_type)
                 ([val_binding (variable_pat ~ty:s c)
                               (fn_appl send_str give_tyargs [e; var c])],
                  with_dummy_pos p), t
-         | GiveNothing ({node=c, Some t; _}) ->
-            o, `Var c, t
-         | Select ({node=c, Some s; _}, label, p) ->
+         | CPGiveNothing ({node=c, Some t; _}) ->
+            o, Var c, t
+         | CPSelect ({node=c, Some s; _}, label, p) ->
             let envs = o#backup_envs in
             let o = {< var_env = TyEnv.bind (o#get_var_env ()) (c, TypeUtils.select_type label s) >} in
             let (o, p, t) = desugar_cp o p in
             let o = o#restore_envs envs in
             o, block_node
                 ([val_binding (variable_pat ~ty:(TypeUtils.select_type label s) c)
-                               (with_dummy_pos (`Select (label, var c)))],
+                               (with_dummy_pos (Select (label, var c)))],
                  with_dummy_pos p), t
-         | Offer ({node=c, Some s; _}, cases) ->
+         | CPOffer ({node=c, Some s; _}, cases) ->
             let desugar_branch (label, p) (o, cases) =
               let envs = o#backup_envs in
               let o = {< var_env = TyEnv.bind (o#get_var_env ()) (c, TypeUtils.choice_at label s) >} in
               let (o, p, t) = desugar_cp o p in
-              let pat : pattern = with_dummy_pos (`Variant (label,
+              let pat : Pattern.with_pos = with_dummy_pos (Pattern.Variant (label,
                       Some (variable_pat ~ty:(TypeUtils.choice_at label s) c))) in
               o#restore_envs envs, ((pat, with_dummy_pos p), t) :: cases in
             let (o, cases) = List.fold_right desugar_branch cases (o, []) in
             (match List.split cases with
                 | (_, []) -> assert false (* Case list cannot be empty *)
                 | (cases, t :: _ts) ->
-                    o, `Offer (var c, cases, Some t), t)
-         | Link ({node=c, Some ct; _}, {node=d, Some _; _}) ->
+                    o, Offer (var c, cases, Some t), t)
+         | CPLink ({node=c, Some ct; _}, {node=d, Some _; _}) ->
             o, fn_appl_node link_sync_str [`Type ct; `Row o#lookup_effects]
                             [var c; var d],
             Types.make_endbang_type
-         | Comp ({node=c, Some s; _}, left, right) ->
+         | CPComp ({node=c, Some s; _}, left, right) ->
             let envs = o#backup_envs in
             let (o, left, _typ) = desugar_cp {< var_env = TyEnv.bind (o#get_var_env ()) (c, s) >} left in
             let (o, right, t) = desugar_cp {< var_env = TyEnv.bind (o#get_var_env ()) (c, Types.dual_type s) >} right in
diff --git a/core/desugarDatatypes.ml b/core/desugarDatatypes.ml
index f48405e33..5343b0c63 100644
--- a/core/desugarDatatypes.ml
+++ b/core/desugarDatatypes.ml
@@ -1,3 +1,4 @@
+open CommonTypes
 open Types
 open Sugartypes
 open Utility
@@ -19,7 +20,7 @@ object (self)
     | _ -> self
 
   method! phrasenode = function
-    | `TableLit (_, (_, None), _, _, _) -> {< all_desugared = false >}
+    | TableLit (_, (_, None), _, _, _) -> {< all_desugared = false >}
     | p -> super#phrasenode p
 end
 
@@ -73,32 +74,27 @@ object (self)
   method! bindingnode = function
     (* type declarations bind variables; exclude those from the
        analysis. *)
-    | `Type _    -> self
-    | b          -> super#bindingnode b
-
-  method! datatypenode = function
-    | `TypeVar (x, k, freedom) -> self#add (x, (`Type, k), freedom)
-    | `Mu (v, t)       -> let o = self#bind (v, (`Type, None), `Rigid) in o#datatype t
-    | `Forall (qs, t)  ->
-        let o =
-          List.fold_left
-            (fun o q ->
-               o#bind (rigidify q))
-            self
-            qs
-        in
-          o#datatype t
-    | dt                  -> super#datatypenode dt
-
-  method! row_var = function
-    | `Closed               -> self
-    | `Open (x, k, freedom) -> self#add (x, (`Row, k), freedom)
-    | `Recursive (s, r)     -> let o = self#bind (s, (`Row, None), `Rigid) in o#row r
-
-  method! fieldspec = function
-    | `Absent -> self
-    | `Present t -> self#datatype t
-    | `Var (x, k, freedom) -> self#add (x, (`Presence, k), freedom)
+    | Type _    -> self
+    | b         -> super#bindingnode b
+
+  method! datatypenode = let open Datatype in
+    function
+    | TypeVar (x, k, freedom) -> self#add (x, (pk_type, k), freedom)
+    | Mu (v, t)       -> let o = self#bind (v, (pk_type, None), `Rigid) in o#datatype t
+    | Forall (qs, t)  ->
+        let o = List.fold_left (fun o q -> o#bind (rigidify q)) self qs in
+        o#datatype t
+    | dt -> super#datatypenode dt
+
+  method! row_var = let open Datatype in function
+    | Closed               -> self
+    | Open (x, k, freedom) -> self#add (x, (pk_row, k), freedom)
+    | Recursive (s, r)     -> let o = self#bind (s, (pk_row, None), `Rigid) in o#row r
+
+  method! fieldspec = let open Datatype in function
+    | Absent -> self
+    | Present t -> self#datatype t
+    | Var (x, k, freedom) -> self#add (x, (pk_presence, k), freedom)
 end
 
 type var_env = { tenv : Types.meta_type_var StringMap.t;
@@ -117,44 +113,45 @@ struct
     match t' with
     | {node = t; pos} ->
       let lookup_type t = StringMap.find t var_env.tenv in
+      let open Datatype in
       match t with
-        | `TypeVar (s, _, _) -> (try `MetaTypeVar (lookup_type s)
+        | TypeVar (s, _, _) -> (try `MetaTypeVar (lookup_type s)
                                 with NotFound _ -> raise (UnexpectedFreeVar s))
-        | `QualifiedTypeApplication _ -> assert false (* will have been erased *)
-        | `Function (f, e, t) ->
+        | QualifiedTypeApplication _ -> assert false (* will have been erased *)
+        | Function (f, e, t) ->
             `Function (Types.make_tuple_type (List.map (datatype var_env) f),
-                       effect_row var_env alias_env e,
-                       datatype var_env t)
-        | `Lolli (f, e, t) ->
+                      effect_row var_env alias_env e,
+                      datatype var_env t)
+        | Lolli (f, e, t) ->
             `Lolli (Types.make_tuple_type (List.map (datatype var_env) f),
                        effect_row var_env alias_env e,
                        datatype var_env t)
-        | `Mu (name, t) ->
+        | Mu (name, t) ->
             let var = Types.fresh_raw_variable () in
             (* FIXME: shouldn't we support other subkinds for recursive types? *)
             let point = Unionfind.fresh (`Var (var, default_subkind, `Flexible)) in
             let tenv = StringMap.add name point var_env.tenv in
             let _ = Unionfind.change point (`Recursive (var, datatype {var_env with tenv=tenv} t)) in
               `MetaTypeVar point
-        | `Forall (qs, t) ->
+        | Forall (qs, t) ->
             let desugar_quantifier (var_env, qs) =
               fun (name, kind, _freedom) ->
                 match kind with
-                | `Type, subkind ->
+                | PrimaryKind.Type, subkind ->
                     let subkind = concrete_subkind subkind in
                     let var = Types.fresh_raw_variable () in
                     let point = Unionfind.fresh (`Var (var, subkind, `Rigid)) in
                     let q = (var, subkind, `Type point) in
                     let var_env = {var_env with tenv=StringMap.add name point var_env.tenv} in
                       var_env, q::qs
-                | `Row, subkind ->
+                | PrimaryKind.Row, subkind ->
                     let subkind = concrete_subkind subkind in
                     let var = Types.fresh_raw_variable () in
                     let point = Unionfind.fresh (`Var (var, subkind, `Rigid)) in
                     let q = (var, subkind, `Row point) in
                     let var_env = {var_env with renv=StringMap.add name point var_env.renv} in
                       var_env, q::qs
-                | `Presence, subkind ->
+                | PrimaryKind.Presence, subkind ->
                     let subkind = concrete_subkind subkind in
                     let var = Types.fresh_raw_variable () in
                     let point = Unionfind.fresh (`Var (var, subkind, `Rigid)) in
@@ -167,35 +164,36 @@ struct
             let qs = List.rev qs in
             let t = datatype var_env t in
               `ForAll (Types.box_quantifiers qs, t)
-        | `Unit -> Types.unit_type
-        | `Tuple ks ->
+        | Unit -> Types.unit_type
+        | Tuple ks ->
             let labels = map string_of_int (Utility.fromTo 1 (1 + length ks)) in
             let unit = Types.make_empty_closed_row () in
             let present (s, x) = (s, `Present x)
             in
               `Record (fold_right2 (curry (Types.row_with -<- present)) labels (map (datatype var_env) ks) unit)
-        | `Record r -> `Record (row var_env alias_env r)
-        | `Variant r -> `Variant (row var_env alias_env r)
-        | `Effect r -> `Effect (row var_env alias_env r)
-        | `Table (r, w, n) -> `Table (datatype var_env r, datatype var_env w, datatype var_env n)
-        | `List k -> `Application (Types.list, [`Type (datatype var_env k)])
-        | `TypeApplication (tycon, ts) ->
+        | Record r -> `Record (row var_env alias_env r)
+        | Variant r -> `Variant (row var_env alias_env r)
+        | Effect r -> `Effect (row var_env alias_env r)
+        | Table (r, w, n) -> `Table (datatype var_env r, datatype var_env w, datatype var_env n)
+        | List k -> `Application (Types.list, [`Type (datatype var_env k)])
+        | TypeApplication (tycon, ts) ->
             begin match SEnv.find alias_env tycon with
               | None -> raise (UnboundTyCon (pos,tycon))
               | Some (`Alias (qs, _dt)) ->
                  let exception Kind_mismatch (* TODO add more information *) in
                  let match_kinds (q, t) =
-                   let primary_kind_of_type_arg : Sugartypes.type_arg -> primary_kind = function
-                     | `Type _ -> `Type
-                     | `Row _ -> `Row
-                     | `Presence _ -> `Presence
+                   let primary_kind_of_type_arg : Datatype.type_arg -> PrimaryKind.t =
+                     function
+                     | Datatype.Type     _ -> pk_type
+                     | Datatype.Row      _ -> pk_row
+                     | Datatype.Presence _ -> pk_presence
                    in
                    if primary_kind_of_quantifier q <> primary_kind_of_type_arg t then
                      raise Kind_mismatch
                    else (q, t)
                  in
                  let type_arg' var_env alias_env = function
-                   | `Row r -> `Row (effect_row var_env alias_env r)
+                   | Row r -> `Row (effect_row var_env alias_env r)
                    | t -> type_arg var_env alias_env t
                  in
                  begin try
@@ -204,7 +202,7 @@ struct
                            (fun (q,t) ->
                              let (q, t) = match_kinds (q, t) in
                              match subkind_of_quantifier q with
-                             | (_, `Effect) -> type_arg' var_env alias_env t
+                             | (_, Restriction.Effect) -> type_arg' var_env alias_env t
                              | _ -> type_arg var_env alias_env t)
                            ts
                          in
@@ -219,38 +217,27 @@ struct
                   (* TODO: check that the kinds match up *)
                   `Application (abstype, List.map (type_arg var_env alias_env) ts)
             end
-        | `Primitive k -> `Primitive k
-        | `DB -> `Primitive `DB
-        | (`Input _ | `Output _ | `Select _ | `Choice _ | `Dual _ | `End) as s -> session_type var_env alias_env s
+        | Primitive k -> `Primitive k
+        | DB -> `Primitive `DB
+        | (Input _ | Output _ | Select _ | Choice _ | Dual _ | End) as s -> session_type var_env alias_env s
   and session_type var_env alias_env =
     (* let lookup_type t = StringMap.find t var_env.tenv in  -- used only in commented code *)
     (* HACKY *)
+    let open Datatype in
     function
-    | `Input (t, s) -> `Input (datatype var_env alias_env t, datatype var_env alias_env s)
-    | `Output (t, s) -> `Output (datatype var_env alias_env t, datatype var_env alias_env s)
-    | `Select r -> `Select (row var_env alias_env r)
-    | `Choice r -> `Choice (row var_env alias_env r)
-    (* | `TypeVar (name, _, _) -> *)
-    (*   begin *)
-    (*     try `MetaSessionVar (lookup_type name) *)
-    (*     with NotFound _ -> raise (UnexpectedFreeVar name) *)
-    (*   end *)
-    (* | `Mu (name, s) -> *)
-    (*   let var = Types.fresh_raw_variable () in *)
-    (*   let point = Unionfind.fresh (`Var (var, (`Any, `Session), `Flexible)) in *)
-    (*   let tenv = StringMap.add name point var_env.tenv in *)
-    (*   let _ = Unionfind.change point (`Recursive (var, *)
-    (*                                               `Session (session_type {var_env with tenv=tenv} alias_env s))) in *)
-    (*     `MetaSessionVar point *)
-    | `Dual s -> `Dual (datatype var_env alias_env s)
-    | `End -> `End
+    | Input (t, s)  -> `Input (datatype var_env alias_env t, datatype var_env alias_env s)
+    | Output (t, s) -> `Output (datatype var_env alias_env t, datatype var_env alias_env s)
+    | Select r      -> `Select (row var_env alias_env r)
+    | Choice r      -> `Choice (row var_env alias_env r)
+    | Dual s        -> `Dual (datatype var_env alias_env s)
+    | End           -> `End
     | _ -> assert false
   and fieldspec var_env alias_env =
     let lookup_flag = flip StringMap.find var_env.penv in
-      function
-        | `Absent -> `Absent
-        | `Present t -> `Present (datatype var_env alias_env t)
-        | `Var (name, _, _) ->
+      let open Datatype in function
+        | Absent -> `Absent
+        | Present t -> `Present (datatype var_env alias_env t)
+        | Var (name, _, _) ->
             begin
               try `Var (lookup_flag name)
               with NotFound _ -> raise (UnexpectedFreeVar name)
@@ -258,14 +245,15 @@ struct
   and row var_env alias_env (fields, rv) =
     let lookup_row = flip StringMap.find var_env.renv in
     let seed =
+      let open Datatype in
       match rv with
-        | `Closed -> Types.make_empty_closed_row ()
-        | `Open (rv, _, _) ->
+        | Closed -> Types.make_empty_closed_row ()
+        | Open (rv, _, _) ->
             begin
               try (StringMap.empty, lookup_row rv, false)
               with NotFound _ -> raise (UnexpectedFreeVar rv)
             end
-        | `Recursive (name, r) ->
+        | Recursive (name, r) ->
             let var = Types.fresh_raw_variable () in
             let point = Unionfind.fresh (`Var (var, default_subkind, `Flexible)) in
             let renv = StringMap.add name point var_env.renv in
@@ -284,15 +272,15 @@ struct
          operations. Note any row which can be closed will have an
          unbound effect variable.  *)
       try List.map
-            (function
-            | (name, `Present { node = `Function (domain, (fields, rv), codomain); pos}) as op
+            (let open Datatype in function
+            | (name, Present { node = Function (domain, (fields, rv), codomain); pos}) as op
                 when not (TypeUtils.is_builtin_effect name) ->
                (* Elaborates `Op : a -> b' to `Op : a {}-> b' *)
                begin match rv, fields with
-               | `Closed, [] -> op
-               | `Open _, []
-               | (`Recursive _), [] -> (* might need an extra check on recursive rows *)
-                  (name, `Present { node = `Function (domain, ([], `Closed), codomain); pos})
+               | Closed, [] -> op
+               | Open _, []
+               | Recursive _, [] -> (* might need an extra check on recursive rows *)
+                  (name, Present { node = Function (domain, ([], Closed), codomain); pos})
                | _,_ -> raise (UnexpectedOperationEffects name)
                end
             | x -> x)
@@ -311,26 +299,15 @@ struct
              (* Elaborates `Op : a' to `Op : () {}-> a' *)
              let eff = Types.make_empty_closed_row () in
              `Present (Types.make_function_type [] eff t)
-          (* | `Present t *)
-          (*     when not (TypeUtils.is_builtin_effect name) && TypeUtils.is_function_type t -> *)
-          (*    let domain = TypeUtils.arg_types t in *)
-          (*    let eff = TypeUtils.effect_row t in *)
-          (*    let codomain = TypeUtils.return_type t in *)
-          (*    let t = *)
-          (*      if Types.is_empty_row eff *)
-          (*      then Types.make_function_type domain (Types.make_empty_closed_row ()) codomain *)
-          (*      else t *)
-          (*    in *)
-          (*    `Present t *)
           | t -> t)
         fields
     in
     (fields, rho, dual)
   and type_arg var_env alias_env =
-    function
-      | `Type t -> `Type (datatype var_env alias_env t)
-      | `Row r -> `Row (row var_env alias_env r)
-      | `Presence f -> `Presence (fieldspec var_env alias_env f)
+    let open Datatype in function
+    | Type t -> `Type (datatype var_env alias_env t)
+    | Row r -> `Row (row var_env alias_env r)
+    | Presence f -> `Presence (fieldspec var_env alias_env f)
 
   (* pre condition: all subkinds have been filled in *)
   let generate_var_mapping (vars : type_variable list) : (Types.quantifier list * var_env) =
@@ -343,13 +320,13 @@ struct
            let var = Types.fresh_raw_variable () in
              fun (x, kind, freedom) ->
              match (kind, freedom) with
-             | (`Type, Some subkind), freedom ->
+             | (PrimaryKind.Type, Some subkind), freedom ->
                let t = Unionfind.fresh (`Var (var, subkind, freedom)) in
                  (var, subkind, `Type t)::vars, addt x t envs
-             | (`Row, Some subkind), freedom ->
+             | (PrimaryKind.Row, Some subkind), freedom ->
                let r = Unionfind.fresh (`Var (var, subkind, freedom)) in
                  (var, subkind, `Row r)::vars, addr x r envs
-             | (`Presence, Some subkind), freedom ->
+             | (PrimaryKind.Presence, Some subkind), freedom ->
                let f = Unionfind.fresh (`Var (var, subkind, freedom)) in
                  (var, subkind, `Presence f)::vars, addf x f envs
              | (_, None), _ ->
@@ -375,17 +352,17 @@ struct
             ~f:(fun (q, _) (args, {tenv=tenv; renv=renv; penv=penv}) ->
                   let var = Types.fresh_raw_variable () in
                     match q with
-                      | (name, (`Type, subkind), _freedom) ->
+                      | (name, (PrimaryKind.Type, subkind), _freedom) ->
                           let subkind = concrete_subkind subkind in
                           let point = Unionfind.fresh (`Var (var, subkind, `Rigid)) in
                             ((q, Some (var, subkind, `Type point))::args,
                              {tenv=StringMap.add name point tenv; renv=renv; penv=penv})
-                      | (name, (`Row, subkind), _freedom) ->
+                      | (name, (PrimaryKind.Row, subkind), _freedom) ->
                           let subkind = concrete_subkind subkind in
                           let point = Unionfind.fresh (`Var (var, subkind, `Rigid)) in
                             ((q, Some (var, subkind, `Row point))::args,
                              {tenv=tenv; renv=StringMap.add name point renv; penv=penv})
-                      | (name, (`Presence, subkind), _freedom) ->
+                      | (name, (PrimaryKind.Presence, subkind), _freedom) ->
                           let subkind = concrete_subkind subkind in
                           let point = Unionfind.fresh (`Var (var, subkind, `Rigid)) in
                             ((q, Some (var, subkind, `Presence point))::args,
@@ -445,14 +422,14 @@ object (self)
   val alias_env = initial_alias_env
 
   method! patternnode = function
-    | `HasType (pat, dt) ->
+    | Pattern.HasType (pat, dt) ->
         let o, pat = self#pattern pat in
-          o, `HasType (pat, Desugar.datatype' map alias_env dt)
+          o, Pattern.HasType (pat, Desugar.datatype' map alias_env dt)
     | p -> super#patternnode p
 
 
   method! phrasenode = function
-    | `Block (bs, p) ->
+    | Block (bs, p) ->
         (* aliases bound in `bs'
            should not escape the scope of the block *)
         let o       = {<>} in
@@ -461,25 +438,25 @@ object (self)
           (* NB: we return `self' rather than `_o' in order to return
              to the outer scope; any aliases bound in _o are
              unreachable from outside the block *)
-          self, `Block (bs, p)
-    | `TypeAnnotation (p, dt) ->
+          self, Block (bs, p)
+    | TypeAnnotation (p, dt) ->
         let o, p = self#phrase p in
-          o, `TypeAnnotation (p, Desugar.datatype' map self#aliases dt)
-    | `Upcast (p, dt1, dt2) ->
+          o, TypeAnnotation (p, Desugar.datatype' map self#aliases dt)
+    | Upcast (p, dt1, dt2) ->
         let o, p = self#phrase p in
-          o, `Upcast (p, Desugar.datatype' map alias_env dt1, Desugar.datatype' map alias_env dt2)
-    | `TableLit (t, (dt, _), cs, keys, p) ->
+          o, Upcast (p, Desugar.datatype' map alias_env dt1, Desugar.datatype' map alias_env dt2)
+    | TableLit (t, (dt, _), cs, keys, p) ->
         let read, write, needed = Desugar.tableLit alias_env cs dt in
         let o, t = self#phrase t in
 	let o, keys = o#phrase keys in
         let o, p = o#phrase p in
-          o, `TableLit (t, (dt, Some (read, write, needed)), cs, keys, p)
+          o, TableLit (t, (dt, Some (read, write, needed)), cs, keys, p)
     (* Switch and receive type annotations are never filled in by
        this point, so we ignore them.  *)
     | p -> super#phrasenode p
 
   method! bindingnode = function
-    | `Type (t, args, dt) ->
+    | Type (t, args, dt) ->
         let args, dt' = Desugar.typename alias_env t args dt in
         let (name, vars) = (t, args) in
         let (t, dt) =
@@ -489,19 +466,19 @@ object (self)
           (* NB: type aliases are scoped; we allow shadowing.
              We also allow type aliases to shadow abstract types. *)
           ({< alias_env = SEnv.bind alias_env (name, `Alias (List.map (snd ->- val_of) vars, dt)) >},
-           `Type (name, vars, (t, Some dt)))
+           Type (name, vars, (t, Some dt)))
 
-    | `Val (pat, (tyvars, p), loc, dt) ->
+    | Val (pat, (tyvars, p), loc, dt) ->
         let o, pat = self#pattern pat in
         let o, p   = o#phrase p in
         let o, loc = o#location loc in
-          o, `Val (pat, (tyvars, p), loc, opt_map (Desugar.datatype' map alias_env) dt)
-    | `Fun (bind, lin, (tyvars, fl), loc, dt) ->
+          o, Val (pat, (tyvars, p), loc, opt_map (Desugar.datatype' map alias_env) dt)
+    | Fun (bind, lin, (tyvars, fl), loc, dt) ->
         let o, bind = self#binder bind in
         let o, fl   = o#funlit fl in
         let o, loc  = o#location loc in
-          o, `Fun (bind, lin, (tyvars, fl), loc, opt_map (Desugar.datatype' map alias_env) dt)
-    | `Funs binds ->
+          o, Fun (bind, lin, (tyvars, fl), loc, opt_map (Desugar.datatype' map alias_env) dt)
+    | Funs binds ->
         let o, binds =
           super#list
             (fun o (bind, lin, (tyvars, fl), loc, dt, pos) ->
@@ -512,11 +489,11 @@ object (self)
                let o, pos  = o#position pos
                in (o, (bind, lin, (tyvars, fl), loc, dt, pos)))
             binds
-        in o, `Funs binds
-    | `Foreign (bind, raw_name, lang, file, dt) ->
+        in o, Funs binds
+    | Foreign (bind, raw_name, lang, file, dt) ->
         let _, bind = self#binder bind in
         let dt' = Desugar.foreign alias_env dt in
-        self, `Foreign (bind, raw_name, lang, file, dt')
+        self, Foreign (bind, raw_name, lang, file, dt')
     | b -> super#bindingnode b
 
   method! sentence =
diff --git a/core/desugarDbs.ml b/core/desugarDbs.ml
index f76f0ba88..9b1681355 100644
--- a/core/desugarDbs.ml
+++ b/core/desugarDbs.ml
@@ -1,3 +1,5 @@
+open CommonTypes
+open Sugartypes
 open SugarConstructors.Make
 
 (*
@@ -46,7 +48,7 @@ object (o : 'self_type)
   inherit (TransformSugar.transform env) as super
 
   method! phrasenode : Sugartypes.phrasenode -> ('self_type * Sugartypes.phrasenode * Types.datatype) = function
-    | `DBInsert (table, _labels, rows, returning) ->
+    | DBInsert (table, _labels, rows, returning) ->
       (* TODO: work out how to type this properly *)
         let eff = o#lookup_effects in
         let o, table, table_type = o#phrase table in
@@ -62,7 +64,7 @@ object (o : 'self_type)
            from well-typed insert expressions. An alternative approach
            would be to maintain some kind of insert expression in the
            IR. *)
-        let value_type = `Record (Types.make_empty_open_row (`Any, `Any)) in
+        let value_type = `Record (Types.make_empty_open_row (lin_any, res_any)) in
         let o, rows, _ = o#phrase rows in
         let tyvars = [`Type read_type; `Type write_type; `Type needed_type;
                       `Type value_type; `Row eff] in
@@ -87,6 +89,6 @@ object
   method satisfied = has_no_dbs
 
   method! phrasenode = function
-    | `DBInsert _ -> {< has_no_dbs = false >}
+    | DBInsert _ -> {< has_no_dbs = false >}
     | e -> super#phrasenode e
 end
diff --git a/core/desugarFormlets.ml b/core/desugarFormlets.ml
index c4da2d60c..d0ff83b75 100644
--- a/core/desugarFormlets.ml
+++ b/core/desugarFormlets.ml
@@ -1,16 +1,17 @@
+open CommonTypes
 open Utility
 open Sugartypes
 open SugarConstructors.Make
 
 let rec is_raw phrase =
   match phrase.node with
-    | `TextNode _ -> true
-    | `Block _    -> true
-    | `FormBinding _ -> false
-    | `Xml (_, _, _, children) ->
-        List.for_all is_raw children
-    | _ ->
-        raise (Errors.SugarError (phrase.pos, "Invalid element in formlet literal"))
+  | TextNode _ -> true
+  | Block _    -> true
+  | FormBinding _ -> false
+  | Xml (_, _, _, children) ->
+     List.for_all is_raw children
+  | _ ->
+     raise (Errors.SugarError (phrase.pos, "Invalid element in formlet literal"))
 
 let tt =
   function
@@ -33,23 +34,23 @@ object (o : 'self_type)
 
     (this roughly corresponds to the dagger transformation)
   *)
-  method formlet_patterns : Sugartypes.phrase -> (Sugartypes.pattern list * Sugartypes.phrase list * Types.datatype list) =
+  method formlet_patterns : Sugartypes.phrase -> (Sugartypes.Pattern.with_pos list * Sugartypes.phrase list * Types.datatype list) =
     fun ph ->
       match ph.node with
         | _ when is_raw ph ->
             [tuple_pat []], [tuple []], [Types.unit_type]
-        | `FormBinding (f, p) ->
+        | FormBinding (f, p) ->
             let (_o, _f, ft) = o#phrase f in
-            let t = Types.fresh_type_variable (`Any, `Any) in
+            let t = Types.fresh_type_variable (lin_any, res_any) in
             let () =
               Unify.datatypes
                 (ft, Instantiate.alias "Formlet" [`Type t] tycon_env) in
             let name = Utility.gensym ~prefix:"_formlet_" () in
             let (xb, x) = (binder name ~ty:t, var name) in
-              [with_dummy_pos (`As (xb, p))], [x], [t]
-        | `Xml (_, _, _, [node]) ->
+              [with_dummy_pos (Pattern.As (xb, p))], [x], [t]
+        | Xml (_, _, _, [node]) ->
             o#formlet_patterns node
-        | `Xml (_, _, _, contents) ->
+        | Xml (_, _, _, contents) ->
             let ps, vs, ts =
               List.fold_left
                 (fun (ps, vs, ts) e ->
@@ -67,22 +68,22 @@ object (o : 'self_type)
   method private formlet_body_node : Sugartypes.phrasenode -> ('self_type * Sugartypes.phrasenode * Types.datatype) =
     fun e ->
         match e with
-          | `TextNode s ->
+          | TextNode s ->
               let e =
                 fn_appl_node xml_str [`Row (o#lookup_effects)]
                   [fn_appl string_to_xml_str [`Row (o#lookup_effects)]
                      [constant_str s]]
               in (o, e, Types.xml_type)
-          | `Block (bs, e) ->
+          | Block (bs, e) ->
               let (o, e, _) =
                 o#phrasenode
                   (block_node
                      (bs, (fn_appl xml_str [`Row (o#lookup_effects)] [e])))
               in (o, e, Types.xml_type)
-          | `FormBinding (f, _) ->
+          | FormBinding (f, _) ->
               let (o, {node=f; _}, ft) = o#phrase f
               in (o, f, ft)
-          | `Xml ("#", [], None, contents) ->
+          | Xml ("#", [], None, contents) ->
               (* pure (fun ps -> vs) <*> e1 <*> ... <*> ek *)
               let pss, vs, ts =
                 let pss, vs, ts =
@@ -110,7 +111,7 @@ object (o : 'self_type)
                   match args with
                     | [] ->
                         let (o, e, _) =
-                          super#phrasenode (`Xml ("#", [], None, contents))
+                          super#phrasenode (Xml ("#", [], None, contents))
                         in (o, fn_appl_node xml_str [`Row (o#lookup_effects)]
                                             [with_dummy_pos e],
                             Types.xml_type)
@@ -119,7 +120,7 @@ object (o : 'self_type)
                         let mb = `Row (o#lookup_effects) in
                         let base : phrase =
                           fn_appl pure_str [`Type ft; mb]
-                            [fun_lit ~args:(List.rev args) `Unl (List.rev pss)
+                            [fun_lit ~args:(List.rev args) dl_unl (List.rev pss)
                                      (tuple vs)] in
                         let p, et =
                           List.fold_right
@@ -134,14 +135,14 @@ object (o : 'self_type)
                         in
                           (o, p.node, et)
                 end
-          | `Xml(tag, attrs, attrexp, contents) ->
+          | Xml(tag, attrs, attrexp, contents) ->
               (* plug (fun x -> (<tag attrs>{x}</tag>)) (<#>contents</#>)^o*)
               let (o, attrexp, _) = TransformSugar.option o (fun o -> o#phrase) attrexp in
               let eff = o#lookup_effects in
               let context : phrase =
                 let name = Utility.gensym ~prefix:"_formlet_" () in
                 fun_lit ~args:[Types.make_tuple_type [Types.xml_type], eff]
-                        `Unl
+                        dl_unl
                         [[variable_pat ~ty:(Types.xml_type) name]]
                         (xml tag attrs attrexp [block ([], var name)]) in
               let (o, e, t) = o#formlet_body (xml "#" [] None contents) in
@@ -154,7 +155,7 @@ object (o : 'self_type)
       let (o, node, t) = o#formlet_body_node node in (o, {node; pos}, t)
 
   method! phrasenode  : phrasenode -> ('self_type * phrasenode * Types.datatype) = function
-    | `Formlet (body, yields) ->
+    | Formlet (body, yields) ->
         (* pure (fun q^ -> [[e]]* ) <*> q^o *)
         (* let e_in = `Formlet (body, yields) in *)
         let empty_eff = Types.make_empty_closed_row () in
@@ -176,7 +177,7 @@ object (o : 'self_type)
              [`Type arg_type; `Type yields_type; mb]
              [body; fn_appl pure_str
                     [`Type (`Function (Types.make_tuple_type [arg_type], empty_eff, yields_type)); mb]
-                    [fun_lit ~args:[Types.make_tuple_type [arg_type], empty_eff] `Unl pss yields]]
+                    [fun_lit ~args:[Types.make_tuple_type [arg_type], empty_eff] dl_unl pss yields]]
         in
           (o, e, Instantiate.alias "Formlet" [`Type yields_type] tycon_env)
     | e -> super#phrasenode e
@@ -192,6 +193,6 @@ object
   method satisfied = has_no_formlets
 
   method! phrasenode = function
-    | `Formlet _ -> {< has_no_formlets = false >}
+    | Formlet _ -> {< has_no_formlets = false >}
     | e -> super#phrasenode e
 end
diff --git a/core/desugarFors.ml b/core/desugarFors.ml
index 0d016a7e3..957fa9e85 100644
--- a/core/desugarFors.ml
+++ b/core/desugarFors.ml
@@ -1,4 +1,5 @@
 open Utility
+open CommonTypes
 open Sugartypes
 open SugarConstructors.Make
 
@@ -61,7 +62,7 @@ let results :  Types.row ->
             let qt = t in
             let qst = Types.make_tuple_type ts in
 
-            let ((qsb, qs) : Sugartypes.pattern list * Sugartypes.phrase list) =
+            let ((qsb, qs) : Sugartypes.Pattern.with_pos list * Sugartypes.phrase list) =
               List.split
                 (List.map2 (fun x t -> (variable_pat ~ty:t x, var x)) xs ts) in
             let qb, q = (variable_pat ~ty:t x, var x) in
@@ -76,12 +77,13 @@ let results :  Types.row ->
                   | [t] -> Types.make_tuple_type [t]
                   | ts -> Types.make_tuple_type [Types.make_tuple_type ts]
               in
-              fun_lit ~args:[a, eff] `Unl [ps] (tuple (q::qs)) in
+              fun_lit ~args:[a, eff] dl_unl [ps] (tuple (q::qs)) in
             let outer : Sugartypes.phrase =
               let a = `Type qst in
               let b = `Type (Types.make_tuple_type (t :: ts)) in
-                fun_lit ~args:[Types.make_tuple_type [t], eff] `Unl [[qb]]
-                  (fn_appl "map" [a; `Row eff; b] [inner; r]) in
+                fun_lit ~args:[Types.make_tuple_type [t], eff]
+                        dl_unl [[qb]]
+                        (fn_appl "map" [a; `Row eff; b] [inner; r]) in
             let a = `Type qt in
             let b = `Type (Types.make_tuple_type (t :: ts)) in
             fn_appl "concatMap" [a; `Row eff; b] [outer; e]
@@ -100,14 +102,14 @@ object (o : 'self_type)
   *)
   method qualifiers : Sugartypes.iterpatt list ->
     'self_type *
-      (Sugartypes.phrase list * Sugartypes.pattern list * Sugartypes.name list *
+      (Sugartypes.phrase list * Sugartypes.Pattern.with_pos list * Sugartypes.name list *
          Types.datatype list) =
     fun qs ->
       let o, (es, ps, xs, ts) =
         List.fold_left
           (fun (o, (es, ps, xs, ts)) q ->
              match q with
-               | `List (p, e) ->
+               | List (p, e) ->
                    let (o, e, t) = o#phrase e in
                    let (o, p) = o#pattern p in
 
@@ -115,8 +117,9 @@ object (o : 'self_type)
 
                    let var = Utility.gensym ~prefix:"_for_" () in
                    let xb = binder ~ty:t var in
-                     o, (e::es, with_dummy_pos (`As (xb, p))::ps, var::xs, element_type::ts)
-               | `Table (p, e) ->
+                     o, (e::es, with_dummy_pos (Pattern.As (xb, p))::ps,
+                         var::xs, element_type::ts)
+               | Table (p, e) ->
                    let (o, e, t) = o#phrase e in
                    let (o, p) = o#pattern p in
 
@@ -130,7 +133,8 @@ object (o : 'self_type)
                    let e = fn_appl "AsList" [r; w; n; eff] [e] in
                    let var = Utility.gensym ~prefix:"_for_" () in
                    let xb = binder ~ty:t var in
-                     o, (e::es, with_dummy_pos (`As (xb, p))::ps, var::xs, element_type::ts))
+                     o, (e::es, with_dummy_pos (Pattern.As (xb, p))::ps,
+                         var::xs, element_type::ts))
           (o, ([], [], [], []))
           qs
       in
@@ -139,7 +143,7 @@ object (o : 'self_type)
   method! phrasenode : Sugartypes.phrasenode ->
     ('self_type * Sugartypes.phrasenode * Types.datatype) =
     function
-    | `Iteration (generators, body, filter, sort) ->
+    | Iteration (generators, body, filter, sort) ->
         let eff = o#lookup_effects in
         let o, (es, ps, xs, ts) = o#qualifiers generators in
         let o, body, body_type = o#phrase body in
@@ -151,7 +155,7 @@ object (o : 'self_type)
           match filter with
             | None -> body
             | Some condition ->
-                with_dummy_pos (`Conditional (condition, body, list ~ty:elem_type [])) in
+                with_dummy_pos (Conditional (condition, body, list ~ty:elem_type [])) in
 
         let arg =
           match ps with
@@ -164,7 +168,7 @@ object (o : 'self_type)
             | ts -> Types.make_tuple_type ts in
 
         let f : phrase = fun_lit ~args:[Types.make_tuple_type [arg_type], eff]
-                                 `Unl [arg] body in
+                                 dl_unl [arg] body in
 
         let results = results eff (es, xs, ts) in
         let results =
@@ -176,7 +180,7 @@ object (o : 'self_type)
 
                 let g : phrase =
                   fun_lit ~args:[Types.make_tuple_type [arg_type], eff]
-                          `Unl [arg] sort
+                          dl_unl [arg] sort
                 in
                 fn_appl sort_by [`Type arg_type; `Row eff; sort_type_arg]
                         [g; results]
@@ -200,6 +204,6 @@ object
   method satisfied = has_no_fors
 
   method! phrasenode = function
-    | `Iteration _ -> {< has_no_fors = false >}
+    | Iteration _ -> {< has_no_fors = false >}
     | e -> super#phrasenode e
 end
diff --git a/core/desugarFuns.ml b/core/desugarFuns.ml
index 7f2dd145f..75dc42e7a 100644
--- a/core/desugarFuns.ml
+++ b/core/desugarFuns.ml
@@ -1,3 +1,4 @@
+open CommonTypes
 open Utility
 open Sugartypes
 open SugarConstructors.Make
@@ -65,7 +66,7 @@ object (o : 'self_type)
   inherit (TransformSugar.transform env) as super
 
   method! phrasenode : Sugartypes.phrasenode -> ('self_type * Sugartypes.phrasenode * Types.datatype) = function
-    | `FunLit (Some argss, lin, lam, location) ->
+    | FunLit (Some argss, lin, lam, location) ->
         let inner_mb = snd (try last argss with Invalid_argument s -> raise (Invalid_argument ("!"^s))) in
         let (o, lam, rt) = o#funlit inner_mb lam in
         let ft =
@@ -77,15 +78,15 @@ object (o : 'self_type)
         let f = gensym ~prefix:"_fun_" () in
         let e =
           block_node
-            ([with_dummy_pos (`Fun (unwrap_def ( binder ~ty:ft f, lin, ([], lam)
-                                               , location, None)))],
+            ([with_dummy_pos (Fun (unwrap_def ( binder ~ty:ft f, lin, ([], lam)
+                                              , location, None)))],
              var f)
         in
           (o, e, ft)
-    | `Section (`Project name) ->
-        let ab, a = Types.fresh_type_quantifier (`Any, `Any) in
-        let rhob, (fields, rho, _) = Types.fresh_row_quantifier (`Any, `Any) in
-        let effb, eff = Types.fresh_row_quantifier (`Any, `Any) in
+    | Section (Section.Project name) ->
+        let ab, a = Types.fresh_type_quantifier (lin_any, res_any) in
+        let rhob, (fields, rho, _) = Types.fresh_row_quantifier (lin_any, res_any) in
+        let effb, eff = Types.fresh_row_quantifier (lin_any, res_any) in
 
         let r = `Record (StringMap.add name (`Present a) fields, rho, false) in
 
@@ -95,7 +96,7 @@ object (o : 'self_type)
                                            `Function (Types.make_tuple_type [r], eff, a)) in
 
         let pss = [[variable_pat ~ty:r x]] in
-        let body = with_dummy_pos (`Projection (var x, name)) in
+        let body = with_dummy_pos (Projection (var x, name)) in
         let e : phrasenode =
           block_node
             ([fun_binding' ~tyvars:[ab; rhob; effb] (binder ~ty:ft f) (pss, body)],
@@ -104,18 +105,18 @@ object (o : 'self_type)
     | e -> super#phrasenode e
 
   method! bindingnode = function
-    | `Fun _ as b ->
+    | Fun _ as b ->
         let (o, b) = super#bindingnode b in
           begin
             match b with
-              | `Fun r -> (o, `Fun (unwrap_def r))
+              | Fun r -> (o, Fun (unwrap_def r))
               | _ -> assert false
           end
-    | `Funs _ as b ->
+    | Funs _ as b ->
         let (o, b) = super#bindingnode b in
           begin
             match b with
-              | `Funs defs -> (o, `Funs (List.map unwrap_def_dp defs))
+              | Funs defs -> (o, Funs (List.map unwrap_def_dp defs))
               | _ -> assert false
           end
     | b -> super#bindingnode b
@@ -131,14 +132,14 @@ object
   method satisfied = has_no_funs
 
   method! phrasenode = function
-    | `FunLit _ -> {< has_no_funs = false >}
+    | FunLit _ -> {< has_no_funs = false >}
     | e -> super#phrasenode e
 
   method! bindingnode = function
-    | `Fun (_f, _lin, (_tyvars, ([_ps], _body)), _location, _t) as b ->
+    | Fun (_f, _lin, (_tyvars, ([_ps], _body)), _location, _t) as b ->
         super#bindingnode b
-    | `Fun _ -> {< has_no_funs = false >}
-    | `Funs defs as b ->
+    | Fun _ -> {< has_no_funs = false >}
+    | Funs defs as b ->
         if
           List.exists
             (function
diff --git a/core/desugarHandlers.ml b/core/desugarHandlers.ml
index acadeb3c3..2937db9bd 100644
--- a/core/desugarHandlers.ml
+++ b/core/desugarHandlers.ml
@@ -1,4 +1,6 @@
 open Utility
+open CommonTypes
+open Operators
 open Sugartypes
 open SugarConstructors.Make
 
@@ -20,47 +22,49 @@ open SugarConstructors.Make
 
 
 (* Computes the set of names in a given pattern *)
-let rec names : pattern -> string list
+let rec names : Pattern.with_pos -> string list
   = fun pat ->
+    let open Pattern in
     match pat.node with
-      `Variant (_,pat_opt) -> opt_app names [] pat_opt
-    | `Record (name_pats,pat_opt) ->
+      Variant (_,pat_opt) -> opt_app names [] pat_opt
+    | Record (name_pats,pat_opt) ->
        let optns = opt_app names [] pat_opt in
        (List.fold_left (fun ns p -> (names p) @ ns) [] (List.map snd name_pats)) @ optns
-    | `Variable bndr              -> [name_of_binder bndr]
-    | `Cons (pat,pat')            -> (names pat) @ (names pat')
-    | `Tuple pats
-    | `List pats                  -> List.fold_left (fun ns pat -> (names pat) @ ns ) [] pats
-    | `Negative ns'               -> List.fold_left (fun ns n -> n :: ns) [] ns'
-    | `As  (bndr,pat)             -> [name_of_binder bndr] @ (names pat)
-    | `HasType (pat,_)            -> names pat
-    | _                           -> []
+    | Variable bndr              -> [name_of_binder bndr]
+    | Cons (pat,pat')            -> (names pat) @ (names pat')
+    | Tuple pats
+    | List pats                  -> List.fold_left (fun ns pat -> (names pat) @ ns ) [] pats
+    | Negative ns'               -> List.fold_left (fun ns n -> n :: ns) [] ns'
+    | As  (bndr,pat)             -> [name_of_binder bndr] @ (names pat)
+    | HasType (pat,_)            -> names pat
+    | _                          -> []
 
 (* This function resolves name conflicts in a given pattern p.
    The conflict resolution is simple:
    Given a set of conflicting names ns, then for every name n if (n \in p && n \in ns) then n gets rewritten as _.
  *)
-let resolve_name_conflicts : pattern -> stringset -> pattern
+let resolve_name_conflicts : Pattern.with_pos -> stringset -> Pattern.with_pos
   = fun pat conflicts ->
-    let rec hide_names : pattern -> pattern
+    let rec hide_names : Pattern.with_pos -> Pattern.with_pos
       = fun pat -> with_dummy_pos
          begin
+          let open Pattern in
           match pat.node with
-          | `Variant (label, pat_opt)    -> `Variant (label, opt_map hide_names pat_opt)
-          | `Record (name_pats, pat_opt) -> `Record  (List.map (fun (label, pat) -> (label, hide_names pat)) name_pats, opt_map hide_names pat_opt)
-          | `Variable bndr               ->
+          | Variant (label, pat_opt)    -> Variant (label, opt_map hide_names pat_opt)
+          | Record (name_pats, pat_opt) -> Record  (List.map (fun (label, pat) -> (label, hide_names pat)) name_pats, opt_map hide_names pat_opt)
+          | Variable bndr               ->
              if StringSet.mem (name_of_binder bndr) conflicts
-             then `Any
+             then Pattern.Any
              else pat.node
-          | `Cons (pat, pat')            -> `Cons (hide_names pat, hide_names pat')
-          | `Tuple pats                  -> `Tuple (List.map hide_names pats)
-          | `List pats                   -> `List (List.map hide_names pats)
-          | `Negative _                  -> failwith "desugarHandlers.ml: hide_names `Negative not yet implemented"
-          | `As (bndr,pat)               -> let {node;_} as pat = hide_names pat in
+          | Cons (pat, pat')            -> Cons (hide_names pat, hide_names pat')
+          | Tuple pats                  -> Tuple (List.map hide_names pats)
+          | List pats                   -> List (List.map hide_names pats)
+          | Negative _                  -> failwith "desugarHandlers.ml: hide_names Negative not yet implemented"
+          | As (bndr,pat)               -> let {node;_} as pat = hide_names pat in
                                             if StringSet.mem (name_of_binder bndr) conflicts
                                             then node
-                                            else `As (bndr, pat)
-          | `HasType (pat, t)            -> `HasType (hide_names pat, t)
+                                            else As (bndr, pat)
+          | HasType (pat, t)            -> HasType (hide_names pat, t)
           | _ -> pat.node
          end
     in hide_names pat
@@ -82,7 +86,7 @@ let resolve_name_conflicts : pattern -> stringset -> pattern
  and the parameters of the introduced functions which encompass clause bodies. Currently,
  the clause-parameters shadow the introduced function parameters.
 *)
-let parameterize : (pattern * phrase) list -> pattern list list option -> (pattern * phrase) list
+let parameterize : (Pattern.with_pos * phrase) list -> Pattern.with_pos list list option -> (Pattern.with_pos * phrase) list
   = fun cases params ->
   match params with
     None
@@ -95,65 +99,70 @@ let parameterize : (pattern * phrase) list -> pattern list list option -> (patte
          StringSet.inter (StringSet.from_list pat_names) (StringSet.from_list param_names)
        in
        let params = List.map (List.map (fun p -> resolve_name_conflicts p name_conflicts)) params in
-       (pat, fun_lit `Unl params body)
+       (pat, fun_lit dl_unl params body)
      ) cases
 
 
 (* This function assigns fresh names to `Any (_) *)
-let rec deanonymize : pattern -> pattern
+let rec deanonymize : Pattern.with_pos -> Pattern.with_pos
   = fun pat -> with_dummy_pos
      begin
+      let open Pattern in
       match pat.node with
-        `Any                         -> `Variable (binder (Utility.gensym ~prefix:"dsh" ()))
-      | `Nil                         -> `Nil
-      | `Cons (p, p')                -> `Cons (deanonymize p, deanonymize p')
-      | `List ps                     -> `List (List.map deanonymize ps)
-      | `Effect (name, ps, kpat)     -> `Effect (name, List.map deanonymize ps, deanonymize kpat)
-      | `Variant (name, pat_opt)     -> `Variant (name, opt_map deanonymize pat_opt)
-      | `Negative ns                 -> `Negative ns
-      | `Record (name_pats, pat_opt) -> `Record (List.map (fun (n,p) -> (n, deanonymize p)) name_pats, opt_map deanonymize pat_opt)
-      | `Tuple ps                    -> `Tuple (List.map deanonymize ps)
-      | `Constant c                  -> `Constant c
-      | `Variable b                  -> `Variable b
-      | `As (b,p)                    -> `As (b, deanonymize p)
-      | `HasType (p,t)               -> `HasType (deanonymize p, t)
+      | Any                         -> Variable (binder (Utility.gensym ~prefix:"dsh" ()))
+      | Nil                         -> Nil
+      | Cons (p, p')                -> Cons (deanonymize p, deanonymize p')
+      | List ps                     -> List (List.map deanonymize ps)
+      | Effect (name, ps, kpat)     -> Effect (name, List.map deanonymize ps, deanonymize kpat)
+      | Variant (name, pat_opt)     -> Variant (name, opt_map deanonymize pat_opt)
+      | Negative ns                 -> Negative ns
+      | Record (name_pats, pat_opt) -> Record (List.map (fun (n,p) -> (n, deanonymize p)) name_pats, opt_map deanonymize pat_opt)
+      | Tuple ps                    -> Tuple (List.map deanonymize ps)
+      | Constant c                  -> Constant c
+      | Variable b                  -> Variable b
+      | As (b,p)                    -> As (b, deanonymize p)
+      | HasType (p,t)               -> HasType (deanonymize p, t)
      end
 
 (* This function translates a pattern into a phrase. It assumes that the given pattern has been deanonymised. *)
-let rec phrase_of_pattern : pattern -> phrase
+let rec phrase_of_pattern : Pattern.with_pos -> phrase
   = fun pat ->
      begin
+      let open Pattern in
       match pat.node with
-        `Any                         -> assert false (* can never happen after the fresh name generation pass *)
-      | `Nil                         -> list []
-      | `Cons (hd, tl)               -> infix_appl' (phrase_of_pattern hd) `Cons (phrase_of_pattern tl)
-      | `List ps                     -> list (List.map phrase_of_pattern ps)
-      | `Effect _                    -> assert false
-      | `Variant (name, pat_opt)     -> constructor name ?body:(opt_map phrase_of_pattern pat_opt)
-      | `Negative _                  -> failwith "desugarHandlers.ml: phrase_of_pattern case for `Negative not yet implemented!"
-      | `Record (name_pats, pat_opt) -> record (List.map (fun (n,p) -> (n, phrase_of_pattern p)) name_pats)
-                                               ?exp:(opt_map phrase_of_pattern pat_opt)
-      | `Tuple ps                    -> tuple (List.map phrase_of_pattern ps)
-      | `Constant c                  -> constant c
-      | `Variable b                  -> var (name_of_binder b)
-      | `As (b,_)                    -> var (name_of_binder b)
-      | `HasType (p,t)               -> with_dummy_pos (`TypeAnnotation (phrase_of_pattern p, t))
+        Any                         -> assert false (* can never happen after the fresh name generation pass *)
+      | Nil                         -> list []
+      | Cons (hd, tl)               -> infix_appl' (phrase_of_pattern hd) BinaryOp.Cons (phrase_of_pattern tl)
+      | List ps                     -> list (List.map phrase_of_pattern ps)
+      | Effect _                    -> assert false
+      | Variant (name, pat_opt)     -> constructor name ?body:(opt_map phrase_of_pattern pat_opt)
+      | Negative _                  -> failwith "desugarHandlers.ml: phrase_of_pattern case for `Negative not yet implemented!"
+      | Record (name_pats, pat_opt) -> record (List.map (fun (n,p) -> (n, phrase_of_pattern p)) name_pats)
+                                              ?exp:(opt_map phrase_of_pattern pat_opt)
+      | Tuple ps                    -> tuple (List.map phrase_of_pattern ps)
+      | Constant c                  -> constant c
+      | Variable b                  -> var (name_of_binder b)
+      | As (b,_)                    -> var (name_of_binder b)
+      | HasType (p,t)               -> with_dummy_pos (TypeAnnotation (phrase_of_pattern p, t))
      end
 
 (* This function applies the list of parameters to the generated handle. *)
 let apply_params : phrase -> phrase list list -> phrase
   = fun h pss ->
-    List.fold_right (fun ps acc -> with_dummy_pos (`FnAppl (acc, ps)) ) (List.rev pss) h
+    List.fold_right (fun ps acc -> with_dummy_pos (FnAppl (acc, ps)) ) (List.rev pss) h
 
-let split_handler_cases : (pattern * phrase) list -> (pattern * phrase) list * (pattern * phrase) list
+let split_handler_cases : (Pattern.with_pos * phrase) list -> (Pattern.with_pos * phrase) list * (Pattern.with_pos * phrase) list
   = fun cases ->
     let ret, ops =
       List.fold_left
         (fun (val_cases, eff_cases) (pat, body) ->
           match pat.node with
-          | `Variant ("Return", None)     -> failwith "Improper pattern-matching on return value"
-          | `Variant ("Return", Some pat) -> (pat, body) :: val_cases, eff_cases
-          | _                             -> val_cases, (pat, body) :: eff_cases)
+          | Pattern.Variant ("Return", None) ->
+             failwith "Improper pattern-matching on return value"
+          | Pattern.Variant ("Return", Some pat) ->
+             (pat, body) :: val_cases, eff_cases
+          | _ ->
+             val_cases, (pat, body) :: eff_cases)
         ([], []) cases
     in
     match ret with
@@ -167,10 +176,10 @@ let split_handler_cases : (pattern * phrase) list -> (pattern * phrase) list * (
 let funlit_of_handlerlit : Sugartypes.handlerlit -> Sugartypes.funlit
   = fun (depth, m, cases, params) ->
     let m    = deanonymize m in
-    let comp = with_dummy_pos (`FnAppl (phrase_of_pattern m, [])) in
+    let comp = with_dummy_pos (FnAppl (phrase_of_pattern m, [])) in
     let cases = parameterize cases params in
     let hndlr = SugarConstructors.Make.untyped_handler comp cases depth in
-    let handle = block ([], (with_dummy_pos (`Handle hndlr))) in
+    let handle = block ([], (with_dummy_pos (Handle hndlr))) in
     let params = opt_map (List.map (List.map deanonymize)) params in
     let body  =
       match params with
@@ -179,7 +188,7 @@ let funlit_of_handlerlit : Sugartypes.handlerlit -> Sugartypes.funlit
          let params = List.map (List.map phrase_of_pattern) params in
          apply_params handle params
     in
-    let fnparams : pattern list list = [[]] in
+    let fnparams : Pattern.with_pos list list = [[]] in
     let fnparams =
       match params with
         Some params -> params @ ([m] :: fnparams)
@@ -191,22 +200,22 @@ let desugar_handlers_early =
 object
   inherit SugarTraversals.map as super
   method! phrasenode = function
-    | `HandlerLit hnlit ->
+    | HandlerLit hnlit ->
        let (fnparams, body) = funlit_of_handlerlit hnlit in
-       let funlit : Sugartypes.phrasenode = (fun_lit `Unl fnparams body).node in
+       let funlit : Sugartypes.phrasenode = (fun_lit dl_unl fnparams body).node in
        super#phrasenode funlit
     | e -> super#phrasenode e
 
   method! phrase {node; pos} =
     match node with
-    | `Handle h ->
+    | Handle h ->
        let (val_cases, eff_cases) = split_handler_cases h.sh_effect_cases in
-       with_dummy_pos (`Handle { h with sh_effect_cases = eff_cases;
+       with_dummy_pos (Handle { h with sh_effect_cases = eff_cases;
                                         sh_value_cases  = val_cases })
     | _ -> super#phrase {node; pos}
 
   method! bindingnode = function
-    | `Handler (binder, hnlit, annotation) ->
+    | Handler (binder, hnlit, annotation) ->
        let fnlit  = funlit_of_handlerlit hnlit in
        (fun_binding' ?annotation binder fnlit).node
     | b -> super#bindingnode b
diff --git a/core/desugarInners.ml b/core/desugarInners.ml
index 041f084a1..d28a55d9a 100644
--- a/core/desugarInners.ml
+++ b/core/desugarInners.ml
@@ -1,4 +1,5 @@
 open Utility
+open Operators
 open Sugartypes
 
 (* Recursive functions must be used monomorphically inside their
@@ -34,26 +35,26 @@ object (o : 'self_type)
     {< extra_env = StringMap.remove f extra_env >}
 
   method! phrasenode = function
-    | `TAppl ({node=`Var name;_} as phn, tyargs) when StringMap.mem name extra_env ->
+    | TAppl ({node=Var name;_} as phn, tyargs) when StringMap.mem name extra_env ->
         let extras = StringMap.find name extra_env in
         let tyargs = add_extras (extras, tyargs) in
-          super#phrasenode (`TAppl (phn, tyargs))
-    | `InfixAppl ((tyargs, `Name name), e1, e2) when StringMap.mem name extra_env ->
+          super#phrasenode (TAppl (phn, tyargs))
+    | InfixAppl ((tyargs, BinaryOp.Name name), e1, e2) when StringMap.mem name extra_env ->
         let extras = StringMap.find name extra_env in
         let tyargs = add_extras (extras, tyargs) in
-          super#phrasenode (`InfixAppl ((tyargs, `Name name), e1, e2))
-    | `UnaryAppl ((tyargs, `Name name), e) when StringMap.mem name extra_env ->
+          super#phrasenode (InfixAppl ((tyargs, BinaryOp.Name name), e1, e2))
+    | UnaryAppl ((tyargs, UnaryOp.Name name), e) when StringMap.mem name extra_env ->
         let extras = StringMap.find name extra_env in
         let tyargs = add_extras (extras, tyargs) in
-          super#phrasenode (`UnaryAppl ((tyargs, `Name name), e))
+          super#phrasenode (UnaryAppl ((tyargs, UnaryOp.Name name), e))
             (* HACK: manage the lexical scope of extras *)
-    | `Spawn _ as e ->
+    | Spawn _ as e ->
         let (o, e, t) = super#phrasenode e in
           (o#with_extra_env extra_env, e, t)
-    | `Escape _ as e ->
+    | Escape _ as e ->
         let (o, e, t) = super#phrasenode e in
           (o#with_extra_env extra_env, e, t)
-    | `Block _ as e ->
+    | Block _ as e ->
         let (o, e, t) = super#phrasenode e in
           (o#with_extra_env extra_env, e, t)
     | e -> super#phrasenode e
@@ -65,7 +66,7 @@ object (o : 'self_type)
         (o#with_extra_env extra_env, lam, t)
 
   method! bindingnode = function
-    | `Funs defs ->
+    | Funs defs ->
         (* put the outer bindings in the environment *)
         let o, defs = o#rec_activate_outer_bindings defs in
 
@@ -109,7 +110,7 @@ object (o : 'self_type)
                o#unbind (name_of_binder bndr))
             o defs
         in
-          (o, (`Funs defs))
+          (o, (Funs defs))
     | b -> super#bindingnode b
 
   method! binder : binder -> ('self_type * binder) = function
@@ -129,7 +130,7 @@ object
   method satisfied = has_no_inners
 
   method! bindingnode = function
-    | `Funs defs ->
+    | Funs defs ->
         {< has_no_inners =
             List.for_all
               (fun (_f, _, ((_tyvars, dt_opt), _), _, _, _) ->
diff --git a/core/desugarLAttributes.ml b/core/desugarLAttributes.ml
index 3e5f517bd..7e69eb398 100644
--- a/core/desugarLAttributes.ml
+++ b/core/desugarLAttributes.ml
@@ -1,4 +1,5 @@
 open Utility
+open CommonTypes
 open Sugartypes
 open List
 open SugarConstructors.Make
@@ -11,7 +12,7 @@ open SugarConstructors.Make
 *)
 
 let has_lattrs : phrasenode -> bool = function
-  | `Xml (_, attrs, _, _) -> exists (fst ->- start_of ~is:"l:") attrs
+  | Xml (_, attrs, _, _) -> exists (fst ->- start_of ~is:"l:") attrs
   | _ -> false
 
 let apply name args : phrase = fn_appl name [] args
@@ -28,24 +29,23 @@ let fresh_names () =
   id, name
 
 let desugar_lhref : phrasenode -> phrasenode = function
-  | `Xml (("a"|"A") as a, attrs, attrexp, children)
+  | Xml (("a"|"A") as a, attrs, attrexp, children)
       when mem_assoc "l:href" attrs ->
       let attrs =
         match partition (fst ->- (=)"l:href") attrs with
           | [_,[target]], rest ->
               ("href",
                [constant_str "?_k=";
-                apply "pickleCont" [fun_lit ~location:`Server `Unl [[]] target]])
+                apply "pickleCont" [fun_lit ~location:loc_server dl_unl [[]] target]])
               :: rest
           | _ -> assert false (* multiple l:hrefs, or an invalid rhs;
                                  NOTE: this is a user error and should
                                  be reported as such --ez.*)
-      in
-        `Xml (a, attrs, attrexp, children)
+      in Xml (a, attrs, attrexp, children)
   | e -> e
 
 let desugar_laction : phrasenode -> phrasenode = function
-  | `Xml (("form"|"FORM") as form, attrs, attrexp, children)
+  | Xml (("form"|"FORM") as form, attrs, attrexp, children)
       when mem_assoc "l:action" attrs ->
       begin match partition (fst ->- (=)"l:action") attrs with
         | [_,[action_expr]], rest ->
@@ -54,10 +54,10 @@ let desugar_laction : phrasenode -> phrasenode = function
                   ["type",  [constant_str "hidden"];
                    "name",  [constant_str "_k"];
                    "value", [apply "pickleCont"
-                                   [fun_lit ~location:`Server `Unl [[]] action_expr]]]
+                                   [fun_lit ~location:loc_server dl_unl [[]] action_expr]]]
                   None []
             and action = ("action", [constant_str "#"])
-            in `Xml (form, action::rest, attrexp, hidden::children)
+            in Xml (form, action::rest, attrexp, hidden::children)
         | _ -> assert false (* multiple l:actions, or an invalid rhs;
                                NOTE: this is a user error and should
                                be reported as such --ez. *)
@@ -69,24 +69,24 @@ let desugar_lonevent : phrasenode -> phrasenode =
     | (name, [rhs]) ->
         let event_name = StringLabels.sub ~pos:4 ~len:(String.length name - 4) name in
           tuple [constant_str event_name;
-                 fun_lit ~location:`Client `Unl [[variable_pat "event"]] rhs]
+                 fun_lit ~location:loc_client dl_unl [[variable_pat "event"]] rhs]
     | _ -> assert false
   in function
-    | `Xml (tag, attrs, attrexp, children)
+    | Xml (tag, attrs, attrexp, children)
         when exists (fst ->- start_of ~is:"l:on") attrs ->
         let lons, others = partition (fst ->- start_of ~is:"l:on") attrs in
         let idattr =
           ("key",
            [apply "registerEventHandlers"
                   [list (List.map (event_handler_pair) lons)]]) in
-          `Xml (tag, idattr::others, attrexp, children)
+          Xml (tag, idattr::others, attrexp, children)
     | e -> e
 
 let desugar_lnames (p : phrasenode) : phrasenode * (string * string) StringMap.t =
   let lnames = ref StringMap.empty in
   let add lname (id,name) = lnames := StringMap.add lname (id,name) !lnames in
   let attr : string * phrase list -> (string * phrase list) list = function
-    | "l:name", [{node=`Constant (`String v); _}] ->
+    | "l:name", [{node=Constant (`String v); _}] ->
         let id, name = fresh_names () in
           add v (id,name);
           [("name", [constant_str name]);
@@ -94,18 +94,18 @@ let desugar_lnames (p : phrasenode) : phrasenode * (string * string) StringMap.t
     | "l:name", _ -> failwith ("Invalid l:name binding")
     | a -> [a] in
   let rec aux : phrasenode -> phrasenode  = function
-    | `Xml (tag, attrs, attrexp, children) ->
+    | Xml (tag, attrs, attrexp, children) ->
         let attrs = concat_map attr attrs
         and children = List.map (fun {node;_} -> with_dummy_pos (aux node))
                                 children in
-          `Xml (tag, attrs, attrexp, children)
+          Xml (tag, attrs, attrexp, children)
     | p -> p
   in
   let p' = aux p in
     p', !lnames
 
 let let_in name rhs body : phrase =
-  block ([val_binding' NoSig (Name name, rhs, `Unknown)], body)
+  block ([val_binding' NoSig (PatName name, rhs, loc_unknown)], body)
 
 let bind_lname_vars lnames = function
   | "l:action" as attr, es ->
@@ -121,7 +121,7 @@ let bind_lname_vars lnames = function
   | attr -> attr
 
 let desugar_form : phrasenode -> phrasenode = function
-  | `Xml (("form"|"FORM") as form, attrs, attrexp, children) ->
+  | Xml (("form"|"FORM") as form, attrs, attrexp, children) ->
       let children = List.map (fun {node;_} -> node) children in
       let children, lnames = List.split (List.map desugar_lnames children) in
       let lnames =
@@ -129,14 +129,14 @@ let desugar_form : phrasenode -> phrasenode = function
         with StringMap.Not_disjoint (item, _) ->
           raise (Errors.SugarError (dummy_position, "Duplicate l:name binding: " ^ item)) in
       let attrs = List.map (bind_lname_vars lnames) attrs in
-        `Xml (form, attrs, attrexp, List.map with_dummy_pos children)
+        Xml (form, attrs, attrexp, List.map with_dummy_pos children)
   | e -> e
 
 let replace_lattrs : phrasenode -> phrasenode = desugar_form ->- desugar_laction ->- desugar_lhref ->- desugar_lonevent ->-
   (fun (xml) ->
      if (has_lattrs xml) then
        match xml with
-         | `Xml (_tag, _attributes, _, _) ->
+         | Xml (_tag, _attributes, _, _) ->
              raise (Errors.SugarError (dummy_position, "Illegal l: attribute in XML node"))
          | _ -> assert false
      else
@@ -146,7 +146,7 @@ let desugar_lattributes =
 object
   inherit SugarTraversals.map as super
   method! phrasenode = function
-    | `Xml _ as x when has_lattrs x ->
+    | Xml _ as x when has_lattrs x ->
         super#phrasenode (replace_lattrs x)
     | e -> super#phrasenode e
 end
@@ -159,6 +159,6 @@ object (_self)
   method satisfied = no_lattributes
 
   method! phrasenode = function
-    | `Xml _ as x when has_lattrs x -> {< no_lattributes = false >}
+    | Xml _ as x when has_lattrs x -> {< no_lattributes = false >}
     | e -> super#phrasenode e
 end
diff --git a/core/desugarModules.ml b/core/desugarModules.ml
index 1b4ff2990..ec074072e 100644
--- a/core/desugarModules.ml
+++ b/core/desugarModules.ml
@@ -24,6 +24,7 @@
  *
 *)
 open Utility
+open Operators
 open Sugartypes
 open Printf
 open ModuleUtils
@@ -38,13 +39,13 @@ object(self)
   inherit SugarTraversals.map as super
 
   method! phrasenode : phrasenode -> phrasenode = function
-    | `Block (bs, phr) ->
+    | Block (bs, phr) ->
         let flattened_bindings =
           List.concat (
             List.map (fun b -> ((flatten_bindings ())#binding b)#get_bindings) bs
           ) in
         let flattened_phrase = self#phrase phr in
-        `Block (flattened_bindings, flattened_phrase)
+        Block (flattened_bindings, flattened_phrase)
     | x -> super#phrasenode x
 end
 
@@ -62,9 +63,9 @@ object(self)
   method get_bindings = List.rev bindings
 
   method! binding = function
-    | {node = `Module (_, bindings); _} ->
+    | {node = Module (_, bindings); _} ->
         self#list (fun o -> o#binding) bindings
-    | {node = `QualifiedImport _; _} -> self
+    | {node = QualifiedImport _; _} -> self
     | b -> self#add_binding ((flatten_simple ())#binding b)
 
   method! program = function
@@ -93,7 +94,7 @@ let group_bindings : binding list -> binding list list = fun bindings ->
   let rec group_bindings_inner acc ret = function
     | [] when acc = [] -> List.rev ret
     | [] -> List.rev ((List.rev acc) :: ret)
-    | ({node=`Fun (_, _, _, _, _); _} as bnd) :: bs ->
+    | ({node=Fun (_, _, _, _, _); _} as bnd) :: bs ->
         group_bindings_inner (bnd :: acc) ret bs
     | b :: bs ->
         (* End block of functions, need to start a new scope *)
@@ -132,30 +133,30 @@ let rec rename_binders_get_shadow_tbl module_table
          (self#bind_shadow_term n fqn, set_binder_name bndr fqn)
 
     method! bindingnode = function
-      | `Fun (bnd, lin, (tvs, fnlit), loc, dt_opt) ->
+      | Fun (bnd, lin, (tvs, fnlit), loc, dt_opt) ->
           let (o, bnd') = self#binder bnd in
-          (o, `Fun (bnd', lin, (tvs, fnlit), loc, dt_opt))
-      | `Type t -> (self, `Type t)
-      | `Val v -> (self, `Val v)
-      | `Exp b -> (self, `Exp b)
-      | `Foreign (bnd, raw_name, lang, ext_file, dt) ->
+          (o, Fun (bnd', lin, (tvs, fnlit), loc, dt_opt))
+      | Type t -> (self, Type t)
+      | Val v -> (self, Val v)
+      | Exp b -> (self, Exp b)
+      | Foreign (bnd, raw_name, lang, ext_file, dt) ->
           let (o, bnd') = self#binder bnd in
-          (o, `Foreign (bnd', raw_name, lang, ext_file, dt))
-      | `AlienBlock (lang, lib, decls) ->
+          (o, Foreign (bnd', raw_name, lang, ext_file, dt))
+      | AlienBlock (lang, lib, decls) ->
           let (o, decls') = self#list (fun o (bnd, dt) ->
             let (o, bnd') = o#binder bnd in
             (o, (bnd', dt))) decls in
-          (o, `AlienBlock (lang, lib, decls'))
-      | `QualifiedImport [] -> assert false
-      | `QualifiedImport ((hd :: tl) as ns) ->
+          (o, AlienBlock (lang, lib, decls'))
+      | QualifiedImport [] -> assert false
+      | QualifiedImport ((hd :: tl) as ns) ->
           (* Try to resolve head of PQN. This will either resolve to itself, or
            * to a prefix. Once we have the prefix, we can construct the FQN. *)
           (* Qualified names must (by parser construction) be of at least length 1. *)
           let final = List.hd (List.rev ns) in
           let prefix = resolve hd term_shadow_table in
           let fqn = String.concat module_sep (prefix :: tl) in
-          (self#bind_open final fqn, `QualifiedImport ns)
-      | `Module (n, bs) ->
+          (self#bind_open final fqn, QualifiedImport ns)
+      | Module (n, bs) ->
           let new_path = path @ [n] in
           let fqn = lst_to_path new_path in
           (* New FQN for module must shadow n *)
@@ -166,9 +167,9 @@ let rec rename_binders_get_shadow_tbl module_table
           (* Recursively get *and rename* inner scope *)
           let (_, _, bindings') =
               process_binding_list bs module_table new_path o_term_ht o_type_ht in
-          (* Finally, return `Module with updated bindings. The module itself
+          (* Finally, return Module with updated bindings. The module itself
            * will be flattened out on the flattening pass. *)
-          (o, `Module (n, bindings'))
+          (o, Module (n, bindings'))
       | b -> super#bindingnode b
   end
 
@@ -192,10 +193,10 @@ and perform_renaming module_table path term_ht type_ht =
          (self#bind_shadow_term n fqn, set_binder_name bndr fqn)
 
     method! patternnode = function
-      | `Variant (n, p_opt) ->
+      | Pattern.Variant (n, p_opt) ->
           let fqn = resolve n term_shadow_table in
           let (o, p_opt') = self#option (fun o -> o#pattern) p_opt in
-          (o, `Variant (fqn, p_opt'))
+          (o, Pattern.Variant (fqn, p_opt'))
       | p -> super#patternnode p
 
     method! row = function
@@ -208,40 +209,40 @@ and perform_renaming module_table path term_ht type_ht =
           (self, (xs', rv'))
 
     method! bindingnode = function
-      | `Module (n, bs) ->
-          (self, `Module (n, bs))
-      | `AlienBlock ab ->
-          (self, `AlienBlock ab)
-      | `Foreign f -> (self, `Foreign f)
-      | `Type (n, tvs, dt) ->
+      | Module (n, bs) ->
+          (self, Module (n, bs))
+      | AlienBlock ab ->
+          (self, AlienBlock ab)
+      | Foreign f -> (self, Foreign f)
+      | Type (n, tvs, dt) ->
           (* Add type binding *)
           let fqn = make_path_string path n in
           let o = self#bind_shadow_type n fqn in
           let (o, dt') = o#datatype' dt in
-          (o, `Type (fqn, tvs, dt'))
-      | `Val (pat, (tvs, phr), loc, dt_opt) ->
+          (o, Type (fqn, tvs, dt'))
+      | Val (pat, (tvs, phr), loc, dt_opt) ->
           let (_, phr') = self#phrase phr in
           let (o, pat') = self#pattern pat in
           let (o, dt_opt') = o#option (fun o -> o#datatype') dt_opt in
-          (o, `Val (pat', (tvs, phr'), loc, dt_opt'))
-      | `Fun (bnd, lin, (tvs, fnlit), loc, dt_opt) ->
+          (o, Val (pat', (tvs, phr'), loc, dt_opt'))
+      | Fun (bnd, lin, (tvs, fnlit), loc, dt_opt) ->
           (* Binder will have been changed. We need to add the funlit pattern
            * to the env. *)
           let (_, fnlit') = self#funlit fnlit in
           let (o, dt_opt') = self#option (fun o -> o#datatype') dt_opt in
-          (o, `Fun (bnd, lin, (tvs, fnlit'), loc, dt_opt'))
+          (o, Fun (bnd, lin, (tvs, fnlit'), loc, dt_opt'))
       | b -> super#bindingnode b
 
     method! binop = function
-      | `Name n -> (self, `Name (resolve n term_shadow_table))
+      | BinaryOp.Name n -> (self, BinaryOp.Name (resolve n term_shadow_table))
       | bo -> super#binop bo
 
     method! unary_op = function
-      | `Name n -> (self, `Name (resolve n term_shadow_table))
+      | UnaryOp.Name n -> (self, UnaryOp.Name (resolve n term_shadow_table))
       | uo -> super#unary_op uo
 
     method! phrasenode = function
-      | `Block (bs, phr) ->
+      | Block (bs, phr) ->
           (* Process bindings, then process the phrase using
            * updated shadow table. *)
           let (term_ht, type_ht, bs') =
@@ -250,47 +251,48 @@ and perform_renaming module_table path term_ht type_ht =
           let (_, phr') =
               (perform_renaming module_table path
                 term_ht type_ht)#phrase phr in
-          (self, `Block (bs', phr'))
-      | `Var n -> (self, `Var (resolve n term_shadow_table))
-      | `RecordLit (xs, p_opt) ->
+          (self, Block (bs', phr'))
+      | Var n -> (self, Var (resolve n term_shadow_table))
+      | RecordLit (xs, p_opt) ->
           let (_, xs') =
             self#list (fun o (n, p) ->
               let (o, p') = o#phrase p in
               (o, (n, p'))) xs in
           let (_, p_opt') = self#option (fun o -> o#phrase) p_opt in
-          (self, `RecordLit (xs', p_opt'))
-      | `Projection (p, n) ->
+          (self, RecordLit (xs', p_opt'))
+      | Projection (p, n) ->
           let (_, p') = self#phrase p in
-          (self, `Projection (p', n))
-      | `ConstructorLit (n, p_opt, dt_opt) ->
+          (self, Projection (p', n))
+      | ConstructorLit (n, p_opt, dt_opt) ->
           (* Resolve constructor name using term table *)
           let fqn = resolve n term_shadow_table in
           let (_, p_opt') = self#option (fun o -> o#phrase) p_opt in
-          (self, `ConstructorLit (fqn, p_opt', dt_opt))
-      | `QualifiedVar [] -> assert false
-      | `QualifiedVar (hd :: tl) ->
+          (self, ConstructorLit (fqn, p_opt', dt_opt))
+      | QualifiedVar [] -> assert false
+      | QualifiedVar (hd :: tl) ->
           (* Similar to qualified imports. *)
           let prefix = resolve hd term_shadow_table in
           let fqn = String.concat module_sep (prefix :: tl) in
-          (self, `Var fqn)
+          (self, Var fqn)
       | phr -> super#phrasenode phr
 
-    method! datatypenode = function
-      | `Function (dts, row, dt) ->
+    method! datatypenode = let open Datatype in
+      function
+      | Function (dts, row, dt) ->
           let (_, dts') = self#list (fun o -> o#datatype) dts in
           let (_, dt') = self#datatype dt in
-          (self, `Function (dts', row, dt'))
-      | `TypeApplication (n, args) ->
+          (self, Function (dts', row, dt'))
+      | TypeApplication (n, args) ->
           let fqn = resolve n type_shadow_table in
           let (_, args') = self#list (fun o -> o#type_arg) args in
-          (self, `TypeApplication (fqn, args'))
-      | `QualifiedTypeApplication ([], _args) -> assert false
-      | `QualifiedTypeApplication (hd :: tl, args) ->
+          (self, TypeApplication (fqn, args'))
+      | QualifiedTypeApplication ([], _args) -> assert false
+      | QualifiedTypeApplication (hd :: tl, args) ->
           let prefix = resolve hd type_shadow_table in
           let fqn = String.concat module_sep (prefix :: tl) in
           let (_, args') = self#list (fun o -> o#type_arg) args in
-          (self, `TypeApplication (fqn, args'))
-      | `Variant (xs, rv) ->
+          (self, TypeApplication (fqn, args'))
+      | Variant (xs, rv) ->
           (* Variants need to have constructors renamed *)
           let (o, xs') =
             self#list (fun o (name, fspec) ->
@@ -299,7 +301,7 @@ and perform_renaming module_table path term_ht type_ht =
               let (o, fspec') = o#fieldspec fspec in
               (o, (fqn, fspec'))) xs in
           let (o, rv') = o#row_var rv in
-          (o, `Variant (xs', rv'))
+          (o, Variant (xs', rv'))
       | dt -> super#datatypenode dt
 
   end
diff --git a/core/desugarPages.ml b/core/desugarPages.ml
index 1d6347fd4..316b5f1b8 100644
--- a/core/desugarPages.ml
+++ b/core/desugarPages.ml
@@ -1,16 +1,17 @@
+open CommonTypes
 open Sugartypes
 open SugarConstructors.Make
 
 let rec is_raw phrase =
   match phrase.node with
-    | `TextNode _ -> true
-    | `Block _ -> true
-    | `FormletPlacement _
-    | `PagePlacement _ -> false
-    | `Xml (_, _, _, children) ->
-        List.for_all is_raw children
-    | _e ->
-        raise (Errors.SugarError (phrase.pos, "Invalid element in page literal"))
+  | TextNode _ -> true
+  | Block _ -> true
+  | FormletPlacement _
+  | PagePlacement _ -> false
+  | Xml (_, _, _, children) ->
+     List.for_all is_raw children
+  | _e ->
+     raise (Errors.SugarError (phrase.pos, "Invalid element in page literal"))
 
 (* DODGEYNESS:
 
@@ -33,22 +34,22 @@ let rec desugar_page (o, page_type) =
         | _ when is_raw phrase ->
           (* TODO: check that e doesn't contain any formletplacements or page placements *)
            fn_appl "bodyP" [`Row (o#lookup_effects)] [phrase]
-        | `FormletPlacement (formlet, handler, attributes) ->
+        | FormletPlacement (formlet, handler, attributes) ->
             let (_, formlet, formlet_type) = o#phrase formlet in
             let formlet_type = Types.concrete_type formlet_type in
-            let a = Types.fresh_type_variable (`Any, `Any) in
-            let b = Types.fresh_type_variable (`Any, `Any) in
+            let a = Types.fresh_type_variable (lin_any, res_any) in
+            let b = Types.fresh_type_variable (lin_any, res_any) in
               Unify.datatypes (`Alias (("Formlet", [`Type a]), b), formlet_type);
               fn_appl "formP" [`Type a; `Row (o#lookup_effects)]
                       [formlet; handler; attributes]
-        | `PagePlacement (page) -> page
-        | `Xml ("#", [], _, children) ->
+        | PagePlacement (page) -> page
+        | Xml ("#", [], _, children) ->
             desugar_nodes children
-        | `Xml (name, attrs, dynattrs, children) ->
+        | Xml (name, attrs, dynattrs, children) ->
             let x = Utility.gensym ~prefix:"xml" () in
             fn_appl "plugP" [`Row (o#lookup_effects)]
                [fun_lit ~args:[Types.make_tuple_type [Types.xml_type], o#lookup_effects]
-                        `Unl [[variable_pat ~ty:Types.xml_type x]]
+                        dl_unl [[variable_pat ~ty:Types.xml_type x]]
                         (xml name attrs dynattrs [block ([], var x)]);
                 desugar_nodes children]
         | _ ->
@@ -59,7 +60,7 @@ object
   inherit (TransformSugar.transform env) as super
 
   method! phrasenode = function
-    | `Page e ->
+    | Page e ->
         let (o, e, _t) = super#phrase e in
         let page_type = Instantiate.alias "Page" [] env.Types.tycon_env in
         let e = desugar_page (o, page_type) e in
@@ -75,6 +76,6 @@ object
   method satisfied = pageless
 
   method! phrasenode = function
-    | `Page _ -> {< pageless = false >}
+    | Page _ -> {< pageless = false >}
     | e -> super#phrasenode e
 end
diff --git a/core/desugarProcesses.ml b/core/desugarProcesses.ml
index 1b990b7f4..8ef4f3e07 100644
--- a/core/desugarProcesses.ml
+++ b/core/desugarProcesses.ml
@@ -1,4 +1,5 @@
 open Utility
+open CommonTypes
 open Sugartypes
 open SugarConstructors.Make
 
@@ -18,7 +19,7 @@ object (o : 'self_type)
   inherit (TransformSugar.transform env) as super
 
   method! phrasenode : Sugartypes.phrasenode -> ('self_type * Sugartypes.phrasenode * Types.datatype) = function
-    | `Spawn (Wait, spawn_loc, body, Some inner_eff) ->
+    | Spawn (Wait, spawn_loc, body, Some inner_eff) ->
         assert (spawn_loc = NoSpawnLocation);
         (* bring the inner effects into scope, then restore the
            outer effects afterwards *)
@@ -30,10 +31,10 @@ object (o : 'self_type)
 
         let e : phrasenode =
           fn_appl_node "spawnWait" [`Row inner_eff; `Type body_type; `Row outer_eff]
-            [fun_lit ~args:[(Types.make_tuple_type [], inner_eff)] `Unl [[]] body]
+            [fun_lit ~args:[(Types.make_tuple_type [], inner_eff)] dl_unl [[]] body]
         in
           (o, e, body_type)
-    | `Spawn (k, spawn_loc, body, Some inner_eff) ->
+    | Spawn (k, spawn_loc, body, Some inner_eff) ->
         (* bring the inner effects into scope, then restore the
            outer effects afterwards *)
         let process_type = `Application (Types.process, [`Row inner_eff]) in
@@ -62,20 +63,20 @@ object (o : 'self_type)
 
         let e : phrasenode =
           fn_appl_node spawn_fun [`Row inner_eff; `Type body_type; `Row outer_eff]
-             [fun_lit ~args:[(Types.make_tuple_type [], inner_eff)] `Unl [[]] body;
+             [fun_lit ~args:[(Types.make_tuple_type [], inner_eff)] dl_unl [[]] body;
               spawn_loc_phr]
         in
           (o, e, process_type)
-    | `Receive (cases, Some t) ->
+    | Receive (cases, Some t) ->
         let fields, row_var, _ = o#lookup_effects in
         let other_effects = StringMap.remove "hear" (StringMap.remove "wild" fields), row_var, false in
           begin
             match StringMap.find "hear" fields with
               | (`Present mbt) ->
                   o#phrasenode
-                    (`Switch (fn_appl "recv" [`Type mbt; `Row other_effects] [],
-                              cases,
-                              Some t))
+                    (Switch (fn_appl "recv" [`Type mbt; `Row other_effects] [],
+                             cases,
+                             Some t))
               | _ -> assert false
         end
     | e -> super#phrasenode e
@@ -91,7 +92,7 @@ object
   method satisfied = has_no_processes
 
   method! phrasenode = function
-    | `Spawn _
-    | `Receive _ -> {< has_no_processes = false >}
+    | Spawn _
+    | Receive _ -> {< has_no_processes = false >}
     | e -> super#phrasenode e
 end
diff --git a/core/desugarRegexes.ml b/core/desugarRegexes.ml
index ff0091121..1d2dd1abc 100644
--- a/core/desugarRegexes.ml
+++ b/core/desugarRegexes.ml
@@ -1,3 +1,4 @@
+open Operators
 open Sugartypes
 open SugarConstructors.Make
 
@@ -55,9 +56,9 @@ let desugar_regex phrase regex_type regex : phrase =
         constructor' repeat_str ~body:(tuple [desugar_repeat rep; aux r])
       | Splice e ->
         constructor' quote_str ~body:(constructor' ~body:(expr e) simply_str)
-      | Replace (re, (`Literal tmpl)) ->
+      | Replace (re, (Literal tmpl)) ->
         constructor' replace_str ~body:(tuple [aux re; constant_str tmpl])
-      | Replace (re, (`Splice e)) ->
+      | Replace (re, (SpliceExpr e)) ->
          constructor' replace_str ~body:(tuple [aux re; expr e])
   in block (List.map (fun (v, e1, t) ->
                 val_binding (variable_pat ~ty:t v) e1) !exprs,
@@ -70,14 +71,14 @@ object(self)
   val regex_type = Instantiate.alias "Regex" [] env.Types.tycon_env
 
   method! phrase ({node=p; pos} as ph) = match p with
-    | `InfixAppl ((tyargs, `RegexMatch flags), e1, {node=`Regex((Replace(_,_) as r)); _}) ->
+    | InfixAppl ((tyargs, BinaryOp.RegexMatch flags), e1, {node=Regex((Replace(_,_) as r)); _}) ->
         let libfn =
           if List.exists ((=)RegexNative) flags
           then "sntilde"
           else "stilde" in
           self#phrase (fn_appl libfn tyargs
                             [e1; desugar_regex self#phrase regex_type r])
-    | `InfixAppl ((tyargs, `RegexMatch flags), e1, {node=`Regex r; _}) ->
+    | InfixAppl ((tyargs, BinaryOp.RegexMatch flags), e1, {node=Regex r; _}) ->
         let nativep = List.exists ((=) RegexNative) flags
         and listp   = List.exists ((=) RegexList)   flags in
         let libfn = match listp, nativep with
@@ -87,7 +88,7 @@ object(self)
           | false, true  -> "ntilde" in
           self#phrase (fn_appl libfn tyargs
                             [e1; desugar_regex self#phrase regex_type r])
-    | `InfixAppl ((_tyargs, `RegexMatch _), _, _) ->
+    | InfixAppl ((_tyargs, BinaryOp.RegexMatch _), _, _) ->
         raise (Errors.SugarError (pos, "Internal error: unexpected rhs of regex operator"))
     | _ -> super#phrase ph
 end
diff --git a/core/desugarSessionExceptions.ml b/core/desugarSessionExceptions.ml
index afae3ae83..b3e87edcd 100644
--- a/core/desugarSessionExceptions.ml
+++ b/core/desugarSessionExceptions.ml
@@ -23,12 +23,12 @@ object (o: 'self_type)
   inherit (TransformSugar.transform env) as super
 
   method! phrasenode = function
-    | (`Spawn (Wait, _, _, _)) as sw ->
+    | (Spawn (Wait, _, _, _)) as sw ->
         super#phrasenode sw
-    | `Spawn (k, spawn_loc, {node=body;_}, Some inner_effects) ->
+    | Spawn (k, spawn_loc, {node=body;_}, Some inner_effects) ->
         let as_var = Utility.gensym ~prefix:"spawn_aspat" () in
         let as_pat = variable_pat ~ty:`Not_typed as_var in
-        let unit_phr = with_dummy_pos (`RecordLit ([], None)) in
+        let unit_phr = with_dummy_pos (RecordLit ([], None)) in
 
         let (o, spawn_loc) = o#given_spawn_location spawn_loc in
         let envs = o#backup_envs in
@@ -37,10 +37,10 @@ object (o: 'self_type)
         let o = o#with_effects inner_effects in
         let (o, body, _) = o#phrasenode body in
         let body =
-          `TryInOtherwise (with_dummy_pos body, as_pat,
-                           var as_var, unit_phr, Some (Types.unit_type)) in
+          TryInOtherwise (with_dummy_pos body, as_pat,
+                          var as_var, unit_phr, Some (Types.unit_type)) in
         let o = o#restore_envs envs in
-        (o, (`Spawn (k, spawn_loc, with_dummy_pos body, Some inner_effects)), process_type)
+        (o, Spawn (k, spawn_loc, with_dummy_pos body, Some inner_effects), process_type)
     | e -> super#phrasenode e
 end
 
@@ -50,10 +50,10 @@ object (o : 'self_type)
   inherit (TransformSugar.transform env) as super
 
   method! phrasenode = function
-    | `Raise ->
-        (o, `DoOperation (failure_op_name, [], Some `Not_typed), `Not_typed)
-    | `TryInOtherwise (_, _, _, _, None) -> assert false
-    | `TryInOtherwise (try_phr, pat, as_phr, otherwise_phr, (Some dt)) ->
+    | Raise ->
+        (o, DoOperation (failure_op_name, [], Some `Not_typed), `Not_typed)
+    | TryInOtherwise (_, _, _, _, None) -> assert false
+    | TryInOtherwise (try_phr, pat, as_phr, otherwise_phr, (Some dt)) ->
         let (o, try_phr, try_dt) = o#phrase try_phr in
         let envs = o#backup_envs in
         let (o, pat) = o#pattern pat in
@@ -69,8 +69,8 @@ object (o : 'self_type)
          * continuation argument. *)
         let cont_pat = variable_pat ~ty:`Not_typed (Utility.gensym ~prefix:"dsh" ()) in
 
-        let otherwise_pat : Sugartypes.pattern =
-          with_dummy_pos (`Effect (failure_op_name, [], cont_pat)) in
+        let otherwise_pat : Sugartypes.Pattern.with_pos =
+          with_dummy_pos (Pattern.Effect (failure_op_name, [], cont_pat)) in
 
         let otherwise_clause = (otherwise_pat, otherwise_phr) in
 
@@ -107,7 +107,7 @@ object (o : 'self_type)
           sh_effect_cases = effect_cases;
           sh_value_cases = value_cases;
           sh_descr = hndl_desc
-        } in (o, `Handle hndlr, dt)
+        } in (o, Handle hndlr, dt)
     | e -> super#phrasenode e
 end
 
@@ -120,8 +120,8 @@ let contains_session_exceptions prog =
       method satisfied = has_exceptions
 
       method! phrasenode = function
-        | `TryInOtherwise _
-        | `Raise -> {< has_exceptions = true >}
+        | TryInOtherwise _
+        | Raise -> {< has_exceptions = true >}
         | p -> super#phrasenode p
     end in
   (o#program prog)#satisfied
@@ -160,20 +160,20 @@ let wrap_linear_handlers prog =
     object
       inherit SugarTraversals.map as super
       method! phrase = function
-        | {node=`TryInOtherwise (l, x, m, n, dtopt); _} ->
+        | {node=TryInOtherwise (l, x, m, n, dtopt); _} ->
             let fresh_var = Utility.gensym ?prefix:(Some "try_x") () in
             let fresh_pat = variable_pat fresh_var in
             with_dummy_pos
-            (`Switch (
+            (Switch (
               with_dummy_pos
-               (`TryInOtherwise
+               (TryInOtherwise
                 (super#phrase l,
                  fresh_pat,
                  constructor ~body:(var fresh_var) "Just",
                  constructor "Nothing", dtopt)),
               [
-                (with_dummy_pos (`Variant ("Just", (Some x))), super#phrase m);
-                (with_dummy_pos (`Variant ("Nothing", None)), super#phrase n)
+                (with_dummy_pos (Pattern.Variant ("Just", (Some x))), super#phrase m);
+                (with_dummy_pos (Pattern.Variant ("Nothing", None)), super#phrase n)
               ], None))
         | p -> super#phrase p
     end
diff --git a/core/dumpTypes.ml b/core/dumpTypes.ml
index e228b3d3a..f8af13543 100644
--- a/core/dumpTypes.ml
+++ b/core/dumpTypes.ml
@@ -37,7 +37,7 @@ let program =
 
       method! phrase =
         function
-          | {Sugartypes.node=`Var x; Sugartypes.pos} when o#bound x ->
+          | {Sugartypes.node=Sugartypes.Var x; Sugartypes.pos} when o#bound x ->
               o#use (x, o#lookup x, pos)
           | e -> super#phrase e
     end in
diff --git a/core/evalir.ml b/core/evalir.ml
index 5b2c923d1..abb7dbe71 100644
--- a/core/evalir.ml
+++ b/core/evalir.ml
@@ -1,3 +1,4 @@
+open CommonTypes
 open Webserver_types
 open Ir
 open Lwt
@@ -68,14 +69,14 @@ struct
     | Some (finfo, _, None, location) ->
       begin
         match location with
-        | `Server | `Unknown ->
+        | Location.Server | Location.Unknown ->
           (* TODO: perhaps we should actually use env here - and make
              sure we only call this function when it is sufficiently
              small *)
           Some (`FunctionPtr (f, None))
-        | `Client ->
+        | Location.Client ->
           Some (`ClientFunction (Js.var_name_binder (f, finfo)))
-        | `Native -> assert false
+        | Location.Native -> assert false
       end
     | _ -> assert false
 
diff --git a/core/experimentalExtensions.ml b/core/experimentalExtensions.ml
index a69544ca4..928537739 100644
--- a/core/experimentalExtensions.ml
+++ b/core/experimentalExtensions.ml
@@ -2,6 +2,8 @@
  Check whether an experimental feature is enabled before use.
  **)
 
+open Sugartypes
+
 module BS = Basicsettings
 
 let get setting = Settings.get_value setting
@@ -17,22 +19,22 @@ object
       failwith "Code uses relational lenses, but relational lenses are not enabled. Please set the relational lenses flag."
     in
     function
-    | `Handle _     when not (get BS.Handlers.enabled) ->
+    | Handle _     when not (get BS.Handlers.enabled) ->
        failwith "Handlers are only allowed with setting enable_handlers set to true."
-    | `HandlerLit _ when not (get BS.Handlers.enabled) ->
+    | HandlerLit _ when not (get BS.Handlers.enabled) ->
        failwith "Handlers are only allowed with setting enable_handlers set to true."
-    | `LensLit _        when relational_lenses_disabled -> relational_fail ()
-    | `LensKeysLit _    when relational_lenses_disabled -> relational_fail ()
-    | `LensFunDepsLit _ when relational_lenses_disabled -> relational_fail ()
-    | `LensDropLit _    when relational_lenses_disabled -> relational_fail ()
-    | `LensSelectLit _  when relational_lenses_disabled -> relational_fail ()
-    | `LensJoinLit _    when relational_lenses_disabled -> relational_fail ()
-    | `LensGetLit _     when relational_lenses_disabled -> relational_fail ()
-    | `LensPutLit _     when relational_lenses_disabled -> relational_fail ()
+    | LensLit _        when relational_lenses_disabled -> relational_fail ()
+    | LensKeysLit _    when relational_lenses_disabled -> relational_fail ()
+    | LensFunDepsLit _ when relational_lenses_disabled -> relational_fail ()
+    | LensDropLit _    when relational_lenses_disabled -> relational_fail ()
+    | LensSelectLit _  when relational_lenses_disabled -> relational_fail ()
+    | LensJoinLit _    when relational_lenses_disabled -> relational_fail ()
+    | LensGetLit _     when relational_lenses_disabled -> relational_fail ()
+    | LensPutLit _     when relational_lenses_disabled -> relational_fail ()
     | e -> super#phrasenode e
 
   method! bindingnode = function
-    | `Handler _ when not (get BS.Handlers.enabled) ->
+    | Handler _ when not (get BS.Handlers.enabled) ->
        failwith "Handlers are only allowed with setting enable_handlers set to true."
     | b -> super#bindingnode b
 end
diff --git a/core/instantiate.ml b/core/instantiate.ml
index c3172b695..1fafe2283 100644
--- a/core/instantiate.ml
+++ b/core/instantiate.ml
@@ -1,3 +1,4 @@
+open CommonTypes
 open Utility
 open Types
 
@@ -49,7 +50,7 @@ let instantiate_datatype : instantiation_maps -> datatype -> datatype =
                         else
                           begin
                             let var' = Types.fresh_raw_variable () in
-                            let point' = Unionfind.fresh (`Var (var', (`Any, `Any), `Flexible)) in
+                            let point' = Unionfind.fresh (`Var (var', (lin_any, res_any), `Flexible)) in
                             let t' = inst (IntMap.add var point' rec_type_env, rec_row_env) t in
                             let _ = Unionfind.change point' (`Recursive (var', t')) in
                               `MetaTypeVar point'
@@ -149,7 +150,7 @@ let instantiate_datatype : instantiation_maps -> datatype -> datatype =
                     else
                       begin
                         let var' = Types.fresh_raw_variable () in
-                        let point' = Unionfind.fresh (`Var (var', (`Any, `Any), `Flexible)) in
+                        let point' = Unionfind.fresh (`Var (var', (lin_any, res_any), `Flexible)) in
                         let rec_row' = inst_row (rec_type_env, IntMap.add var point' rec_row_env) rec_row in
                         let _ = Unionfind.change point' (`Recursive (var', rec_row')) in
                           (StringMap.empty, point', dual)
@@ -419,7 +420,10 @@ let alias name tyargs env =
             (fun q arg (tenv, renv, penv) ->
               if not (primary_kind_of_quantifier q = primary_kind_of_type_arg arg)
               then failwith (Printf.sprintf
-"Argument '%s' to type alias '%s' has the wrong kind ('%s' instead of '%s')" (Types.string_of_type_arg arg) name (Types.string_of_primary_kind (primary_kind_of_type_arg arg)) (Types.string_of_primary_kind (primary_kind_of_quantifier q)));
+                 "Argument '%s' to type alias '%s' has the wrong kind ('%s' instead of '%s')"
+                 (Types.string_of_type_arg arg) name
+                 (PrimaryKind.to_string (primary_kind_of_type_arg arg))
+                 (PrimaryKind.to_string (primary_kind_of_quantifier q)));
               let x = var_of_quantifier q in
                 match arg with
                 | `Type t ->
diff --git a/core/ir.ml b/core/ir.ml
index 866431a79..4743aed55 100644
--- a/core/ir.ml
+++ b/core/ir.ml
@@ -36,7 +36,7 @@ type language = string
 type constant = Constant.constant
   [@@deriving show]
 
-type location = Sugartypes.location
+type location = CommonTypes.Location.t
   [@@deriving show]
 
 type value =
diff --git a/core/ir.mli b/core/ir.mli
index b5a537660..8b2da6804 100644
--- a/core/ir.mli
+++ b/core/ir.mli
@@ -36,7 +36,7 @@ type language = string
 type constant = Constant.constant
   [@@deriving show]
 
-type location = Sugartypes.location
+type location = CommonTypes.Location.t
   [@@deriving show]
 
 (* INVARIANT: all IR binders have unique names *)
diff --git a/core/irCheck.ml b/core/irCheck.ml
index c401ecffd..33fb8c232 100644
--- a/core/irCheck.ml
+++ b/core/irCheck.ml
@@ -1,3 +1,4 @@
+open CommonTypes
 open Utility
 open Ir
 
@@ -164,7 +165,7 @@ let eq_types occurrence : type_eq_context -> (Types.datatype * Types.datatype) -
               begin match t2 with
                 `MetaTypeVar rpoint ->
                 begin match lpoint_cont, Unionfind.find rpoint with
-                | `Var lv, `Var rv ->  handle_variable `Type lv rv context
+                | `Var lv, `Var rv ->  handle_variable pk_type lv rv context
                 | `Body _, `Body _ -> failwith "Should have  removed `Body by now"
                 | _ -> (context, false)
                 end
@@ -281,7 +282,7 @@ let eq_types occurrence : type_eq_context -> (Types.datatype * Types.datatype) -
       | `Var lpoint, `Var rpoint -> begin match Unionfind.find lpoint, Unionfind.find rpoint with
                                     | `Body _,  _
                                     | _, `Body _ -> failwith "should have removed all `Body variants by now"
-                                    |  `Var lv, `Var rv -> handle_variable `Presence lv rv context
+                                    |  `Var lv, `Var rv -> handle_variable pk_presence lv rv context
                                     end
       | _, _ -> (context, false)
     and eq_field_envs  (context, lfield_env, rfield_env) =
@@ -295,7 +296,7 @@ let eq_types occurrence : type_eq_context -> (Types.datatype * Types.datatype) -
     and eq_row_vars (context, lpoint, rpoint) =
       match Unionfind.find lpoint, Unionfind.find rpoint with
       | `Closed, `Closed ->  (context, true)
-      | `Var lv, `Var rv ->   handle_variable `Row lv rv context
+      | `Var lv, `Var rv ->   handle_variable pk_row lv rv context
       | `Recursive _, _
       | _, `Recursive _ -> Debug.print "IR typechecker encountered recursive type"; (context, true)
       | _ ->  (context, false)
diff --git a/core/irtojs.ml b/core/irtojs.ml
index d108d092d..2c9d14363 100644
--- a/core/irtojs.ml
+++ b/core/irtojs.ml
@@ -1,6 +1,7 @@
 
 (** JavaScript generation *)
 open Utility
+open CommonTypes
 
 let _ = ParseSettings.config_file
 
@@ -690,7 +691,7 @@ end = functor (K : CONTINUATION) -> struct
               | _ ->
                  if Lib.is_primitive f_name
                    && not (List.mem f_name cps_prims)
-                   && Lib.primitive_location f_name <> `Server
+                   && not (Location.is_server (Lib.primitive_location f_name))
                  then
                    Call (Var ("_" ^ f_name), List.map gv vs)
                  else
@@ -743,7 +744,7 @@ end = functor (K : CONTINUATION) -> struct
          advantage of dynamic scoping *)
 
         match location with
-        | `Client | `Native | `Unknown ->
+        | Location.Client | Location.Native | Location.Unknown ->
            let xs_names'' = xs_names'@[__kappa] in
            LetFun ((Js.var_name_binder fb,
                     xs_names'',
@@ -751,7 +752,7 @@ end = functor (K : CONTINUATION) -> struct
                           List.map (fun x -> Var x) xs_names''),
                     location),
                    code)
-        | `Server ->
+        | Location.Server ->
            LetFun ((Js.var_name_binder fb,
                     xs_names'@[__kappa],
                     generate_remote_call f_var xs_names env,
@@ -786,7 +787,7 @@ end = functor (K : CONTINUATION) -> struct
           (Env.Int.fold
              (fun var _v funcs ->
                let name = Lib.primitive_name var in
-               if Lib.primitive_location name = `Server then
+               if Location.is_server (Lib.primitive_location name) then
                  (name, var)::funcs
                else
                  funcs)
@@ -811,7 +812,7 @@ end = functor (K : CONTINUATION) -> struct
             ((name,
               args @ [__kappa],
               body,
-              `Server),
+              loc_server),
              code))
         prim_server_calls
         code
@@ -843,7 +844,7 @@ end = functor (K : CONTINUATION) -> struct
                 | _ ->
                    if Lib.is_primitive f_name
                      && not (List.mem f_name cps_prims)
-                     && Lib.primitive_location f_name <> `Server
+                     && not (Location.is_server (Lib.primitive_location f_name))
                    then
                      let arg = Call (Var ("_" ^ f_name), List.map gv vs) in
                      K.apply ~strategy:`Direct kappa arg
@@ -1159,10 +1160,10 @@ end = functor (K : CONTINUATION) -> struct
       let body_env = List.fold_left VEnv.bind env (fs @ bs) in
       let body =
         match location with
-        | `Client | `Unknown ->
+        | Location.Client | Location.Unknown ->
            snd (generate_computation body_env body (K.reflect (Var __kappa)))
-        | `Server -> generate_remote_call f xs_names (Dict [])
-        | `Native -> failwith ("Not implemented native calls yet")
+        | Location.Server -> generate_remote_call f xs_names (Dict [])
+        | Location.Native -> failwith ("Not implemented native calls yet")
       in
       (f_name,
        xs_names @ [__kappa],
diff --git a/core/json.ml b/core/json.ml
index beee88dd9..77391456b 100644
--- a/core/json.ml
+++ b/core/json.ml
@@ -1,5 +1,6 @@
 (* Side-effect-free JSON operations. *)
 open ProcessTypes
+open CommonTypes
 open Utility
 
 (* Setting *)
@@ -58,10 +59,10 @@ let js_dq_escape_char =
   | ch -> String.make 1 ch
 
 let jsonize_location : Ir.location -> string = function
-  | `Client  -> "client"
-  | `Server  -> "server"
-  | `Native  -> "native"
-  | `Unknown -> "unknown"
+  | Location.Client  -> "client"
+  | Location.Server  -> "server"
+  | Location.Native  -> "native"
+  | Location.Unknown -> "unknown"
 
 let rec string_listify : string list -> string = function
   | [] -> nil_literal
diff --git a/core/lens/lensTypes.ml b/core/lens/lensTypes.ml
index 1cd042ee0..a786ff5da 100644
--- a/core/lens/lensTypes.ml
+++ b/core/lens/lensTypes.ml
@@ -39,13 +39,13 @@ let sort_cols_of_table (tableName : string) (t : Types.typ) =
 
 let var_name (var : phrase) =
     match var.node with
-    | `Var name -> name
+    | Var name -> name
     | _ -> failwith "Expected a `Var type"
 
 let cols_of_phrase (key : phrase) : string list =
     match key.node with
-    | `TupleLit keys -> List.map var_name keys
-    | `Var name -> [name]
+    | TupleLit keys -> List.map var_name keys
+    | Var name -> [name]
     | _ -> failwith "Expected a tuple or a variable."
 
 let select_lens_sort (sort : Lens_sort.t) (pred : lens_phrase) : Lens_sort.t =
diff --git a/core/lens/lens_operators.ml b/core/lens/lens_operators.ml
index 1cf7df17e..9cca86c4f 100644
--- a/core/lens/lens_operators.ml
+++ b/core/lens/lens_operators.ml
@@ -1,3 +1,5 @@
+open Operators
+
 (* The operators named here are the ones that it is difficult or
    impossible to define as "user" infix operators:
 
@@ -18,10 +20,9 @@ module Unary = struct
 
   let from_links v =
     match v with
-    | `Minus -> Minus
-    | `FloatMinus -> Minus
-    | `Not -> Not
-    | `Name name -> Name name
+    | UnaryOp.Minus -> Minus
+    | UnaryOp.FloatMinus -> Minus
+    | UnaryOp.Name name -> Name name
 
   let to_string =
   function
@@ -59,14 +60,14 @@ module Binary = struct
 
   let of_supertype_operator v =
     match v with
-    | `Minus -> Minus
-    | `FloatMinus -> Minus
-    | `Cons -> Cons
-    | `And -> Logical Logical_binop.And
-    | `Or -> Logical Logical_binop.Or
-    | `Name "==" -> Equal
-    | `Name name -> Name name
-    | `RegexMatch _ -> failwith "Regex not supported in relational lenses."
+    | BinaryOp.Minus -> Minus
+    | BinaryOp.FloatMinus -> Minus
+    | BinaryOp.Cons -> Cons
+    | BinaryOp.And -> Logical Logical_binop.And
+    | BinaryOp.Or -> Logical Logical_binop.Or
+    | BinaryOp.Name "==" -> Equal
+    | BinaryOp.Name name -> Name name
+    | BinaryOp.RegexMatch _ -> failwith "Regex not supported in relational lenses."
 
   let to_string =
     function
diff --git a/core/lens/lens_phrase.ml b/core/lens/lens_phrase.ml
index 424219289..3b4257bd8 100644
--- a/core/lens/lens_phrase.ml
+++ b/core/lens/lens_phrase.ml
@@ -1,6 +1,5 @@
 open Utility
 open Types
-open Sugartypes
 open Lens_operators
 open Lens_utility
 
@@ -25,19 +24,19 @@ let tuple v = TupleLit v
 let tuple_singleton v = tuple [v]
 
 let name_of_var expr =
-  match expr.node with
-  | `Var n -> n
+  match expr.Sugartypes.node with
+  | Sugartypes.Var n -> n
   | _ -> failwith "Expected var."
 
 let of_phrase p =
   let rec f p =
-    match p.node with
-    | `Constant c -> Constant c
-    | `Var v -> Var v
-    | `UnaryAppl ((_, op), phrase) -> UnaryAppl (Unary.from_links op, f phrase)
-    | `InfixAppl ((_, op), phrase1, phrase2) -> InfixAppl (Binary.of_supertype_operator op, f phrase1, f phrase2)
-    | `TupleLit l -> TupleLit (List.map f l)
-    | `FnAppl (fn, arg) ->
+    match p.Sugartypes.node with
+    | Sugartypes.Constant c -> Constant c
+    | Sugartypes.Var v -> Var v
+    | Sugartypes.UnaryAppl ((_, op), phrase) -> UnaryAppl (Unary.from_links op, f phrase)
+    | Sugartypes.InfixAppl ((_, op), phrase1, phrase2) -> InfixAppl (Binary.of_supertype_operator op, f phrase1, f phrase2)
+    | Sugartypes.TupleLit l -> TupleLit (List.map f l)
+    | Sugartypes.FnAppl (fn, arg) ->
       begin
         match name_of_var fn with
         | "not" -> UnaryAppl ((Unary.Name "!"), f (List.hd arg))
diff --git a/core/lexer.mll b/core/lexer.mll
index 68fd28eb8..ab2deabf9 100644
--- a/core/lexer.mll
+++ b/core/lexer.mll
@@ -36,6 +36,7 @@
 open Lexing
 open Utility
 open Parser
+open Operators
 
 (* Constructors are not first class in OCaml *)
 let infix0  x = INFIX0  x
@@ -131,13 +132,13 @@ object
     try List.assoc name optable name
     with NotFound _ -> default_precedence name
 
-  method setprec (assoc : [`None|`Left|`Right|`Pre|`Post]) level name =
+  method setprec (assoc : Associativity.t) level name =
     let value = match List.nth precs level, assoc with
-      | (a,_,_), `None -> a
-      | (_,a,_), `Left -> a
-      | (_,_,a), `Right -> a
-      | _,       `Pre -> prefix
-      | _,       `Post -> postfix
+      | (a,_,_), Associativity.None -> a
+      | (_,a,_), Associativity.Left -> a
+      | (_,_,a), Associativity.Right -> a
+      | _,       Associativity.Pre -> prefix
+      | _,       Associativity.Post -> postfix
     in
       optable <- (name, value) :: optable
 
diff --git a/core/lib.ml b/core/lib.ml
index c2431dd97..9d79d3c9e 100644
--- a/core/lib.ml
+++ b/core/lib.ml
@@ -1,3 +1,4 @@
+open CommonTypes
 open List
 
 (*open Value*)
@@ -71,7 +72,7 @@ let conversion_op' ~unbox ~conv ~(box :'a->Value.t): Value.t list -> Value.t = f
 
 let conversion_op ~from ~unbox ~conv ~(box :'a->Value.t) ~into pure : located_primitive * Types.datatype * pure =
   ((`PFun (fun _ x -> conversion_op' ~unbox:unbox ~conv:conv ~box:box x) : located_primitive),
-   (let q, r = Types.fresh_row_quantifier (`Any, `Any) in
+   (let q, r = Types.fresh_row_quantifier (lin_any, res_any) in
       (`ForAll (Types.box_quantifiers [q], `Function (make_tuple_type [from], r, into)) : Types.datatype)),
    pure)
 
@@ -1655,9 +1656,9 @@ let primitive_name = Env.Int.lookup venv
 
 let primitive_location (name:string) =
   match fst3 (List.assoc name env) with
-    | `Client ->  `Client
-    | `Server _ -> `Server
-    | #primitive -> `Unknown
+    | `Client    -> Location.Client
+    | `Server _  -> Location.Server
+    | #primitive -> Location.Unknown
 
 let rec function_arity =
   function
diff --git a/core/lib.mli b/core/lib.mli
index 55ee53918..4702b24db 100644
--- a/core/lib.mli
+++ b/core/lib.mli
@@ -28,7 +28,7 @@ val apply_pfun_by_code : Var.var -> Value.t list -> RequestData.request_data ->
 val primitive_stub_by_code : Var.var -> Value.t
 
 val primitive_name : Var.var -> string
-val primitive_location : string -> Sugartypes.location
+val primitive_location : string -> CommonTypes.Location.t
 val primitive_arity : string -> int option
 
 val cohttp_server_response : (string * string) list -> string -> RequestData.request_data -> (Cohttp.Response.t * Cohttp_lwt.Body.t) Lwt.t
diff --git a/core/moduleUtils.ml b/core/moduleUtils.ml
index 6388c2ecc..b338de80f 100644
--- a/core/moduleUtils.ml
+++ b/core/moduleUtils.ml
@@ -55,16 +55,16 @@ object
   method satisfied = has_no_modules
 
   method! bindingnode = function
-    | `QualifiedImport _
-    | `Module _ -> {< has_no_modules = false >}
+    | QualifiedImport _
+    | Module _ -> {< has_no_modules = false >}
     | b -> super#bindingnode b
 
   method! datatypenode = function
-    | `QualifiedTypeApplication _ -> {< has_no_modules = false >}
+    | Datatype.QualifiedTypeApplication _ -> {< has_no_modules = false >}
     | dt -> super#datatypenode dt
 
   method! phrasenode = function
-    | `QualifiedVar _ -> {< has_no_modules = false >}
+    | QualifiedVar _ -> {< has_no_modules = false >}
     | pn -> super#phrasenode pn
 end
 
@@ -72,7 +72,7 @@ end
 let separate_modules =
   List.fold_left (fun (mods, binds) b ->
     match b with
-      | {node = `Module _; _} as m -> (m :: mods, binds)
+      | {node = Module _; _} as m -> (m :: mods, binds)
       | b -> (mods, b :: binds)) ([], [])
 
 type module_info = {
@@ -94,13 +94,14 @@ let get_pat_vars () =
     method get_bindings = bindings (* Order doesn't matter *)
 
     method! patternnode = function
-      | `Variant (_n, p_opt) ->
-           self#option (fun o p -> o#pattern p) p_opt
+      | Pattern.Variant (_n, p_opt) ->
+         self#option (fun o p -> o#pattern p) p_opt
       (* | `Negative ns -> self#list (fun o p -> o#add_binding p) ns *)
-      | `Record (ls, p_opt) ->
-          let o1 = self#list (fun o (_, p) -> o#pattern p) ls in
-          o1#option (fun o p -> o#pattern p) p_opt
-      | `Variable bndr -> self#add_binding (Sugartypes.name_of_binder bndr)
+      | Pattern.Record (ls, p_opt) ->
+         let o1 = self#list (fun o (_, p) -> o#pattern p) ls in
+         o1#option (fun o p -> o#pattern p) p_opt
+      | Pattern.Variable bndr ->
+         self#add_binding (Sugartypes.name_of_binder bndr)
       | p -> super#patternnode p
   end
 
@@ -120,7 +121,7 @@ let get_ffi_files_obj =
     method get_filenames = List.rev filenames
 
     method! bindingnode = function
-      | `Foreign (_, _, _, filename, _) -> self#add_external_file filename
+      | Foreign (_, _, _, filename, _) -> self#add_external_file filename
       | x -> super#bindingnode x
   end
 
@@ -141,7 +142,7 @@ let get_data_constructors init_constrs =
         method get_constrs = StringSet.elements constrs
 
         method! datatypenode = function
-            | `Variant (xs, _) ->
+            | Datatype.Variant (xs, _) ->
                 self#list (fun o (lbl, _) -> o#add_constr lbl) xs
             | dt -> super#datatypenode dt
     end
@@ -158,7 +159,7 @@ let create_module_info_map program =
     (* Recursively traverse a list of modules *)
     let rec traverse_modules = function
       | [] -> []
-      | {node=`Module (submodule_name, mod_bs);_} :: bs ->
+      | {node=Module (submodule_name, mod_bs);_} :: bs ->
           (* Recursively process *)
           let new_path = if name = "" then [] else parent_path @ [name] in
           create_and_add_module_info new_path submodule_name mod_bs;
@@ -169,16 +170,16 @@ let create_module_info_map program =
     (* Getting binding names -- we're interested in function and value names *)
     let rec get_binding_names = function
       | [] -> []
-      | {node = `Val (pat, _, _, _); _} :: bs ->
+      | {node = Val (pat, _, _, _); _} :: bs ->
          (get_pattern_variables pat) @ get_binding_names bs
-      | {node = `Fun (bndr, _, _, _, _); _} :: bs ->
+      | {node = Fun (bndr, _, _, _, _); _} :: bs ->
          Sugartypes.name_of_binder bndr :: (get_binding_names bs)
       | _ :: bs -> get_binding_names bs in (* Other binding types are uninteresting for this pass *)
 
     (* Getting type names -- we're interested in typename decls *)
     let rec get_type_names = function
       | [] -> []
-      | { node = `Type (n, _, _); _} :: bs -> n :: (get_type_names bs)
+      | { node = Type (n, _, _); _} :: bs -> n :: (get_type_names bs)
       | _ :: bs -> get_type_names bs in
 
     (* Gets data constructors for variants *)
diff --git a/core/operators.ml b/core/operators.ml
new file mode 100644
index 000000000..cf1ad9122
--- /dev/null
+++ b/core/operators.ml
@@ -0,0 +1,67 @@
+(* The operators named here are the ones that it is difficult or
+   impossible to define as "user" infix operators:
+
+      - -.  are both infix and prefix
+     && ||  have special evaluation
+     ::     is also used in patterns
+     ~      triggers a lexer state switch
+
+   Operators were extracted from Sugartypes to their own module to avoid import
+   cycle with lens code.  If, at any point in the future, the import cycle no
+   longer exists this module can be merged back into Sugartypes.
+*)
+
+type name = string [@@deriving show]
+
+type regexflag = RegexList | RegexNative | RegexGlobal | RegexReplace
+    [@@deriving show]
+
+module Associativity = struct
+  type t = Left | Right | None | Pre | Post
+    [@@deriving show]
+end
+
+module UnaryOp = struct
+  type t =
+    | Minus
+    | FloatMinus
+    | Name of name
+    [@@deriving show]
+end
+
+let string_of_unary_op =
+  function
+  | UnaryOp.Minus -> "-"
+  | UnaryOp.FloatMinus -> ".-"
+  | UnaryOp.Name name -> name
+
+module BinaryOp = struct
+  type t =
+    | Minus
+    | FloatMinus
+    | RegexMatch of regexflag list
+    | And
+    | Or
+    | Cons
+    | Name of name
+    [@@deriving show]
+end
+
+let string_of_binop =
+  let open BinaryOp in function
+  | Minus -> "-"
+  | FloatMinus -> ".-"
+  | RegexMatch _ -> "<some regex nonsense>"
+  | And -> "&&"
+  | Or -> "||"
+  | Cons -> "::"
+  | Name name -> name
+
+let binop_of_string : string -> BinaryOp.t =
+   let open BinaryOp in function
+   | "-"  -> Minus
+   | ".-" -> FloatMinus
+   | "&&" -> And
+   | "||" -> Or
+   | "::" -> Cons
+   | name -> Name name
diff --git a/core/parse.ml b/core/parse.ml
index ef25f401f..0ab5b6ab1 100644
--- a/core/parse.ml
+++ b/core/parse.ml
@@ -115,7 +115,7 @@ let reader_of_readline ps1 =
 
 let interactive : Sugartypes.sentence grammar = Parser.interactive
 let program : (Sugartypes.binding list * Sugartypes.phrase option) grammar = Parser.file
-let datatype : Sugartypes.datatype grammar = Parser.just_datatype
+let datatype : Sugartypes.Datatype.with_pos grammar = Parser.just_datatype
 
 let normalize_pp = function
   | "" -> None
diff --git a/core/parse.mli b/core/parse.mli
index 4e4331317..75bbfd806 100644
--- a/core/parse.mli
+++ b/core/parse.mli
@@ -3,7 +3,7 @@
 type 'result grammar
 
 (* Grammar for types *)
-val datatype    :  Sugartypes.datatype grammar
+val datatype    :  Sugartypes.Datatype.with_pos grammar
 (* Grammar for interactive shell *)
 val interactive : Sugartypes.sentence grammar
 (* Grammar for programs stored in files etc. *)
diff --git a/core/parser.mly b/core/parser.mly
index 23bd8be1e..52f1d2aa2 100644
--- a/core/parser.mly
+++ b/core/parser.mly
@@ -37,15 +37,19 @@ or Menhir it is no longer necessary.
 
 %{
 
+open CommonTypes
 open Utility
+open Operators
 open Sugartypes
 open SugarConstructors
 
 module Links_core = (* See Note [Dune "wrapped" workaround] *)
 struct
+  module CommonTypes       = CommonTypes
   module Sugartypes        = Sugartypes
   module SugarConstructors = SugarConstructors
   module Types             = Types
+  module Operators         = Operators
 end
 
 (* Construction of nodes using positions produced by Menhir parser *)
@@ -70,24 +74,24 @@ let default_fixity = 9
 
 let primary_kind_of_string p =
   function
-  | "Type"     -> `Type
-  | "Row"      -> `Row
-  | "Presence" -> `Presence
+  | "Type"     -> pk_type
+  | "Row"      -> pk_row
+  | "Presence" -> pk_presence
   | pk         ->
      raise (ConcreteSyntaxError ("Invalid primary kind: " ^ pk, pos p))
 
 let linearity_of_string p =
   function
-  | "Any" -> `Any
-  | "Unl" -> `Unl
+  | "Any" -> lin_any
+  | "Unl" -> lin_unl
   | lin   ->
      raise (ConcreteSyntaxError ("Invalid kind linearity: " ^ lin, pos p))
 
 let restriction_of_string p =
   function
-  | "Any"     -> `Any
-  | "Base"    -> `Base
-  | "Session" -> `Session
+  | "Any"     -> res_any
+  | "Base"    -> res_base
+  | "Session" -> res_session
   | rest      ->
      raise (ConcreteSyntaxError ("Invalid kind restriction: " ^ rest, pos p))
 
@@ -104,33 +108,33 @@ let full_subkind_of pos lin rest =
 
 (* In kind and subkind abbreviations, we aim to provide the most
 common case. For everything except session types, the default
-linearity is `Unl and the default restriction is `Any. For session
-types the default linearity is `Any. *)
+linearity is Unl and the default restriction is Any. For session
+types the default linearity is Any. *)
 
-(* Currently "Any" means `Any,`Any, but it is probably advisable to
+(* Currently "Any" means Any,Any, but it is probably advisable to
 change "Any" to something more evocative of linearity - "Lin"
 perhaps. *)
 
 let kind_of p =
   function
   (* primary kind abbreviation  *)
-  | "Type"     -> (`Type, None)
-  | "Row"      -> (`Row, None)
-  | "Presence" -> (`Presence, None)
+  | "Type"     -> (pk_type, None)
+  | "Row"      -> (pk_row, None)
+  | "Presence" -> (pk_presence, None)
   (* subkind of type abbreviations *)
-  | "Any"      -> (`Type, Some (`Any, `Any))
-  | "Base"     -> (`Type, Some (`Unl, `Base))
-  | "Session"  -> (`Type, Some (`Any, `Session))
-  | "Eff"      -> (`Row, Some (`Unl, `Effect))
+  | "Any"      -> (pk_type, Some (lin_any, res_any))
+  | "Base"     -> (pk_type, Some (lin_unl, res_base))
+  | "Session"  -> (pk_type, Some (lin_any, res_session))
+  | "Eff"      -> (pk_row , Some (lin_unl, res_effect))
   | k          -> raise (ConcreteSyntaxError ("Invalid kind: " ^ k, pos p))
 
 let subkind_of p =
   function
   (* subkind abbreviations *)
-  | "Any"     -> Some (`Any, `Any)
-  | "Base"    -> Some (`Unl, `Base)
-  | "Session" -> Some (`Any, `Session)
-  | "Eff"     -> Some (`Unl, `Effect)
+  | "Any"     -> Some (lin_any, res_any)
+  | "Base"    -> Some (lin_unl, res_base)
+  | "Session" -> Some (lin_any, res_session)
+  | "Eff"     -> Some (lin_unl, res_effect)
   | sk        -> raise (ConcreteSyntaxError ("Invalid subkind: " ^ sk, pos p))
 
 let attach_kind (t, k) = (t, k, `Rigid)
@@ -140,14 +144,14 @@ let attach_subkind_helper update sk = update sk
 let attach_subkind (t, subkind) =
   let update sk =
     match t with
-    | `TypeVar (x, _, freedom) -> `TypeVar (x, sk, freedom)
+    | Datatype.TypeVar (x, _, freedom) -> Datatype.TypeVar (x, sk, freedom)
     | _ -> assert false
   in attach_subkind_helper update subkind
 
 let attach_row_subkind (r, subkind) =
   let update sk =
     match r with
-    | `Open (x, _, freedom) -> `Open (x, sk, freedom)
+    | Datatype.Open (x, _, freedom) -> Datatype.Open (x, sk, freedom)
     | _ -> assert false
   in attach_subkind_helper update subkind
 
@@ -213,7 +217,7 @@ let parseRegexFlags f =
 %token <string> QUOTEDMETA
 %token <string> SLASHFLAGS
 %token UNDERSCORE AS
-%token <[`Left|`Right|`None|`Pre|`Post] -> int -> string -> unit> INFIX INFIXL INFIXR PREFIX POSTFIX
+%token <Operators.Associativity.t -> int -> string -> unit> INFIX INFIXL INFIXR PREFIX POSTFIX
 %token TYPENAME
 %token TYPE ROW PRESENCE
 %token TRY OTHERWISE RAISE
@@ -234,15 +238,15 @@ let parseRegexFlags f =
 %start file
 
 %type <Sugartypes.binding list * Sugartypes.phrase option> file
-%type <Sugartypes.datatype> datatype
-%type <Sugartypes.datatype> just_datatype
+%type <Sugartypes.Datatype.with_pos> datatype
+%type <Sugartypes.Datatype.with_pos> just_datatype
 %type <Sugartypes.sentence> interactive
 %type <Sugartypes.regex> regex_pattern_alternate
 %type <Sugartypes.regex> regex_pattern
 %type <Sugartypes.regex list> regex_pattern_sequence
-%type <Sugartypes.pattern> pattern
-%type <Sugartypes.declared_linearity * Sugartypes.name *
-       Sugartypes.pattern list list * Sugartypes.location *
+%type <Sugartypes.Pattern.with_pos> pattern
+%type <DeclaredLinearity.t * Sugartypes.name *
+       Sugartypes.Pattern.with_pos list list * Location.t *
        Sugartypes.phrase> tlfunbinding
 %type <Sugartypes.phrase> postfix_expression
 %type <Sugartypes.phrase> primary_expression
@@ -301,11 +305,11 @@ declaration:
 nofun_declaration:
 | alien_block                                                  { $1 }
 | ALIEN VARIABLE STRING VARIABLE COLON datatype SEMICOLON      { with_pos $loc
-                                                                          (`Foreign (binder ~ppos:$loc($4) $4,
+                                                                          (Foreign (binder ~ppos:$loc($4) $4,
                                                                                      $4, $2, $3, datatype $6)) }
 | fixity perhaps_uinteger op SEMICOLON                         { let assoc, set = $1 in
                                                                  set assoc (from_option default_fixity $2) ($3.node);
-                                                                 with_pos $loc `Infix }
+                                                                 with_pos $loc Infix }
 | signature? tlvarbinding SEMICOLON                            { val_binding' ~ppos:$loc($2) (sig_of_opt $1) $2 }
 | typedecl SEMICOLON | links_module | links_open SEMICOLON     { $1 }
 
@@ -316,10 +320,10 @@ alien_datatypes:
 | alien_datatype+                                              { $1 }
 
 links_module:
-| MODULE module_name moduleblock                               { with_pos $loc($2) (`Module ($2, $3)) }
+| MODULE module_name moduleblock                               { with_pos $loc($2) (Module ($2, $3)) }
 
 alien_block:
-| ALIEN VARIABLE STRING LBRACE alien_datatypes RBRACE          { with_pos $loc (`AlienBlock ($2, $3, $5)) }
+| ALIEN VARIABLE STRING LBRACE alien_datatypes RBRACE          { with_pos $loc (AlienBlock ($2, $3, $5)) }
 
 module_name:
 | CONSTRUCTOR                                                  { $1 }
@@ -338,31 +342,31 @@ typed_handler_binding:
                 handler_parameterization                       { ($3, hnlit_arg $1 $2 $4) }
 
 optional_computation_parameter:
-| /* empty */                                                  { with_pos $sloc `Any }
+| /* empty */                                                  { with_pos $sloc Pattern.Any }
 | LBRACKET pattern RBRACKET                                    { $2 }
 
 perhaps_uinteger:
 | UINTEGER?                                                    { $1 }
 
 linearity:
-| FUN                                                          { `Unl }
-| LINFUN                                                       { `Lin }
+| FUN                                                          { dl_unl }
+| LINFUN                                                       { dl_lin }
 
 tlfunbinding:
-| linearity VARIABLE arg_lists perhaps_location block          { ($1, $2, $3, $4, $5)                }
-| OP pattern op pattern perhaps_location block                 { (`Unl, $3.node, [[$2; $4]], $5, $6) }
-| OP PREFIXOP pattern perhaps_location block                   { (`Unl, $2, [[$3]], $4, $5)          }
-| OP pattern POSTFIXOP perhaps_location block                  { (`Unl, $3, [[$2]], $4, $5)          }
+| linearity VARIABLE arg_lists perhaps_location block          { ($1, $2, $3, $4, $5)                 }
+| OP pattern op pattern perhaps_location block                 { (dl_unl, $3.node, [[$2; $4]], $5, $6) }
+| OP PREFIXOP pattern perhaps_location block                   { (dl_unl, $2, [[$3]], $4, $5)          }
+| OP pattern POSTFIXOP perhaps_location block                  { (dl_unl, $3, [[$2]], $4, $5)          }
 
 tlvarbinding:
-| VAR VARIABLE perhaps_location EQ exp                         { (Name $2, $5, $3) }
+| VAR VARIABLE perhaps_location EQ exp                         { (PatName $2, $5, $3) }
 
 signature:
 | SIG var COLON datatype                                       { with_pos $loc ($2, datatype $4) }
 | SIG op COLON datatype                                        { with_pos $loc ($2, datatype $4) }
 
 typedecl:
-| TYPENAME CONSTRUCTOR typeargs_opt EQ datatype                { with_pos $loc (`Type ($2, $3, datatype $5)) }
+| TYPENAME CONSTRUCTOR typeargs_opt EQ datatype                { with_pos $loc (Type ($2, $3, datatype $5)) }
 
 typeargs_opt:
 | /* empty */                                                  { [] }
@@ -378,24 +382,24 @@ subkind:
 | COLONCOLON CONSTRUCTOR                                       { subkind_of $loc($2) $2     }
 
 typearg:
-| VARIABLE                                                     { (($1, (`Type, None), `Rigid), None) }
+| VARIABLE                                                     { (($1, (PrimaryKind.Type, None), `Rigid), None) }
 | VARIABLE kind                                                { (attach_kind ($1, $2), None)        }
 
 varlist:
 | separated_nonempty_list(COMMA, typearg)                      { $1 }
 
 fixity:
-| INFIX                                                        { (`None , $1) }
-| INFIXL                                                       { (`Left , $1) }
-| INFIXR                                                       { (`Right, $1) }
-| PREFIX                                                       { (`Pre  , $1) }
-| POSTFIX                                                      { (`Post , $1) }
+| INFIX                                                        { (Associativity.None , $1) }
+| INFIXL                                                       { (Associativity.Left , $1) }
+| INFIXR                                                       { (Associativity.Right, $1) }
+| PREFIX                                                       { (Associativity.Pre  , $1) }
+| POSTFIX                                                      { (Associativity.Post , $1) }
 
 perhaps_location:
-| SERVER                                                       { `Server  }
-| CLIENT                                                       { `Client  }
-| NATIVE                                                       { `Native  }
-| /* empty */                                                  { `Unknown }
+| SERVER                                                       { loc_server  }
+| CLIENT                                                       { loc_client  }
+| NATIVE                                                       { loc_native  }
+| /* empty */                                                  { loc_unknown }
 
 constant:
 | UINTEGER                                                     { `Int    $1  }
@@ -416,13 +420,13 @@ qualified_type_name:
 | CONSTRUCTOR DOT separated_nonempty_list(DOT, CONSTRUCTOR)    { $1 :: $3 }
 
 atomic_expression:
-| qualified_name                                               { with_pos $loc (`QualifiedVar $1) }
-| VARIABLE                                                     { with_pos $loc (`Var          $1) }
-| constant                                                     { with_pos $loc (`Constant     $1) }
+| qualified_name                                               { with_pos $loc (QualifiedVar $1) }
+| VARIABLE                                                     { with_pos $loc (Var          $1) }
+| constant                                                     { with_pos $loc (Constant     $1) }
 | parenthesized_thing                                          { $1 }
 /* HACK: allows us to support both mailbox receive syntax
 and receive for session types. */
-| RECEIVE                                                      { with_pos $loc (`Var "receive") }
+| RECEIVE                                                      { with_pos $loc (Var "receive") }
 
 cp_name:
 | VARIABLE                                                     { binder ~ppos:$loc($1) $1 }
@@ -443,25 +447,25 @@ perhaps_name:
 | cp_name?                                                     { $1 }
 
 cp_expression:
-| LBRACE block_contents RBRACE                                 { with_pos $loc (Unquote $2) }
-| cp_name LPAREN perhaps_name RPAREN DOT cp_expression         { with_pos $loc (Grab ((name_of_binder $1, None), $3, $6)) }
-| cp_name LPAREN perhaps_name RPAREN                           { with_pos $loc (Grab ((name_of_binder $1, None), $3, cp_unit $loc)) }
-| cp_name LBRACKET exp RBRACKET DOT cp_expression              { with_pos $loc (Give ((name_of_binder $1, None), Some $3, $6)) }
-| cp_name LBRACKET exp RBRACKET                                { with_pos $loc (Give ((name_of_binder $1, None), Some $3, cp_unit $loc)) }
-| cp_name LBRACKET RBRACKET                                    { with_pos $loc (GiveNothing $1) }
-| OFFER cp_name LBRACE perhaps_cp_cases RBRACE                 { with_pos $loc (Offer ($2, $4)) }
-| cp_label cp_name DOT cp_expression                           { with_pos $loc (Select ($2, $1, $4)) }
-| cp_label cp_name                                             { with_pos $loc (Select ($2, $1, cp_unit $loc)) }
-| cp_name LRARROW cp_name                                      { with_pos $loc (Link ($1, $3)) }
-| NU cp_name DOT LPAREN cp_expression VBAR cp_expression RPAREN{ with_pos $loc (Comp ($2, $5, $7)) }
+| LBRACE block_contents RBRACE                                 { with_pos $loc (CPUnquote $2) }
+| cp_name LPAREN perhaps_name RPAREN DOT cp_expression         { with_pos $loc (CPGrab ((name_of_binder $1, None), $3, $6)) }
+| cp_name LPAREN perhaps_name RPAREN                           { with_pos $loc (CPGrab ((name_of_binder $1, None), $3, cp_unit $loc)) }
+| cp_name LBRACKET exp RBRACKET DOT cp_expression              { with_pos $loc (CPGive ((name_of_binder $1, None), Some $3, $6)) }
+| cp_name LBRACKET exp RBRACKET                                { with_pos $loc (CPGive ((name_of_binder $1, None), Some $3, cp_unit $loc)) }
+| cp_name LBRACKET RBRACKET                                    { with_pos $loc (CPGiveNothing $1) }
+| OFFER cp_name LBRACE perhaps_cp_cases RBRACE                 { with_pos $loc (CPOffer ($2, $4)) }
+| cp_label cp_name DOT cp_expression                           { with_pos $loc (CPSelect ($2, $1, $4)) }
+| cp_label cp_name                                             { with_pos $loc (CPSelect ($2, $1, cp_unit $loc)) }
+| cp_name LRARROW cp_name                                      { with_pos $loc (CPLink ($1, $3)) }
+| NU cp_name DOT LPAREN cp_expression VBAR cp_expression RPAREN{ with_pos $loc (CPComp ($2, $5, $7)) }
 
 primary_expression:
 | atomic_expression                                            { $1 }
 | LBRACKET perhaps_exps RBRACKET                               { list ~ppos:$loc $2 }
-| LBRACKET exp DOTDOT exp RBRACKET                             { with_pos $loc (`RangeLit($2, $4))   }
+| LBRACKET exp DOTDOT exp RBRACKET                             { with_pos $loc (RangeLit($2, $4))   }
 | xml                                                          { $1 }
 | linearity arg_lists block                                    { fun_lit ~ppos:$loc $1 $2 $3 }
-| LEFTTRIANGLE cp_expression RIGHTTRIANGLE                     { with_pos $loc (`CP $2) }
+| LEFTTRIANGLE cp_expression RIGHTTRIANGLE                     { with_pos $loc (CP $2) }
 | handler_depth optional_computation_parameter
      handler_parameterization                                  { handler_lit ~ppos:$loc (hnlit_arg $1 $2 $3) }
 
@@ -479,17 +483,17 @@ constructor_expression:
 | CONSTRUCTOR parenthesized_thing?                             { constructor ~ppos:$loc ?body:$2 $1 }
 
 parenthesized_thing:
-| LPAREN binop RPAREN                                          { with_pos $loc (`Section $2)              }
-| LPAREN DOT record_label RPAREN                               { with_pos $loc (`Section (`Project $3))   }
-| LPAREN RPAREN                                                { record ~ppos:$loc []                     }
-| LPAREN labeled_exps preceded(VBAR, exp)? RPAREN              { record ~ppos:$loc $2 ?exp:$3             }
-| LPAREN exps RPAREN                                           { with_pos $loc (`TupleLit ($2))           }
-| LPAREN exp WITH labeled_exps RPAREN                          { with_pos $loc (`With ($2, $4))           }
-
-binop:
-| MINUS                                                        { `Minus          }
-| MINUSDOT                                                     { `FloatMinus     }
-| op                                                           { `Name ($1.node) }
+| LPAREN binop_section RPAREN                                  { with_pos $loc (Section $2)                   }
+| LPAREN DOT record_label RPAREN                               { with_pos $loc (Section (Section.Project $3)) }
+| LPAREN RPAREN                                                { record ~ppos:$loc []                         }
+| LPAREN labeled_exps preceded(VBAR, exp)? RPAREN              { record ~ppos:$loc $2 ?exp:$3                 }
+| LPAREN exps RPAREN                                           { with_pos $loc (TupleLit ($2))                }
+| LPAREN exp WITH labeled_exps RPAREN                          { with_pos $loc (With ($2, $4))                }
+
+binop_section:
+| MINUS                                                        { Section.Minus          }
+| MINUSDOT                                                     { Section.FloatMinus     }
+| op                                                           { Section.Name ($1.node) }
 
 op:
 | INFIX0 | INFIXL0 | INFIXR0
@@ -513,13 +517,13 @@ spawn_expression:
 
 postfix_expression:
 | primary_expression | spawn_expression                        { $1 }
-| primary_expression POSTFIXOP                                 { unary_appl ~ppos:$loc (`Name $2) $1 }
+| primary_expression POSTFIXOP                                 { unary_appl ~ppos:$loc (UnaryOp.Name $2) $1 }
 | block                                                        { $1 }
 | QUERY block                                                  { query ~ppos:$loc None $2 }
-| QUERY LBRACKET exp RBRACKET block                            { query ~ppos:$loc (Some ($3, with_pos $loc (`Constant (`Int 0)))) $5 }
+| QUERY LBRACKET exp RBRACKET block                            { query ~ppos:$loc (Some ($3, with_pos $loc (Constant (`Int 0)))) $5 }
 | QUERY LBRACKET exp COMMA exp RBRACKET block                  { query ~ppos:$loc (Some ($3, $5)) $7 }
-| postfix_expression arg_spec                                  { with_pos $loc (`FnAppl ($1, $2)) }
-| postfix_expression DOT record_label                          { with_pos $loc (`Projection ($1, $3)) }
+| postfix_expression arg_spec                                  { with_pos $loc (FnAppl ($1, $2)) }
+| postfix_expression DOT record_label                          { with_pos $loc (Projection ($1, $3)) }
 
 
 arg_spec:
@@ -532,11 +536,11 @@ perhaps_exps:
 | loption(exps)                                                { $1 }
 
 unary_expression:
-| MINUS unary_expression                                       { unary_appl ~ppos:$loc `Minus      $2 }
-| MINUSDOT unary_expression                                    { unary_appl ~ppos:$loc `FloatMinus $2 }
-| PREFIXOP unary_expression                                    { unary_appl ~ppos:$loc (`Name $1)  $2 }
+| MINUS unary_expression                                       { unary_appl ~ppos:$loc UnaryOp.Minus      $2 }
+| MINUSDOT unary_expression                                    { unary_appl ~ppos:$loc UnaryOp.FloatMinus $2 }
+| PREFIXOP unary_expression                                    { unary_appl ~ppos:$loc (UnaryOp.Name $1)  $2 }
 | postfix_expression | constructor_expression                  { $1 }
-| DOOP CONSTRUCTOR loption(arg_spec)                           { with_pos $loc (`DoOperation ($2, $3, None)) }
+| DOOP CONSTRUCTOR loption(arg_spec)                           { with_pos $loc (DoOperation ($2, $3, None)) }
 
 
 infixr_9:
@@ -551,8 +555,8 @@ infixl_9:
 infixr_8:
 | infixl_9                                                     { $1 }
 | infixl_9 INFIX8  infixl_9
-| infixl_9 INFIXR8 infixr_8                                    { infix_appl  ~ppos:$loc $1 $2    $3 }
-| infixl_9 COLONCOLON infixr_8                                 { infix_appl' ~ppos:$loc $1 `Cons $3 }
+| infixl_9 INFIXR8 infixr_8                                    { infix_appl  ~ppos:$loc $1 $2            $3 }
+| infixl_9 COLONCOLON infixr_8                                 { infix_appl' ~ppos:$loc $1 BinaryOp.Cons $3 }
 
 infixl_8:
 | infixr_8                                                     { $1 }
@@ -574,9 +578,9 @@ infixr_6:
 
 infixl_6:
 | infixr_6                                                     { $1 }
-| infixl_6 INFIXL6 infixr_6                                    { infix_appl  ~ppos:$loc $1 $2          $3 }
-| infixl_6 MINUS infixr_6                                      { infix_appl' ~ppos:$loc $1 `Minus      $3 }
-| infixl_6 MINUSDOT infixr_6                                   { infix_appl' ~ppos:$loc $1 `FloatMinus $3 }
+| infixl_6 INFIXL6 infixr_6                                    { infix_appl  ~ppos:$loc $1 $2                  $3 }
+| infixl_6 MINUS infixr_6                                      { infix_appl' ~ppos:$loc $1 BinaryOp.Minus      $3 }
+| infixl_6 MINUSDOT infixr_6                                   { infix_appl' ~ppos:$loc $1 BinaryOp.FloatMinus $3 }
 /* HACK: the type variables should get inserted later... */
 | infixl_6 BANG infixr_6                                       { infix_appl  ~ppos:$loc $1 "!" $3         }
 
@@ -594,7 +598,7 @@ infixr_4:
 | infixl_5 INFIX4    infixl_5
 | infixl_5 INFIXR4   infixr_4                                  { infix_appl ~ppos:$loc $1 $2 $3 }
 | infixr_5 EQUALSTILDE regex                                   { let r, flags = $3 in
-                                                                 infix_appl' ~ppos:$loc $1 (`RegexMatch flags) r }
+                                                                 infix_appl' ~ppos:$loc $1 (BinaryOp.RegexMatch flags) r }
 
 infixl_4:
 | infixr_4                                                     { $1 }
@@ -638,19 +642,19 @@ infixl_0:
 
 logical_expression:
 | infixl_0                                                     { $1 }
-| logical_expression BARBAR infixl_0                           { infix_appl' ~ppos:$loc $1 `Or  $3 }
-| logical_expression AMPAMP infixl_0                           { infix_appl' ~ppos:$loc $1 `And $3 }
+| logical_expression BARBAR infixl_0                           { infix_appl' ~ppos:$loc $1 BinaryOp.Or  $3 }
+| logical_expression AMPAMP infixl_0                           { infix_appl' ~ppos:$loc $1 BinaryOp.And $3 }
 
 typed_expression:
 | logical_expression                                           { $1 }
-| typed_expression COLON datatype                              { with_pos $loc (`TypeAnnotation ($1, datatype $3)) }
-| typed_expression COLON datatype LARROW datatype              { with_pos $loc (`Upcast ($1, datatype $3, datatype $5)) }
+| typed_expression COLON datatype                              { with_pos $loc (TypeAnnotation ($1, datatype $3)) }
+| typed_expression COLON datatype LARROW datatype              { with_pos $loc (Upcast ($1, datatype $3, datatype $5)) }
 
 db_expression:
-| DELETE LPAREN table_generator RPAREN perhaps_where           { let pat, phrase = $3 in with_pos $loc (`DBDelete (pat, phrase, $5)) }
+| DELETE LPAREN table_generator RPAREN perhaps_where           { let pat, phrase = $3 in with_pos $loc (DBDelete (pat, phrase, $5)) }
 | UPDATE LPAREN table_generator RPAREN
          perhaps_where
-         SET LPAREN labeled_exps RPAREN                        { let pat, phrase = $3 in with_pos $loc (`DBUpdate(pat, phrase, $5, $8)) }
+         SET LPAREN labeled_exps RPAREN                        { let pat, phrase = $3 in with_pos $loc (DBUpdate(pat, phrase, $5, $8)) }
 
 /* XML */
 xmlid:
@@ -678,28 +682,28 @@ xml_contents:
 | block                                                        { $1 }
 | formlet_binding | formlet_placement | page_placement
 | xml                                                          { $1 }
-| CDATA                                                        { with_pos $loc (`TextNode (Utility.xml_unescape $1)) }
+| CDATA                                                        { with_pos $loc (TextNode (Utility.xml_unescape $1)) }
 
 formlet_binding:
-| LBRACE logical_expression RARROW pattern RBRACE              { with_pos $loc (`FormBinding($2, $4)) }
+| LBRACE logical_expression RARROW pattern RBRACE              { with_pos $loc (FormBinding($2, $4)) }
 
 formlet_placement:
 | LBRACE logical_expression
-         FATRARROW logical_expression RBRACE                   { with_pos $loc (`FormletPlacement ($2, $4,
+         FATRARROW logical_expression RBRACE                   { with_pos $loc (FormletPlacement ($2, $4,
                                                                                                    list ~ppos:$loc [])) }
 | LBRACE logical_expression
          FATRARROW logical_expression
-         WITH logical_expression RBRACE                        { with_pos $loc (`FormletPlacement ($2, $4, $6)) }
+         WITH logical_expression RBRACE                        { with_pos $loc (FormletPlacement ($2, $4, $6)) }
 
 page_placement:
-| LBRACEBAR exp BARRBRACE                                      { with_pos $loc($2) (`PagePlacement $2) }
+| LBRACEBAR exp BARRBRACE                                      { with_pos $loc($2) (PagePlacement $2) }
 
 session_expression:
-| SELECT field_label exp                                       { with_pos $loc (`Select ($2, $3))      }
-| OFFER LPAREN exp RPAREN LBRACE perhaps_cases RBRACE          { with_pos $loc (`Offer ($3, $6, None)) }
+| SELECT field_label exp                                       { with_pos $loc (Select ($2, $3))      }
+| OFFER LPAREN exp RPAREN LBRACE perhaps_cases RBRACE          { with_pos $loc (Offer ($3, $6, None)) }
 
 conditional_expression:
-| IF LPAREN exp RPAREN exp ELSE exp                            { with_pos $loc (`Conditional ($3, $5, $7)) }
+| IF LPAREN exp RPAREN exp ELSE exp                            { with_pos $loc (Conditional ($3, $5, $7)) }
 
 case:
 | CASE pattern RARROW block_contents                           { $2, block ~ppos:$loc($4) $4 }
@@ -711,15 +715,15 @@ perhaps_cases:
 | case*                                                        { $1 }
 
 case_expression:
-| SWITCH LPAREN exp RPAREN LBRACE perhaps_cases RBRACE         { with_pos $loc (`Switch ($3, $6, None)) }
-| RECEIVE LBRACE perhaps_cases RBRACE                          { with_pos $loc (`Receive ($3, None)) }
-| SHALLOWHANDLE LPAREN exp RPAREN LBRACE cases RBRACE          { with_pos $loc (`Handle (untyped_handler $3 $6 Shallow)) }
-| HANDLE LPAREN exp RPAREN LBRACE perhaps_cases RBRACE         { with_pos $loc (`Handle (untyped_handler $3 $6 Deep   )) }
+| SWITCH LPAREN exp RPAREN LBRACE perhaps_cases RBRACE         { with_pos $loc (Switch ($3, $6, None)) }
+| RECEIVE LBRACE perhaps_cases RBRACE                          { with_pos $loc (Receive ($3, None)) }
+| SHALLOWHANDLE LPAREN exp RPAREN LBRACE cases RBRACE          { with_pos $loc (Handle (untyped_handler $3 $6 Shallow)) }
+| HANDLE LPAREN exp RPAREN LBRACE perhaps_cases RBRACE         { with_pos $loc (Handle (untyped_handler $3 $6 Deep   )) }
 | HANDLE LPAREN exp RPAREN LPAREN handle_params RPAREN LBRACE perhaps_cases RBRACE
-                                                               { with_pos $loc (`Handle (untyped_handler ~parameters:(List.rev $6)
+                                                               { with_pos $loc (Handle (untyped_handler ~parameters:(List.rev $6)
                                                                                          $3 $9 Deep)) }
-| RAISE                                                        { with_pos $loc (`Raise) }
-| TRY exp AS pattern IN exp OTHERWISE exp                      { with_pos $loc (`TryInOtherwise ($2, $4, $6, $8, None)) }
+| RAISE                                                        { with_pos $loc (Raise) }
+| TRY exp AS pattern IN exp OTHERWISE exp                      { with_pos $loc (TryInOtherwise ($2, $4, $6, $8, None)) }
 
 handle_params:
 | rev(separated_nonempty_list(COMMA,
@@ -729,14 +733,14 @@ iteration_expression:
 | FOR LPAREN perhaps_generators RPAREN
       perhaps_where
       perhaps_orderby
-      exp                                                      { with_pos $loc (`Iteration ($3, $7, $5, $6)) }
+      exp                                                      { with_pos $loc (Iteration ($3, $7, $5, $6)) }
 
 perhaps_generators:
 | separated_list(COMMA, generator)                             { $1 }
 
 generator:
-| list_generator                                               { `List $1  }
-| table_generator                                              { `Table $1 }
+| list_generator                                               { List $1  }
+| table_generator                                              { Table $1 }
 
 list_generator:
 | pattern LARROW exp                                           { ($1, $3) }
@@ -753,18 +757,18 @@ perhaps_orderby:
 | ORDERBY LPAREN exps RPAREN                                   { Some (tuple ~ppos:$loc($3) $3) }
 
 escape_expression:
-| ESCAPE VARIABLE IN postfix_expression                        { with_pos $loc (`Escape (binder ~ppos:$loc($2) $2, $4)) }
+| ESCAPE VARIABLE IN postfix_expression                        { with_pos $loc (Escape (binder ~ppos:$loc($2) $2, $4)) }
 
 formlet_expression:
-| FORMLET xml YIELDS exp                                       { with_pos $loc (`Formlet ($2, $4)) }
-| PAGE xml                                                     { with_pos $loc (`Page $2)          }
+| FORMLET xml YIELDS exp                                       { with_pos $loc (Formlet ($2, $4)) }
+| PAGE xml                                                     { with_pos $loc (Page $2)          }
 
 table_expression:
-| TABLE exp WITH datatype perhaps_table_constraints FROM exp   { with_pos $loc (`TableLit ($2, datatype $4, $5,
-                                                                                           list ~ppos:$loc [], $7)) }
+| TABLE exp WITH datatype perhaps_table_constraints FROM exp   { with_pos $loc (TableLit ($2, datatype $4, $5,
+                                                                                          list ~ppos:$loc [], $7)) }
 /* SAND */
 | TABLE exp WITH datatype perhaps_table_constraints
-            TABLEKEYS exp FROM exp                             { with_pos $loc (`TableLit ($2, datatype $4, $5, $7, $9))}
+            TABLEKEYS exp FROM exp                             { with_pos $loc (TableLit ($2, datatype $4, $5, $7, $9))}
 
 perhaps_table_constraints:
 | loption(preceded(WHERE, table_constraints))                  { $1 }
@@ -806,7 +810,7 @@ database_expression:
   RPAREN RBRACKET preceded(RETURNING, VARIABLE)?               { db_insert ~ppos:$loc $2 (labels $6) (db_exps ~ppos:$loc($6) $6) $9  }
 | INSERT exp VALUES LPAREN record_labels RPAREN db_expression
   RETURNING VARIABLE                                           { db_insert ~ppos:$loc $2 $5 $7 (Some $9) }
-| DATABASE atomic_expression perhaps_db_driver                 { with_pos $loc (`DatabaseLit ($2, $3))           }
+| DATABASE atomic_expression perhaps_db_driver                 { with_pos $loc (DatabaseLit ($2, $3))           }
 
 fn_dep_cols:
 | VARIABLE+                                                    { $1 }
@@ -818,31 +822,31 @@ fn_deps:
 | separated_nonempty_list(COMMA, fn_dep)                       { $1 }
 
 lens_expression:
-| LENS exp DEFAULT                                             { with_pos $loc (`LensLit ($2, None))}
-| LENS exp TABLEKEYS exp                                       { with_pos $loc (`LensKeysLit ($2, $4, None))}
-| LENS exp WITH LBRACE fn_deps RBRACE                          { with_pos $loc (`LensFunDepsLit ($2, $5, None))}
+| LENS exp DEFAULT                                             { with_pos $loc (LensLit ($2, None))}
+| LENS exp TABLEKEYS exp                                       { with_pos $loc (LensKeysLit ($2, $4, None))}
+| LENS exp WITH LBRACE fn_deps RBRACE                          { with_pos $loc (LensFunDepsLit ($2, $5, None))}
 | LENSDROP VARIABLE DETERMINED BY
-  VARIABLE DEFAULT exp FROM exp                                { with_pos $loc (`LensDropLit ($9, $2, $5, $7, None)) }
-| LENSSELECT FROM exp BY exp                                   { with_pos $loc (`LensSelectLit ($3, $5, None)) }
-| LENSJOIN exp WITH exp ON exp DELETE LBRACE exp COMMA exp RBRACE  { with_pos $loc (`LensJoinLit ($2, $4, $6, $9, $11, None)) }
-| LENSJOIN exp WITH exp ON exp DELETE_LEFT                     { with_pos $loc (`LensJoinLit ($2, $4, $6,
-                                                                                       with_pos $loc (`Constant (`Bool true )),
-                                                                                       with_pos $loc (`Constant (`Bool false)), None)) }
-| LENSGET exp                                                  { with_pos $loc (`LensGetLit ($2, None)) }
-| LENSPUT exp WITH exp                                         { with_pos $loc (`LensPutLit ($2, $4, None)) }
+  VARIABLE DEFAULT exp FROM exp                                { with_pos $loc (LensDropLit ($9, $2, $5, $7, None)) }
+| LENSSELECT FROM exp BY exp                                   { with_pos $loc (LensSelectLit ($3, $5, None)) }
+| LENSJOIN exp WITH exp ON exp DELETE LBRACE exp COMMA exp RBRACE  { with_pos $loc (LensJoinLit ($2, $4, $6, $9, $11, None)) }
+| LENSJOIN exp WITH exp ON exp DELETE_LEFT                     { with_pos $loc (LensJoinLit ($2, $4, $6,
+                                                                                       with_pos $loc (Constant (`Bool true )),
+                                                                                       with_pos $loc (Constant (`Bool false)), None)) }
+| LENSGET exp                                                  { with_pos $loc (LensGetLit ($2, None)) }
+| LENSPUT exp WITH exp                                         { with_pos $loc (LensPutLit ($2, $4, None)) }
 
 
 record_labels:
 | separated_list(COMMA, record_label)                          { $1 }
 
 links_open:
-| OPEN separated_nonempty_list(DOT, CONSTRUCTOR)               { with_pos $loc (`QualifiedImport $2) }
+| OPEN separated_nonempty_list(DOT, CONSTRUCTOR)               { with_pos $loc (QualifiedImport $2) }
 
 binding:
 | VAR pattern EQ exp SEMICOLON                                 { val_binding ~ppos:$loc $2 $4 }
-| exp SEMICOLON                                                { with_pos $loc (`Exp $1) }
-| signature linearity VARIABLE arg_lists block                 { fun_binding ~ppos:$loc (Sig $1) ($2, $3, $4, `Unknown, $5) }
-| linearity VARIABLE arg_lists block                           { fun_binding ~ppos:$loc  NoSig   ($1, $2, $3, `Unknown, $4) }
+| exp SEMICOLON                                                { with_pos $loc (Exp $1) }
+| signature linearity VARIABLE arg_lists block                 { fun_binding ~ppos:$loc (Sig $1) ($2, $3, $4, loc_unknown, $5) }
+| linearity VARIABLE arg_lists block                           { fun_binding ~ppos:$loc  NoSig   ($1, $2, $3, loc_unknown, $4) }
 | typed_handler_binding                                        { handler_binding ~ppos:$loc NoSig $1 }
 | typedecl SEMICOLON | links_module | alien_block | links_open { $1 }
 
@@ -857,13 +861,13 @@ block:
 | LBRACE block_contents RBRACE                                 { block ~ppos:$loc $2 }
 
 block_contents:
-| bindings exp SEMICOLON                                       { ($1 @ [with_pos $loc($2) (`Exp $2)],
+| bindings exp SEMICOLON                                       { ($1 @ [with_pos $loc($2) (Exp $2)],
                                                                   record ~ppos:$loc []) }
 | bindings exp                                                 { ($1, $2) }
-| exp SEMICOLON                                                { ([with_pos $loc($1) (`Exp $1)],
+| exp SEMICOLON                                                { ([with_pos $loc($1) (Exp $1)],
                                                                   record ~ppos:$loc []) }
 | exp                                                          { ([], $1) }
-| SEMICOLON | /* empty */                                      { ([], with_pos $loc (`TupleLit [])) }
+| SEMICOLON | /* empty */                                      { ([], with_pos $loc (TupleLit [])) }
 
 labeled_exps:
 | separated_nonempty_list(COMMA,
@@ -879,7 +883,7 @@ datatype:
 | mu_datatype | straight_arrow | squiggly_arrow                { with_pos $loc $1 }
 
 arrow_prefix:
-| LBRACE RBRACE                                                { ([], `Closed) }
+| LBRACE RBRACE                                                { ([], Datatype.Closed) }
 | LBRACE efields RBRACE                                        { $2            }
 
 straight_arrow_prefix:
@@ -891,33 +895,33 @@ squig_arrow_prefix:
 | TILDE nonrec_row_var | TILDE kinded_nonrec_row_var           { ([], $2) }
 
 hear_arrow_prefix:
-| LBRACE COLON datatype COMMA efields RBRACE                   { hear_arrow_prefix $3 $5            }
-| LBRACE COLON datatype RBRACE                                 { hear_arrow_prefix $3 ([], `Closed) }
+| LBRACE COLON datatype COMMA efields RBRACE                   { hear_arrow_prefix $3 $5                    }
+| LBRACE COLON datatype RBRACE                                 { hear_arrow_prefix $3 ([], Datatype.Closed) }
 | LBRACE COLON datatype VBAR nonrec_row_var RBRACE
-| LBRACE COLON datatype VBAR kinded_nonrec_row_var RBRACE      { hear_arrow_prefix $3 ([], $5)      }
+| LBRACE COLON datatype VBAR kinded_nonrec_row_var RBRACE      { hear_arrow_prefix $3 ([], $5)              }
 
 straight_arrow:
 | parenthesized_datatypes
-  straight_arrow_prefix RARROW datatype                        { `Function ($1, $2, $4) }
+  straight_arrow_prefix RARROW datatype                        { Datatype.Function ($1, $2, $4) }
 | parenthesized_datatypes
-  straight_arrow_prefix LOLLI datatype                         { `Lolli    ($1, $2, $4) }
-| parenthesized_datatypes RARROW datatype                      { `Function ($1, fresh_row (), $3) }
-| parenthesized_datatypes LOLLI datatype                       { `Lolli    ($1, fresh_row (), $3) }
+  straight_arrow_prefix LOLLI datatype                         { Datatype.Lolli    ($1, $2, $4) }
+| parenthesized_datatypes RARROW datatype                      { Datatype.Function ($1, fresh_row (), $3) }
+| parenthesized_datatypes LOLLI datatype                       { Datatype.Lolli    ($1, fresh_row (), $3) }
 
 squiggly_arrow:
 | parenthesized_datatypes
-  squig_arrow_prefix SQUIGRARROW datatype                      { `Function ($1, row_with_wp $2, $4) }
+  squig_arrow_prefix SQUIGRARROW datatype                      { Datatype.Function ($1, row_with_wp $2, $4) }
 | parenthesized_datatypes
-  squig_arrow_prefix SQUIGLOLLI datatype                       { `Lolli    ($1, row_with_wp $2, $4) }
-| parenthesized_datatypes SQUIGRARROW datatype                 { `Function ($1, row_with_wp (fresh_row ()), $3) }
-| parenthesized_datatypes SQUIGLOLLI datatype                  { `Lolli    ($1, row_with_wp (fresh_row ()), $3) }
+  squig_arrow_prefix SQUIGLOLLI datatype                       { Datatype.Lolli    ($1, row_with_wp $2, $4) }
+| parenthesized_datatypes SQUIGRARROW datatype                 { Datatype.Function ($1, row_with_wp (fresh_row ()), $3) }
+| parenthesized_datatypes SQUIGLOLLI datatype                  { Datatype.Lolli    ($1, row_with_wp (fresh_row ()), $3) }
 
 mu_datatype:
-| MU VARIABLE DOT mu_datatype                                  { `Mu ($2, with_pos $loc($4) $4) }
+| MU VARIABLE DOT mu_datatype                                  { Datatype.Mu ($2, with_pos $loc($4) $4) }
 | forall_datatype                                              { $1 }
 
 forall_datatype:
-| FORALL varlist DOT datatype                                  { `Forall (labels $2, $4) }
+| FORALL varlist DOT datatype                                  { Datatype.Forall (labels $2, $4) }
 | session_datatype                                             { $1 }
 
 /* Parenthesised dts disambiguate between sending qualified types and recursion variables.
@@ -937,14 +941,14 @@ forall_datatype:
    among several nonterminals.
 */
 session_datatype:
-| BANG primary_datatype_pos DOT datatype                       { `Output ($2, $4) }
-| QUESTION primary_datatype_pos DOT datatype                   { `Input  ($2, $4) }
-| LBRACKETPLUSBAR row BARPLUSRBRACKET                          { `Select $2       }
-| LBRACKETAMPBAR row BARAMPRBRACKET                            { `Choice $2       }
-| END                                                          { `End             }
-| primary_datatype                                             { $1               }
-| qualified_type_name                                          { `QualifiedTypeApplication ($1, []) }
-| qualified_type_name LPAREN type_arg_list RPAREN              { `QualifiedTypeApplication ($1, $3) }
+| BANG primary_datatype_pos DOT datatype                       { Datatype.Output ($2, $4) }
+| QUESTION primary_datatype_pos DOT datatype                   { Datatype.Input  ($2, $4) }
+| LBRACKETPLUSBAR row BARPLUSRBRACKET                          { Datatype.Select $2       }
+| LBRACKETAMPBAR row BARAMPRBRACKET                            { Datatype.Choice $2       }
+| END                                                          { Datatype.End             }
+| primary_datatype                                             { $1                       }
+| qualified_type_name                                          { Datatype.QualifiedTypeApplication ($1, []) }
+| qualified_type_name LPAREN type_arg_list RPAREN              { Datatype.QualifiedTypeApplication ($1, $3) }
 
 parenthesized_datatypes:
 | LPAREN RPAREN                                                { [] }
@@ -954,33 +958,34 @@ primary_datatype_pos:
 | primary_datatype                                             { with_pos $loc $1 }
 
 primary_datatype:
-| TILDE primary_datatype_pos                                   { `Dual $2 }
+| TILDE primary_datatype_pos                                   { Datatype.Dual $2 }
 | parenthesized_datatypes                                      { match $1 with
-                                                                   | [] -> `Unit
+                                                                   | [] -> Datatype.Unit
                                                                    | [{node;_}] -> node
-                                                                   | ts  -> `Tuple ts }
-| LPAREN rfields RPAREN                                        { `Record $2 }
+                                                                   | ts  -> Datatype.Tuple ts }
+| LPAREN rfields RPAREN                                        { Datatype.Record $2 }
 | TABLEHANDLE
-     LPAREN datatype COMMA datatype COMMA datatype RPAREN      { `Table ($3, $5, $7) }
-| LBRACKETBAR vrow BARRBRACKET                                 { `Variant $2 }
-| LBRACKET datatype RBRACKET                                   { `List $2 }
+     LPAREN datatype COMMA datatype COMMA datatype RPAREN      { Datatype.Table ($3, $5, $7) }
+| LBRACKETBAR vrow BARRBRACKET                                 { Datatype.Variant $2 }
+| LBRACKET datatype RBRACKET                                   { Datatype.List $2 }
 | type_var                                                     { $1 }
 | kinded_type_var                                              { $1 }
-| CONSTRUCTOR                                                  { match $1 with
-                                                                   | "Bool"    -> `Primitive `Bool
-                                                                   | "Int"     -> `Primitive `Int
-                                                                   | "Char"    -> `Primitive `Char
-                                                                   | "Float"   -> `Primitive `Float
-                                                                   | "XmlItem" -> `Primitive `XmlItem
-                                                                   | "String"  -> `Primitive `String
-                                                                   | "Database"-> `DB
-                                                                   | t         -> `TypeApplication (t, [])
+| CONSTRUCTOR                                                  { let open Datatype in
+                                                                 match $1 with
+                                                                   | "Bool"    -> Primitive `Bool
+                                                                   | "Int"     -> Primitive `Int
+                                                                   | "Char"    -> Primitive `Char
+                                                                   | "Float"   -> Primitive `Float
+                                                                   | "XmlItem" -> Primitive `XmlItem
+                                                                   | "String"  -> Primitive `String
+                                                                   | "Database"-> DB
+                                                                   | t         -> TypeApplication (t, [])
                                                                }
-| CONSTRUCTOR LPAREN type_arg_list RPAREN                      { `TypeApplication ($1, $3) }
+| CONSTRUCTOR LPAREN type_arg_list RPAREN                      { Datatype.TypeApplication ($1, $3) }
 
 type_var:
-| VARIABLE                                                     { `TypeVar ($1, None, `Rigid)    }
-| PERCENTVAR                                                   { `TypeVar ($1, None, `Flexible) }
+| VARIABLE                                                     { Datatype.TypeVar ($1, None, `Rigid)    }
+| PERCENTVAR                                                   { Datatype.TypeVar ($1, None, `Flexible) }
 | UNDERSCORE                                                   { fresh_rigid_type_variable ()   }
 | PERCENT                                                      { fresh_type_variable ()         }
 
@@ -994,27 +999,27 @@ type_arg_list:
    (TYPE, ROW, and PRESENCE are no longer tokens...)
 */
 type_arg:
-| datatype                                                     { `Type $1     }
-| TYPE LPAREN datatype RPAREN                                  { `Type $3     }
-| ROW LPAREN row RPAREN                                        { `Row $3      }
-| PRESENCE LPAREN fieldspec RPAREN                             { `Presence $3 }
-| LBRACE row RBRACE                                            { `Row $2      }
+| datatype                                                     { Datatype.Type $1     }
+| TYPE LPAREN datatype RPAREN                                  { Datatype.Type $3     }
+| ROW LPAREN row RPAREN                                        { Datatype.Row $3      }
+| PRESENCE LPAREN fieldspec RPAREN                             { Datatype.Presence $3 }
+| LBRACE row RBRACE                                            { Datatype.Row $2      }
 
 datatypes:
 | separated_nonempty_list(COMMA, datatype)                     { $1 }
 
 vrow:
-| vfields                                                      { $1            }
-| /* empty */                                                  { ([], `Closed) }
+| vfields                                                      { $1                    }
+| /* empty */                                                  { ([], Datatype.Closed) }
 
 row:
-| fields                                                       { $1            }
-| /* empty */                                                  { ([], `Closed) }
+| fields                                                       { $1                    }
+| /* empty */                                                  { ([], Datatype.Closed) }
 
 fields_def(field_prod, row_var_prod, kinded_row_var_prod):
-| field_prod                                                   { ([$1]       , `Closed) }
-| soption(field_prod) VBAR row_var_prod                        { ( $1        , $3     ) }
-| soption(field_prod) VBAR kinded_row_var_prod                 { ( $1        , $3     ) }
+| field_prod                                                   { ([$1], Datatype.Closed) }
+| soption(field_prod) VBAR row_var_prod                        { ( $1 , $3             ) }
+| soption(field_prod) VBAR kinded_row_var_prod                 { ( $1 , $3             ) }
 | field_prod COMMA
     fields_def(field_prod, row_var_prod, kinded_row_var_prod)  { ( $1::fst $3, snd $3 ) }
 
@@ -1045,10 +1050,10 @@ record_label:
 | field_label                                                  { $1 }
 
 vfields:
-| vfield                                                       { ([$1]      , `Closed) }
-| row_var                                                      { ([]        , $1     ) }
-| kinded_row_var                                               { ([]        , $1     ) }
-| vfield VBAR vfields                                          { ($1::fst $3, snd $3 ) }
+| vfield                                                       { ([$1], Datatype.Closed) }
+| row_var                                                      { ([]  , $1             ) }
+| kinded_row_var                                               { ([]  , $1             ) }
+| vfield VBAR vfields                                          { ($1::fst $3, snd $3   ) }
 
 vfield:
 | CONSTRUCTOR                                                  { ($1, present) }
@@ -1066,18 +1071,18 @@ effect_label:
 | VARIABLE                                                     { $1 }
 
 fieldspec:
-| COLON datatype                                               { `Present $2 }
-| LBRACE COLON datatype RBRACE                                 { `Present $3 }
-| MINUS                                                        { `Absent }
-| LBRACE MINUS RBRACE                                          { `Absent }
-| LBRACE VARIABLE RBRACE                                       { `Var ($2, None, `Rigid) }
-| LBRACE PERCENTVAR RBRACE                                     { `Var ($2, None, `Flexible) }
+| COLON datatype                                               { Datatype.Present $2 }
+| LBRACE COLON datatype RBRACE                                 { Datatype.Present $3 }
+| MINUS                                                        { Datatype.Absent }
+| LBRACE MINUS RBRACE                                          { Datatype.Absent }
+| LBRACE VARIABLE RBRACE                                       { Datatype.Var ($2, None, `Rigid) }
+| LBRACE PERCENTVAR RBRACE                                     { Datatype.Var ($2, None, `Flexible) }
 | LBRACE UNDERSCORE RBRACE                                     { fresh_rigid_presence_variable () }
 | LBRACE PERCENT RBRACE                                        { fresh_presence_variable ()       }
 
 nonrec_row_var:
-| VARIABLE                                                     { `Open ($1, None, `Rigid   ) }
-| PERCENTVAR                                                   { `Open ($1, None, `Flexible) }
+| VARIABLE                                                     { Datatype.Open ($1, None, `Rigid   ) }
+| PERCENTVAR                                                   { Datatype.Open ($1, None, `Flexible) }
 | UNDERSCORE                                                   { fresh_rigid_row_variable () }
 | PERCENT                                                      { fresh_row_variable ()       }
 
@@ -1087,7 +1092,7 @@ nonrec_row_var:
  */
 row_var:
 | nonrec_row_var                                               { $1 }
-| LPAREN MU VARIABLE DOT vfields RPAREN                        { `Recursive ($3, $5) }
+| LPAREN MU VARIABLE DOT vfields RPAREN                        { Datatype.Recursive ($3, $5) }
 
 kinded_nonrec_row_var:
 | nonrec_row_var subkind                                       { attach_row_subkind ($1, $2) }
@@ -1099,10 +1104,10 @@ kinded_row_var:
  * Regular expression grammar
  */
 regex:
-| SLASH regex_pattern_alternate regex_flags_opt                { with_pos $loc($2) (`Regex $2), $3 }
-| SLASH regex_flags_opt                                        { with_pos $loc (`Regex (Simply "")), $2 }
+| SLASH regex_pattern_alternate regex_flags_opt                { with_pos $loc($2) (Regex $2), $3 }
+| SLASH regex_flags_opt                                        { with_pos $loc (Regex (Simply "")), $2 }
 | SSLASH regex_pattern_alternate SLASH regex_replace
-    regex_flags_opt                                            { with_pos $loc (`Regex (Replace ($2, $4))),
+    regex_flags_opt                                            { with_pos $loc (Regex (Replace ($2, $4))),
                                                                  RegexReplace :: $5 }
 
 regex_flags_opt:
@@ -1110,9 +1115,9 @@ regex_flags_opt:
 | SLASHFLAGS                                                   { parseRegexFlags $1 }
 
 regex_replace:
-| /* empty */                                                  { `Literal "" }
-| REGEXREPL                                                    { `Literal $1 }
-| block                                                        { `Splice $1 }
+| /* empty */                                                  { Literal "" }
+| REGEXREPL                                                    { Literal $1 }
+| block                                                        { SpliceExpr $1 }
 
 regex_pattern:
 | RANGE                                                        { Range $1 }
@@ -1139,40 +1144,40 @@ regex_pattern_sequence:
  */
 pattern:
 | typed_pattern                                                { $1 }
-| typed_pattern COLON primary_datatype_pos                         { with_pos $loc (`HasType ($1, datatype $3)) }
+| typed_pattern COLON primary_datatype_pos                     { with_pos $loc (Pattern.HasType ($1, datatype $3)) }
 
 typed_pattern:
 | cons_pattern                                                 { $1 }
-| cons_pattern AS VARIABLE                                     { with_pos $loc (`As (binder ~ppos:$loc($3) $3, $1)) }
+| cons_pattern AS VARIABLE                                     { with_pos $loc (Pattern.As (binder ~ppos:$loc($3) $3, $1)) }
 
 cons_pattern:
 | constructor_pattern                                          { $1 }
-| constructor_pattern COLONCOLON cons_pattern                  { with_pos $loc (`Cons ($1, $3)) }
+| constructor_pattern COLONCOLON cons_pattern                  { with_pos $loc (Pattern.Cons ($1, $3)) }
 
 constructor_pattern:
 | negative_pattern                                             { $1 }
-| CONSTRUCTOR parenthesized_pattern?                           { with_pos $loc (`Variant ($1, $2)) }
+| CONSTRUCTOR parenthesized_pattern?                           { with_pos $loc (Pattern.Variant ($1, $2)) }
 
 constructors:
 | separated_nonempty_list(COMMA, CONSTRUCTOR)                  { $1 }
 
 negative_pattern:
 | primary_pattern                                              { $1 }
-| MINUS CONSTRUCTOR                                            { with_pos $loc (`Negative [$2]) }
-| MINUS LPAREN constructors RPAREN                             { with_pos $loc (`Negative $3)   }
+| MINUS CONSTRUCTOR                                            { with_pos $loc (Pattern.Negative [$2]) }
+| MINUS LPAREN constructors RPAREN                             { with_pos $loc (Pattern.Negative $3)   }
 
 parenthesized_pattern:
-| LPAREN RPAREN                                                { with_pos $loc (`Tuple []) }
+| LPAREN RPAREN                                                { with_pos $loc (Pattern.Tuple []) }
 | LPAREN pattern RPAREN                                        { $2 }
-| LPAREN pattern COMMA patterns RPAREN                         { with_pos $loc (`Tuple ($2 :: $4)) }
-| LPAREN labeled_patterns preceded(VBAR, pattern)? RPAREN      { with_pos $loc (`Record ($2, $3))  }
+| LPAREN pattern COMMA patterns RPAREN                         { with_pos $loc (Pattern.Tuple ($2 :: $4)) }
+| LPAREN labeled_patterns preceded(VBAR, pattern)? RPAREN      { with_pos $loc (Pattern.Record ($2, $3))  }
 
 primary_pattern:
 | VARIABLE                                                     { variable_pat ~ppos:$loc $1   }
 | UNDERSCORE                                                   { any_pat $loc                 }
-| constant                                                     { with_pos $loc (`Constant $1) }
-| LBRACKET RBRACKET                                            { with_pos $loc `Nil           }
-| LBRACKET patterns RBRACKET                                   { with_pos $loc (`List $2)     }
+| constant                                                     { with_pos $loc (Pattern.Constant $1) }
+| LBRACKET RBRACKET                                            { with_pos $loc Pattern.Nil           }
+| LBRACKET patterns RBRACKET                                   { with_pos $loc (Pattern.List $2)     }
 | parenthesized_pattern                                        { $1 }
 
 patterns:
diff --git a/core/query/query.ml b/core/query/query.ml
index 37a4f6bce..0bfe30911 100644
--- a/core/query/query.ml
+++ b/core/query/query.ml
@@ -1,4 +1,5 @@
 open Utility
+open CommonTypes
 
 type base_type = [ `Bool | `Char | `Float | `Int | `String ]
 
@@ -301,16 +302,16 @@ struct
         | _ ->
           begin
             match location with
-            | `Server | `Unknown ->
+            | Location.Server | Location.Unknown ->
                 let env =
                   match z, fvs with
                   | None, None       -> Value.Env.empty
                   | Some z, Some fvs -> Value.Env.bind z (fvs, `Local) Value.Env.empty
                   | _, _ -> assert false in
                 `Closure ((xs, body), env_of_value_env env)
-            | `Client ->
+            | Location.Client ->
               failwith ("Attempt to use client function: " ^ Js.var_name_binder (f, finfo) ^ " in query")
-            | `Native ->
+            | Location.Native ->
               failwith ("Attempt to use native function: " ^ Var.show_binder (f, finfo) ^ " in query")
           end
       end
@@ -608,7 +609,7 @@ struct
               | `Let (xb, (_, tc)) ->
                   let x = Var.var_of_binder xb in
                     computation (bind env (x, tail_computation env tc)) (bs, tailcomp)
-              | `Fun (_, _, _, (`Client | `Native)) ->
+              | `Fun (_, _, _, (Location.Client | Location.Native)) ->
                   eval_error "Client function"
               | `Fun ((f, _), _, _, _) ->
                 (* This should never happen now that we have closure conversion*)
diff --git a/core/refineBindings.ml b/core/refineBindings.ml
index f4680c11c..20013082f 100644
--- a/core/refineBindings.ml
+++ b/core/refineBindings.ml
@@ -28,22 +28,22 @@ let refine_bindings : binding list -> binding list =
             match binding with
               (* Modules & qualified imports will have been eliminated by now. Funs
                * aren't introduced yet. *)
-              | `Handler _
-              | `Module _
-              | `QualifiedImport _
-              | `AlienBlock _
-              | `Funs _ -> assert false
-              | `Exp _
-              | `Foreign _
-              | `Type _
-              | `Val _ ->
+              | Handler _
+              | Module _
+              | QualifiedImport _
+              | AlienBlock _
+              | Funs _ -> assert false
+              | Exp _
+              | Foreign _
+              | Type _
+              | Val _ ->
                  (* collapse the group we're collecting, then start a
                      new empty group *)
                  ([], add [bind] (add thisgroup othergroups))
-              | `Fun _ ->
+              | Fun _ ->
                  (* Add binding to group *)
                  (bind::thisgroup, othergroups)
-              | `Infix ->
+              | Infix ->
                  (* discard binding *)
                  (thisgroup, othergroups))
             bindings ([], [])
@@ -55,7 +55,7 @@ let refine_bindings : binding list -> binding list =
       = fun defs ->
         let defs = List.map
           (function
-            | {node=`Fun (bndr, _, (_, funlit), _, _); _} ->
+            | {node=Fun (bndr, _, (_, funlit), _, _); _} ->
                (name_of_binder bndr, funlit)
             | _ -> assert false) defs in
         let names = StringSet.from_list (List.map fst defs) in
@@ -68,12 +68,12 @@ let refine_bindings : binding list -> binding list =
     let groupFuns pos (funs : binding list) : binding list =
       (* Unwrap from the bindingnode type *)
       let unFun = function
-        | {node = `Fun (b, lin, (_, funlit), location, dt); pos} ->
+        | {node = Fun (b, lin, (_, funlit), location, dt); pos} ->
            (b, lin, (([], None), funlit), location, dt, pos)
         | _ -> assert false in
       let find_fun name =
         List.find (function
-                     | {node=`Fun (bndr, _, _, _, _); _} ->
+                     | {node=Fun (bndr, _, _, _, _); _} ->
                         name = name_of_binder bndr
                      | _ -> false)
           funs in
@@ -86,8 +86,8 @@ let refine_bindings : binding list -> binding list =
                  | [(bndr, lin, ((tyvars, _), body), location, dt, pos)]
                      when not (StringSet.mem (name_of_binder bndr)
                                              (Freevars.funlit body)) ->
-                    with_pos pos (`Fun (bndr, lin, (tyvars, body), location, dt))
-                 | _ -> with_pos pos (`Funs (funs)))
+                    with_pos pos (Fun (bndr, lin, (tyvars, body), location, dt))
+                 | _ -> with_pos pos (Funs (funs)))
 
           sccs
     in
@@ -98,7 +98,7 @@ let refine_bindings : binding list -> binding list =
            Compute the position corresponding to the whole collection
            of functions.
         *)
-      | {node=`Fun _; _}::_ as funs -> groupFuns (Lexing.dummy_pos, Lexing.dummy_pos, None) funs
+      | {node=Fun _; _}::_ as funs -> groupFuns (Lexing.dummy_pos, Lexing.dummy_pos, None) funs
       | binds -> binds in
     concat_map groupBindings initial_groups
 
@@ -119,16 +119,16 @@ object (self)
     StringSet.elements (StringSet.from_list (List.rev references))
 
   method! datatypenode = function
-    | `TypeApplication (tyAppName, argList) ->
+    | Datatype.TypeApplication (tyAppName, argList) ->
           let o =
             List.fold_left (fun acc ta -> acc#type_arg ta) self argList
           in
             o#add tyAppName
     | x -> super#datatypenode x
 
-  method! row_var = function
-    | `Open (x, _, _) -> self#add x
-    | `Recursive (x, row) ->
+  method! row_var = let open Datatype in function
+    | Open (x, _, _) -> self#add x
+    | Recursive (x, row) ->
         let o = self#add x in o#row row
     | x -> super#row_var x
 
@@ -143,9 +143,10 @@ let subst_ty_app refFrom refTo =
 object(_self)
   inherit SugarTraversals.map as super
 
-  method! datatypenode : datatypenode -> datatypenode = function
-    | `TypeApplication (tyAppName, _) as tyApp ->
-        if tyAppName = refFrom then `TypeVar (refTo, Some default_subkind, `Rigid)
+  method! datatypenode : Datatype.t -> Datatype.t = let open Datatype in
+    function
+    | TypeApplication (tyAppName, _) as tyApp ->
+        if tyAppName = refFrom then TypeVar (refTo, Some default_subkind, `Rigid)
         else super#datatypenode tyApp
     | dt -> super#datatypenode dt
 end
@@ -155,7 +156,7 @@ let substTyApp ty refFrom refTo =
 
 
 (* Type variable substitution *)
-let subst_ty_var varFrom (taTo : type_arg) =
+let subst_ty_var varFrom (taTo : Datatype.type_arg) =
 object(self)
   inherit SugarTraversals.map as super
 
@@ -165,37 +166,39 @@ object(self)
    *  - This is the one found in the application
    *)
 
-  method! datatypenode : datatypenode -> datatypenode =
+  method! datatypenode : Datatype.t -> Datatype.t =
     fun dt ->
+      let open Datatype in
       match dt with
-        | `TypeVar (n, _, _) when n = varFrom ->
+        | TypeVar (n, _, _) when n = varFrom ->
             (match taTo with
-               | `Type {node = dtTo; _} -> dtTo
+               | Type {node = dtTo; _} -> dtTo
                | _ -> super#datatypenode dt)
-        | `Forall (qs, {node = quantDt; pos}) ->
+        | Forall (qs, {node = quantDt; pos}) ->
             (match taTo with
-              | `Type {node = `TypeVar (n, _, _); _} ->
+              | Type {node = TypeVar (n, _, _); _} ->
                   let qs' =
                     List.map (fun (tv, k, f as q) ->
                       if tv = varFrom then
                         (n, k, f)
-                      else q) qs in `Forall (qs', with_pos pos (self#datatypenode quantDt))
+                      else q) qs in Forall (qs', with_pos pos (self#datatypenode quantDt))
               | _ -> super#datatypenode dt)
         | _ -> super#datatypenode dt
 
-  method! fieldspec : fieldspec -> fieldspec =
+  method! fieldspec : Datatype.fieldspec -> Datatype.fieldspec =
     fun fs ->
+      let open Datatype in
       match fs with
-        | `Var (n, _, _) when n = varFrom ->
+        | Var (n, _, _) when n = varFrom ->
             (match taTo with
-              | `Presence (`Var _ as fsTo) -> fsTo
+              | Presence (Var _ as fsTo) -> fsTo
               | _ -> super#fieldspec fs)
         | _ -> super#fieldspec fs
 
-  method! row_var : row_var -> row_var = function
-    | `Open (n, _, _) as rv when n = varFrom ->
+  method! row_var : Datatype.row_var -> Datatype.row_var = let open Datatype in function
+    | Open (n, _, _) as rv when n = varFrom ->
         (match taTo with
-          | `Row (_, (`Open _ as rv2)) -> rv2
+          | Row (_, (Open _ as rv2)) -> rv2
           | _ -> super#row_var rv)
     | rv -> super#row_var rv
 
@@ -209,10 +212,10 @@ let inline_ty toFind inlineArgs toInline =
 object(_self)
   inherit SugarTraversals.map as super
 
-  method! datatypenode : datatypenode -> datatypenode =
+  method! datatypenode : Datatype.t -> Datatype.t =
     fun dt ->
       match dt with
-        | `TypeApplication (tyAppName, argList) as tyApp ->
+        | Datatype.TypeApplication (tyAppName, argList) as tyApp ->
             if tyAppName = toFind then (* && List.length argList = 0 then *)
               (* Ok, so what we need to do:
                 * We have a list of the type arguments of the type to inline,
@@ -263,19 +266,19 @@ module RefineTypeBindings = struct
       let group, groups =
         List.fold_right (fun ({node=binding; _} as bind) (currentGroup, otherGroups) ->
 	  match binding with
-          | `Handler _  (* Desugared at this point *)
-          | `Module _
-          | `QualifiedImport _
-          | `AlienBlock _
-          | `Funs _ -> assert false
-          | `Fun _
-          | `Foreign _
-          | `Val _
-          | `Exp _
-          | `Infix ->
+          | Handler _  (* Desugared at this point *)
+          | Module _
+          | QualifiedImport _
+          | AlienBlock _
+          | Funs _ -> assert false
+          | Fun _
+          | Foreign _
+          | Val _
+          | Exp _
+          | Infix ->
               (* Collapse and start a new group *)
               ([], add [bind] (add currentGroup otherGroups))
-          | `Type _ ->
+          | Type _ ->
               (* Add to this group *)
               (bind :: currentGroup, otherGroups)
         ) bindings ([], [])
@@ -302,11 +305,11 @@ module RefineTypeBindings = struct
     fun (name, _, _) -> name
 
   (* Gets the sugared datatype from a type binding. *)
-  let getDT : type_ty -> datatype =
+  let getDT : type_ty -> Datatype.with_pos =
     fun (_, _, (dt, _)) -> dt
 
   (* Updates the datatype in a type binding. *)
-  let updateDT : type_ty -> datatypenode -> type_ty =
+  let updateDT : type_ty -> Datatype.t -> type_ty =
     fun (name, tyArgs, ({pos; _}, unsugaredDT)) newDT ->
       (name, tyArgs, ((with_pos pos newDT), unsugaredDT))
 
@@ -315,7 +318,7 @@ module RefineTypeBindings = struct
       let ht = Hashtbl.create 30 in
       List.iter (fun {node = bind; pos} ->
         match bind with
-          | `Type (name, _, _ as tyTy) ->
+          | Type (name, _, _ as tyTy) ->
               let refs = typeReferences tyTy typeHt in
               let referencesSelf = refersToSelf tyTy refs in
               Hashtbl.add ht name (refs, referencesSelf, pos)
@@ -352,7 +355,7 @@ module RefineTypeBindings = struct
         if List.mem_assoc tyName env then assert false else
         if rts || List.length sccs > 1 then
           let muName = gensym ~prefix:"refined_mu" () in
-            ((tyName, muName) :: env, `Mu (muName, sugaredDT))
+            ((tyName, muName) :: env, Datatype.Mu (muName, sugaredDT))
         else (env, sugaredDT.node) in
       (* Now, we go through the list of type references.
        * If the reference is in the substitution environment, we replace it
@@ -390,11 +393,11 @@ module RefineTypeBindings = struct
         thd3 (Hashtbl.find ri name) in
       List.map (fun name ->
         let res = refineType (Hashtbl.find ht name) [] ht sccs ri in
-        with_pos (getPos name) (`Type res)
+        with_pos (getPos name) (Type res)
       ) sccs
 
   let isTypeGroup : binding list -> bool = function
-    | {node = `Type _; _} :: _xs -> true
+    | {node = Type _; _} :: _xs -> true
     | _ -> false
 
   (* Performs type refinement on a binding group. *)
@@ -404,7 +407,7 @@ module RefineTypeBindings = struct
       let ht = Hashtbl.create 30 in
       List.iter (fun {node; _} ->
         match node with
-          | `Type (name, _, _ as tyTy) ->
+          | Type (name, _, _ as tyTy) ->
             Hashtbl.add ht name tyTy;
           | _ -> assert false;
       ) binds;
@@ -429,13 +432,13 @@ let refine_bindings =
 object (self)
   inherit SugarTraversals.map as super
   method! phrasenode : phrasenode -> phrasenode = function
-    |`Block (bindings, body) ->
+    | Block (bindings, body) ->
        let bindings = self#list (fun o -> o#binding) bindings in
        let body = self#phrase body in
        let refined_bindings =
          (RefineTypeBindings.refineTypeBindings ->-
          refine_bindings) bindings in
-       `Block (refined_bindings, body)
+       Block (refined_bindings, body)
     | p -> super#phrasenode p
 
   method! program : program -> program =
diff --git a/core/sugarConstructors.ml b/core/sugarConstructors.ml
index fd9657df3..53088e1bf 100644
--- a/core/sugarConstructors.ml
+++ b/core/sugarConstructors.ml
@@ -1,3 +1,5 @@
+open CommonTypes
+open Operators
 open Sugartypes
 open Utility.OptionUtils
 
@@ -21,29 +23,29 @@ module SugarConstructors (Position : Pos)
 
   let type_variable_counter = ref 0
 
-  let fresh_type_variable () : datatypenode =
+  let fresh_type_variable () : Datatype.t =
     incr type_variable_counter;
-    `TypeVar ("_" ^ string_of_int (!type_variable_counter), None, `Flexible)
+    Datatype.TypeVar ("_" ^ string_of_int (!type_variable_counter), None, `Flexible)
 
-  let fresh_rigid_type_variable () : datatypenode =
+  let fresh_rigid_type_variable () : Datatype.t =
     incr type_variable_counter;
-    `TypeVar ("_" ^ string_of_int (!type_variable_counter), None, `Rigid)
+    Datatype.TypeVar ("_" ^ string_of_int (!type_variable_counter), None, `Rigid)
 
-  let fresh_row_variable () : row_var =
+  let fresh_row_variable () : Datatype.row_var =
     incr type_variable_counter;
-    `Open ("_" ^ string_of_int (!type_variable_counter), None, `Flexible)
+    Datatype.Open ("_" ^ string_of_int (!type_variable_counter), None, `Flexible)
 
-  let fresh_rigid_row_variable () : row_var =
+  let fresh_rigid_row_variable () : Datatype.row_var =
     incr type_variable_counter;
-    `Open ("_" ^ string_of_int (!type_variable_counter), None, `Rigid)
+    Datatype.Open ("_" ^ string_of_int (!type_variable_counter), None, `Rigid)
 
-  let fresh_presence_variable () : fieldspec =
+  let fresh_presence_variable () : Datatype.fieldspec =
     incr type_variable_counter;
-    `Var ("_" ^ string_of_int (!type_variable_counter), None, `Flexible)
+    Datatype.Var ("_" ^ string_of_int (!type_variable_counter), None, `Flexible)
 
-  let fresh_rigid_presence_variable () : fieldspec =
+  let fresh_rigid_presence_variable () : Datatype.fieldspec =
     incr type_variable_counter;
-    `Var ("_" ^ string_of_int (!type_variable_counter), None, `Rigid)
+    Datatype.Var ("_" ^ string_of_int (!type_variable_counter), None, `Rigid)
 
 
   (** Helper data types and functions for passing arguments to smart
@@ -51,7 +53,7 @@ module SugarConstructors (Position : Pos)
 
   (* Stores either a name of variable to be used in a binding pattern or the
      pattern itself.  Used for passing an argument to val_binding. *)
-  type name_or_pat = Name of name | Pat of pattern
+  type name_or_pat = PatName of name | Pat of Pattern.with_pos
 
   (* Optionally stores a datatype signature.  Isomporphic to Option. *)
   type signature = Sig of (name with_pos * datatype') with_pos | NoSig
@@ -75,37 +77,37 @@ module SugarConstructors (Position : Pos)
 
   (** Common stuff *)
 
-  let var ?(ppos=dp) name = with_pos ppos (`Var name)
+  let var ?(ppos=dp) name = with_pos ppos (Var name)
 
   (* Create a Block from block_body. *)
-  let block_node       block_contents = `Block block_contents
+  let block_node       block_contents = Block block_contents
   let block ?(ppos=dp) block_contents =
     with_pos ppos (block_node block_contents)
 
   let datatype d = (d, None)
 
   (* Create a record with a given list of labels. *)
-  let record ?(ppos=dp) ?exp lbls = with_pos ppos (`RecordLit (lbls, exp))
+  let record ?(ppos=dp) ?exp lbls = with_pos ppos (RecordLit (lbls, exp))
 
   (* Create a tuple.  Preserves 1-tuples. *)
   let tuple ?(ppos=dp) = function
     | [e] -> record ~ppos [("1", e)]
-    | es  -> with_pos ppos (`TupleLit es)
+    | es  -> with_pos ppos (TupleLit es)
 
-  let cp_unit ppos = with_pos ppos (Unquote ([], tuple ~ppos []))
+  let cp_unit ppos = with_pos ppos (CPUnquote ([], tuple ~ppos []))
 
   let list ?(ppos=dp) ?ty elems =
-    with_pos ppos (`ListLit (elems, ty))
+    with_pos ppos (ListLit (elems, ty))
 
   let constructor ?(ppos=dp) ?body ?ty name =
-    with_pos ppos (`ConstructorLit (name, body, ty))
+    with_pos ppos (ConstructorLit (name, body, ty))
 
 
   (** Constants **)
 
-  let constant      ?(ppos=dp) c = with_pos ppos (`Constant c)
-  let constant_str  ?(ppos=dp) s = with_pos ppos (`Constant (`String s))
-  let constant_char ?(ppos=dp) c = with_pos ppos (`Constant (`Char   c))
+  let constant      ?(ppos=dp) c = with_pos ppos (Constant c)
+  let constant_str  ?(ppos=dp) s = with_pos ppos (Constant (`String s))
+  let constant_char ?(ppos=dp) c = with_pos ppos (Constant (`Char   c))
 
 
   (** Binders **)
@@ -117,19 +119,19 @@ module SugarConstructors (Position : Pos)
 
   (* Create a variable pattern with a given name. *)
   let variable_pat ?(ppos=dp) ?ty name =
-    with_pos ppos (`Variable (binder ~ppos ?ty name))
+    with_pos ppos (Pattern.Variable (binder ~ppos ?ty name))
 
   (* Create a tuple pattern. *)
   let tuple_pat ?(ppos=dp) pats =
-    with_pos ppos (`Tuple pats)
+    with_pos ppos (Pattern.Tuple pats)
 
-  let any_pat ppos = with_pos ppos `Any
+  let any_pat ppos = with_pos ppos Pattern.Any
 
   (** Fieldspec *)
 
-  let present        = `Present (Sugartypes.with_dummy_pos `Unit)
+  let present        = Datatype.Present (Sugartypes.with_dummy_pos Datatype.Unit)
   let wild_present   = ("wild", present)
-  let hear_present p = ("hear", `Present p)
+  let hear_present p = ("hear", Datatype.Present p)
 
 
   (** Rows *)
@@ -144,8 +146,8 @@ module SugarConstructors (Position : Pos)
   (** Various phrases *)
 
   (* Create a FunLit. *)
-  let fun_lit ?(ppos=dp) ?args ?(location=`Unknown) linearity pats blk =
-    with_pos ppos (`FunLit (args, linearity, (pats, blk), location))
+  let fun_lit ?(ppos=dp) ?args ?(location=loc_unknown) linearity pats blk =
+    with_pos ppos (FunLit (args, linearity, (pats, blk), location))
 
   (* Create an argument used by Handler and HandlerLit. *)
   let hnlit_arg depth computation_param handler_param =
@@ -153,14 +155,14 @@ module SugarConstructors (Position : Pos)
 
   (* Create a HandlerLit. *)
   let handler_lit ?(ppos=dp) handlerlit =
-    with_pos ppos (`HandlerLit handlerlit)
+    with_pos ppos (HandlerLit handlerlit)
 
   (* Create a Spawn. *)
   let spawn ?(ppos=dp) ?row spawn_kind location blk =
-    with_pos ppos (`Spawn (spawn_kind, location, blk, row))
+    with_pos ppos (Spawn (spawn_kind, location, blk, row))
 
   let fn_appl_node ?(ppos=dp) name tyvars vars =
-    `FnAppl (with_pos ppos (tappl (`Var name, tyvars)), vars)
+    FnAppl (with_pos ppos (tappl (Var name, tyvars)), vars)
 
   let fn_appl ?(ppos=dp) name tyvars vars =
     with_pos ppos (fn_appl_node ~ppos name tyvars vars)
@@ -173,36 +175,36 @@ module SugarConstructors (Position : Pos)
   (* Create a function binding. *)
   let fun_binding ?(ppos=dp) sig_opt (linearity, bndr, args, location, blk) =
     let datatype = datatype_opt_of_sig_opt sig_opt bndr in
-    with_pos ppos (`Fun (binder bndr, linearity,
+    with_pos ppos (Fun (binder bndr, linearity,
                          ([], (args, blk)), location, datatype))
 
-  let fun_binding' ?(ppos=dp) ?(linearity=`Unl) ?(tyvars=[])
-        ?(location=`Unknown) ?annotation bndr fnlit =
-    with_pos ppos (`Fun (bndr, linearity, (tyvars, fnlit), location, annotation))
+  let fun_binding' ?(ppos=dp) ?(linearity=dl_unl) ?(tyvars=[])
+        ?(location=loc_unknown) ?annotation bndr fnlit =
+    with_pos ppos (Fun (bndr, linearity, (tyvars, fnlit), location, annotation))
 
 
   (* Create a handler binding. *)
   let handler_binding ?(ppos=dp) sig_opt (name, handlerlit) =
     let datatype = datatype_opt_of_sig_opt sig_opt name in
-    with_pos ppos (`Handler (binder name, handlerlit, datatype))
+    with_pos ppos (Handler (binder name, handlerlit, datatype))
 
   (* Create a Val binding.  This function takes either a name for a variable
      pattern or an already constructed pattern.  In the latter case no signature
      should be passed. *)
   let val_binding' ?(ppos=dp) sig_opt (name_or_pat, phrase, location) =
     let pat, datatype = match name_or_pat with
-      | Name name ->
+      | PatName name ->
          let pat      = variable_pat ~ppos name in
          let datatype = datatype_opt_of_sig_opt sig_opt name in
          (pat, datatype)
       | Pat pat ->
          assert (sig_opt = NoSig);
          (pat, None) in
-    with_pos ppos (`Val (pat, ([], phrase), location, datatype))
+    with_pos ppos (Val (pat, ([], phrase), location, datatype))
 
   (* A commonly used wrapper around val_binding *)
   let val_binding ?(ppos=dp) pat phrase =
-    val_binding' ~ppos NoSig (Pat pat, phrase, `Unknown)
+    val_binding' ~ppos NoSig (Pat pat, phrase, loc_unknown)
 
 
   (** Database queries *)
@@ -213,7 +215,7 @@ module SugarConstructors (Position : Pos)
 
   (* Is the list of labeled database expressions empty? *)
   let is_empty_db_exps : phrase -> bool = function
-    | {node=`ListLit ([{node=`RecordLit ([], _);_}], _);_} -> true
+    | {node=ListLit ([{node=RecordLit ([], _);_}], _);_} -> true
     | _                                                    -> false
 
   (* Create a database insertion query.  Raises an exception when the list of
@@ -224,26 +226,26 @@ module SugarConstructors (Position : Pos)
       raise (ConcreteSyntaxError ("Invalid insert statement.  Either provide" ^
           " a nonempty list of labeled expression or a return variable.",
            pos ppos));
-    with_pos ppos (`DBInsert (ins_exp, lbls, exps,
+    with_pos ppos (DBInsert (ins_exp, lbls, exps,
        opt_map (fun name -> constant_str ~ppos name) var_opt))
 
   (* Create a query. *)
   let query ?(ppos=dp) phrases_opt blk =
-    with_pos ppos (`Query (phrases_opt, blk, None))
+    with_pos ppos (Query (phrases_opt, blk, None))
 
 
   (** Operator applications *)
   (* Apply a binary infix operator. *)
   let infix_appl' ?(ppos=dp) arg1 op arg2 =
-    with_pos ppos (`InfixAppl (([], op), arg1, arg2))
+    with_pos ppos (InfixAppl (([], op), arg1, arg2))
 
   (* Apply a binary infix operator with a specified name. *)
   let infix_appl ?(ppos=dp) arg1 op arg2 =
-    infix_appl' ~ppos arg1 (`Name op) arg2
+    infix_appl' ~ppos arg1 (BinaryOp.Name op) arg2
 
   (* Apply an unary operator. *)
   let unary_appl ?(ppos=dp) op arg =
-    with_pos ppos (`UnaryAppl (([], op), arg))
+    with_pos ppos (UnaryAppl (([], op), arg))
 
   (** XML *)
   (* Create an XML tree.  Raise an exception if opening and closing tags don't
@@ -256,7 +258,7 @@ module SugarConstructors (Position : Pos)
                   ("Closing tag '" ^ closing ^ "' does not match start tag '"
                    ^ opening ^ "'.", pos ppos))
       | _ -> () in
-    with_pos ppos (`Xml (name, attr_list, blk_opt, contents))
+    with_pos ppos (Xml (name, attr_list, blk_opt, contents))
 
   (** Handlers *)
   let untyped_handler ?(val_cases = []) ?parameters expr eff_cases depth =
diff --git a/core/sugarConstructorsIntf.ml b/core/sugarConstructorsIntf.ml
index 86cfc783e..f9f81fed5 100644
--- a/core/sugarConstructorsIntf.ml
+++ b/core/sugarConstructorsIntf.ml
@@ -1,6 +1,8 @@
 (* This module contains module signatures used by SugarConstructors module.
    Putting them here allows to avoid repetition. *)
 
+open CommonTypes
+open Operators
 open Sugartypes
 
 (* An abstract type of positions and operations on them.  The core type of
@@ -37,17 +39,17 @@ module type SugarConstructorsSig = sig
   val with_dummy_pos : 'a -> 'a with_pos
 
   (* Fresh type variables. *)
-  val fresh_type_variable           : unit -> datatypenode
-  val fresh_rigid_type_variable     : unit -> datatypenode
-  val fresh_row_variable            : unit -> row_var
-  val fresh_rigid_row_variable      : unit -> row_var
-  val fresh_presence_variable       : unit -> fieldspec
-  val fresh_rigid_presence_variable : unit -> fieldspec
+  val fresh_type_variable           : unit -> Datatype.t
+  val fresh_rigid_type_variable     : unit -> Datatype.t
+  val fresh_row_variable            : unit -> Datatype.row_var
+  val fresh_rigid_row_variable      : unit -> Datatype.row_var
+  val fresh_presence_variable       : unit -> Datatype.fieldspec
+  val fresh_rigid_presence_variable : unit -> Datatype.fieldspec
 
   (* Helper data types and functions for passing arguments to smart
      constructors.  *)
-  type name_or_pat = Name of name
-                   | Pat  of pattern
+  type name_or_pat = PatName of name
+                   | Pat     of Pattern.with_pos
 
   type signature   = Sig of (name with_pos * datatype') with_pos
                    | NoSig
@@ -58,7 +60,7 @@ module type SugarConstructorsSig = sig
   val var         : ?ppos:t -> name -> phrase
   val block       : ?ppos:t -> block_body -> phrase
   val block_node  :            block_body -> phrasenode
-  val datatype    : datatype -> datatype * 'a option
+  val datatype    : Datatype.with_pos -> Datatype.with_pos * 'a option
   val cp_unit     : t -> cp_phrase
   val record      : ?ppos:t -> ?exp:phrase -> (name * phrase) list -> phrase
   val tuple       : ?ppos:t -> phrase list -> phrase
@@ -76,25 +78,27 @@ module type SugarConstructorsSig = sig
   val binder   : ?ppos:t -> ?ty:Types.datatype -> name -> binder
 
   (* Patterns *)
-  val variable_pat : ?ppos:t -> ?ty:Types.datatype -> name -> pattern
-  val tuple_pat    : ?ppos:t -> pattern list -> pattern
-  val any_pat      : t -> pattern
+  val variable_pat : ?ppos:t -> ?ty:Types.datatype -> name -> Pattern.with_pos
+  val tuple_pat    : ?ppos:t -> Pattern.with_pos list -> Pattern.with_pos
+  val any_pat      : t -> Pattern.with_pos
 
   (* Fieldspec *)
-  val present : fieldspec
+  val present : Datatype.fieldspec
 
   (* Rows *)
-  val fresh_row         : unit -> row
-  val row_with_wp       : row -> row
-  val hear_arrow_prefix : datatype -> row -> row
+  val fresh_row         : unit -> Datatype.row
+  val row_with_wp       : Datatype.row -> Datatype.row
+  val hear_arrow_prefix : Datatype.with_pos -> Datatype.row -> Datatype.row
 
   (* Various phrases *)
   val fun_lit
       : ?ppos:t -> ?args:((Types.datatype * Types.row) list)
-     -> ?location:location -> declared_linearity -> pattern list list -> phrase
+     -> ?location:Location.t -> DeclaredLinearity.t
+     -> Pattern.with_pos list list -> phrase
      -> phrase
   val hnlit_arg
-      : handler_depth -> pattern -> clause list * pattern list list option
+      : handler_depth -> Pattern.with_pos
+     -> clause list * Pattern.with_pos list list option
      -> handlerlit
   val handler_lit
       : ?ppos:t -> handlerlit -> phrase
@@ -112,20 +116,21 @@ module type SugarConstructorsSig = sig
   (* Bindings *)
   val fun_binding
       : ?ppos:t -> signature
-     -> (declared_linearity * name * pattern list list * location * phrase)
+     -> (DeclaredLinearity.t * name * Pattern.with_pos list list * Location.t *
+           phrase)
      -> binding
   val fun_binding'
-      : ?ppos:t -> ?linearity:declared_linearity -> ?tyvars:tyvar list
-     -> ?location:location -> ?annotation:datatype' -> binder -> funlit
+      : ?ppos:t -> ?linearity:DeclaredLinearity.t -> ?tyvars:tyvar list
+     -> ?location:Location.t -> ?annotation:datatype' -> binder -> funlit
      -> binding
   val handler_binding
       : ?ppos:t -> signature -> (name * handlerlit)
      -> binding
   val val_binding'
-      : ?ppos:t -> signature -> (name_or_pat * phrase * location)
+      : ?ppos:t -> signature -> (name_or_pat * phrase * Location.t)
      -> binding
   val val_binding
-      : ?ppos:t -> pattern -> phrase
+      : ?ppos:t -> Pattern.with_pos -> phrase
      -> binding
 
   (* Database queries *)
@@ -138,9 +143,9 @@ module type SugarConstructorsSig = sig
       : ?ppos:t -> (phrase * phrase) option -> phrase -> phrase
 
   (* Operator applications *)
-  val infix_appl' : ?ppos:t -> phrase -> binop    -> phrase -> phrase
-  val infix_appl  : ?ppos:t -> phrase -> string   -> phrase -> phrase
-  val unary_appl  : ?ppos:t ->           unary_op -> phrase -> phrase
+  val infix_appl' : ?ppos:t -> phrase -> BinaryOp.t -> phrase -> phrase
+  val infix_appl  : ?ppos:t -> phrase -> string     -> phrase -> phrase
+  val unary_appl  : ?ppos:t ->           UnaryOp.t  -> phrase -> phrase
 
   (* XML *)
   val xml
@@ -150,7 +155,8 @@ module type SugarConstructorsSig = sig
 
   (* Handlers *)
   val untyped_handler
-      : ?val_cases:(clause list) -> ?parameters:((phrase * pattern) list)
+      : ?val_cases:(clause list)
+     -> ?parameters:((phrase * Pattern.with_pos) list)
      -> phrase -> clause list -> handler_depth
      -> handler
 end
diff --git a/core/sugarTraversals.ml b/core/sugarTraversals.ml
index 1d090b438..08024d416 100644
--- a/core/sugarTraversals.ml
+++ b/core/sugarTraversals.ml
@@ -8,6 +8,8 @@
    generate all this automatically instead of maintaining this file.
 *)
 
+open Operators
+open CommonTypes
 open Sugartypes
 
 class map =
@@ -36,13 +38,13 @@ class map =
 
     method bool : bool -> bool = function | false -> false | true -> true
 
-    method unary_op : unary_op -> unary_op =
-      function
-      | `Minus -> `Minus
-      | `FloatMinus -> `FloatMinus
-      | `Name _x -> let _x = o#name _x in `Name _x
+    method unary_op : UnaryOp.t -> UnaryOp.t =
+      let open UnaryOp in function
+      | Minus -> Minus
+      | FloatMinus -> FloatMinus
+      | Name _x -> let _x = o#name _x in Name _x
 
-    method tyunary_op : tyarg list * unary_op -> tyarg list * unary_op =
+    method tyunary_op : tyarg list * UnaryOp.t -> tyarg list * UnaryOp.t =
       fun (_x, _x_i1) -> (_x, o#unary_op _x_i1)
 
     method binder : binder -> binder =
@@ -59,12 +61,12 @@ class map =
       | Expression _x -> let _x = o#phrase _x in Expression _x
       | Directive _x -> let _x = o#directive _x in Directive _x
 
-    method sec : sec -> sec =
-      function
-      | `Minus -> `Minus
-      | `FloatMinus -> `FloatMinus
-      | `Project _x -> let _x = o#name _x in `Project _x
-      | `Name _x -> let _x = o#name _x in `Name _x
+    method section : Section.t -> Section.t =
+      let open Section in function
+      | Minus -> Minus
+      | FloatMinus -> FloatMinus
+      | Project _x -> let _x = o#name _x in Project _x
+      | Name _x -> let _x = o#name _x in Name _x
 
     method subkind : subkind -> subkind = fun x -> x
 
@@ -84,16 +86,17 @@ class map =
         let _x_i1 = o#option (fun o -> o#subkind) _x_i1 in
         let _x_i2 = o#freedom _x_i2 in (_x, _x_i1, _x_i2)
 
-    method row_var : row_var -> row_var =
+    method row_var : Datatype.row_var -> Datatype.row_var =
+      let open Datatype in
       function
-      | `Closed -> `Closed
-      | `Open _x ->
-          let _x = o#known_type_variable _x in `Open _x
-      | `Recursive ((_x, _x_i1)) ->
+      | Closed -> Closed
+      | Open _x ->
+          let _x = o#known_type_variable _x in Open _x
+      | Recursive ((_x, _x_i1)) ->
           let _x = o#name _x in
-          let _x_i1 = o#row _x_i1 in `Recursive ((_x, _x_i1))
+          let _x_i1 = o#row _x_i1 in Recursive ((_x, _x_i1))
 
-    method row : row -> row =
+    method row : Datatype.row -> Datatype.row =
       fun (_x, _x_i1) ->
         let _x =
           o#list
@@ -105,8 +108,8 @@ class map =
 
     method replace_rhs : replace_rhs -> replace_rhs =
       function
-      | `Literal _x -> let _x = o#string _x in `Literal _x
-      | `Splice _x -> let _x = o#phrase _x in `Splice _x
+      | Literal    _x -> let _x = o#string _x in Literal    _x
+      | SpliceExpr _x -> let _x = o#phrase _x in SpliceExpr _x
 
     method regexflag : regexflag -> regexflag =
       fun flag -> flag
@@ -153,68 +156,68 @@ class map =
 
     method phrasenode : phrasenode -> phrasenode =
       function
-      | `Constant _x -> let _x = o#constant _x in `Constant _x
-      | `Var _x -> let _x = o#name _x in `Var _x
-      | `QualifiedVar _xs ->
-          let _xs = o#list (fun o -> o#name) _xs in `QualifiedVar _xs
-      | `FunLit (_x, _x1, _x_i1, _x_i2) -> let _x_i1 = o#funlit _x_i1 in
-                                           let _x_i2 = o#location _x_i2 in `FunLit (_x, _x1, _x_i1, _x_i2)
-      | `HandlerLit hnlit ->
+      | Constant _x -> let _x = o#constant _x in Constant _x
+      | Var _x -> let _x = o#name _x in Var _x
+      | QualifiedVar _xs ->
+          let _xs = o#list (fun o -> o#name) _xs in QualifiedVar _xs
+      | FunLit (_x, _x1, _x_i1, _x_i2) -> let _x_i1 = o#funlit _x_i1 in
+                                           let _x_i2 = o#location _x_i2 in FunLit (_x, _x1, _x_i1, _x_i2)
+      | HandlerLit hnlit ->
 	 let hnlit = o#handlerlit hnlit in
-	 `HandlerLit hnlit
-      | `Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt) ->
+	 HandlerLit hnlit
+      | Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt) ->
           let _given_spawn_location = o#given_spawn_location _given_spawn_location in
           let _block_phr = o#phrase _block_phr in
-          `Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt)
-      | `Query (_x, _x_i1, _x_i2) ->
+          Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt)
+      | Query (_x, _x_i1, _x_i2) ->
           let _x =
             o#option
               (fun o (_x, _x_i1) ->
                  let _x = o#phrase _x in
                  let _x_i1 = o#phrase _x_i1 in (_x, _x_i1))
               _x in
-          let _x_i1 = o#phrase _x_i1 in `Query (_x, _x_i1, _x_i2)
-      | `ListLit (_x, _x_i1) ->
-          let _x = o#list (fun o -> o#phrase) _x in `ListLit (_x, _x_i1)
-      | `Iteration ((_x, _x_i1, _x_i2, _x_i3)) ->
+          let _x_i1 = o#phrase _x_i1 in Query (_x, _x_i1, _x_i2)
+      | ListLit (_x, _x_i1) ->
+          let _x = o#list (fun o -> o#phrase) _x in ListLit (_x, _x_i1)
+      | Iteration ((_x, _x_i1, _x_i2, _x_i3)) ->
           let _x = o#list (fun o -> o#iterpatt) _x in
           let _x_i1 = o#phrase _x_i1 in
           let _x_i2 = o#option (fun o -> o#phrase) _x_i2 in
           let _x_i3 = o#option (fun o -> o#phrase) _x_i3
-          in `Iteration ((_x, _x_i1, _x_i2, _x_i3))
-      | `Escape ((_x, _x_i1)) ->
+          in Iteration ((_x, _x_i1, _x_i2, _x_i3))
+      | Escape ((_x, _x_i1)) ->
           let _x = o#binder _x in
-          let _x_i1 = o#phrase _x_i1 in `Escape ((_x, _x_i1))
-      | `Section _x -> let _x = o#sec _x in `Section _x
-      | `Conditional ((_x, _x_i1, _x_i2)) ->
+          let _x_i1 = o#phrase _x_i1 in Escape ((_x, _x_i1))
+      | Section _x -> let _x = o#section _x in Section _x
+      | Conditional ((_x, _x_i1, _x_i2)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#phrase _x_i1 in
-          let _x_i2 = o#phrase _x_i2 in `Conditional ((_x, _x_i1, _x_i2))
-      | `Block ((_x, _x_i1)) ->
+          let _x_i2 = o#phrase _x_i2 in Conditional ((_x, _x_i1, _x_i2))
+      | Block ((_x, _x_i1)) ->
           let _x = o#list (fun o -> o#binding) _x in
-          let _x_i1 = o#phrase _x_i1 in `Block ((_x, _x_i1))
-      | `InfixAppl ((_x, _x_i1, _x_i2)) ->
+          let _x_i1 = o#phrase _x_i1 in Block ((_x, _x_i1))
+      | InfixAppl ((_x, _x_i1, _x_i2)) ->
           let _x = o#tybinop _x in
           let _x_i1 = o#phrase _x_i1 in
-          let _x_i2 = o#phrase _x_i2 in `InfixAppl ((_x, _x_i1, _x_i2))
-      | `RangeLit ((_x_i1, _x_i2)) ->
+          let _x_i2 = o#phrase _x_i2 in InfixAppl ((_x, _x_i1, _x_i2))
+      | RangeLit ((_x_i1, _x_i2)) ->
           let _x_i1 = o#phrase _x_i1 in
-          let _x_i2 = o#phrase _x_i2 in `RangeLit ((_x_i1, _x_i2))
-      | `Regex _x -> let _x = o#regex _x in `Regex _x
-      | `UnaryAppl ((_x, _x_i1)) ->
+          let _x_i2 = o#phrase _x_i2 in RangeLit ((_x_i1, _x_i2))
+      | Regex _x -> let _x = o#regex _x in Regex _x
+      | UnaryAppl ((_x, _x_i1)) ->
           let _x = o#tyunary_op _x in
-          let _x_i1 = o#phrase _x_i1 in `UnaryAppl ((_x, _x_i1))
-      | `FnAppl ((_x, _x_i1)) ->
+          let _x_i1 = o#phrase _x_i1 in UnaryAppl ((_x, _x_i1))
+      | FnAppl ((_x, _x_i1)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#list (fun o -> o#phrase) _x_i1
-          in `FnAppl ((_x, _x_i1))
-      | `TAbstr ((_x, _x_i1)) ->
-          let _x_i1 = o#phrase _x_i1 in `TAbstr ((_x, _x_i1))
-      | `TAppl ((_x, _x_i1)) ->
-          let _x = o#phrase _x in `TAppl ((_x, _x_i1))
-      | `TupleLit _x ->
-          let _x = o#list (fun o -> o#phrase) _x in `TupleLit _x
-      | `RecordLit ((_x, _x_i1)) ->
+          in FnAppl ((_x, _x_i1))
+      | TAbstr ((_x, _x_i1)) ->
+          let _x_i1 = o#phrase _x_i1 in TAbstr ((_x, _x_i1))
+      | TAppl ((_x, _x_i1)) ->
+          let _x = o#phrase _x in TAppl ((_x, _x_i1))
+      | TupleLit _x ->
+          let _x = o#list (fun o -> o#phrase) _x in TupleLit _x
+      | RecordLit ((_x, _x_i1)) ->
           let _x =
             o#list
               (fun o (_x, _x_i1) ->
@@ -222,11 +225,11 @@ class map =
                  let _x_i1 = o#phrase _x_i1 in (_x, _x_i1))
               _x in
           let _x_i1 = o#option (fun o -> o#phrase) _x_i1
-          in `RecordLit ((_x, _x_i1))
-      | `Projection ((_x, _x_i1)) ->
+          in RecordLit ((_x, _x_i1))
+      | Projection ((_x, _x_i1)) ->
           let _x = o#phrase _x in
-          let _x_i1 = o#name _x_i1 in `Projection ((_x, _x_i1))
-      | `With ((_x, _x_i1)) ->
+          let _x_i1 = o#name _x_i1 in Projection ((_x, _x_i1))
+      | With ((_x, _x_i1)) ->
           let _x = o#phrase _x in
           let _x_i1 =
             o#list
@@ -234,23 +237,23 @@ class map =
                  let _x = o#name _x in
                  let _x_i1 = o#phrase _x_i1 in (_x, _x_i1))
               _x_i1
-          in `With ((_x, _x_i1))
-      | `TypeAnnotation ((_x, _x_i1)) ->
+          in With ((_x, _x_i1))
+      | TypeAnnotation ((_x, _x_i1)) ->
           let _x = o#phrase _x in
-          let _x_i1 = o#datatype' _x_i1 in `TypeAnnotation ((_x, _x_i1))
-      | `Upcast ((_x, _x_i1, _x_i2)) ->
+          let _x_i1 = o#datatype' _x_i1 in TypeAnnotation ((_x, _x_i1))
+      | Upcast ((_x, _x_i1, _x_i2)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#datatype' _x_i1 in
-          let _x_i2 = o#datatype' _x_i2 in `Upcast ((_x, _x_i1, _x_i2))
-      | `ConstructorLit ((_x, _x_i1, _x_i2)) ->
+          let _x_i2 = o#datatype' _x_i2 in Upcast ((_x, _x_i1, _x_i2))
+      | ConstructorLit ((_x, _x_i1, _x_i2)) ->
           let _x = o#name _x in
           let _x_i1 = o#option (fun o -> o#phrase) _x_i1
-          in `ConstructorLit ((_x, _x_i1, _x_i2))
-      | `DoOperation (name, ps, t) ->
+          in ConstructorLit ((_x, _x_i1, _x_i2))
+      | DoOperation (name, ps, t) ->
           let ps  = o#list (fun o -> o#phrase) ps in
           let t   = o#option (fun o -> o#unknown) t in
-          `DoOperation (name, ps, t)
-      | `Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
+          DoOperation (name, ps, t)
+      | Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
          let m = o#phrase sh_expr in
          let params =
             o#option (fun o -> o#handle_params) sh_descr.shd_params
@@ -271,8 +274,8 @@ class map =
 	     )
              sh_value_cases
 	 in
-         `Handle { sh_expr = m; sh_effect_cases = eff_cases; sh_value_cases = val_cases; sh_descr = { sh_descr with shd_params = params } }
-      | `Switch ((_x, _x_i1, _x_i2)) ->
+         Handle { sh_expr = m; sh_effect_cases = eff_cases; sh_value_cases = val_cases; sh_descr = { sh_descr with shd_params = params } }
+      | Switch ((_x, _x_i1, _x_i2)) ->
           let _x = o#phrase _x in
           let _x_i1 =
             o#list
@@ -281,8 +284,8 @@ class map =
                  let _x_i1 = o#phrase _x_i1 in (_x, _x_i1))
               _x_i1 in
           let _x_i2 = o#option (fun o -> o#unknown) _x_i2
-          in `Switch ((_x, _x_i1, _x_i2))
-      | `Receive ((_x, _x_i1)) ->
+          in Switch ((_x, _x_i1, _x_i2))
+      | Receive ((_x, _x_i1)) ->
           let _x =
             o#list
               (fun o (_x, _x_i1) ->
@@ -290,15 +293,15 @@ class map =
                  let _x_i1 = o#phrase _x_i1 in (_x, _x_i1))
               _x in
           let _x_i1 = o#option (fun o -> o#unknown) _x_i1
-          in `Receive (_x, _x_i1)
-      (* | `Link ((_x, _x_i1)) -> *)
+          in Receive (_x, _x_i1)
+      (* | Link ((_x, _x_i1)) -> *)
       (*     let _x = o#phrase _x in *)
-      (*     let _x_i1 = o#phrase _x_i1 in `Link ((_x, _x_i1)) *)
-      | `Select ((_x, _x_i1)) ->
+      (*     let _x_i1 = o#phrase _x_i1 in Link ((_x, _x_i1)) *)
+      | Select ((_x, _x_i1)) ->
           let _x = o#name _x in
           let _x_i1 = o#phrase _x_i1
-          in `Select (_x, _x_i1)
-      | `Offer ((_x, _x_i1, _x_i2)) ->
+          in Select (_x, _x_i1)
+      | Offer ((_x, _x_i1, _x_i2)) ->
           let _x = o#phrase _x in
           let _x_i1 =
             o#list
@@ -307,17 +310,17 @@ class map =
                  let _x_i1 = o#phrase _x_i1 in (_x, _x_i1))
               _x_i1 in
           let _x_i2 = o#option (fun o -> o#unknown) _x_i2
-          in `Offer (_x, _x_i1, _x_i2)
-      | `CP p -> `CP (o#cp_phrase p)
-      | `DatabaseLit ((_x, _x_i1)) ->
+          in Offer (_x, _x_i1, _x_i2)
+      | CP p -> CP (o#cp_phrase p)
+      | DatabaseLit ((_x, _x_i1)) ->
           let _x = o#phrase _x in
           let _x_i1 =
             (fun (_x, _x_i1) ->
                let _x = o#option (fun o -> o#phrase) _x in
                let _x_i1 = o#option (fun o -> o#phrase) _x_i1 in (_x, _x_i1))
               _x_i1
-          in `DatabaseLit ((_x, _x_i1))
-      | `TableLit ((_x, (y, z), _x_i2, _x_i3, _x_i4)) ->
+          in DatabaseLit ((_x, _x_i1))
+      | TableLit ((_x, (y, z), _x_i2, _x_i3, _x_i4)) ->
           let _x = o#phrase _x in
           let y = o#datatype y in
           let z = o#option
@@ -332,59 +335,59 @@ class map =
                  in (_x, _x_i1))
               _x_i2 in
           let _x_i3 = o#phrase _x_i3 in
-	  let _x_i4 = o#phrase _x_i4 in `TableLit ((_x, (y, z), _x_i2, _x_i3, _x_i4))
-      | `LensLit ((_x, _x_i1)) ->
+	  let _x_i4 = o#phrase _x_i4 in TableLit ((_x, (y, z), _x_i2, _x_i3, _x_i4))
+      | LensLit ((_x, _x_i1)) ->
               let _x = o#phrase _x in
               let _x_i1 = o#option (fun o -> o#unknown) _x_i1 in
-              `LensLit (_x, _x_i1)
-      | `LensKeysLit ((_x, _x_i1, _x_i2)) ->
+              LensLit (_x, _x_i1)
+      | LensKeysLit ((_x, _x_i1, _x_i2)) ->
               let _x = o#phrase _x in
               let _x_i1 = o#phrase _x_i1 in
               let _x_i2 = o#option (fun o -> o#unknown) _x_i2 in
-              `LensKeysLit (_x, _x_i1, _x_i2)
-      | `LensFunDepsLit ((_x, _x_i1, _x_i2)) ->
+              LensKeysLit (_x, _x_i1, _x_i2)
+      | LensFunDepsLit ((_x, _x_i1, _x_i2)) ->
               let _x = o#phrase _x in
               let _x_i2 = o#option (fun o -> o#unknown) _x_i2 in
-              `LensFunDepsLit (_x, _x_i1, _x_i2)
-      | `LensDropLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
+              LensFunDepsLit (_x, _x_i1, _x_i2)
+      | LensDropLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#string _x_i1 in
           let _x_i2 = o#string _x_i2 in
           let _x_i3 = o#phrase _x_i3 in
           let _x_i4 = o#option (fun o -> o#unknown) _x_i4 in
-          `LensDropLit((_x, _x_i1, _x_i2, _x_i3, _x_i4))
-      | `LensSelectLit ((_x, _x_i1, _x_i2)) ->
+          LensDropLit((_x, _x_i1, _x_i2, _x_i3, _x_i4))
+      | LensSelectLit ((_x, _x_i1, _x_i2)) ->
           let _x = o#phrase _x in
           (* let _x_i1 = o#phrase _x_i1 in *)
           let _x_i2 = o#option (fun o -> o#unknown) _x_i2 in
-            `LensSelectLit ((_x, _x_i1, _x_i2))
-      | `LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5)) ->
+            LensSelectLit ((_x, _x_i1, _x_i2))
+      | LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#phrase _x_i1 in
           let _x_i2 = o#phrase _x_i2 in
           (* _x_i3 and _x_i4 are both phrases which are left unchanged *)
           let _x_i5 = o#option (fun o -> o#unknown) _x_i5 in
-            `LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5))
-      | `LensGetLit ((_x, _x_i1)) ->
+            LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5))
+      | LensGetLit ((_x, _x_i1)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#option (fun o -> o#unknown) _x_i1 in
-            `LensGetLit ((_x, _x_i1))
-      | `LensPutLit ((_x, _x_i1, _x_i2)) ->
+            LensGetLit ((_x, _x_i1))
+      | LensPutLit ((_x, _x_i1, _x_i2)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#phrase _x_i1 in
           let _x_i2 = o#option (fun o -> o#unknown) _x_i2 in
-            `LensPutLit ((_x, _x_i1, _x_i2))
-      | `DBDelete ((_x, _x_i1, _x_i2)) ->
+            LensPutLit ((_x, _x_i1, _x_i2))
+      | DBDelete ((_x, _x_i1, _x_i2)) ->
           let _x = o#pattern _x in
           let _x_i1 = o#phrase _x_i1 in
           let _x_i2 = o#option (fun o -> o#phrase) _x_i2
-          in `DBDelete ((_x, _x_i1, _x_i2))
-      | `DBInsert ((_x, _x_i1, _x_i2, _x_i3)) ->
+          in DBDelete ((_x, _x_i1, _x_i2))
+      | DBInsert ((_x, _x_i1, _x_i2, _x_i3)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#list (fun o -> o#name) _x_i1 in
           let _x_i2 = o#phrase _x_i2 in
-          let _x_i3 = o#option (fun o -> o#phrase) _x_i3 in `DBInsert ((_x, _x_i1, _x_i2, _x_i3))
-      | `DBUpdate ((_x, _x_i1, _x_i2, _x_i3)) ->
+          let _x_i3 = o#option (fun o -> o#phrase) _x_i3 in DBInsert ((_x, _x_i1, _x_i2, _x_i3))
+      | DBUpdate ((_x, _x_i1, _x_i2, _x_i3)) ->
           let _x = o#pattern _x in
           let _x_i1 = o#phrase _x_i1 in
           let _x_i2 = o#option (fun o -> o#phrase) _x_i2 in
@@ -394,8 +397,8 @@ class map =
                  let _x = o#name _x in
                  let _x_i1 = o#phrase _x_i1 in (_x, _x_i1))
               _x_i3
-          in `DBUpdate ((_x, _x_i1, _x_i2, _x_i3))
-      | `Xml ((_x, _x_i1, _x_i2, _x_i3)) ->
+          in DBUpdate ((_x, _x_i1, _x_i2, _x_i3))
+      | Xml ((_x, _x_i1, _x_i2, _x_i3)) ->
           let _x = o#name _x in
           let _x_i1 =
             o#list
@@ -405,28 +408,28 @@ class map =
               _x_i1 in
           let _x_i2 = o#option (fun o -> o#phrase) _x_i2 in
           let _x_i3 = o#list (fun o -> o#phrase) _x_i3
-          in `Xml ((_x, _x_i1, _x_i2, _x_i3))
-      | `TextNode _x -> let _x = o#string _x in `TextNode _x
-      | `Formlet ((_x, _x_i1)) ->
+          in Xml ((_x, _x_i1, _x_i2, _x_i3))
+      | TextNode _x -> let _x = o#string _x in TextNode _x
+      | Formlet ((_x, _x_i1)) ->
           let _x = o#phrase _x in
-          let _x_i1 = o#phrase _x_i1 in `Formlet ((_x, _x_i1))
-      | `Page _x -> let _x = o#phrase _x in `Page _x
-      | `FormletPlacement ((_x, _x_i1, _x_i2)) ->
+          let _x_i1 = o#phrase _x_i1 in Formlet ((_x, _x_i1))
+      | Page _x -> let _x = o#phrase _x in Page _x
+      | FormletPlacement ((_x, _x_i1, _x_i2)) ->
           let _x = o#phrase _x in
           let _x_i1 = o#phrase _x_i1 in
           let _x_i2 = o#phrase _x_i2
-          in `FormletPlacement ((_x, _x_i1, _x_i2))
-      | `PagePlacement _x -> let _x = o#phrase _x in `PagePlacement _x
-      | `FormBinding ((_x, _x_i1)) ->
+          in FormletPlacement ((_x, _x_i1, _x_i2))
+      | PagePlacement _x -> let _x = o#phrase _x in PagePlacement _x
+      | FormBinding ((_x, _x_i1)) ->
           let _x = o#phrase _x in
-          let _x_i1 = o#pattern _x_i1 in `FormBinding ((_x, _x_i1))
-      | `TryInOtherwise (_p1, _pat, _p2, _p3, _ty) ->
+          let _x_i1 = o#pattern _x_i1 in FormBinding ((_x, _x_i1))
+      | TryInOtherwise (_p1, _pat, _p2, _p3, _ty) ->
           let _p1 = o#phrase _p1 in
           let _pat = o#pattern _pat in
           let _p2 = o#phrase _p2 in
           let _p3 = o#phrase _p3 in
-          `TryInOtherwise (_p1, _pat, _p2, _p3, _ty)
-      | `Raise -> `Raise
+          TryInOtherwise (_p1, _pat, _p2, _p3, _ty)
+      | Raise -> Raise
 
 
     method phrase : phrase -> phrase =
@@ -437,39 +440,40 @@ class map =
 
     method cp_phrasenode : cp_phrasenode -> cp_phrasenode =
       function
-      | Unquote (bs, e)  -> Unquote (o#list (fun o -> o#binding) bs, o#phrase e)
-      | Grab (c, x, p)   -> Grab (c, x, o#cp_phrase p)
-      | Give (c, e, p)   -> Give (c, o#option (fun o -> o#phrase) e, o#cp_phrase p)
-      | GiveNothing c    -> GiveNothing (o#binder c)
-      | Select (c, l, p) -> Select (c, l, o#cp_phrase p)
-      | Offer (c, bs)    -> Offer (c, o#list (fun o (l, p) -> (l, o#cp_phrase p)) bs)
-      | Link (c, d)      -> Link (c, d)
-      | Comp (c, p, q)   -> Comp (c, o#cp_phrase p, o#cp_phrase q)
+      | CPUnquote (bs, e)  -> CPUnquote (o#list (fun o -> o#binding) bs, o#phrase e)
+      | CPGrab (c, x, p)   -> CPGrab (c, x, o#cp_phrase p)
+      | CPGive (c, e, p)   -> CPGive (c, o#option (fun o -> o#phrase) e, o#cp_phrase p)
+      | CPGiveNothing c    -> CPGiveNothing (o#binder c)
+      | CPSelect (c, l, p) -> CPSelect (c, l, o#cp_phrase p)
+      | CPOffer (c, bs)    -> CPOffer (c, o#list (fun o (l, p) -> (l, o#cp_phrase p)) bs)
+      | CPLink (c, d)      -> CPLink (c, d)
+      | CPComp (c, p, q)   -> CPComp (c, o#cp_phrase p, o#cp_phrase q)
 
     method cp_phrase : cp_phrase -> cp_phrase =
       fun {node; pos} -> with_pos (o#position pos) (o#cp_phrasenode node)
 
-    method patternnode : patternnode -> patternnode =
+    method patternnode : Pattern.t -> Pattern.t =
+      let open Pattern in
       function
-      | `Any -> `Any
-      | `Nil -> `Nil
-      | `Cons ((_x, _x_i1)) ->
+      | Any -> Any
+      | Nil -> Nil
+      | Cons ((_x, _x_i1)) ->
           let _x = o#pattern _x in
-          let _x_i1 = o#pattern _x_i1 in `Cons ((_x, _x_i1))
-      | `List _x -> let _x = o#list (fun o -> o#pattern) _x in `List _x
-      | `Variant ((_x, _x_i1)) ->
+          let _x_i1 = o#pattern _x_i1 in Cons ((_x, _x_i1))
+      | List _x -> let _x = o#list (fun o -> o#pattern) _x in List _x
+      | Variant ((_x, _x_i1)) ->
           let _x = o#name _x in
           let _x_i1 = o#option (fun o -> o#pattern) _x_i1
-          in `Variant ((_x, _x_i1))
-      | `Effect (name, ps, k) ->
+          in Variant ((_x, _x_i1))
+      | Effect (name, ps, k) ->
          let name = o#name name in
          let ps = o#list (fun o -> o#pattern) ps in
          let k  = o#pattern k in
-         `Effect (name, ps, k)
-      | `Negative _x ->
+         Effect (name, ps, k)
+      | Negative _x ->
           let _x = o#list (fun o -> o#name) _x
-          in `Negative _x
-      | `Record ((_x, _x_i1)) ->
+          in Negative _x
+      | Record ((_x, _x_i1)) ->
           let _x =
             o#list
               (fun o (_x, _x_i1) ->
@@ -477,37 +481,34 @@ class map =
                  let _x_i1 = o#pattern _x_i1 in (_x, _x_i1))
               _x in
           let _x_i1 = o#option (fun o -> o#pattern) _x_i1
-          in `Record ((_x, _x_i1))
-      | `Tuple _x -> let _x = o#list (fun o -> o#pattern) _x in `Tuple _x
-      | `Constant _x -> let _x = o#constant _x in `Constant _x
-      | `Variable _x -> let _x = o#binder _x in `Variable _x
-      | `As ((_x, _x_i1)) ->
+          in Record ((_x, _x_i1))
+      | Tuple _x -> let _x = o#list (fun o -> o#pattern) _x in Tuple _x
+      | Constant _x -> let _x = o#constant _x in Constant _x
+      | Variable _x -> let _x = o#binder _x in Variable _x
+      | As ((_x, _x_i1)) ->
           let _x = o#binder _x in
-          let _x_i1 = o#pattern _x_i1 in `As ((_x, _x_i1))
-      | `HasType ((_x, _x_i1)) ->
+          let _x_i1 = o#pattern _x_i1 in As ((_x, _x_i1))
+      | HasType ((_x, _x_i1)) ->
           let _x = o#pattern _x in
-          let _x_i1 = o#datatype' _x_i1 in `HasType ((_x, _x_i1))
+          let _x_i1 = o#datatype' _x_i1 in HasType ((_x, _x_i1))
 
-    method pattern : pattern -> pattern =
+    method pattern : Pattern.with_pos -> Pattern.with_pos =
       fun {node; pos} ->
         let node = o#patternnode node in
         let pos = o#position pos in {node; pos}
 
     method name : name -> name = o#string
 
-    method logical_binop : logical_binop -> logical_binop =
-      function | `And -> `And | `Or -> `Or
-
-    method location : location -> location = o#unknown
+    method location : Location.t -> Location.t = o#unknown
 
     method iterpatt : iterpatt -> iterpatt =
       function
-      | `List ((_x, _x_i1)) ->
+      | List ((_x, _x_i1)) ->
           let _x = o#pattern _x in
-          let _x_i1 = o#phrase _x_i1 in `List ((_x, _x_i1))
-      | `Table ((_x, _x_i1)) ->
+          let _x_i1 = o#phrase _x_i1 in List ((_x, _x_i1))
+      | Table ((_x, _x_i1)) ->
           let _x = o#pattern _x in
-          let _x_i1 = o#phrase _x_i1 in `Table ((_x, _x_i1))
+          let _x_i1 = o#phrase _x_i1 in Table ((_x, _x_i1))
 
     method funlit : funlit -> funlit =
       fun (_x, _x_i1) ->
@@ -545,11 +546,11 @@ class map =
         in
         { params with shp_bindings = bindings }
 
-    method fieldspec : fieldspec -> fieldspec =
-      function
-      | `Present _x -> let _x = o#datatype _x in `Present _x
-      | `Absent -> `Absent
-      | `Var _x -> let _x = o#known_type_variable _x in `Var _x
+    method fieldspec : Datatype.fieldspec -> Datatype.fieldspec =
+      let open Datatype in function
+      | Present _x -> let _x = o#datatype _x in Present _x
+      | Absent -> Absent
+      | Var _x -> let _x = o#known_type_variable _x in Var _x
 
     method fieldconstraint : fieldconstraint -> fieldconstraint =
       fun fc -> fc
@@ -559,73 +560,73 @@ class map =
         let _x = o#string _x in
         let _x_i1 = o#list (fun o -> o#string) _x_i1 in (_x, _x_i1)
 
-    method datatypenode : datatypenode -> datatypenode =
+    method datatypenode : Datatype.t -> Datatype.t =
+      let open Datatype in
       function
-      | `TypeVar _x ->
-          let _x = o#known_type_variable _x in `TypeVar _x
-      | `QualifiedTypeApplication (ns, args) ->
+      | TypeVar _x ->
+          let _x = o#known_type_variable _x in TypeVar _x
+      | QualifiedTypeApplication (ns, args) ->
           let ns = o#list (fun o -> o#name) ns in
           let args = o#list (fun o -> o#type_arg) args in
-          `QualifiedTypeApplication (ns, args)
-      | `Function (_x, _x_i1, _x_i2) ->
+          QualifiedTypeApplication (ns, args)
+      | Function (_x, _x_i1, _x_i2) ->
           let _x = o#list (fun o -> o#datatype) _x in
           let _x_i1 = o#row _x_i1 in
-          let _x_i2 = o#datatype _x_i2 in `Function (_x, _x_i1, _x_i2)
-      | `Lolli (_x, _x_i1, _x_i2) ->
+          let _x_i2 = o#datatype _x_i2 in Function (_x, _x_i1, _x_i2)
+      | Lolli (_x, _x_i1, _x_i2) ->
           let _x = o#list (fun o -> o#datatype) _x in
           let _x_i1 = o#row _x_i1 in
-          let _x_i2 = o#datatype _x_i2 in `Lolli (_x, _x_i1, _x_i2)
-      | `Mu (_x, _x_i1) ->
+          let _x_i2 = o#datatype _x_i2 in Lolli (_x, _x_i1, _x_i2)
+      | Mu (_x, _x_i1) ->
           let _x = o#name _x in
-          let _x_i1 = o#datatype _x_i1 in `Mu (_x, _x_i1)
-      | `Forall (_x, _x_i1) ->
-          let _x = _x in (*o#list (fun o -> o#quantifier) _x in*)
-          let _x_i1 = o#datatype _x_i1 in `Forall (_x, _x_i1)
-      | `Unit -> `Unit
-      | `Tuple _x ->
-          let _x = o#list (fun o -> o#datatype) _x in `Tuple _x
-      | `Record _x -> let _x = o#row _x in `Record _x
-      | `Variant _x -> let _x = o#row _x in `Variant _x
-      | `Effect r -> let r = o#row r in `Effect r
-      | `Table (_x, _x_i1, _x_i2) ->
+          let _x_i1 = o#datatype _x_i1 in Mu (_x, _x_i1)
+      | Forall (_x, _x_i1) ->
+          let _x_i1 = o#datatype _x_i1 in Forall (_x, _x_i1)
+      | Unit -> Unit
+      | Tuple _x ->
+          let _x = o#list (fun o -> o#datatype) _x in Tuple _x
+      | Record _x -> let _x = o#row _x in Record _x
+      | Variant _x -> let _x = o#row _x in Variant _x
+      | Effect r -> let r = o#row r in Effect r
+      | Table (_x, _x_i1, _x_i2) ->
          let _x = o#datatype _x in
          let _x_i1 = o#datatype _x_i1 in
-         let _x_i2 = o#datatype _x_i2 in `Table (_x, _x_i1, _x_i2)
-      | `List _x -> let _x = o#datatype _x in `List _x
-      | `TypeApplication _x ->
+         let _x_i2 = o#datatype _x_i2 in Table (_x, _x_i1, _x_i2)
+      | List _x -> let _x = o#datatype _x in List _x
+      | TypeApplication _x ->
           let _x =
             (fun (_x, _x_i1) ->
                let _x = o#name _x in
                let _x_i1 = o#list (fun o -> o#type_arg) _x_i1 in (_x, _x_i1))
               _x
-          in `TypeApplication _x
-      | `Primitive _x -> let _x = o#unknown _x in `Primitive _x
-      | `DB -> `DB
-      | `Input (_x, _x_i1) ->
+          in TypeApplication _x
+      | Primitive _x -> let _x = o#unknown _x in Primitive _x
+      | DB -> DB
+      | Input (_x, _x_i1) ->
         let _x = o#datatype _x in
-        let _x_i1 = o#datatype _x_i1 in `Input (_x, _x_i1)
-      | `Output (_x, _x_i1) ->
+        let _x_i1 = o#datatype _x_i1 in Input (_x, _x_i1)
+      | Output (_x, _x_i1) ->
         let _x = o#datatype _x in
-        let _x_i1 = o#datatype _x_i1 in `Output (_x, _x_i1)
-      | `Select _x ->
-        let _x = o#row _x in `Select _x
-      | `Choice _x ->
-        let _x = o#row _x in `Choice _x
-      | `Dual _x ->
-        let _x = o#datatype _x in `Dual _x
-      | `End -> `End
-
-    method datatype : datatype -> datatype =
+        let _x_i1 = o#datatype _x_i1 in Output (_x, _x_i1)
+      | Select _x ->
+        let _x = o#row _x in Select _x
+      | Choice _x ->
+        let _x = o#row _x in Choice _x
+      | Dual _x ->
+        let _x = o#datatype _x in Dual _x
+      | End -> End
+
+    method datatype : Datatype.with_pos -> Datatype.with_pos =
       fun {node; pos} ->
         let node = o#datatypenode node in
         let pos  = o#position pos in
         {node; pos}
 
-    method type_arg : type_arg -> type_arg =
-      function
-      | `Type _x -> let _x = o#datatype _x in `Type _x
-      | `Row _x -> let _x = o#row _x in `Row _x
-      | `Presence _x -> let _x = o#fieldspec _x in `Presence _x
+    method type_arg : Datatype.type_arg -> Datatype.type_arg =
+      let open Datatype in function
+      | Type _x -> let _x = o#datatype _x in Type _x
+      | Row _x -> let _x = o#row _x in Row _x
+      | Presence _x -> let _x = o#fieldspec _x in Presence _x
 
     method constant : constant -> constant =
       function
@@ -635,34 +636,35 @@ class map =
       | `Bool _x -> let _x = o#bool _x in `Bool _x
       | `Char _x -> let _x = o#char _x in `Char _x
 
-    method binop : binop -> binop =
-      function
-      | `Minus -> `Minus
-      | `FloatMinus -> `FloatMinus
-      | `RegexMatch _x ->
-          let _x = o#list (fun o -> o#regexflag) _x in `RegexMatch _x
-      | (#logical_binop as x) -> (o#logical_binop x :> binop)
-      | `Cons -> `Cons
-      | `Name _x -> let _x = o#name _x in `Name _x
-
-    method tybinop : tyarg list * binop -> tyarg list * binop =
+    method binop : BinaryOp.t -> BinaryOp.t =
+      let open BinaryOp in function
+      | Minus -> Minus
+      | FloatMinus -> FloatMinus
+      | RegexMatch _x ->
+          let _x = o#list (fun o -> o#regexflag) _x in RegexMatch _x
+      | And -> And
+      | Or -> Or
+      | Cons -> Cons
+      | Name _x -> let _x = o#name _x in Name _x
+
+    method tybinop : tyarg list * BinaryOp.t -> tyarg list * BinaryOp.t =
       fun (_x, _x_i1) -> (_x, o#binop _x_i1)
 
     method bindingnode : bindingnode -> bindingnode =
       function
-      | `Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
+      | Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
           let _x    = o#pattern _x in
           let _x_i2 = o#phrase _x_i2 in
           let _x_i3 = o#location _x_i3 in
           let _x_i4 = o#option (fun o -> o#datatype') _x_i4
-          in `Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4))
-      | `Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
+          in Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4))
+      | Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
           let _x = o#binder _x in
           let _x_i2 = o#funlit _x_i2 in
           let _x_i3 = o#location _x_i3 in
           let _x_i4 = o#option (fun o -> o#datatype') _x_i4
-          in `Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4))
-      | `Funs _x ->
+          in Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4))
+      | Funs _x ->
           let _x =
             o#list
               (fun o (_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4, _x_i5) ->
@@ -673,23 +675,23 @@ class map =
                  let _x_i5 = o#position _x_i5
                  in (_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4, _x_i5))
               _x
-          in `Funs _x
-      | `Handler (b, hnlit, t) ->
+          in Funs _x
+      | Handler (b, hnlit, t) ->
           let b = o#binder b in
           let hnlit = o#handlerlit hnlit in
           let t     = o#option (fun o -> o#unknown) t in
-          `Handler (b, hnlit, t)
-      | `Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
+          Handler (b, hnlit, t)
+      | Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
           let _x = o#binder _x in
           let _x_i1 = o#name _x_i1 in
           let _x_i2 = o#name _x_i2 in
           let _x_i3 = o#name _x_i3 in
           let _x_i4 = o#datatype' _x_i4 in
-          `Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4))
-      | `QualifiedImport _xs ->
+          Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4))
+      | QualifiedImport _xs ->
           let _xs = o#list (fun o -> o#name) _xs in
-          `QualifiedImport _xs
-      | `Type ((_x, _x_i1, _x_i2)) ->
+          QualifiedImport _xs
+      | Type ((_x, _x_i1, _x_i2)) ->
           let _x = o#name _x in
           let _x_i1 =
             o#list
@@ -698,21 +700,21 @@ class map =
                  let _x_i1 = o#unknown _x_i1
                  in (_x, _x_i1))
               _x_i1
-          in let _x_i2 = o#datatype' _x_i2 in `Type ((_x, _x_i1, _x_i2))
-      | `Infix -> `Infix
-      | `Exp _x -> let _x = o#phrase _x in `Exp _x
-      | `Module (n, bs) ->
+          in let _x_i2 = o#datatype' _x_i2 in Type ((_x, _x_i1, _x_i2))
+      | Infix -> Infix
+      | Exp _x -> let _x = o#phrase _x in Exp _x
+      | Module (n, bs) ->
           let n = o#name n in
           let bs = o#list (fun o -> o#binding) bs in
-          `Module (n, bs)
-      | `AlienBlock (lang, lib, dts) ->
+          Module (n, bs)
+      | AlienBlock (lang, lib, dts) ->
           let lang = o#name lang in
           let lib = o#name lib in
           let dts = o#list (fun o (b, dt) ->
             let b = o#binder b in
             let dt = o#datatype' dt in
             (b, dt)) dts in
-          `AlienBlock (lang, lib, dts)
+          AlienBlock (lang, lib, dts)
 
     method binding : binding -> binding =
       fun {node; pos} ->
@@ -752,13 +754,13 @@ class fold =
 
     method bool : bool -> 'self_type = function | false -> o | true -> o
 
-    method unary_op : unary_op -> 'self_type =
-      function
-      | `Minus -> o
-      | `FloatMinus -> o
-      | `Name _x -> let o = o#name _x in o
+    method unary_op : UnaryOp.t -> 'self_type =
+      let open UnaryOp in function
+      | Minus -> o
+      | FloatMinus -> o
+      | Name _x -> let o = o#name _x in o
 
-    method tyunary_op : tyarg list * unary_op -> 'self_type =
+    method tyunary_op : tyarg list * UnaryOp.t -> 'self_type =
       fun (_x, _x_i1) -> o#unary_op _x_i1
 
     method binder : binder -> 'self_type =
@@ -773,12 +775,12 @@ class fold =
       | Expression _x -> let o = o#phrase _x in o
       | Directive _x -> let o = o#directive _x in o
 
-    method sec : sec -> 'self_type =
-      function
-      | `Minus -> o
-      | `FloatMinus -> o
-      | `Project _x -> let o = o#name _x in o
-      | `Name _x -> let o = o#name _x in o
+    method section : Section.t -> 'self_type =
+      let open Section in function
+      | Minus -> o
+      | FloatMinus -> o
+      | Project _x -> let o = o#name _x in o
+      | Name _x -> let o = o#name _x in o
 
     method subkind : subkind -> 'self_type = fun _ -> o
 
@@ -798,15 +800,15 @@ class fold =
         let o = o#option (fun o -> o#subkind) _x_i1 in
         let o = o#freedom _x_i2 in o
 
-    method row_var : row_var -> 'self_type =
-      function
-      | `Closed -> o
-      | `Open _x ->
+    method row_var : Datatype.row_var -> 'self_type =
+      let open Datatype in function
+      | Closed -> o
+      | Open _x ->
           let o = o#known_type_variable _x in o
-      | `Recursive ((_x, _x_i1)) ->
+      | Recursive ((_x, _x_i1)) ->
           let o = o#name _x in let o = o#row _x_i1 in o
 
-    method row : row -> 'self_type =
+    method row : Datatype.row -> 'self_type =
       fun (_x, _x_i1) ->
         let o =
           o#list
@@ -817,8 +819,8 @@ class fold =
 
     method replace_rhs : replace_rhs -> 'self_type =
       function
-      | `Literal _x -> let o = o#string _x in o
-      | `Splice _x -> let o = o#phrase _x in o
+      | Literal    _x -> let o = o#string _x in o
+      | SpliceExpr _x -> let o = o#phrase _x in o
 
     method regexflag : regexflag -> 'self_type =
       fun _ -> o
@@ -860,18 +862,18 @@ class fold =
 
     method phrasenode : phrasenode -> 'self_type =
       function
-      | `Constant _x -> let o = o#constant _x in o
-      | `Var _x -> let o = o#name _x in o
-      | `QualifiedVar _xs ->
+      | Constant _x -> let o = o#constant _x in o
+      | Var _x -> let o = o#name _x in o
+      | QualifiedVar _xs ->
           let o = o#list (fun o -> o#name) _xs in o
-      | `FunLit (_x, _x1, _x_i1, _x_i2) -> let o = o#funlit _x_i1 in let _x_i2 = o#location _x_i2 in o
-      | `HandlerLit hnlit ->
+      | FunLit (_x, _x1, _x_i1, _x_i2) -> let o = o#funlit _x_i1 in let _x_i2 = o#location _x_i2 in o
+      | HandlerLit hnlit ->
 	 let o = o#handlerlit hnlit in o
-      | `Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt) ->
+      | Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt) ->
           let o = o#given_spawn_location _given_spawn_location in
           let o = o#phrase _block_phr in
           o
-      | `Query (_x, _x_i1, _x_i2) ->
+      | Query (_x, _x_i1, _x_i2) ->
           let o =
             o#option
               (fun o (_x, _x_i1) ->
@@ -879,48 +881,48 @@ class fold =
                  let o = o#phrase _x_i1 in o)
               _x in
           let o = o#phrase _x_i1 in o
-      | `ListLit (_x, _x_i1) -> let o = o#list (fun o -> o#phrase) _x in o
-      | `Iteration ((_x, _x_i1, _x_i2, _x_i3)) ->
+      | ListLit (_x, _x_i1) -> let o = o#list (fun o -> o#phrase) _x in o
+      | Iteration ((_x, _x_i1, _x_i2, _x_i3)) ->
           let o = o#list (fun o -> o#iterpatt) _x in
           let o = o#phrase _x_i1 in
           let o = o#option (fun o -> o#phrase) _x_i2 in
           let o = o#option (fun o -> o#phrase) _x_i3 in o
-      | `Escape ((_x, _x_i1)) ->
+      | Escape ((_x, _x_i1)) ->
           let o = o#binder _x in let o = o#phrase _x_i1 in o
-      | `Section _x -> let o = o#sec _x in o
-      | `Conditional ((_x, _x_i1, _x_i2)) ->
+      | Section _x -> let o = o#section _x in o
+      | Conditional ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           let o = o#phrase _x_i1 in let o = o#phrase _x_i2 in o
-      | `Block ((_x, _x_i1)) ->
+      | Block ((_x, _x_i1)) ->
           let o = o#list (fun o -> o#binding) _x in
           let o = o#phrase _x_i1 in o
-      | `InfixAppl ((_x, _x_i1, _x_i2)) ->
+      | InfixAppl ((_x, _x_i1, _x_i2)) ->
           let o = o#tybinop _x in
           let o = o#phrase _x_i1 in let o = o#phrase _x_i2 in o
-      | `RangeLit ((_x_i1, _x_i2)) ->
+      | RangeLit ((_x_i1, _x_i2)) ->
           let o = o#phrase _x_i1 in let o = o#phrase _x_i2 in o
-      | `Regex _x -> let o = o#regex _x in o
-      | `UnaryAppl ((_x, _x_i1)) ->
+      | Regex _x -> let o = o#regex _x in o
+      | UnaryAppl ((_x, _x_i1)) ->
           let o = o#tyunary_op _x in let o = o#phrase _x_i1 in o
-      | `FnAppl ((_x, _x_i1)) ->
+      | FnAppl ((_x, _x_i1)) ->
           let o = o#phrase _x in
           let o = o#list (fun o -> o#phrase) _x_i1 in o
-      | `TAbstr ((_x, _x_i1)) ->
+      | TAbstr ((_x, _x_i1)) ->
           let o = o#list (fun o -> o#tyvar) (Types.unbox_quantifiers _x) in
           let o = o#phrase _x_i1 in o
-      | `TAppl ((_x, _x_i1)) ->
+      | TAppl ((_x, _x_i1)) ->
           let o = o#phrase _x in o
-      | `TupleLit _x -> let o = o#list (fun o -> o#phrase) _x in o
-      | `RecordLit ((_x, _x_i1)) ->
+      | TupleLit _x -> let o = o#list (fun o -> o#phrase) _x in o
+      | RecordLit ((_x, _x_i1)) ->
           let o =
             o#list
               (fun o (_x, _x_i1) ->
                  let o = o#name _x in let o = o#phrase _x_i1 in o)
               _x in
           let o = o#option (fun o -> o#phrase) _x_i1 in o
-      | `Projection ((_x, _x_i1)) ->
+      | Projection ((_x, _x_i1)) ->
           let o = o#phrase _x in let o = o#name _x_i1 in o
-      | `With ((_x, _x_i1)) ->
+      | With ((_x, _x_i1)) ->
           let o = o#phrase _x in
           let o =
             o#list
@@ -928,19 +930,19 @@ class fold =
                  let o = o#name _x in let o = o#phrase _x_i1 in o)
               _x_i1
           in o
-      | `TypeAnnotation ((_x, _x_i1)) ->
+      | TypeAnnotation ((_x, _x_i1)) ->
           let o = o#phrase _x in let o = o#datatype' _x_i1 in o
-      | `Upcast ((_x, _x_i1, _x_i2)) ->
+      | Upcast ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           let o = o#datatype' _x_i1 in let o = o#datatype' _x_i2 in o
-      | `ConstructorLit ((_x, _x_i1, _x_i2)) ->
+      | ConstructorLit ((_x, _x_i1, _x_i2)) ->
           let o = o#name _x in
           let o = o#option (fun o -> o#phrase) _x_i1 in o
-      | `DoOperation (name,ps,t) ->
+      | DoOperation (name,ps,t) ->
          let o = o#name name in
 	 let o = o#option (fun o -> o#unknown) t in
 	 let o = o#list (fun o -> o#phrase) ps in o
-      | `Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
+      | Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
          let o = o#phrase sh_expr in
          let o =
            o#option (fun o -> o#handle_params) sh_descr.shd_params
@@ -961,7 +963,7 @@ class fold =
 	     )
              sh_value_cases
 	 in o
-      | `Switch ((_x, _x_i1, _x_i2)) ->
+      | Switch ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           let o =
             o#list
@@ -970,7 +972,7 @@ class fold =
               _x_i1 in
           let o = o#option (fun o -> o#unknown) _x_i2
           in o
-      | `Receive ((_x, _x_i1)) ->
+      | Receive ((_x, _x_i1)) ->
           let o =
             o#list
               (fun o (_x, _x_i1) ->
@@ -978,15 +980,15 @@ class fold =
               _x in
           let o = o#option (fun o -> o#unknown) _x_i1
           in o
-      (* | `Link ((_x, _x_i1)) -> *)
+      (* | Link ((_x, _x_i1)) -> *)
       (*     let o = o#phrase _x in *)
       (*     let o = o#phrase _x_i1 *)
       (*     in o *)
-      | `Select ((_x, _x_i1)) ->
+      | Select ((_x, _x_i1)) ->
           let o = o#name _x in
           let o = o#phrase _x_i1
           in o
-      | `Offer ((_x, _x_i1, _x_i2)) ->
+      | Offer ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           let o =
             o#list
@@ -995,8 +997,8 @@ class fold =
               _x_i1 in
           let o = o#option (fun o -> o#unknown) _x_i2
           in o
-      | `CP p -> o#cp_phrase p
-      | `DatabaseLit ((_x, _x_i1)) ->
+      | CP p -> o#cp_phrase p
+      | DatabaseLit ((_x, _x_i1)) ->
           let o = o#phrase _x in
           let o =
             (fun (_x, _x_i1) ->
@@ -1004,7 +1006,7 @@ class fold =
                let o = o#option (fun o -> o#phrase) _x_i1 in o)
               _x_i1
           in o
-      | `TableLit ((_x, (y,z), _x_i2, _x_i3, _x_i4)) ->
+      | TableLit ((_x, (y,z), _x_i2, _x_i3, _x_i4)) ->
           let o = o#phrase _x in
           let o = o#datatype y in
           let o = o#option
@@ -1020,55 +1022,55 @@ class fold =
           let o = o#phrase _x_i3 in
 	  let o = o#phrase _x_i4 in
 	    o
-      | `LensLit ((_x, _x_i1)) ->
+      | LensLit ((_x, _x_i1)) ->
           let o = o#phrase _x in
           let o = o#option (fun o -> o#unknown) _x_i1 in
             o
-      | `LensKeysLit ((_x, _x_i1, _x_i2)) ->
+      | LensKeysLit ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           let o = o#phrase _x_i1 in
           let o = o#option (fun o -> o#unknown) _x_i2 in
             o
-      | `LensFunDepsLit ((_x, _x_i1, _x_i2)) ->
+      | LensFunDepsLit ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           let o = o#option (fun o -> o#unknown) _x_i2 in
             o
-      | `LensDropLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
+      | LensDropLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
           let o = o#phrase _x in
           let o = o#string _x_i1 in
           let o = o#string _x_i2 in
           let o = o#phrase _x_i3 in
           let o = o#option (fun o -> o#unknown) _x_i4 in
             o
-      | `LensSelectLit ((_x, _x_i1, _x_i2)) ->
+      | LensSelectLit ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           (* let o = o#phrase _x_i1 in *)
           let o = o#option (fun o -> o#unknown) _x_i2 in
             o
-      | `LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5)) ->
+      | LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5)) ->
           let o = o#phrase _x in
           let o = o#phrase _x_i1 in
           let o = o#phrase _x_i2 in
           let o = o#option (fun o -> o#unknown) _x_i5 in
             o
-      | `LensGetLit ((_x, _x_i1)) ->
+      | LensGetLit ((_x, _x_i1)) ->
           let o = o#phrase _x in
           let o = o#option (fun o -> o#unknown) _x_i1 in
             o
-      | `LensPutLit ((_x, _x_i1, _x_i2)) ->
+      | LensPutLit ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           let o = o#phrase _x_i1 in
           let o = o#option (fun o -> o#unknown) _x_i2 in
             o
-      | `DBDelete ((_x, _x_i1, _x_i2)) ->
+      | DBDelete ((_x, _x_i1, _x_i2)) ->
           let o = o#pattern _x in
           let o = o#phrase _x_i1 in
           let o = o#option (fun o -> o#phrase) _x_i2 in o
-      | `DBInsert ((_x, _x_i1, _x_i2, _x_i3)) ->
+      | DBInsert ((_x, _x_i1, _x_i2, _x_i3)) ->
           let o = o#phrase _x in
           let o = o#list (fun o -> o#name) _x_i1 in
           let o = o#phrase _x_i2 in let o = o#option (fun o -> o#phrase) _x_i3 in o
-      | `DBUpdate ((_x, _x_i1, _x_i2, _x_i3)) ->
+      | DBUpdate ((_x, _x_i1, _x_i2, _x_i3)) ->
           let o = o#pattern _x in
           let o = o#phrase _x_i1 in
           let o = o#option (fun o -> o#phrase) _x_i2 in
@@ -1078,7 +1080,7 @@ class fold =
                  let o = o#name _x in let o = o#phrase _x_i1 in o)
               _x_i3
           in o
-      | `Xml ((_x, _x_i1, _x_i2, _x_i3)) ->
+      | Xml ((_x, _x_i1, _x_i2, _x_i3)) ->
           let o = o#name _x in
           let o =
             o#list
@@ -1088,23 +1090,23 @@ class fold =
               _x_i1 in
           let o = o#option (fun o -> o#phrase) _x_i2 in
           let o = o#list (fun o -> o#phrase) _x_i3 in o
-      | `TextNode _x -> let o = o#string _x in o
-      | `Formlet ((_x, _x_i1)) ->
+      | TextNode _x -> let o = o#string _x in o
+      | Formlet ((_x, _x_i1)) ->
           let o = o#phrase _x in let o = o#phrase _x_i1 in o
-      | `Page _x -> let o = o#phrase _x in o
-      | `FormletPlacement ((_x, _x_i1, _x_i2)) ->
+      | Page _x -> let o = o#phrase _x in o
+      | FormletPlacement ((_x, _x_i1, _x_i2)) ->
           let o = o#phrase _x in
           let o = o#phrase _x_i1 in let o = o#phrase _x_i2 in o
-      | `PagePlacement _x -> let o = o#phrase _x in o
-      | `FormBinding ((_x, _x_i1)) ->
+      | PagePlacement _x -> let o = o#phrase _x in o
+      | FormBinding ((_x, _x_i1)) ->
           let o = o#phrase _x in let o = o#pattern _x_i1 in o
-      | `TryInOtherwise (_p1, _pat, _p2, _p3, _ty) ->
+      | TryInOtherwise (_p1, _pat, _p2, _p3, _ty) ->
           let o = o#phrase _p1 in
           let o = o#pattern _pat in
           let o = o#phrase _p2 in
           let o = o#phrase _p3 in
           o
-      | `Raise -> o
+      | Raise -> o
 
     method phrase : phrase -> 'self_type =
       fun {node; pos} ->
@@ -1112,51 +1114,52 @@ class fold =
 
     method cp_phrasenode : cp_phrasenode -> 'self_type =
       function
-      | Unquote (bs, e)    -> (o#list (fun o -> o#binding) bs)#phrase e
-      | Grab (_c, _x, p)   -> o#cp_phrase p
-      | Give (_c, e, p)    -> (o#option (fun o -> o#phrase) e)#cp_phrase p
-      | GiveNothing c      -> o#binder c
-      | Select (_c, _l, p) -> o#cp_phrase p
-      | Offer (_c, bs)     -> o#list (fun o (_l, b) -> o#cp_phrase b) bs
-      | Link (_c, _d)      -> o
-      | Comp (_c, p, q)    -> (o#cp_phrase p)#cp_phrase q
+      | CPUnquote (bs, e)    -> (o#list (fun o -> o#binding) bs)#phrase e
+      | CPGrab (_c, _x, p)   -> o#cp_phrase p
+      | CPGive (_c, e, p)    -> (o#option (fun o -> o#phrase) e)#cp_phrase p
+      | CPGiveNothing c      -> o#binder c
+      | CPSelect (_c, _l, p) -> o#cp_phrase p
+      | CPOffer (_c, bs)     -> o#list (fun o (_l, b) -> o#cp_phrase b) bs
+      | CPLink (_c, _d)      -> o
+      | CPComp (_c, p, q)    -> (o#cp_phrase p)#cp_phrase q
 
     method cp_phrase : cp_phrase -> 'self_node =
       fun {node; pos} -> (o#cp_phrasenode node)#position pos
 
-    method patternnode : patternnode -> 'self_type =
+    method patternnode : Pattern.t -> 'self_type =
+      let open Pattern in
       function
-      | `Any -> o
-      | `Nil -> o
-      | `Cons ((_x, _x_i1)) ->
+      | Any -> o
+      | Nil -> o
+      | Cons ((_x, _x_i1)) ->
           let o = o#pattern _x in let o = o#pattern _x_i1 in o
-      | `List _x -> let o = o#list (fun o -> o#pattern) _x in o
-      | `Variant ((_x, _x_i1)) ->
+      | List _x -> let o = o#list (fun o -> o#pattern) _x in o
+      | Variant ((_x, _x_i1)) ->
           let o = o#name _x in
           let o = o#option (fun o -> o#pattern) _x_i1 in o
-      | `Effect (name, ps, k) ->
+      | Effect (name, ps, k) ->
          let o = o#name name in
          let o = o#list (fun o -> o#pattern) ps in
          let o = o#pattern k in
          o
-      | `Negative _x ->
+      | Negative _x ->
           let o = o#list (fun o -> o#name) _x in o
-      | `Record ((_x, _x_i1)) ->
+      | Record ((_x, _x_i1)) ->
           let o =
             o#list
               (fun o (_x, _x_i1) ->
                  let o = o#name _x in let o = o#pattern _x_i1 in o)
               _x in
           let o = o#option (fun o -> o#pattern) _x_i1 in o
-      | `Tuple _x -> let o = o#list (fun o -> o#pattern) _x in o
-      | `Constant _x -> let o = o#constant _x in o
-      | `Variable _x -> let o = o#binder _x in o
-      | `As ((_x, _x_i1)) ->
+      | Tuple _x -> let o = o#list (fun o -> o#pattern) _x in o
+      | Constant _x -> let o = o#constant _x in o
+      | Variable _x -> let o = o#binder _x in o
+      | As ((_x, _x_i1)) ->
           let o = o#binder _x in let o = o#pattern _x_i1 in o
-      | `HasType ((_x, _x_i1)) ->
+      | HasType ((_x, _x_i1)) ->
           let o = o#pattern _x in let o = o#datatype' _x_i1 in o
 
-    method pattern : pattern -> 'self_type =
+    method pattern : Pattern.with_pos -> 'self_type =
       fun {node; pos} ->
         let o = o#patternnode node in
         let o = o#position pos in
@@ -1164,16 +1167,13 @@ class fold =
 
     method name : name -> 'self_type = o#string
 
-    method logical_binop : logical_binop -> 'self_type =
-      function | `And -> o | `Or -> o
-
-    method location : location -> 'self_type = o#unknown
+    method location : Location.t -> 'self_type = o#unknown
 
     method iterpatt : iterpatt -> 'self_type =
       function
-      | `List ((_x, _x_i1)) ->
+      | List ((_x, _x_i1)) ->
           let o = o#pattern _x in let o = o#phrase _x_i1 in o
-      | `Table ((_x, _x_i1)) ->
+      | Table ((_x, _x_i1)) ->
           let o = o#pattern _x in let o = o#phrase _x_i1 in o
 
     method funlit : funlit -> 'self_type =
@@ -1208,11 +1208,11 @@ class fold =
             o#pattern pat)
           params.shp_bindings
 
-    method fieldspec : fieldspec -> 'self_type =
-      function
-      | `Present _x -> let o = o#datatype _x in o
-      | `Absent -> o
-      | `Var _x -> let o = o#known_type_variable _x in o
+    method fieldspec : Datatype.fieldspec -> 'self_type =
+      let open Datatype in function
+      | Present _x -> let o = o#datatype _x in o
+      | Absent -> o
+      | Var _x -> let o = o#known_type_variable _x in o
 
     method fieldconstraint : fieldconstraint -> 'self_type =
       fun _ -> o
@@ -1223,66 +1223,67 @@ class fold =
 
     method tyvar : tyvar -> 'self_type = fun _ -> o
 
-    method datatypenode : datatypenode -> 'self_type =
+    method datatypenode : Datatype.t -> 'self_type =
+      let open Datatype in
       function
-      | `TypeVar _x ->
+      | TypeVar _x ->
           let o = o#known_type_variable _x in o
-      | `QualifiedTypeApplication (ns, args) ->
+      | QualifiedTypeApplication (ns, args) ->
           let o = o#list (fun o -> o#name) ns in
           let o = o#list (fun o -> o#type_arg) args in
           o
-      | `Function (_x, _x_i1, _x_i2) ->
+      | Function (_x, _x_i1, _x_i2) ->
           let o = o#list (fun o -> o#datatype) _x in
           let o = o#row _x_i1 in let o = o#datatype _x_i2 in o
-      | `Lolli (_x, _x_i1, _x_i2) ->
+      | Lolli (_x, _x_i1, _x_i2) ->
           let o = o#list (fun o -> o#datatype) _x in
           let o = o#row _x_i1 in let o = o#datatype _x_i2 in o
-      | `Mu (_x, _x_i1) ->
+      | Mu (_x, _x_i1) ->
           let o = o#name _x in let o = o#datatype _x_i1 in o
-      | `Forall (_x, _x_i1) ->
-          let o = o (*o#list (fun o -> o#quantifier) _x*) in let o = o#datatype _x_i1 in o
-      | `Unit -> o
-      | `Tuple _x -> let o = o#list (fun o -> o#datatype) _x in o
-      | `Record _x -> let o = o#row _x in o
-      | `Variant _x -> let o = o#row _x in o
-      | `Effect r -> let o = o#row r in o
-      | `Table (_x, _x_i1, _x_i2) ->
+      | Forall (_x, _x_i1) ->
+          let o = o#datatype _x_i1 in o
+      | Unit -> o
+      | Tuple _x -> let o = o#list (fun o -> o#datatype) _x in o
+      | Record _x -> let o = o#row _x in o
+      | Variant _x -> let o = o#row _x in o
+      | Effect r -> let o = o#row r in o
+      | Table (_x, _x_i1, _x_i2) ->
           let o = o#datatype _x in let o = o#datatype _x_i1 in let o = o#datatype _x_i2 in o
-      | `List _x -> let o = o#datatype _x in o
-      | `TypeApplication _x ->
+      | List _x -> let o = o#datatype _x in o
+      | TypeApplication _x ->
           let o =
             (fun (_x, _x_i1) ->
                let o = o#name _x in
                let o = o#list (fun o -> o#type_arg) _x_i1 in o)
               _x
           in o
-      | `Primitive _x -> let o = o#unknown _x in o
-      | `DB -> o
-      | `Input (_x, _x_i1) ->
+      | Primitive _x -> let o = o#unknown _x in o
+      | DB -> o
+      | Input (_x, _x_i1) ->
         let o = o#datatype _x in
         let o = o#datatype _x_i1 in o
-      | `Output (_x, _x_i1) ->
+      | Output (_x, _x_i1) ->
         let o = o#datatype _x in
         let o = o#datatype _x_i1 in o
-      | `Select _x ->
+      | Select _x ->
         let o = o#row _x in o
-      | `Choice _x ->
+      | Choice _x ->
         let o = o#row _x in o
-      | `Dual _x ->
+      | Dual _x ->
         let o = o#datatype _x in o
-      | `End -> o
+      | End -> o
 
-    method datatype : datatype -> 'self_type =
+    method datatype : Datatype.with_pos -> 'self_type =
       fun {node; pos} ->
         let o = o#datatypenode node in
         let o = o#position pos in
         o
 
-    method type_arg : type_arg -> 'self_type =
-      function
-      | `Type _x -> let o = o#datatype _x in o
-      | `Row _x -> let o = o#row _x in o
-      | `Presence _x -> let o = o#fieldspec _x in o
+    method type_arg : Datatype.type_arg -> 'self_type =
+      let open Datatype in function
+      | Type _x -> let o = o#datatype _x in o
+      | Row _x -> let o = o#row _x in o
+      | Presence _x -> let o = o#fieldspec _x in o
 
     method constant : constant -> 'self_type =
       function
@@ -1292,33 +1293,34 @@ class fold =
       | `Bool _x -> let o = o#bool _x in o
       | `Char _x -> let o = o#char _x in o
 
-    method binop : binop -> 'self_type =
-      function
-      | `Minus -> o
-      | `FloatMinus -> o
-      | `RegexMatch _x -> let o = o#list (fun o -> o#regexflag) _x in o
-      | (#logical_binop as x) -> o#logical_binop x
-      | `Cons -> o
-      | `Name _x -> let o = o#name _x in o
-
-    method tybinop : tyarg list * binop -> 'self_type =
+    method binop : BinaryOp.t -> 'self_type =
+      let open BinaryOp in function
+      | Minus -> o
+      | FloatMinus -> o
+      | RegexMatch _x -> let o = o#list (fun o -> o#regexflag) _x in o
+      | And -> o
+      | Or -> o
+      | Cons -> o
+      | Name _x -> let o = o#name _x in o
+
+    method tybinop : tyarg list * BinaryOp.t -> 'self_type =
       fun (_x, _x_i1) -> o#binop _x_i1
 
     method bindingnode : bindingnode -> 'self_type =
       function
-      | `Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
+      | Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
           let o = o#pattern _x in
           let o = o#list (fun o -> o#tyvar) _x_i1 in
           let o = o#phrase _x_i2 in
           let o = o#location _x_i3 in
           let o = o#option (fun o -> o#datatype') _x_i4 in o
-      | `Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
+      | Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
           let o = o#binder _x in
           let o = o#list (fun o -> o#tyvar) _x_i1 in
           let o = o#funlit _x_i2 in
           let o = o#location _x_i3 in
           let o = o#option (fun o -> o#datatype') _x_i4 in o
-      | `Funs _x ->
+      | Funs _x ->
           let o =
             o#list
               (fun o (_x, _x1, ((_x_i1, _), _x_i2), _x_i3, _x_i4, _x_i5) ->
@@ -1330,20 +1332,20 @@ class fold =
                  let o = o#position _x_i5 in o)
               _x
           in o
-      | `Handler (b, hnlit, t) ->
+      | Handler (b, hnlit, t) ->
           let o = o#binder b in
           let o = o#handlerlit hnlit in
           let o = o#option (fun o -> o#unknown) t in o
-      | `Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
+      | Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
           let o = o#binder _x in
           let o = o#name _x_i1 in
           let o = o#name _x_i2 in
           let o = o#name _x_i3 in
           let o = o#datatype' _x_i4 in o
-      | `QualifiedImport _xs ->
+      | QualifiedImport _xs ->
           let o = o#list (fun o -> o#name) _xs in
           o
-      | `Type ((_x, _x_i1, _x_i2)) ->
+      | Type ((_x, _x_i1, _x_i2)) ->
           let o = o#name _x in
           let o =
             o#list
@@ -1353,13 +1355,13 @@ class fold =
                  in o)
               _x_i1
           in let o = o#datatype' _x_i2 in o
-      | `Infix -> o
-      | `Exp _x -> let o = o#phrase _x in o
-      | `Module (n, bs) ->
+      | Infix -> o
+      | Exp _x -> let o = o#phrase _x in o
+      | Module (n, bs) ->
           let o = o#name n in
           let o = o#list (fun o -> o#binding) bs in
           o
-      | `AlienBlock (lang, lib, dts) ->
+      | AlienBlock (lang, lib, dts) ->
           let o = o#name lang in
           let o = o#name lib in
           let o = o#list (fun o (b, dt)->
@@ -1421,13 +1423,13 @@ class fold_map =
     method bool : bool -> ('self_type * bool) =
       function | false -> (o, false) | true -> (o, true)
 
-    method unary_op : unary_op -> ('self_type * unary_op) =
-      function
-      | `Minus -> (o, `Minus)
-      | `FloatMinus -> (o, `FloatMinus)
-      | `Name _x -> let (o, _x) = o#name _x in (o, (`Name _x))
+    method unary_op : UnaryOp.t -> ('self_type * UnaryOp.t) =
+      let open UnaryOp in function
+      | Minus -> (o, Minus)
+      | FloatMinus -> (o, FloatMinus)
+      | Name _x -> let (o, _x) = o#name _x in (o, Name _x)
 
-    method tyunary_op : tyarg list * unary_op -> 'self_type * (tyarg list * unary_op) =
+    method tyunary_op : tyarg list * UnaryOp.t -> 'self_type * (tyarg list * UnaryOp.t) =
       fun (_x, _x_i1) ->
         let (o, _x_i1) = o#unary_op _x_i1 in (o, (_x, _x_i1))
 
@@ -1439,12 +1441,12 @@ class fold_map =
       | Expression _x -> let (o, _x) = o#phrase _x in (o, Expression _x)
       | Directive _x -> let (o, _x) = o#directive _x in (o, Directive _x)
 
-    method sec : sec -> ('self_type * sec) =
-      function
-      | `Minus -> (o, `Minus)
-      | `FloatMinus -> (o, `FloatMinus)
-      | `Project _x -> let (o, _x) = o#name _x in (o, (`Project _x))
-      | `Name _x -> let (o, _x) = o#name _x in (o, (`Name _x))
+    method section : Section.t -> ('self_type * Section.t) =
+      let open Section in function
+      | Minus -> (o, Minus)
+      | FloatMinus -> (o, FloatMinus)
+      | Project _x -> let (o, _x) = o#name _x in (o, Project _x)
+      | Name _x -> let (o, _x) = o#name _x in (o, Name _x)
 
     method subkind : subkind -> ('self_type * subkind) = fun k -> (o, k)
 
@@ -1464,16 +1466,16 @@ class fold_map =
         let (o, _x_i1) = o#option (fun o -> o#subkind) _x_i1 in
         let (o, _x_i2) = o#freedom _x_i2 in (o, (_x, _x_i1, _x_i2))
 
-    method row_var : row_var -> ('self_type * row_var) =
-      function
-      | `Closed -> (o, `Closed)
-      | `Open _x ->
-          let (o, _x) = o#known_type_variable _x in (o, (`Open _x))
-      | `Recursive ((_x, _x_i1)) ->
+    method row_var : Datatype.row_var -> ('self_type * Datatype.row_var) =
+      let open Datatype in function
+      | Closed -> (o, Closed)
+      | Open _x ->
+          let (o, _x) = o#known_type_variable _x in (o, (Open _x))
+      | Recursive ((_x, _x_i1)) ->
           let (o, _x) = o#name _x in
-          let (o, _x_i1) = o#row _x_i1 in (o, (`Recursive ((_x, _x_i1))))
+          let (o, _x_i1) = o#row _x_i1 in (o, Recursive ((_x, _x_i1)))
 
-    method row : row -> ('self_type * row) =
+    method row : Datatype.row -> ('self_type * Datatype.row) =
       fun (_x, _x_i1) ->
         let (o, _x) =
           o#list
@@ -1485,8 +1487,8 @@ class fold_map =
 
     method replace_rhs : replace_rhs -> ('self_type * replace_rhs) =
       function
-      | `Literal _x -> let (o, _x) = o#string _x in (o, (`Literal _x))
-      | `Splice _x -> let (o, _x) = o#phrase _x in (o, (`Splice _x))
+      | Literal    _x -> let (o, _x) = o#string _x in (o, (Literal _x))
+      | SpliceExpr _x -> let (o, _x) = o#phrase _x in (o, (SpliceExpr _x))
 
     method regexflag : regexflag -> ('self_type * regexflag) =
       fun flag -> (o, flag)
@@ -1535,73 +1537,73 @@ class fold_map =
 
     method phrasenode : phrasenode -> ('self_type * phrasenode) =
       function
-      | `Constant _x -> let (o, _x) = o#constant _x in (o, (`Constant _x))
-      | `Var _x -> let (o, _x) = o#name _x in (o, (`Var _x))
-      | `QualifiedVar _xs ->
+      | Constant _x -> let (o, _x) = o#constant _x in (o, (Constant _x))
+      | Var _x -> let (o, _x) = o#name _x in (o, (Var _x))
+      | QualifiedVar _xs ->
           let (o, _xs) = o#list (fun o n -> o#name n) _xs in
-          (o, (`QualifiedVar _xs))
-      | `FunLit (_x, _x1, _x_i1, _x_i2) ->
+          (o, (QualifiedVar _xs))
+      | FunLit (_x, _x1, _x_i1, _x_i2) ->
         let (o, _x_i1) = o#funlit _x_i1 in
-        let (o, _x_i2) = o#location _x_i2 in (o, (`FunLit (_x, _x1, _x_i1, _x_i2)))
-      | `HandlerLit hnlit ->
+        let (o, _x_i2) = o#location _x_i2 in (o, (FunLit (_x, _x1, _x_i1, _x_i2)))
+      | HandlerLit hnlit ->
 	 let (o, hnlit) = o#handlerlit hnlit in
-	 (o, `HandlerLit hnlit)
-      | `Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt) ->
+	 (o, HandlerLit hnlit)
+      | Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt) ->
           let (o, _given_spawn_location) = o#given_spawn_location _given_spawn_location in
           let (o, _block_phr) = o#phrase _block_phr in
-          (o, (`Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt)))
-      | `Query (_x, _x_i1, _x_i2) ->
+          (o, (Spawn (_spawn_kind, _given_spawn_location, _block_phr, _dt)))
+      | Query (_x, _x_i1, _x_i2) ->
           let (o, _x) =
             o#option
               (fun o (_x, _x_i1) ->
                  let (o, _x) = o#phrase _x in
                  let (o, _x_i1) = o#phrase _x_i1 in (o, (_x, _x_i1)))
               _x in
-          let (o, _x_i1) = o#phrase _x_i1 in (o, (`Query (_x, _x_i1, _x_i2)))
-      | `ListLit (_x, _x_i1) ->
-          let (o, _x) = o#list (fun o -> o#phrase) _x in (o, (`ListLit (_x, _x_i1)))
-      | `RangeLit ((_x_i1, _x_i2)) ->
+          let (o, _x_i1) = o#phrase _x_i1 in (o, (Query (_x, _x_i1, _x_i2)))
+      | ListLit (_x, _x_i1) ->
+          let (o, _x) = o#list (fun o -> o#phrase) _x in (o, (ListLit (_x, _x_i1)))
+      | RangeLit ((_x_i1, _x_i2)) ->
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#phrase _x_i2
-          in (o, (`RangeLit ((_x_i1, _x_i2))))
-      | `Iteration ((_x, _x_i1, _x_i2, _x_i3)) ->
+          in (o, (RangeLit ((_x_i1, _x_i2))))
+      | Iteration ((_x, _x_i1, _x_i2, _x_i3)) ->
           let (o, _x) = o#list (fun o -> o#iterpatt) _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#option (fun o -> o#phrase) _x_i2 in
           let (o, _x_i3) = o#option (fun o -> o#phrase) _x_i3
-          in (o, (`Iteration ((_x, _x_i1, _x_i2, _x_i3))))
-      | `Escape ((_x, _x_i1)) ->
+          in (o, (Iteration ((_x, _x_i1, _x_i2, _x_i3))))
+      | Escape ((_x, _x_i1)) ->
           let (o, _x) = o#binder _x in
-          let (o, _x_i1) = o#phrase _x_i1 in (o, (`Escape ((_x, _x_i1))))
-      | `Section _x -> let (o, _x) = o#sec _x in (o, (`Section _x))
-      | `Conditional ((_x, _x_i1, _x_i2)) ->
+          let (o, _x_i1) = o#phrase _x_i1 in (o, (Escape ((_x, _x_i1))))
+      | Section _x -> let (o, _x) = o#section _x in (o, (Section _x))
+      | Conditional ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#phrase _x_i2
-          in (o, (`Conditional ((_x, _x_i1, _x_i2))))
-      | `Block ((_x, _x_i1)) ->
+          in (o, (Conditional ((_x, _x_i1, _x_i2))))
+      | Block ((_x, _x_i1)) ->
           let (o, _x) = o#list (fun o -> o#binding) _x in
-          let (o, _x_i1) = o#phrase _x_i1 in (o, (`Block ((_x, _x_i1))))
-      | `InfixAppl ((_x, _x_i1, _x_i2)) ->
+          let (o, _x_i1) = o#phrase _x_i1 in (o, (Block ((_x, _x_i1))))
+      | InfixAppl ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#tybinop _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#phrase _x_i2
-          in (o, (`InfixAppl ((_x, _x_i1, _x_i2))))
-      | `Regex _x -> let (o, _x) = o#regex _x in (o, (`Regex _x))
-      | `UnaryAppl ((_x, _x_i1)) ->
+          in (o, (InfixAppl ((_x, _x_i1, _x_i2))))
+      | Regex _x -> let (o, _x) = o#regex _x in (o, (Regex _x))
+      | UnaryAppl ((_x, _x_i1)) ->
           let (o, _x) = o#tyunary_op _x in
-          let (o, _x_i1) = o#phrase _x_i1 in (o, (`UnaryAppl ((_x, _x_i1))))
-      | `FnAppl ((_x, _x_i1)) ->
+          let (o, _x_i1) = o#phrase _x_i1 in (o, (UnaryAppl ((_x, _x_i1))))
+      | FnAppl ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#list (fun o -> o#phrase) _x_i1
-          in (o, (`FnAppl ((_x, _x_i1))))
-      | `TAbstr ((_x, _x_i1)) ->
-          let (o, _x_i1) = o#phrase _x_i1 in (o, (`TAbstr ((_x, _x_i1))))
-      | `TAppl ((_x, _x_i1)) ->
-          let (o, _x) = o#phrase _x in (o, (`TAppl ((_x, _x_i1))))
-      | `TupleLit _x ->
-          let (o, _x) = o#list (fun o -> o#phrase) _x in (o, (`TupleLit _x))
-      | `RecordLit ((_x, _x_i1)) ->
+          in (o, (FnAppl ((_x, _x_i1))))
+      | TAbstr ((_x, _x_i1)) ->
+          let (o, _x_i1) = o#phrase _x_i1 in (o, (TAbstr ((_x, _x_i1))))
+      | TAppl ((_x, _x_i1)) ->
+          let (o, _x) = o#phrase _x in (o, (TAppl ((_x, _x_i1))))
+      | TupleLit _x ->
+          let (o, _x) = o#list (fun o -> o#phrase) _x in (o, (TupleLit _x))
+      | RecordLit ((_x, _x_i1)) ->
           let (o, _x) =
             o#list
               (fun o (_x, _x_i1) ->
@@ -1609,11 +1611,11 @@ class fold_map =
                  let (o, _x_i1) = o#phrase _x_i1 in (o, (_x, _x_i1)))
               _x in
           let (o, _x_i1) = o#option (fun o -> o#phrase) _x_i1
-          in (o, (`RecordLit ((_x, _x_i1))))
-      | `Projection ((_x, _x_i1)) ->
+          in (o, (RecordLit ((_x, _x_i1))))
+      | Projection ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
-          let (o, _x_i1) = o#name _x_i1 in (o, (`Projection ((_x, _x_i1))))
-      | `With ((_x, _x_i1)) ->
+          let (o, _x_i1) = o#name _x_i1 in (o, (Projection ((_x, _x_i1))))
+      | With ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) =
             o#list
@@ -1621,25 +1623,25 @@ class fold_map =
                  let (o, _x) = o#name _x in
                  let (o, _x_i1) = o#phrase _x_i1 in (o, (_x, _x_i1)))
               _x_i1
-          in (o, (`With ((_x, _x_i1))))
-      | `TypeAnnotation ((_x, _x_i1)) ->
+          in (o, (With ((_x, _x_i1))))
+      | TypeAnnotation ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#datatype' _x_i1
-          in (o, (`TypeAnnotation ((_x, _x_i1))))
-      | `Upcast ((_x, _x_i1, _x_i2)) ->
+          in (o, (TypeAnnotation ((_x, _x_i1))))
+      | Upcast ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#datatype' _x_i1 in
           let (o, _x_i2) = o#datatype' _x_i2
-          in (o, (`Upcast ((_x, _x_i1, _x_i2))))
-      | `ConstructorLit ((_x, _x_i1, _x_i2)) ->
+          in (o, (Upcast ((_x, _x_i1, _x_i2))))
+      | ConstructorLit ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#name _x in
           let (o, _x_i1) = o#option (fun o -> o#phrase) _x_i1
-          in (o, (`ConstructorLit ((_x, _x_i1, _x_i2))))
-      | `DoOperation (name, ps, t) ->
+          in (o, (ConstructorLit ((_x, _x_i1, _x_i2))))
+      | DoOperation (name, ps, t) ->
 	 let (o, t) = o#option (fun o -> o#unknown) t in
 	 let (o, ps) = o#list (fun o -> o#phrase) ps in
-	 (o, `DoOperation (name, ps, t))
-      | `Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
+	 (o, DoOperation (name, ps, t))
+      | Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
           let (o, m) = o#phrase sh_expr in
           let (o, params) =
             o#option (fun o -> o#handle_params) sh_descr.shd_params
@@ -1660,8 +1662,8 @@ class fold_map =
 	      )
               sh_value_cases
 	  in
-          (o, (`Handle { sh_expr = m; sh_effect_cases = eff_cases; sh_value_cases = val_cases; sh_descr = { sh_descr with shd_params = params } }))
-      | `Switch ((_x, _x_i1, _x_i2)) ->
+          (o, (Handle { sh_expr = m; sh_effect_cases = eff_cases; sh_value_cases = val_cases; sh_descr = { sh_descr with shd_params = params } }))
+      | Switch ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) =
             o#list
@@ -1670,8 +1672,8 @@ class fold_map =
                  let (o, _x_i1) = o#phrase _x_i1 in (o, (_x, _x_i1)))
               _x_i1 in
           let (o, _x_i2) = o#option (fun o -> o#unknown) _x_i2
-          in (o, (`Switch ((_x, _x_i1, _x_i2))))
-      | `Receive ((_x, _x_i1)) ->
+          in (o, (Switch ((_x, _x_i1, _x_i2))))
+      | Receive ((_x, _x_i1)) ->
           let (o, _x) =
             o#list
               (fun o (_x, _x_i1) ->
@@ -1679,15 +1681,15 @@ class fold_map =
                  let (o, _x_i1) = o#phrase _x_i1 in (o, (_x, _x_i1)))
               _x in
           let (o, _x_i1) = o#option (fun o -> o#unknown) _x_i1
-          in (o, (`Receive ((_x, _x_i1))))
-      (* | `Link ((_x, _x_i1)) -> *)
+          in (o, (Receive ((_x, _x_i1))))
+      (* | Link ((_x, _x_i1)) -> *)
       (*     let (o, _x) = o#phrase _x in *)
-      (*     let (o, _x_i1) = o#phrase _x in (o, (`Link(_x, _x_i1))) *)
-      | `Select ((_x, _x_i1)) ->
+      (*     let (o, _x_i1) = o#phrase _x in (o, (Link(_x, _x_i1))) *)
+      | Select ((_x, _x_i1)) ->
           let (o, _x) = o#name _x in
           let (o, _x_i1) = o#phrase _x_i1
-          in (o, (`Select (_x, _x_i1)))
-      | `Offer ((_x, _x_i1, _x_i2)) ->
+          in (o, (Select (_x, _x_i1)))
+      | Offer ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) =
             o#list
@@ -1696,11 +1698,11 @@ class fold_map =
                  let (o, _x_i1) = o#phrase _x_i1 in (o, (_x, _x_i1)))
               _x_i1 in
           let (o, _x_i2) = o#option (fun o -> o#unknown) _x_i2
-          in (o, (`Offer ((_x, _x_i1, _x_i2))))
-      | `CP p ->
+          in (o, (Offer ((_x, _x_i1, _x_i2))))
+      | CP p ->
          let (o, p) = o#cp_phrase p in
-         o, `CP p
-      | `DatabaseLit ((_x, _x_i1)) ->
+         o, CP p
+      | DatabaseLit ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) =
             (fun (_x, _x_i1) ->
@@ -1708,8 +1710,8 @@ class fold_map =
                let (o, _x_i1) = o#option (fun o -> o#phrase) _x_i1
                in (o, (_x, _x_i1)))
               _x_i1
-          in (o, (`DatabaseLit ((_x, _x_i1))))
-      | `TableLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
+          in (o, (DatabaseLit ((_x, _x_i1))))
+      | TableLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) =
             (fun (_x, _x_i1) ->
@@ -1730,60 +1732,60 @@ class fold_map =
               _x_i2 in
           let (o, _x_i3) = o#phrase _x_i3 in
           let (o, _x_i4) = o#phrase _x_i4
-          in (o, (`TableLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4))))
-      | `LensLit ((_x, _x_i1)) ->
+          in (o, (TableLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4))))
+      | LensLit ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#option (fun o -> o#unknown) _x_i1 in
-            (o, (`LensLit (_x, _x_i1)))
-      | `LensKeysLit ((_x, _x_i1, _x_i2)) ->
+            (o, (LensLit (_x, _x_i1)))
+      | LensKeysLit ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#option (fun o -> o#unknown) _x_i2 in
-            (o, (`LensKeysLit (_x, _x_i1, _x_i2)))
-      | `LensFunDepsLit ((_x, _x_i1, _x_i2)) ->
+            (o, (LensKeysLit (_x, _x_i1, _x_i2)))
+      | LensFunDepsLit ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i2) = o#option (fun o -> o#unknown) _x_i2 in
-            (o, (`LensFunDepsLit (_x, _x_i1, _x_i2)))
-      | `LensDropLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
+            (o, (LensFunDepsLit (_x, _x_i1, _x_i2)))
+      | LensDropLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#string _x_i1 in
           let (o, _x_i2) = o#string _x_i2 in
           let (o, _x_i3) = o#phrase _x_i3 in
           let (o, _x_i4) = o#option (fun o -> o#unknown) _x_i4 in
-            (o, (`LensDropLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4))))
-      | `LensSelectLit ((_x, _x_i1, _x_i2)) ->
+            (o, (LensDropLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4))))
+      | LensSelectLit ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           (* let (o, _x_i1) = o#phrase _x_i1 in *)
           let (o, _x_i2) = o#option (fun o -> o#unknown) _x_i2 in
-            (o, (`LensSelectLit ((_x, _x_i1, _x_i2))))
+            (o, (LensSelectLit ((_x, _x_i1, _x_i2))))
 
-      | `LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5)) ->
+      | LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#phrase _x_i2 in
           let (o, _x_i5) = o#option (fun o -> o#unknown) _x_i5 in
-            (o, (`LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5))))
-      | `LensGetLit ((_x, _x_i1)) ->
+            (o, (LensJoinLit ((_x, _x_i1, _x_i2, _x_i3, _x_i4, _x_i5))))
+      | LensGetLit ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#option (fun o -> o#unknown) _x_i1 in
-            (o, (`LensGetLit ((_x, _x_i1))))
-      | `LensPutLit ((_x, _x_i1, _x_i2)) ->
+            (o, (LensGetLit ((_x, _x_i1))))
+      | LensPutLit ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#option (fun o -> o#unknown) _x_i2 in
-            (o, (`LensPutLit ((_x, _x_i1, _x_i2))))
-      | `DBDelete ((_x, _x_i1, _x_i2)) ->
+            (o, (LensPutLit ((_x, _x_i1, _x_i2))))
+      | DBDelete ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#pattern _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#option (fun o -> o#phrase) _x_i2
-          in (o, (`DBDelete ((_x, _x_i1, _x_i2))))
-      | `DBInsert ((_x, _x_i1, _x_i2, _x_i3)) ->
+          in (o, (DBDelete ((_x, _x_i1, _x_i2))))
+      | DBInsert ((_x, _x_i1, _x_i2, _x_i3)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#list (fun o -> o#name) _x_i1 in
           let (o, _x_i2) = o#phrase _x_i2 in
           let (o, _x_i3) = o#option (fun o -> o#phrase) _x_i3
-          in (o, (`DBInsert ((_x, _x_i1, _x_i2, _x_i3))))
-      | `DBUpdate ((_x, _x_i1, _x_i2, _x_i3)) ->
+          in (o, (DBInsert ((_x, _x_i1, _x_i2, _x_i3))))
+      | DBUpdate ((_x, _x_i1, _x_i2, _x_i3)) ->
           let (o, _x) = o#pattern _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#option (fun o -> o#phrase) _x_i2 in
@@ -1793,8 +1795,8 @@ class fold_map =
                  let (o, _x) = o#name _x in
                  let (o, _x_i1) = o#phrase _x_i1 in (o, (_x, _x_i1)))
               _x_i3
-          in (o, (`DBUpdate ((_x, _x_i1, _x_i2, _x_i3))))
-      | `Xml ((_x, _x_i1, _x_i2, _x_i3)) ->
+          in (o, (DBUpdate ((_x, _x_i1, _x_i2, _x_i3))))
+      | Xml ((_x, _x_i1, _x_i2, _x_i3)) ->
           let (o, _x) = o#name _x in
           let (o, _x_i1) =
             o#list
@@ -1805,30 +1807,30 @@ class fold_map =
               _x_i1 in
           let (o, _x_i2) = o#option (fun o -> o#phrase) _x_i2 in
           let (o, _x_i3) = o#list (fun o -> o#phrase) _x_i3
-          in (o, (`Xml ((_x, _x_i1, _x_i2, _x_i3))))
-      | `TextNode _x -> let (o, _x) = o#string _x in (o, (`TextNode _x))
-      | `Formlet ((_x, _x_i1)) ->
+          in (o, (Xml ((_x, _x_i1, _x_i2, _x_i3))))
+      | TextNode _x -> let (o, _x) = o#string _x in (o, (TextNode _x))
+      | Formlet ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
-          let (o, _x_i1) = o#phrase _x_i1 in (o, (`Formlet ((_x, _x_i1))))
-      | `Page _x -> let (o, _x) = o#phrase _x in (o, (`Page _x))
-      | `FormletPlacement ((_x, _x_i1, _x_i2)) ->
+          let (o, _x_i1) = o#phrase _x_i1 in (o, (Formlet ((_x, _x_i1))))
+      | Page _x -> let (o, _x) = o#phrase _x in (o, (Page _x))
+      | FormletPlacement ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#phrase _x_i1 in
           let (o, _x_i2) = o#phrase _x_i2
-          in (o, (`FormletPlacement ((_x, _x_i1, _x_i2))))
-      | `PagePlacement _x ->
-          let (o, _x) = o#phrase _x in (o, (`PagePlacement _x))
-      | `FormBinding ((_x, _x_i1)) ->
+          in (o, (FormletPlacement ((_x, _x_i1, _x_i2))))
+      | PagePlacement _x ->
+          let (o, _x) = o#phrase _x in (o, (PagePlacement _x))
+      | FormBinding ((_x, _x_i1)) ->
           let (o, _x) = o#phrase _x in
           let (o, _x_i1) = o#pattern _x_i1
-          in (o, (`FormBinding ((_x, _x_i1))))
-      | `TryInOtherwise (_p1, _pat, _p2, _p3, _ty) ->
+          in (o, (FormBinding ((_x, _x_i1))))
+      | TryInOtherwise (_p1, _pat, _p2, _p3, _ty) ->
           let (o, _p1) = o#phrase _p1 in
           let (o, _pat) = o#pattern _pat in
           let (o, _p2) = o#phrase _p2 in
           let (o, _p3) = o#phrase _p3 in
-          (o, (`TryInOtherwise (_p1, _pat, _p2, _p3, _ty)))
-      | `Raise -> (o, `Raise)
+          (o, (TryInOtherwise (_p1, _pat, _p2, _p3, _ty)))
+      | Raise -> (o, Raise)
 
     method phrase : phrase -> ('self_type * phrase) =
       fun {node; pos} ->
@@ -1838,34 +1840,34 @@ class fold_map =
 
     method cp_phrasenode : cp_phrasenode -> ('self_type * cp_phrasenode) =
       function
-      | Unquote (bs, e) ->
+      | CPUnquote (bs, e) ->
          let o, bs = o#list (fun o -> o#binding) bs in
          let o, e = o#phrase e in
-         o, Unquote (bs, e)
-      | Grab (c, x, p) ->
+         o, CPUnquote (bs, e)
+      | CPGrab (c, x, p) ->
          let o, p = o#cp_phrase p in
-         o, Grab (c, x, p)
-      | Give (c, e, p) ->
+         o, CPGrab (c, x, p)
+      | CPGive (c, e, p) ->
          let o, e = o#option (fun o -> o#phrase) e in
          let o, p = o#cp_phrase p in
-         o, Give (c, e, p)
-      | GiveNothing c ->
+         o, CPGive (c, e, p)
+      | CPGiveNothing c ->
          let o, c = o#binder c in
-         o, GiveNothing c
-      | Select (c, l, p) ->
+         o, CPGiveNothing c
+      | CPSelect (c, l, p) ->
          let o, p = o#cp_phrase p in
-         o, Select (c, l, p)
-      | Offer (c, bs) ->
+         o, CPSelect (c, l, p)
+      | CPOffer (c, bs) ->
          let o, bs = o#list (fun o (l, p) ->
                              let o, p = o#cp_phrase p in
                              o, (l, p)) bs in
-         o, Offer (c, bs)
-      | Link (c, d) ->
-         o, Link (c, d)
-      | Comp (c, p, q) ->
+         o, CPOffer (c, bs)
+      | CPLink (c, d) ->
+         o, CPLink (c, d)
+      | CPComp (c, p, q) ->
          let o, p = o#cp_phrase p in
          let o, q = o#cp_phrase q in
-         o, Comp (c, p, q)
+         o, CPComp (c, p, q)
 
     method cp_phrase : cp_phrase -> ('self_type * cp_phrase) =
       fun {node; pos} ->
@@ -1873,27 +1875,28 @@ class fold_map =
       let o, pos  = o#position pos in
       o, {node; pos}
 
-    method patternnode : patternnode -> ('self_type * patternnode) =
+    method patternnode : Pattern.t -> ('self_type * Pattern.t) =
+      let open Pattern in
       function
-      | `Any -> (o, `Any)
-      | `Nil -> (o, `Nil)
-      | `Cons ((_x, _x_i1)) ->
+      | Any -> (o, Any)
+      | Nil -> (o, Nil)
+      | Cons ((_x, _x_i1)) ->
           let (o, _x) = o#pattern _x in
-          let (o, _x_i1) = o#pattern _x_i1 in (o, (`Cons ((_x, _x_i1))))
-      | `List _x ->
-          let (o, _x) = o#list (fun o -> o#pattern) _x in (o, (`List _x))
-      | `Variant ((_x, _x_i1)) ->
+          let (o, _x_i1) = o#pattern _x_i1 in (o, (Cons ((_x, _x_i1))))
+      | List _x ->
+          let (o, _x) = o#list (fun o -> o#pattern) _x in (o, (List _x))
+      | Variant ((_x, _x_i1)) ->
           let (o, _x) = o#name _x in
           let (o, _x_i1) = o#option (fun o -> o#pattern) _x_i1
-          in (o, (`Variant ((_x, _x_i1))))
-      | `Effect (name, ps, k) ->
+          in (o, (Variant ((_x, _x_i1))))
+      | Effect (name, ps, k) ->
          let (o, name) = o#name name in
          let (o, ps) = o#list (fun o -> o#pattern) ps in
          let (o, k) = o#pattern k in
-         (o, `Effect (name, ps, k))
-      | `Negative _x ->
-          let (o, _x) = o#list (fun o -> o#name) _x in (o, (`Negative _x))
-      | `Record ((_x, _x_i1)) ->
+         (o, Effect (name, ps, k))
+      | Negative _x ->
+          let (o, _x) = o#list (fun o -> o#name) _x in (o, (Negative _x))
+      | Record ((_x, _x_i1)) ->
           let (o, _x) =
             o#list
               (fun o (_x, _x_i1) ->
@@ -1901,19 +1904,19 @@ class fold_map =
                  let (o, _x_i1) = o#pattern _x_i1 in (o, (_x, _x_i1)))
               _x in
           let (o, _x_i1) = o#option (fun o -> o#pattern) _x_i1
-          in (o, (`Record ((_x, _x_i1))))
-      | `Tuple _x ->
-          let (o, _x) = o#list (fun o -> o#pattern) _x in (o, (`Tuple _x))
-      | `Constant _x -> let (o, _x) = o#constant _x in (o, (`Constant _x))
-      | `Variable _x -> let (o, _x) = o#binder _x in (o, (`Variable _x))
-      | `As ((_x, _x_i1)) ->
+          in (o, (Record ((_x, _x_i1))))
+      | Tuple _x ->
+          let (o, _x) = o#list (fun o -> o#pattern) _x in (o, (Tuple _x))
+      | Constant _x -> let (o, _x) = o#constant _x in (o, (Constant _x))
+      | Variable _x -> let (o, _x) = o#binder _x in (o, (Variable _x))
+      | As ((_x, _x_i1)) ->
           let (o, _x) = o#binder _x in
-          let (o, _x_i1) = o#pattern _x_i1 in (o, (`As ((_x, _x_i1))))
-      | `HasType ((_x, _x_i1)) ->
+          let (o, _x_i1) = o#pattern _x_i1 in (o, (As ((_x, _x_i1))))
+      | HasType ((_x, _x_i1)) ->
           let (o, _x) = o#pattern _x in
-          let (o, _x_i1) = o#datatype' _x_i1 in (o, (`HasType ((_x, _x_i1))))
+          let (o, _x_i1) = o#datatype' _x_i1 in (o, (HasType ((_x, _x_i1))))
 
-    method pattern : pattern -> ('self_type * pattern) =
+    method pattern : Pattern.with_pos -> ('self_type * Pattern.with_pos) =
       fun {node; pos} ->
         let (o, node) = o#patternnode node in
         let (o, pos ) = o#position pos in
@@ -1921,19 +1924,16 @@ class fold_map =
 
     method name : name -> ('self_type * name) = o#string
 
-    method logical_binop : logical_binop -> ('self_type * logical_binop) =
-      function | `And -> (o, `And) | `Or -> (o, `Or)
-
-    method location : location -> ('self_type * location) = o#unknown
+    method location : Location.t -> ('self_type * Location.t) = o#unknown
 
     method iterpatt : iterpatt -> ('self_type * iterpatt) =
       function
-      | `List ((_x, _x_i1)) ->
+      | List ((_x, _x_i1)) ->
           let (o, _x) = o#pattern _x in
-          let (o, _x_i1) = o#phrase _x_i1 in (o, (`List ((_x, _x_i1))))
-      | `Table ((_x, _x_i1)) ->
+          let (o, _x_i1) = o#phrase _x_i1 in (o, (List ((_x, _x_i1))))
+      | Table ((_x, _x_i1)) ->
           let (o, _x) = o#pattern _x in
-          let (o, _x_i1) = o#phrase _x_i1 in (o, (`Table ((_x, _x_i1))))
+          let (o, _x_i1) = o#phrase _x_i1 in (o, (Table ((_x, _x_i1))))
 
     method funlit : funlit -> ('self_type * funlit) =
       fun (_x, _x_i1) ->
@@ -1971,11 +1971,11 @@ class fold_map =
         in
         (o, { params with shp_bindings = bindings })
 
-    method fieldspec : fieldspec -> ('self_type * fieldspec) =
-      function
-      | `Present _x -> let (o, _x) = o#datatype _x in (o, `Present _x)
-      | `Absent -> (o, `Absent)
-      | `Var _x -> let (o, _x) = o#known_type_variable _x in (o, `Var _x)
+    method fieldspec : Datatype.fieldspec -> ('self_type * Datatype.fieldspec) =
+      let open Datatype in function
+      | Present _x -> let (o, _x) = o#datatype _x in (o, Present _x)
+      | Absent -> (o, Absent)
+      | Var _x -> let (o, _x) = o#known_type_variable _x in (o, Var _x)
 
     method fieldconstraint : fieldconstraint -> ('self_type * fieldconstraint) =
       fun fc -> (o, fc)
@@ -1991,77 +1991,78 @@ class fold_map =
         let (o, _x_i1) = o#option (fun o -> o#unknown) _x_i1
         in (o, (_x, _x_i1))
 
-    method datatypenode : datatypenode -> ('self_type * datatypenode) =
+    method datatypenode : Datatype.t -> ('self_type * Datatype.t) =
+      let open Datatype in
       function
-      | `TypeVar _x ->
-          let (o, _x) = o#known_type_variable _x in (o, (`TypeVar _x))
-      | `QualifiedTypeApplication (ns, args) ->
+      | TypeVar _x ->
+          let (o, _x) = o#known_type_variable _x in (o, (TypeVar _x))
+      | QualifiedTypeApplication (ns, args) ->
           let (o, ns) = o#list (fun o -> o#name) ns in
           let (o, args) = o#list (fun o -> o#type_arg) args in
-          (o, `QualifiedTypeApplication (ns, args))
-      | `Function (_x, _x_i1, _x_i2) ->
+          (o, QualifiedTypeApplication (ns, args))
+      | Function (_x, _x_i1, _x_i2) ->
           let (o, _x) = o#list (fun o -> o#datatype) _x in
           let (o, _x_i1) = o#row _x_i1 in
           let (o, _x_i2) = o#datatype _x_i2
-          in (o, (`Function (_x, _x_i1, _x_i2)))
-      | `Lolli (_x, _x_i1, _x_i2) ->
+          in (o, (Function (_x, _x_i1, _x_i2)))
+      | Lolli (_x, _x_i1, _x_i2) ->
           let (o, _x) = o#list (fun o -> o#datatype) _x in
           let (o, _x_i1) = o#row _x_i1 in
           let (o, _x_i2) = o#datatype _x_i2
-          in (o, (`Lolli (_x, _x_i1, _x_i2)))
-      | `Mu (_x, _x_i1) ->
+          in (o, (Lolli (_x, _x_i1, _x_i2)))
+      | Mu (_x, _x_i1) ->
           let (o, _x) = o#name _x in
-          let (o, _x_i1) = o#datatype _x_i1 in (o, (`Mu (_x, _x_i1)))
-      | `Forall (_x, _x_i1) ->
+          let (o, _x_i1) = o#datatype _x_i1 in (o, (Mu (_x, _x_i1)))
+      | Forall (_x, _x_i1) ->
           (*let (o, _x) = o#list (fun o -> o#quantifier) _x in*)
-          let (o, _x_i1) = o#datatype _x_i1 in (o, (`Forall (_x, _x_i1)))
-      | `Unit -> (o, `Unit)
-      | `Tuple _x ->
+          let (o, _x_i1) = o#datatype _x_i1 in (o, (Forall (_x, _x_i1)))
+      | Unit -> (o, Unit)
+      | Tuple _x ->
           let (o, _x) = o#list (fun o -> o#datatype) _x
-          in (o, (`Tuple _x))
-      | `Record _x -> let (o, _x) = o#row _x in (o, (`Record _x))
-      | `Variant _x -> let (o, _x) = o#row _x in (o, (`Variant _x))
-      | `Effect r -> let (o, r) = o#row r in (o, `Effect r)
-      | `Table (_x, _x_i1, _x_i2) ->
+          in (o, (Tuple _x))
+      | Record _x -> let (o, _x) = o#row _x in (o, (Record _x))
+      | Variant _x -> let (o, _x) = o#row _x in (o, (Variant _x))
+      | Effect r -> let (o, r) = o#row r in (o, Effect r)
+      | Table (_x, _x_i1, _x_i2) ->
           let (o, _x) = o#datatype _x in
           let (o, _x_i1) = o#datatype _x_i1 in
-          let (o, _x_i2) = o#datatype _x_i2 in (o, (`Table (_x, _x_i1, _x_i2)))
-      | `List _x -> let (o, _x) = o#datatype _x in (o, (`List _x))
-      | `TypeApplication _x ->
+          let (o, _x_i2) = o#datatype _x_i2 in (o, (Table (_x, _x_i1, _x_i2)))
+      | List _x -> let (o, _x) = o#datatype _x in (o, (List _x))
+      | TypeApplication _x ->
           let (o, _x) =
             (fun (_x, _x_i1) ->
                let (o, _x) = o#string _x in
                let (o, _x_i1) = o#list (fun o -> o#type_arg) _x_i1
                in (o, (_x, _x_i1)))
               _x
-          in (o, (`TypeApplication _x))
-      | `Primitive _x ->
-          let (o, _x) = o#unknown _x in (o, (`Primitive _x))
-      | `DB -> (o, `DB)
-      | `Input (_x, _x_i1) ->
+          in (o, (TypeApplication _x))
+      | Primitive _x ->
+          let (o, _x) = o#unknown _x in (o, (Primitive _x))
+      | DB -> (o, DB)
+      | Input (_x, _x_i1) ->
         let (o, _x) = o#datatype _x in
-        let (o, _x_i1) = o#datatype _x_i1 in (o, `Input (_x, _x_i1))
-      | `Output (_x, _x_i1) ->
+        let (o, _x_i1) = o#datatype _x_i1 in (o, Input (_x, _x_i1))
+      | Output (_x, _x_i1) ->
         let (o, _x) = o#datatype _x in
-        let (o, _x_i1) = o#datatype _x_i1 in (o, `Output (_x, _x_i1))
-      | `Select _x ->
-        let (o, _x) = o#row _x in (o, `Select _x)
-      | `Choice _x ->
-        let (o, _x) = o#row _x in (o, `Choice _x)
-      | `Dual _x ->
-        let (o, _x) = o#datatype _x in (o, `Dual _x)
-      | `End -> (o, `End)
-
-    method datatype : datatype -> ('self_type * datatype) =
+        let (o, _x_i1) = o#datatype _x_i1 in (o, Output (_x, _x_i1))
+      | Select _x ->
+        let (o, _x) = o#row _x in (o, Select _x)
+      | Choice _x ->
+        let (o, _x) = o#row _x in (o, Choice _x)
+      | Dual _x ->
+        let (o, _x) = o#datatype _x in (o, Dual _x)
+      | End -> (o, End)
+
+    method datatype : Datatype.with_pos -> ('self_type * Datatype.with_pos) =
       fun {node; pos} ->
         let (o, node) = o#datatypenode node in
         let (o, pos) = o#position pos in (o, {node; pos})
 
-    method type_arg : type_arg -> ('self_type * type_arg) =
-      function
-      | `Type _x -> let (o, _x) = o#datatype _x in (o, `Type _x)
-      | `Row _x -> let (o, _x) = o#row _x in (o, `Row _x)
-      | `Presence _x -> let (o, _x) = o#fieldspec _x in (o, `Presence _x)
+    method type_arg : Datatype.type_arg -> ('self_type * Datatype.type_arg) =
+      let open Datatype in function
+      | Type _x -> let (o, _x) = o#datatype _x in (o, Type _x)
+      | Row _x -> let (o, _x) = o#row _x in (o, Row _x)
+      | Presence _x -> let (o, _x) = o#fieldspec _x in (o, Presence _x)
 
     method constant : constant -> ('self_type * constant) =
       function
@@ -2071,36 +2072,37 @@ class fold_map =
       | `Bool _x -> let (o, _x) = o#bool _x in (o, (`Bool _x))
       | `Char _x -> let (o, _x) = o#char _x in (o, (`Char _x))
 
-    method binop : binop -> ('self_type * binop) =
-      function
-      | `Minus -> (o, `Minus)
-      | `FloatMinus -> (o, `FloatMinus)
-      | `RegexMatch _x ->
+    method binop : BinaryOp.t -> ('self_type * BinaryOp.t) =
+      let open BinaryOp in function
+      | Minus -> (o, Minus)
+      | FloatMinus -> (o, FloatMinus)
+      | RegexMatch _x ->
           let (o, _x) = o#list (fun o -> o#regexflag) _x
-          in (o, (`RegexMatch _x))
-      | (#logical_binop as x) -> (o#logical_binop x :> 'self_type * binop)
-      | `Cons -> (o, `Cons)
-      | `Name _x -> let (o, _x) = o#name _x in (o, (`Name _x))
+          in (o, (RegexMatch _x))
+      | And -> (o, And)
+      | Or -> (o, Or)
+      | Cons -> (o, Cons)
+      | Name _x -> let (o, _x) = o#name _x in (o, (Name _x))
 
-    method tybinop : tyarg list * binop -> 'self_type * (tyarg list * binop) =
+    method tybinop : tyarg list * BinaryOp.t -> 'self_type * (tyarg list * BinaryOp.t) =
       fun (_x, _x_i1) ->
         let (o, _x_i1) = o#binop _x_i1 in (o, (_x, _x_i1))
 
     method bindingnode : bindingnode -> ('self_type * bindingnode) =
       function
-      | `Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
+      | Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
           let (o, _x   ) = o#pattern _x in
           let (o, _x_i2) = o#phrase _x_i2 in
           let (o, _x_i3) = o#location _x_i3 in
           let (o, _x_i4) = o#option (fun o -> o#datatype') _x_i4
-          in (o, (`Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4))))
-      | `Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
+          in (o, (Val ((_x, (_x_i1, _x_i2), _x_i3, _x_i4))))
+      | Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4)) ->
           let (o, _x) = o#binder _x in
           let (o, _x_i2) = o#funlit _x_i2 in
           let (o, _x_i3) = o#location _x_i3 in
           let (o, _x_i4) = o#option (fun o -> o#datatype') _x_i4
-          in (o, (`Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4))))
-      | `Funs _x ->
+          in (o, (Fun ((_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4))))
+      | Funs _x ->
           let (o, _x) =
             o#list
               (fun o (_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4, _x_i5) ->
@@ -2111,23 +2113,23 @@ class fold_map =
                  let (o, _x_i5) = o#position _x_i5
                  in (o, (_x, _x1, (_x_i1, _x_i2), _x_i3, _x_i4, _x_i5)))
               _x
-          in (o, (`Funs _x))
-      | `Handler (b, hnlit, t) ->
+          in (o, (Funs _x))
+      | Handler (b, hnlit, t) ->
           let (o, b) = o#binder b in
           let (o, hnlit) = o#handlerlit hnlit in
           let (o, t) = o#option (fun o -> o#unknown) t in
-          (o, `Handler (b, hnlit, t))
-      | `Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
+          (o, Handler (b, hnlit, t))
+      | Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4)) ->
           let (o, _x) = o#binder _x in
           let (o, _x_i1) = o#name _x_i1 in
           let (o, _x_i2) = o#name _x_i2 in
           let (o, _x_i3) = o#name _x_i3 in
           let (o, _x_i4) = o#datatype' _x_i4
-          in (o, (`Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4))))
-      | `QualifiedImport _xs ->
+          in (o, (Foreign ((_x, _x_i1, _x_i2, _x_i3, _x_i4))))
+      | QualifiedImport _xs ->
           let (o, _xs) = o#list (fun o n -> o#name n) _xs in
-          (o, `QualifiedImport _xs)
-      | `Type ((_x, _x_i1, _x_i2)) ->
+          (o, QualifiedImport _xs)
+      | Type ((_x, _x_i1, _x_i2)) ->
           let (o, _x) = o#name _x in
           let (o, _x_i1) =
             o#list
@@ -2137,14 +2139,14 @@ class fold_map =
                  in (o, (_x, _x_i1)))
               _x_i1 in
           let (o, _x_i2) = o#datatype' _x_i2
-          in (o, (`Type ((_x, _x_i1, _x_i2))))
-      | `Infix -> (o, `Infix)
-      | `Exp _x -> let (o, _x) = o#phrase _x in (o, (`Exp _x))
-      | `Module (n, bs) ->
+          in (o, (Type ((_x, _x_i1, _x_i2))))
+      | Infix -> (o, Infix)
+      | Exp _x -> let (o, _x) = o#phrase _x in (o, (Exp _x))
+      | Module (n, bs) ->
           let (o, n) = o#string n in
           let (o, bs) = o#list (fun o -> o#binding) bs in
-          (o, (`Module (n, bs)))
-      | `AlienBlock (lang, lib, dts) ->
+          (o, (Module (n, bs)))
+      | AlienBlock (lang, lib, dts) ->
           let (o, lang) = o#name lang in
           let (o, lib) = o#name lib in
           let (o, dts) = o#list (fun o (b, dt) ->
@@ -2152,7 +2154,7 @@ class fold_map =
             let (o, dt) = o#datatype' dt in
             (o, (b, dt))
           ) dts in
-          (o, (`AlienBlock (lang, lib, dts)))
+          (o, (AlienBlock (lang, lib, dts)))
 
     method binding : binding -> ('self_type * binding) =
       fun {node; pos} ->
diff --git a/core/sugarTraversals.mli b/core/sugarTraversals.mli
index 5b8f12ba1..89c35c259 100644
--- a/core/sugarTraversals.mli
+++ b/core/sugarTraversals.mli
@@ -1,3 +1,5 @@
+open Operators
+open CommonTypes
 open Sugartypes
 
 (* Make a copy of a value.  You can override any method(s) to get a
@@ -22,18 +24,18 @@ class map :
     method float           : float -> float
     method char            : char -> char
     method bool            : bool -> bool
-    method unary_op        : unary_op -> unary_op
-    method tyunary_op      : tyarg list * unary_op -> tyarg list * unary_op
+    method unary_op        : UnaryOp.t -> UnaryOp.t
+    method tyunary_op      : tyarg list * UnaryOp.t -> tyarg list * UnaryOp.t
     method binder          : binder -> binder
     method sentence        : sentence -> sentence
-    method sec             : sec -> sec
+    method section         : Section.t -> Section.t
     method subkind         : subkind -> subkind
     method kind            : kind -> kind
     method freedom         : freedom -> freedom
     method type_variable   : type_variable -> type_variable
     method known_type_variable   : known_type_variable -> known_type_variable
-    method row_var         : row_var -> row_var
-    method row             : row -> row
+    method row_var         : Datatype.row_var -> Datatype.row_var
+    method row             : Datatype.row -> Datatype.row
     method replace_rhs     : replace_rhs -> replace_rhs
     method regexflag       : regexflag -> regexflag
     method regex           : regex -> regex
@@ -43,25 +45,24 @@ class map :
     method phrase          : phrase -> phrase
     method cp_phrasenode   : cp_phrasenode -> cp_phrasenode
     method cp_phrase       : cp_phrase -> cp_phrase
-    method patternnode     : patternnode -> patternnode
-    method pattern         : pattern -> pattern
+    method patternnode     : Pattern.t -> Pattern.t
+    method pattern         : Pattern.with_pos -> Pattern.with_pos
     method name            : name -> name
-    method logical_binop   : logical_binop -> logical_binop
-    method location        : location -> location
+    method location        : Location.t -> Location.t
     method iterpatt        : iterpatt -> iterpatt
     method funlit          : funlit -> funlit
     method handlerlit      : handlerlit -> handlerlit
     method handle_params   : handler_parameterisation -> handler_parameterisation
-    method fieldspec       : fieldspec -> fieldspec
+    method fieldspec       : Datatype.fieldspec -> Datatype.fieldspec
     method fieldconstraint : fieldconstraint -> fieldconstraint
     method directive       : directive -> directive
-    method datatype        : datatype -> datatype
-    method datatypenode    : datatypenode -> datatypenode
+    method datatype        : Datatype.with_pos -> Datatype.with_pos
+    method datatypenode    : Datatype.t -> Datatype.t
     method datatype'       : datatype' -> datatype'
-    method type_arg        : type_arg -> type_arg
+    method type_arg        : Datatype.type_arg -> Datatype.type_arg
     method constant        : constant -> constant
-    method binop           : binop -> binop
-    method tybinop         : tyarg list * binop -> tyarg list * binop
+    method binop           : BinaryOp.t -> BinaryOp.t
+    method tybinop         : tyarg list * BinaryOp.t -> tyarg list * BinaryOp.t
     method bindingnode     : bindingnode -> bindingnode
     method binding         : binding -> binding
     method program         : program -> program
@@ -92,18 +93,18 @@ class fold :
     method float           : float -> 'self
     method char            : char -> 'self
     method bool            : bool -> 'self
-    method unary_op        : unary_op -> 'self
-    method tyunary_op      : tyarg list * unary_op -> 'self
+    method unary_op        : UnaryOp.t -> 'self
+    method tyunary_op      : tyarg list * UnaryOp.t -> 'self
     method binder          : binder -> 'self
     method sentence        : sentence -> 'self
-    method sec             : sec -> 'self
+    method section         : Section.t -> 'self
     method subkind         : subkind -> 'self
     method kind            : kind -> 'self
     method freedom         : freedom -> 'self
     method type_variable   : type_variable -> 'self
     method known_type_variable : known_type_variable -> 'self
-    method row_var         : row_var -> 'self
-    method row             : row -> 'self
+    method row_var         : Datatype.row_var -> 'self
+    method row             : Datatype.row -> 'self
     method replace_rhs     : replace_rhs -> 'self
     method regexflag       : regexflag -> 'self
     method regex           : regex -> 'self
@@ -113,27 +114,26 @@ class fold :
     method phrase          : phrase -> 'self
     method cp_phrasenode   : cp_phrasenode -> 'self
     method cp_phrase       : cp_phrase -> 'self
-    method patternnode     : patternnode -> 'self
-    method pattern         : pattern -> 'self
+    method patternnode     : Pattern.t -> 'self
+    method pattern         : Pattern.with_pos -> 'self
     method name            : name -> 'self
-    method logical_binop   : logical_binop -> 'self
-    method location        : location -> 'self
+    method location        : Location.t -> 'self
     method iterpatt        : iterpatt -> 'self
     method funlit          : funlit -> 'self
     method handlerlit      : handlerlit -> 'self
     method handle_params   : handler_parameterisation -> 'self
     (* method quantifier      : quantifier -> 'self *)
-    method fieldspec       : fieldspec -> 'self
+    method fieldspec       : Datatype.fieldspec -> 'self
     method fieldconstraint : fieldconstraint -> 'self
     method directive       : directive -> 'self
     method tyvar           : tyvar -> 'self
-    method datatype        : datatype -> 'self
-    method datatypenode    : datatypenode -> 'self
+    method datatype        : Datatype.with_pos -> 'self
+    method datatypenode    : Datatype.t -> 'self
     method datatype'       : datatype' -> 'self
-    method type_arg        : type_arg -> 'self
+    method type_arg        : Datatype.type_arg -> 'self
     method constant        : constant -> 'self
-    method binop           : binop -> 'self
-    method tybinop         : tyarg list * binop -> 'self
+    method binop           : BinaryOp.t -> 'self
+    method tybinop         : tyarg list * BinaryOp.t -> 'self
     method bindingnode     : bindingnode -> 'self
     method binding         : binding -> 'self
     method program         : program -> 'self
@@ -156,17 +156,17 @@ object ('self)
   method binder          : binder -> 'self * binder
   method binding         : binding -> 'self * binding
   method bindingnode     : bindingnode -> 'self * bindingnode
-  method binop           : binop -> 'self * binop
-  method tybinop         : tyarg list * binop -> 'self * (tyarg list * binop)
+  method binop           : BinaryOp.t -> 'self * BinaryOp.t
+  method tybinop         : tyarg list * BinaryOp.t -> 'self * (tyarg list * BinaryOp.t)
   method bool            : bool -> 'self * bool
   method char            : char -> 'self * char
   method constant        : constant -> 'self * constant
-  method datatype        : datatype -> 'self * datatype
-  method datatypenode    : datatypenode -> 'self * datatypenode
+  method datatype        : Datatype.with_pos -> 'self * Datatype.with_pos
+  method datatypenode    : Datatype.t -> 'self * Datatype.t
   method datatype'       : datatype' -> 'self * datatype'
   method directive       : directive -> 'self * directive
   method fieldconstraint : fieldconstraint -> 'self * fieldconstraint
-  method fieldspec       : fieldspec -> 'self * fieldspec
+  method fieldspec       : Datatype.fieldspec -> 'self * Datatype.fieldspec
   method int             : int -> 'self * int
   method float           : float -> 'self * float
   method funlit          : funlit -> 'self * funlit
@@ -174,12 +174,11 @@ object ('self)
   method handle_params   : handler_parameterisation -> 'self * handler_parameterisation
   method iterpatt        : iterpatt -> 'self * iterpatt
   method list            : 'a . ('self -> 'a -> 'self * 'a) -> 'a list -> 'self * 'a list
-  method location        : location -> 'self * location
-  method logical_binop   : logical_binop -> 'self * logical_binop
+  method location        : Location.t -> 'self * Location.t
   method name            : name -> 'self * name
   method option          : 'a . ('self -> 'a -> 'self * 'a) -> 'a option -> 'self * 'a option
-  method patternnode     : patternnode -> 'self * patternnode
-  method pattern         : pattern -> 'self * pattern
+  method patternnode     : Pattern.t -> 'self * Pattern.t
+  method pattern         : Pattern.with_pos -> 'self * Pattern.with_pos
   method phrase          : phrase -> 'self * phrase
   method given_spawn_location : given_spawn_location -> 'self * given_spawn_location
   method phrasenode      : phrasenode -> 'self * phrasenode
@@ -191,9 +190,9 @@ object ('self)
   method regex           : regex -> 'self * regex
   method regexflag       : regexflag -> 'self * regexflag
   method replace_rhs     : replace_rhs -> 'self * replace_rhs
-  method row             : row -> 'self * row
-  method row_var         : row_var -> 'self * row_var
-  method sec             : sec -> 'self * sec
+  method row             : Datatype.row -> 'self * Datatype.row
+  method row_var         : Datatype.row_var -> 'self * Datatype.row_var
+  method section         : Section.t -> 'self * Section.t
   method sentence        : sentence -> 'self * sentence
   method string          : name -> 'self * name
   method subkind         : subkind -> 'self * subkind
@@ -201,8 +200,8 @@ object ('self)
   method freedom         : freedom -> 'self * freedom
   method type_variable   : type_variable -> 'self * type_variable
   method known_type_variable : known_type_variable -> 'self * known_type_variable
-  method type_arg        : type_arg -> 'self * type_arg
-  method tyunary_op      : tyarg list * unary_op -> 'self * (tyarg list * unary_op)
-  method unary_op        : unary_op -> 'self * unary_op
+  method type_arg        : Datatype.type_arg -> 'self * Datatype.type_arg
+  method tyunary_op      : tyarg list * UnaryOp.t -> 'self * (tyarg list * UnaryOp.t)
+  method unary_op        : UnaryOp.t -> 'self * UnaryOp.t
   method unknown         : 'a . 'a -> 'self * 'a
 end
diff --git a/core/sugartoir.ml b/core/sugartoir.ml
index a04f472d6..b24cb84c9 100644
--- a/core/sugartoir.ml
+++ b/core/sugartoir.ml
@@ -1,3 +1,5 @@
+open CommonTypes
+open Operators
 open Utility
 open Ir
 
@@ -596,7 +598,7 @@ struct
     let f_info = (ft, "", `Local) in
     let rest f : tail_computation sem = lift (`Special (`CallCC (`Variable f)),
                                               body_type) in
-      M.bind (fun_binding (f_info, ([], [kb], body), `Unknown)) rest
+      M.bind (fun_binding (f_info, ([], [kb], body), loc_unknown)) rest
 
   let letfun env ((ft, _, _) as f_info, (tyvars, (ps, body)), location) rest =
     let xsb : binder list =
@@ -724,7 +726,6 @@ struct
 
   let rec eval : env -> Sugartypes.phrase -> tail_computation I.sem =
     fun env {Sugartypes.node=e; Sugartypes.pos} ->
-      let with_pos = Sugartypes.with_pos in
       let lookup_var name =
         let x, xt = lookup_name_and_type name env in
           I.var (x, xt) in
@@ -744,10 +745,11 @@ struct
                       failwith "fatal internal error" in
 
       let rec is_pure_primitive e =
-        match e.Sugartypes.node with
-          | `TAbstr (_, e)
-          | `TAppl (e, _) -> is_pure_primitive e
-          | `Var f when Lib.is_pure_primitive f -> true
+        let open Sugartypes in
+        match e.node with
+          | TAbstr (_, e)
+          | TAppl (e, _) -> is_pure_primitive e
+          | Var f when Lib.is_pure_primitive f -> true
           | _ -> false in
 
       let eff = lookup_effects env in
@@ -756,69 +758,70 @@ struct
       let ec = eval env in
       let ev = evalv env in
       let evs = List.map ev in
+        let open Sugartypes in
         match e with
-          | `Constant c -> cofv (I.constant c)
-          | `Var x -> cofv (I.var (lookup_name_and_type x env))
-          | `RangeLit (low, high) ->
+          | Constant c -> cofv (I.constant c)
+          | Var x -> cofv (I.var (lookup_name_and_type x env))
+          | RangeLit (low, high) ->
               I.apply (instantiate_mb "intRange", [ev low; ev high])
-          | `ListLit ([], Some t) ->
+          | ListLit ([], Some t) ->
               cofv (instantiate "Nil" [`Type t])
-          | `ListLit (e::es, Some t) ->
+          | ListLit (e::es, Some t) ->
               cofv (I.apply_pure(instantiate "Cons" [`Type t; `Row eff],
-                                 [ev e; ev (with_pos pos (`ListLit (es, Some t)))]))
-          | `Escape (bndr, body) when Sugartypes.binder_has_type bndr ->
-             let k  = Sugartypes.name_of_binder bndr in
-             let kt = Sugartypes.type_of_binder_exn bndr in
+                                 [ev e; ev (with_pos pos (ListLit (es, Some t)))]))
+          | Escape (bndr, body) when binder_has_type bndr ->
+             let k  = name_of_binder bndr in
+             let kt = type_of_binder_exn bndr in
              I.escape ((kt, k, `Local), eff, fun v -> eval (extend [k] [(v, kt)] env) body)
-          | `Section (`Minus) -> cofv (lookup_var "-")
-          | `Section (`FloatMinus) -> cofv (lookup_var "-.")
-          | `Section (`Name name) -> cofv (lookup_var name)
-          | `Conditional (p, e1, e2) ->
+          | Section (Section.Minus) -> cofv (lookup_var "-")
+          | Section (Section.FloatMinus) -> cofv (lookup_var "-.")
+          | Section (Section.Name name) -> cofv (lookup_var name)
+          | Conditional (p, e1, e2) ->
               I.condition (ev p, ec e1, ec e2)
-          | `InfixAppl ((tyargs, `Name ((">" | ">=" | "==" | "<" | "<=" | "<>") as op)), e1, e2) ->
+          | InfixAppl ((tyargs, BinaryOp.Name ((">" | ">=" | "==" | "<" | "<=" | "<>") as op)), e1, e2) ->
               cofv (I.apply_pure (instantiate op tyargs, [ev e1; ev e2]))
-          | `InfixAppl ((tyargs, `Name "++"), e1, e2) ->
+          | InfixAppl ((tyargs, BinaryOp.Name "++"), e1, e2) ->
               cofv (I.apply_pure (instantiate "Concat" tyargs, [ev e1; ev e2]))
-          | `InfixAppl ((tyargs, `Name "!"), e1, e2) ->
+          | InfixAppl ((tyargs, BinaryOp.Name "!"), e1, e2) ->
               I.apply (instantiate "Send" tyargs, [ev e1; ev e2])
-          | `InfixAppl ((tyargs, `Name n), e1, e2) when Lib.is_pure_primitive n ->
+          | InfixAppl ((tyargs, BinaryOp.Name n), e1, e2) when Lib.is_pure_primitive n ->
               cofv (I.apply_pure (instantiate n tyargs, [ev e1; ev e2]))
-          | `InfixAppl ((tyargs, `Name n), e1, e2) ->
+          | InfixAppl ((tyargs, BinaryOp.Name n), e1, e2) ->
               I.apply (instantiate n tyargs, [ev e1; ev e2])
-          | `InfixAppl ((tyargs, `Cons), e1, e2) ->
+          | InfixAppl ((tyargs, BinaryOp.Cons), e1, e2) ->
               cofv (I.apply_pure (instantiate "Cons" tyargs, [ev e1; ev e2]))
-          | `InfixAppl ((tyargs, `FloatMinus), e1, e2) ->
+          | InfixAppl ((tyargs, BinaryOp.FloatMinus), e1, e2) ->
               cofv (I.apply_pure (instantiate "-." tyargs, [ev e1; ev e2]))
-          | `InfixAppl ((tyargs, `Minus), e1, e2) ->
+          | InfixAppl ((tyargs, BinaryOp.Minus), e1, e2) ->
               cofv (I.apply_pure (instantiate "-" tyargs, [ev e1; ev e2]))
-          | `InfixAppl ((_tyargs, `And), e1, e2) ->
+          | InfixAppl ((_tyargs, BinaryOp.And), e1, e2) ->
               (* IMPORTANT: we compile boolean expressions to
                  conditionals in order to faithfully capture
                  short-circuit evaluation *)
               I.condition (ev e1, ec e2, cofv (I.constant (`Bool false)))
-          | `InfixAppl ((_tyargs, `Or), e1, e2) ->
+          | InfixAppl ((_tyargs, BinaryOp.Or), e1, e2) ->
               I.condition (ev e1, cofv (I.constant (`Bool true)), ec e2)
-          | `UnaryAppl ((_tyargs, `Minus), e) ->
+          | UnaryAppl ((_tyargs, UnaryOp.Minus), e) ->
               cofv (I.apply_pure(instantiate_mb "negate", [ev e]))
-          | `UnaryAppl ((_tyargs, `FloatMinus), e) ->
+          | UnaryAppl ((_tyargs, UnaryOp.FloatMinus), e) ->
               cofv (I.apply_pure(instantiate_mb "negatef", [ev e]))
-          | `UnaryAppl ((tyargs, `Name n), e) when Lib.is_pure_primitive n ->
+          | UnaryAppl ((tyargs, UnaryOp.Name n), e) when Lib.is_pure_primitive n ->
               cofv (I.apply_pure(instantiate n tyargs, [ev e]))
-          | `UnaryAppl ((tyargs, `Name n), e) ->
+          | UnaryAppl ((tyargs, UnaryOp.Name n), e) ->
               I.apply (instantiate n tyargs, [ev e])
-          | `FnAppl ({Sugartypes.node=`Var f; _}, es) when Lib.is_pure_primitive f ->
+          | FnAppl ({node=Var f; _}, es) when Lib.is_pure_primitive f ->
               cofv (I.apply_pure (I.var (lookup_name_and_type f env), evs es))
-          | `FnAppl ({Sugartypes.node=`TAppl ({Sugartypes.node=`Var f; _}, tyargs); _}, es)
+          | FnAppl ({node=TAppl ({node=Var f; _}, tyargs); _}, es)
                when Lib.is_pure_primitive f ->
               cofv (I.apply_pure (instantiate f tyargs, evs es))
-          | `FnAppl (e, es) when is_pure_primitive e ->
+          | FnAppl (e, es) when is_pure_primitive e ->
               cofv (I.apply_pure (ev e, evs es))
-          | `FnAppl (e, es) ->
+          | FnAppl (e, es) ->
               I.apply (ev e, evs es)
-          | `TAbstr (tyvars, e) ->
+          | TAbstr (tyvars, e) ->
               let v = ev e in
                 cofv (I.tabstr (Types.unbox_quantifiers tyvars, v))
-          | `TAppl (e, tyargs) ->
+          | TAppl (e, tyargs) ->
               let v = ev e in
               let vt = I.sem_type v in
                 begin
@@ -827,50 +830,50 @@ struct
                   with
                       Instantiate.ArityMismatch ->
                         prerr_endline ("Arity mismatch in type application (Sugartoir)");
-                        prerr_endline ("expression: " ^ Sugartypes.show_phrasenode (`TAppl (e, tyargs)));
+                        prerr_endline ("expression: " ^ show_phrasenode (TAppl (e, tyargs)));
                         prerr_endline ("type: "^Types.string_of_datatype vt);
                         prerr_endline ("tyargs: "^String.concat "," (List.map (fun t -> Types.string_of_type_arg t) tyargs));
                         failwith "fatal internal error"
                 end
-          | `TupleLit [e] ->
+          | TupleLit [e] ->
               (* It isn't entirely clear whether there should be any 1-tuples at this stage,
                  but if there are we should get rid of them.
 
                  The parser certainly doesn't disallow them.
               *)
               ec e
-          | `TupleLit es ->
+          | TupleLit es ->
               let fields = mapIndex (fun e i -> (string_of_int (i+1), ev e)) es in
                 cofv (I.record (fields, None))
-          | `RecordLit (fields, rest) ->
+          | RecordLit (fields, rest) ->
               cofv
                 (I.record
                    (List.map (fun (name, e) -> (name, ev e)) fields,
                     opt_map ev rest))
-          | `Projection (e, name) ->
+          | Projection (e, name) ->
               cofv (I.project (ev e, name))
-          | `With (e, fields) ->
+          | With (e, fields) ->
               cofv (I.update
                       (ev e,
                        List.map (fun (name, e) -> (name, ev e)) fields))
-          | `TypeAnnotation (e, _) ->
+          | TypeAnnotation (e, _) ->
               (* we might consider getting rid of type annotations before here *)
               ec e
-          | `Upcast (e, (_, Some t), _) ->
+          | Upcast (e, (_, Some t), _) ->
               cofv (I.coerce (ev e, t))
-          | `ConstructorLit (name, None, Some t) ->
+          | ConstructorLit (name, None, Some t) ->
               cofv (I.inject (name, I.record ([], None), t))
-          | `ConstructorLit (name, Some e, Some t) ->
+          | ConstructorLit (name, Some e, Some t) ->
               cofv (I.inject (name, ev e, t))
-          | `DoOperation (name, ps, Some t) ->
+          | DoOperation (name, ps, Some t) ->
              let vs = evs ps in
              I.do_operation (name, vs, t)
-          | `Handle { Sugartypes.sh_expr; Sugartypes.sh_effect_cases; Sugartypes.sh_value_cases; Sugartypes.sh_descr } ->
+          | Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
              let henv, params =
-               let empty_env = (NEnv.empty, TEnv.empty, Types.make_empty_open_row (`Any, `Any)) in
-                match Sugartypes.(sh_descr.shd_params) with
+               let empty_env = (NEnv.empty, TEnv.empty, Types.make_empty_open_row (lin_any, res_any)) in
+                match (sh_descr.shd_params) with
                 | None -> empty_env, []
-                | Some { Sugartypes.shp_bindings = bindings; Sugartypes.shp_types = types } ->
+                | Some { shp_bindings = bindings; shp_types = types } ->
                    let env, bindings =
                      List.fold_left2
                        (fun (env, bindings) (body, p) t ->
@@ -896,7 +899,7 @@ struct
                   sh_value_cases
              in
              I.handle env (ec sh_expr, val_cases, eff_cases, params, sh_descr)
-          | `Switch (e, cases, Some t) ->
+          | Switch (e, cases, Some t) ->
               let cases =
                 List.map
                   (fun (p, body) ->
@@ -905,45 +908,45 @@ struct
                   cases
               in
                 I.switch env (ev e, cases, t)
-          | `DatabaseLit (name, (None, _)) ->
-              I.database (ev (with_pos pos (`RecordLit ([("name", name)],
-                                          Some (with_pos pos (`FnAppl (with_pos pos (`Var "getDatabaseConfig"), [])))))))
-          | `DatabaseLit (name, (Some driver, args)) ->
+          | DatabaseLit (name, (None, _)) ->
+              I.database (ev (with_pos pos (RecordLit ([("name", name)],
+                                          Some (with_pos pos (FnAppl (with_pos pos (Var "getDatabaseConfig"), [])))))))
+          | DatabaseLit (name, (Some driver, args)) ->
               let args =
                 match args with
-                  | None -> with_pos pos (`Constant (`String ""))
+                  | None -> with_pos pos (Constant (`String ""))
                   | Some args -> args
               in
                 I.database
-                  (ev (with_pos pos (`RecordLit ([("name", name); ("driver", driver); ("args", args)], None))))
-          | `LensLit (table, Some t) ->
+                  (ev (with_pos pos (RecordLit ([("name", name); ("driver", driver); ("args", args)], None))))
+          | LensLit (table, Some t) ->
               let table = ev table in
                 I.lens_handle (table, t)
-          | `LensDropLit (lens, drop, key, default, Some t) ->
+          | LensDropLit (lens, drop, key, default, Some t) ->
               let lens = ev lens in
               let default = ev default in
                 I.lens_drop_handle (lens, drop, key, default, t)
-          | `LensSelectLit (lens, pred, Some t) ->
+          | LensSelectLit (lens, pred, Some t) ->
               let lens = ev lens in
               let pred = Lens.Phrase.of_phrase pred in
                 I.lens_select_handle (lens, pred, t)
-          | `LensJoinLit (lens1, lens2, on, left, right, Some t) ->
+          | LensJoinLit (lens1, lens2, on, left, right, Some t) ->
               let lens1 = ev lens1 in
               let lens2 = ev lens2 in
               let on = Lens.Types.cols_of_phrase on in
               let left = Lens.Phrase.of_phrase left in
               let right = Lens.Phrase.of_phrase right in
                 I.lens_join_handle (lens1, lens2, on, left, right, t)
-          | `LensGetLit (lens, Some t) ->
+          | LensGetLit (lens, Some t) ->
               let lens = ev lens in
                 I.lens_get (lens, t)
-          | `LensPutLit (lens, data, Some t) ->
+          | LensPutLit (lens, data, Some t) ->
               let lens = ev lens in
               let data = ev data in
                 I.lens_put (lens, data, t)
-          | `TableLit (name, (_, Some (readtype, writetype, neededtype)), _constraints, keys, db) ->
+          | TableLit (name, (_, Some (readtype, writetype, neededtype)), _constraints, keys, db) ->
               I.table_handle (ev db, ev name, ev keys, (readtype, writetype, neededtype))
-          | `Xml (tag, attrs, attrexp, children) ->
+          | Xml (tag, attrs, attrexp, children) ->
               (* check for duplicates *)
               let () =
                 let rec dup_check names =
@@ -979,15 +982,15 @@ struct
                       | Some e ->
                           cofv (I.apply_pure (instantiate_mb "addAttributes", [body; ev e]))
                     end
-          | `TextNode name ->
+          | TextNode name ->
               cofv
                 (I.apply_pure
-                   (instantiate_mb "stringToXml", [ev (with_pos pos (`Constant (`String name)))]))
-          | `Block (bs, e) -> eval_bindings `Local env bs e
-          | `Query (range, e, _) ->
+                   (instantiate_mb "stringToXml", [ev (with_pos pos (Constant (`String name)))]))
+          | Block (bs, e) -> eval_bindings `Local env bs e
+          | Query (range, e, _) ->
               I.query (opt_map (fun (limit, offset) -> (ev limit, ev offset)) range, ec e)
 
-          | `DBUpdate (p, source, where, fields) ->
+          | DBUpdate (p, source, where, fields) ->
               let p, penv = CompilePatterns.desugar_pattern `Local p in
               let env' = env ++ penv in
               let source = ev source in
@@ -995,9 +998,9 @@ struct
                 opt_map
                   (fun where -> eval env' where)
                   where in
-              let body = eval env' (Sugartypes.with_dummy_pos (`RecordLit (fields, None))) in
+              let body = eval env' (with_dummy_pos (RecordLit (fields, None))) in
                 I.db_update env (p, source, where, body)
-          | `DBDelete (p, source, where) ->
+          | DBDelete (p, source, where) ->
               let p, penv = CompilePatterns.desugar_pattern `Local p in
               let env' = env ++ penv in
               let source = ev source in
@@ -1008,9 +1011,9 @@ struct
               in
                 I.db_delete env (p, source, where)
 
-          | `Select (l, e) ->
+          | Select (l, e) ->
              I.select (l, ev e)
-          | `Offer (e, cases, Some t) ->
+          | Offer (e, cases, Some t) ->
               let cases =
                 List.map
                   (fun (p, body) ->
@@ -1021,41 +1024,41 @@ struct
                 I.offer env (ev e, cases, t)
 
                   (* These things should all have been desugared already *)
-          | `Spawn _
-          | `Receive _
-          | `Section (`Project _)
-          | `FunLit _
-          | `Iteration _
-          | `InfixAppl ((_, `RegexMatch _), _, _)
-          | `DBInsert _
-          | `Regex _
-          | `Formlet _
-          | `Page _
-          | `FormletPlacement _
-          | `PagePlacement _
-          | `FormBinding _
-          | `ListLit _
-          | `Escape _
-          | `Upcast _
-          | `ConstructorLit _
-          | `Switch _
-          | `TableLit _
-          | `LensLit _
-          | `LensDropLit _
-          | `LensSelectLit _
-          | `LensJoinLit _
-          | `LensGetLit _
-          | `LensPutLit _
-          | `LensFunDepsLit _
-          | `LensKeysLit _
-          | `Offer _
-          | `QualifiedVar _
-          | `HandlerLit _
-          | `DoOperation _
-          | `TryInOtherwise _
-          | `Raise
-          | `CP _ ->
-              Debug.print ("oops: " ^ Sugartypes.show_phrasenode e);
+          | Spawn _
+          | Receive _
+          | Section (Section.Project _)
+          | FunLit _
+          | Iteration _
+          | InfixAppl ((_, BinaryOp.RegexMatch _), _, _)
+          | DBInsert _
+          | Regex _
+          | Formlet _
+          | Page _
+          | FormletPlacement _
+          | PagePlacement _
+          | FormBinding _
+          | ListLit _
+          | Escape _
+          | Upcast _
+          | ConstructorLit _
+          | Switch _
+          | TableLit _
+          | LensLit _
+          | LensDropLit _
+          | LensSelectLit _
+          | LensJoinLit _
+          | LensGetLit _
+          | LensPutLit _
+          | LensFunDepsLit _
+          | LensKeysLit _
+          | Offer _
+          | QualifiedVar _
+          | HandlerLit _
+          | DoOperation _
+          | TryInOtherwise _
+          | Raise
+          | CP _ ->
+              Debug.print ("oops: " ^ show_phrasenode e);
               assert false
 
   and eval_bindings scope env bs' e =
@@ -1065,27 +1068,28 @@ struct
         | [] -> ec e
         | { Sugartypes.node = b; _ }::bs ->
             begin
+              let open Sugartypes in
               match b with
-                | `Val ({Sugartypes.node=`Variable bndr; _}, (_, body), _, _)
-                     when Sugartypes.binder_has_type bndr ->
-                    let x  = Sugartypes.name_of_binder bndr in
-                    let xt = Sugartypes.type_of_binder_exn bndr in
+                | Val ({node=Pattern.Variable bndr; _}, (_, body), _, _)
+                     when binder_has_type bndr ->
+                    let x  = name_of_binder bndr in
+                    let xt = type_of_binder_exn bndr in
                     let x_info = (xt, x, scope) in
                       I.letvar
                         (x_info,
                          ec body,
                          fun v ->
                            eval_bindings scope (extend [x] [(v, xt)] env) bs e)
-                | `Val (p, (_, body), _, _) ->
+                | Val (p, (_, body), _, _) ->
                     let p, penv = CompilePatterns.desugar_pattern scope p in
                     let env' = env ++ penv in
                     let s = ev body in
                     let ss = eval_bindings scope env' bs e in
                       I.comp env (p, s, ss)
-                | `Fun (bndr, _, (tyvars, ([ps], body)), location, _)
-                     when Sugartypes.binder_has_type bndr ->
-                    let f  = Sugartypes.name_of_binder bndr in
-                    let ft = Sugartypes.type_of_binder_exn bndr in
+                | Fun (bndr, _, (tyvars, ([ps], body)), location, _)
+                     when binder_has_type bndr ->
+                    let f  = name_of_binder bndr in
+                    let ft = type_of_binder_exn bndr in
                     let ps, body_env =
                       List.fold_right
                         (fun p (ps, body_env) ->
@@ -1098,14 +1102,14 @@ struct
                         env
                         ((ft, f, scope), (tyvars, (ps, body)), location)
                         (fun v -> eval_bindings scope (extend [f] [(v, ft)] env) bs e)
-                | `Exp e' ->
+                | Exp e' ->
                     I.comp env (`Any, ev e', eval_bindings scope env bs e)
-                | `Funs defs ->
+                | Funs defs ->
                     let fs, inner_fts, outer_fts =
                       List.fold_right
                         (fun (bndr, _, ((_tyvars, inner_opt), _), _, _, _) (fs, inner_fts, outer_fts) ->
-                          let f          = Sugartypes.name_of_binder     bndr in
-                          let outer_opt  = Sugartypes.type_of_binder bndr in
+                          let f          = name_of_binder     bndr in
+                          let outer_opt  = type_of_binder bndr in
                           let outer      = OptionUtils.val_of outer_opt in
                           let (inner, _) = OptionUtils.val_of inner_opt in
                               (f::fs, inner::inner_fts, outer::outer_fts))
@@ -1115,8 +1119,8 @@ struct
                       List.map
                         (fun (bndr, _, ((tyvars, _), (pss, body)), location, _, _) ->
                           assert (List.length pss = 1);
-                          let f      = Sugartypes.name_of_binder     bndr in
-                          let ft_opt = Sugartypes.type_of_binder bndr in
+                          let f      = name_of_binder     bndr in
+                          let ft_opt = type_of_binder bndr in
                           let ft     = OptionUtils.val_of ft_opt in
                           let ps     = List.hd pss in
                            let ps, body_env =
@@ -1131,17 +1135,18 @@ struct
                         defs
                     in
                       I.letrec env defs (fun vs -> eval_bindings scope (extend fs (List.combine vs outer_fts) env) bs e)
-                | `Foreign (bndr, raw_name, language, _file, _)
-                     when Sugartypes.binder_has_type bndr ->
-                    let x  = Sugartypes.name_of_binder bndr in
-                    let xt = Sugartypes.type_of_binder_exn bndr in
+                | Foreign (bndr, raw_name, language, _file, _)
+                     when binder_has_type bndr ->
+                    let x  = name_of_binder bndr in
+                    let xt = type_of_binder_exn bndr in
                     I.alien ((xt, x, scope), raw_name, language, fun v -> eval_bindings scope (extend [x] [(v, xt)] env) bs e)
-                | `Type _
-                | `Infix ->
+                | Type _
+                | Infix ->
                     (* Ignore type alias and infix declarations - they
                        shouldn't be needed in the IR *)
                     eval_bindings scope env bs e
-                | `Handler _ | `QualifiedImport _ | `Fun _ | `Foreign _ | `AlienBlock _ | `Module _ -> assert false
+                | Handler _ | QualifiedImport _ | Fun _ | Foreign _
+                | AlienBlock _ | Module _ -> assert false
             end
 
   and evalv env e =
@@ -1203,7 +1208,7 @@ struct
 (*     Debug.print (Sugartypes.show_program (bindings, body)); *)
     let body =
       match body with
-        | None -> Sugartypes.with_dummy_pos (`RecordLit ([], None))
+        | None -> Sugartypes.with_dummy_pos (Sugartypes.RecordLit ([], None))
         | Some body -> body in
       let s = eval_bindings `Global env bindings body in
         let r = (I.reify s) in
diff --git a/core/sugartypes.ml b/core/sugartypes.ml
index 219f2ea53..78f034487 100644
--- a/core/sugartypes.ml
+++ b/core/sugartypes.ml
@@ -1,60 +1,16 @@
+open CommonTypes
+open Operators
 open Utility
 
 (** The syntax tree created by the parser. *)
 
-(* The operators named here are the ones that it is difficult or
-   impossible to define as "user" infix operators:
-
-      - -.  are both infix and prefix
-     && ||  have special evaluation
-     ::     is also used in patterns
-     ~      triggers a lexer state switch
-*)
-
 type name = string [@@deriving show]
 
-type unary_op = [
-| `Minus
-| `FloatMinus
-| `Name of name
-]
-and regexflag = RegexList | RegexNative | RegexGlobal | RegexReplace
-    [@@deriving show]
-type logical_binop = [`And | `Or ]
-    [@@deriving show]
-type binop = [ `Minus | `FloatMinus | `RegexMatch of regexflag list | logical_binop | `Cons | `Name of name ]
-    [@@deriving show]
-
-let string_of_unary_op =
-  function
-    | `Minus -> "-"
-    | `FloatMinus -> ".-"
-    | `Name name -> name
-
-let string_of_binop =
-  function
-    | `Minus -> "-"
-    | `FloatMinus -> ".-"
-    | `RegexMatch _ -> "<some regex nonsense>"
-    | `And -> "&&"
-    | `Or -> "||"
-    | `Cons -> "::"
-    | `Name name -> name
-
-let binop_of_string : string -> binop =
-   function
-      | "-" -> `Minus
-      | ".-" -> `FloatMinus
-      | "&&" -> `And
-      | "||" -> `Or
-      | "::" -> `Cons
-      | name -> `Name name
-
-
 type position = SourceCode.pos
 let dummy_position = SourceCode.dummy_pos
 
-let pp_position : Format.formatter -> position -> unit = fun fmt _ -> Utility.format_omission fmt
+let pp_position : Format.formatter -> position -> unit =
+  fun fmt _ -> Utility.format_omission fmt
 
 type 'a with_pos = { node : 'a
                    ; pos  : position }
@@ -63,6 +19,13 @@ type 'a with_pos = { node : 'a
 let with_pos           pos node   = { node; pos }
 let with_dummy_pos     node       = { node; pos = dummy_position }
 
+(* A type alias to be used inside modules that define a node t and a with_pos
+   type, which is a node with attached position.  Alias is required due to
+   with_pos name inside the module overlapping with top-level with_pos type. *)
+module WithPos = struct
+  type 'a t = 'a with_pos [@@deriving show]
+end
+
 type binder = (name * Types.datatype option) with_pos
     [@@deriving show]
 
@@ -70,10 +33,10 @@ let name_of_binder     {node=(n,_ );_} = n
 let type_of_binder     {node=(_,ty);_} = ty
 let type_of_binder_exn {node=(_,ty);_} =
   OptionUtils.val_of ty (* raises exception when ty = None *)
-let set_binder_name   {node=(_   ,ty); pos} name = with_pos pos (name, ty     )
-let set_binder_type   {node=(name,_ ); pos} ty   = with_pos pos (name, Some ty)
-let erase_binder_type {node=(name,_ ); pos}      = with_pos pos (name, None   )
-let binder_has_type   {node=(_   ,ty); _  }      = Utility.OptionUtils.is_some ty
+let set_binder_name    {node=(_   ,ty); pos} name = with_pos pos (name, ty     )
+let set_binder_type    {node=(name,_ ); pos} ty   = with_pos pos (name, Some ty)
+let erase_binder_type  {node=(name,_ ); pos}      = with_pos pos (name, None   )
+let binder_has_type    {node=(_   ,ty); _  }      = OptionUtils.is_some ty
 
 (* type variables *)
 type tyvar = Types.quantifier
@@ -88,32 +51,15 @@ type tyarg = Types.type_arg
    i.e. in let-bindings.
 *)
 
-type location = [`Client | `Server | `Native | `Unknown]
-    [@@deriving show]
-
-let string_of_location = function
-| `Client -> "client"
-| `Server -> "server"
-| `Native -> "native"
-| `Unknown -> "unknown"
-
-type restriction = [ `Any | `Base | `Session | `Effect ]
-    [@@deriving eq,show]
-type linearity   = [ `Any | `Unl ]
-    [@@deriving eq,show]
-
-type subkind = linearity * restriction
+type subkind = Linearity.t * Restriction.t
     [@@deriving eq,show]
 
-let default_subkind = (`Unl, `Any)
+let default_subkind : subkind = (lin_unl, res_any)
 
 type freedom = [`Flexible | `Rigid]
     [@@deriving show]
 
-type primary_kind = [`Type | `Row | `Presence]
-    [@@deriving show]
-
-type kind = primary_kind * subkind option
+type kind = PrimaryKind.t * subkind option
     [@@deriving show]
 
 type type_variable = name * kind * freedom
@@ -131,98 +77,112 @@ let rigidify (name, kind, _) = (name, kind, `Rigid)
 type fieldconstraint = Readonly | Default
     [@@deriving show]
 
-type datatypenode =
-  [ `TypeVar         of known_type_variable
-  | `QualifiedTypeApplication of (name list * type_arg list)
-  | `Function        of datatype list * row * datatype
-  | `Lolli           of datatype list * row * datatype
-  | `Mu              of name * datatype
-  | `Forall          of quantifier list * datatype
-  | `Unit
-  | `Tuple           of datatype list
-  | `Record          of row
-  | `Variant         of row
-  | `Effect          of row
-  | `Table           of datatype * datatype * datatype
-  | `List            of datatype
-  | `TypeApplication of (string * type_arg list)
-  | `Primitive       of Types.primitive
-  | `DB
-  | `Input           of datatype * datatype
-  | `Output          of datatype * datatype
-  | `Select          of row
-  | `Choice          of row
-  | `Dual            of datatype
-  | `End ]
-and datatype = datatypenode with_pos
-and row = (string * fieldspec) list * row_var
-and row_var =
-    [ `Closed
-    | `Open of known_type_variable
-    | `Recursive of name * row ]
-and fieldspec =
-    [ `Present of datatype
-    | `Absent
-    | `Var of known_type_variable ]
-and type_arg =
-    [ `Type of datatype
-    | `Row of row
-    | `Presence of fieldspec ]
+module Datatype = struct
+  type t =
+    | TypeVar         of known_type_variable
+    | QualifiedTypeApplication of (name list * type_arg list)
+    | Function        of with_pos list * row * with_pos
+    | Lolli           of with_pos list * row * with_pos
+    | Mu              of name * with_pos
+    | Forall          of quantifier list * with_pos
+    | Unit
+    | Tuple           of with_pos list
+    | Record          of row
+    | Variant         of row
+    | Effect          of row
+    | Table           of with_pos * with_pos * with_pos
+    | List            of with_pos
+    | TypeApplication of (string * type_arg list)
+    | Primitive       of Types.primitive
+    | DB
+    | Input           of with_pos * with_pos
+    | Output          of with_pos * with_pos
+    | Select          of row
+    | Choice          of row
+    | Dual            of with_pos
+    | End
+  and with_pos = t WithPos.t
+  and row = (string * fieldspec) list * row_var
+  and row_var =
+    | Closed
+    | Open of known_type_variable
+    | Recursive of name * row
+  and fieldspec =
+    | Present of with_pos
+    | Absent
+    | Var of known_type_variable
+  and type_arg =
+    | Type of with_pos
+    | Row of row
+    | Presence of fieldspec
       [@@deriving show]
+end
 
 (* Store the denotation along with the notation once it's computed *)
-type datatype' = datatype * Types.datatype option
+type datatype' = Datatype.with_pos * Types.datatype option
     [@@deriving show]
 
 type constant = Constant.constant
     [@@deriving show]
 
-type patternnode = [
-| `Any
-| `Nil
-| `Cons     of pattern * pattern
-| `List     of pattern list
-| `Variant  of name * pattern option
-| `Effect   of name * pattern list * pattern
-| `Negative of name list
-| `Record   of (name * pattern) list * pattern option
-| `Tuple    of pattern list
-| `Constant of constant
-| `Variable of binder
-| `As       of binder * pattern
-| `HasType  of pattern * datatype'
-]
-and pattern = patternnode with_pos
-    [@@deriving show]
+module Pattern = struct
+  type t =
+    | Any
+    | Nil
+    | Cons     of with_pos * with_pos
+    | List     of with_pos list
+    | Variant  of name * with_pos option
+    | Effect   of name * with_pos list * with_pos
+    | Negative of name list
+    | Record   of (name * with_pos) list * with_pos option
+    | Tuple    of with_pos list
+    | Constant of constant
+    | Variable of binder
+    | As       of binder * with_pos
+    | HasType  of with_pos * datatype'
+  and with_pos = t WithPos.t
+   [@@deriving show]
+end
 
 type spawn_kind = Angel | Demon | Wait
     [@@deriving show]
 
-type replace_rhs = [
-| `Literal of string
-| `Splice  of phrase
-]
+module Section = struct
+  type t = Minus | FloatMinus | Project of name | Name of name
+    [@@deriving show]
+end
+
+type fn_dep = string * string
+    [@@deriving show]
+
+type handler_depth = Deep | Shallow
+    [@@deriving show]
+
+type replace_rhs =
+  | Literal     of string
+  | SpliceExpr  of phrase
 and given_spawn_location =
-| ExplicitSpawnLocation of phrase (* spawnAt function *)
-| SpawnClient (* spawnClient function *)
-| NoSpawnLocation (* spawn function *)
+  | ExplicitSpawnLocation of phrase (* spawnAt function *)
+  | SpawnClient (* spawnClient function *)
+  | NoSpawnLocation (* spawn function *)
 and regex =
-| Range     of (char * char)
-| Simply    of string
-| Quote     of regex
-| Any
-| StartAnchor
-| EndAnchor
-| Seq       of regex list
-| Alternate of (regex * regex)
-| Group     of regex
-| Repeat    of (Regex.repeat * regex)
-| Splice    of phrase
-| Replace   of (regex * replace_rhs)
-and clause = pattern * phrase
-and funlit = pattern list list * phrase
-and handler_depth = Deep | Shallow
-and handlerlit = handler_depth * pattern * clause list * pattern list list option (* computation arg, cases, parameters *)
+  | Range     of (char * char)
+  | Simply    of string
+  | Quote     of regex
+  | Any
+  | StartAnchor
+  | EndAnchor
+  | Seq       of regex list
+  | Alternate of (regex * regex)
+  | Group     of regex
+  | Repeat    of (Regex.repeat * regex)
+  | Splice    of phrase
+  | Replace   of (regex * replace_rhs)
+and clause = Pattern.with_pos * phrase
+and funlit = Pattern.with_pos list list * phrase
+and handlerlit =
+  handler_depth * Pattern.with_pos * clause list *
+    Pattern.with_pos list list option (* computation arg, cases, parameters *)
 and handler = {
   sh_expr: phrase;
   sh_effect_cases: clause list;
@@ -236,114 +196,132 @@ and handler_descriptor = {
   shd_params: handler_parameterisation option
 }
 and handler_parameterisation = {
-  shp_bindings: (phrase * pattern) list;
+  shp_bindings: (phrase * Pattern.with_pos) list;
   shp_types: Types.datatype list
 }
-and iterpatt = [
-| `List of pattern * phrase
-| `Table of pattern * phrase
-]
-and sec = [`Minus | `FloatMinus | `Project of name | `Name of name]
-and declared_linearity = [ `Lin | `Unl ]
-and fn_dep = string * string
-and phrasenode = [
-| `Constant         of constant
-| `Var              of name
-| `QualifiedVar     of name list
-| `FunLit           of ((Types.datatype * Types.row) list) option * declared_linearity * funlit * location
-| `HandlerLit       of handlerlit
-(* Spawn kind, expression referring to spawn location (client n, server...), spawn block, row opt *)
-| `Spawn            of spawn_kind * given_spawn_location * phrase * Types.row option
-| `Query            of (phrase * phrase) option * phrase * Types.datatype option
-| `RangeLit         of (phrase * phrase)
-| `ListLit          of phrase list * Types.datatype option
-| `Iteration        of iterpatt list * phrase
-    * (*where:*)   phrase option
-                    * (*orderby:*) phrase option
-| `Escape           of binder * phrase
-| `Section          of sec
-| `Conditional      of phrase * phrase * phrase
-| `Block            of block_body
-| `InfixAppl        of (tyarg list * binop) * phrase * phrase
-| `Regex            of regex
-| `UnaryAppl        of (tyarg list * unary_op) * phrase
-| `FnAppl           of phrase * phrase list
-| `TAbstr           of tyvar list ref * phrase
-| `TAppl            of phrase * tyarg list
-| `TupleLit         of phrase list
-| `RecordLit        of (name * phrase) list * phrase option
-| `Projection       of phrase * name
-| `With             of phrase * (name * phrase) list
-| `TypeAnnotation   of phrase * datatype'
-| `Upcast           of phrase * datatype' * datatype'
-| `ConstructorLit   of name * phrase option * Types.datatype option
-| `DoOperation      of name * phrase list * Types.datatype option
-| `Handle           of handler
-| `Switch           of phrase * (pattern * phrase) list * Types.datatype option
-| `Receive          of (pattern * phrase) list * Types.datatype option
-| `DatabaseLit      of phrase * (phrase option * phrase option)
-(* | `TableLit         of phrase * (datatype * (Types.datatype * Types.datatype * Types.datatype) option) * (name * fieldconstraint list) list * phrase *)
-| `TableLit         of phrase * (datatype * (Types.datatype * Types.datatype * Types.datatype) option) * (name * fieldconstraint list) list * phrase * phrase
-| `DBDelete         of pattern * phrase * phrase option
-| `DBInsert         of phrase * name list * phrase * phrase option
-| `DBUpdate         of pattern * phrase * phrase option * (name * phrase) list
-| `LensLit          of phrase * Types.lens_sort option
-(* the lens keys lit is a literal that takes an expression and is converted into a LensLit
-   with the corresponding table keys marked in the lens_sort *)
-| `LensKeysLit      of phrase * phrase * Types.lens_sort option
-| `LensFunDepsLit   of phrase * (string list * string list) list * Types.lens_sort option
-| `LensDropLit      of phrase * string * string * phrase * Types.lens_sort option
-| `LensSelectLit    of phrase * phrase * Types.lens_sort option
-| `LensJoinLit      of phrase * phrase * phrase * phrase * phrase * Types.lens_sort option
-| `LensGetLit       of phrase * Types.datatype option
-| `LensPutLit       of phrase * phrase * Types.datatype option
-| `Xml              of name * (name * (phrase list)) list * phrase option * phrase list
-| `TextNode         of string
-| `Formlet          of phrase * phrase
-| `Page             of phrase
-| `FormletPlacement of phrase * phrase * phrase
-| `PagePlacement    of phrase
-| `FormBinding      of phrase * pattern
-(* choose *)
-| `Select           of name * phrase
-(* choice *)
-| `Offer            of phrase * (pattern * phrase) list * Types.datatype option
-(* | `Fork             of binder * phrase *)
-| `CP               of cp_phrase
-| `TryInOtherwise   of (phrase * pattern * phrase * phrase * Types.datatype option)
-| `Raise
-]
+and iterpatt =
+  | List  of (Pattern.with_pos * phrase)
+  | Table of (Pattern.with_pos * phrase)
+and phrasenode =
+  | Constant         of constant
+  | Var              of name
+  | QualifiedVar     of name list
+  | FunLit           of ((Types.datatype * Types.row) list) option *
+                          DeclaredLinearity.t * funlit * Location.t
+  | HandlerLit       of handlerlit
+  (* Spawn kind, expression referring to spawn location (client n, server...),
+      spawn block, row opt *)
+  | Spawn            of spawn_kind * given_spawn_location * phrase *
+                          Types.row option
+  | Query            of (phrase * phrase) option * phrase *
+                          Types.datatype option
+  | RangeLit         of (phrase * phrase)
+  | ListLit          of phrase list * Types.datatype option
+  | Iteration        of iterpatt list * phrase
+                        * (*where:*)   phrase option
+                        * (*orderby:*) phrase option
+  | Escape           of binder * phrase
+  | Section          of Section.t
+  | Conditional      of phrase * phrase * phrase
+  | Block            of block_body
+  | InfixAppl        of (tyarg list * BinaryOp.t) * phrase * phrase
+  | Regex            of regex
+  | UnaryAppl        of (tyarg list * UnaryOp.t) * phrase
+  | FnAppl           of phrase * phrase list
+  | TAbstr           of tyvar list ref * phrase
+  | TAppl            of phrase * tyarg list
+  | TupleLit         of phrase list
+  | RecordLit        of (name * phrase) list * phrase option
+  | Projection       of phrase * name
+  | With             of phrase * (name * phrase) list
+  | TypeAnnotation   of phrase * datatype'
+  | Upcast           of phrase * datatype' * datatype'
+  | ConstructorLit   of name * phrase option * Types.datatype option
+  | DoOperation      of name * phrase list * Types.datatype option
+  | Handle           of handler
+  | Switch           of phrase * (Pattern.with_pos * phrase) list *
+                          Types.datatype option
+  | Receive          of (Pattern.with_pos * phrase) list * Types.datatype option
+  | DatabaseLit      of phrase * (phrase option * phrase option)
+  | TableLit         of phrase * (Datatype.with_pos * (Types.datatype *
+                           Types.datatype * Types.datatype) option) *
+                          (name * fieldconstraint list) list * phrase * phrase
+  | DBDelete         of Pattern.with_pos * phrase * phrase option
+  | DBInsert         of phrase * name list * phrase * phrase option
+  | DBUpdate         of Pattern.with_pos * phrase * phrase option *
+                          (name * phrase) list
+  | LensLit          of phrase * Types.lens_sort option
+  (* the lens keys lit is a literal that takes an expression and is converted
+     into a LensLit with the corresponding table keys marked in the lens_sort *)
+  | LensKeysLit      of phrase * phrase * Types.lens_sort option
+  | LensFunDepsLit   of phrase * (string list * string list) list *
+                          Types.lens_sort option
+  | LensDropLit      of phrase * string * string * phrase *
+                          Types.lens_sort option
+  | LensSelectLit    of phrase * phrase * Types.lens_sort option
+  | LensJoinLit      of phrase * phrase * phrase * phrase * phrase *
+                          Types.lens_sort option
+  | LensGetLit       of phrase * Types.datatype option
+  | LensPutLit       of phrase * phrase * Types.datatype option
+  | Xml              of name * (name * (phrase list)) list * phrase option *
+                          phrase list
+  | TextNode         of string
+  | Formlet          of phrase * phrase
+  | Page             of phrase
+  | FormletPlacement of phrase * phrase * phrase
+  | PagePlacement    of phrase
+  | FormBinding      of phrase * Pattern.with_pos
+  (* choose *)
+  | Select           of name * phrase
+  (* choice *)
+  | Offer            of phrase * (Pattern.with_pos * phrase) list *
+                          Types.datatype option
+  | CP               of cp_phrase
+  | TryInOtherwise   of (phrase * Pattern.with_pos * phrase * phrase *
+                           Types.datatype option)
+  | Raise
 and phrase = phrasenode with_pos
-and bindingnode = [
-| `Val     of pattern * (tyvar list * phrase) * location * datatype' option
-| `Fun     of binder * declared_linearity * (tyvar list * funlit) * location * datatype' option
-| `Funs    of (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list
-| `Handler of binder * handlerlit * datatype' option
-| `Foreign of binder * name * name * name * datatype' (* Binder, raw function name, language, external file, type *)
-| `QualifiedImport of name list
-| `Type    of name * (quantifier * tyvar option) list * datatype'
-| `Infix
-| `Exp     of phrase
-| `Module  of name * binding list
-| `AlienBlock of (name * name * ((binder * datatype') list))
-]
+and bindingnode =
+  | Val     of (Pattern.with_pos * (tyvar list * phrase) * Location.t *
+                  datatype' option)
+  | Fun     of (binder * DeclaredLinearity.t * (tyvar list * funlit) * Location.t *
+                  datatype' option)
+  | Funs    of (binder * DeclaredLinearity.t *
+                  ((tyvar list *
+                   (Types.datatype * Types.quantifier option list) option)
+                   * funlit) * Location.t * datatype' option * position) list
+  | Handler of (binder * handlerlit * datatype' option)
+  | Foreign of (binder * name * name * name * datatype')
+               (* Binder, raw function name, language, external file, type *)
+  | QualifiedImport of name list
+  | Type    of (name * (quantifier * tyvar option) list * datatype')
+  | Infix
+  | Exp     of phrase
+  | Module  of (name * binding list)
+  | AlienBlock of (name * name * ((binder * datatype') list))
 and binding = bindingnode with_pos
 and block_body = binding list * phrase
-and directive = string * string list
-and sentence =
-| Definitions of binding list
-| Expression  of phrase
-| Directive   of directive
 and cp_phrasenode =
-| Unquote     of (binding list * phrase)
-| Grab        of (string * (Types.datatype * tyarg list) option) * binder option * cp_phrase
-| Give        of (string * (Types.datatype * tyarg list) option) * phrase option * cp_phrase
-| GiveNothing of binder
-| Select      of (binder * string * cp_phrase)
-| Offer       of (binder * (string * cp_phrase) list)
-| Link        of (binder * binder)
-| Comp        of (binder * cp_phrase * cp_phrase)
+  | CPUnquote     of (binding list * phrase)
+  | CPGrab        of (string * (Types.datatype * tyarg list) option) *
+                       binder option * cp_phrase
+  | CPGive        of (string * (Types.datatype * tyarg list) option) *
+                       phrase option * cp_phrase
+  | CPGiveNothing of binder
+  | CPSelect      of (binder * string * cp_phrase)
+  | CPOffer       of (binder * (string * cp_phrase) list)
+  | CPLink        of (binder * binder)
+  | CPComp        of (binder * cp_phrase * cp_phrase)
 and cp_phrase = cp_phrasenode with_pos
+                  [@@deriving show]
+
+type directive = string * string list
+                            [@@deriving show]
+
+type sentence =
+  | Definitions of binding list
+  | Expression  of phrase
+  | Directive   of directive
     [@@deriving show]
 
 type program = binding list * phrase option
@@ -361,13 +339,12 @@ exception RedundantPatternMatch of SourceCode.pos
 let tabstr : tyvar list * phrasenode -> phrasenode = fun (tyvars, e) ->
   match tyvars with
     | [] -> e
-    | _ ->
-        `TAbstr (Types.box_quantifiers tyvars, with_dummy_pos e)
+    | _  -> TAbstr (Types.box_quantifiers tyvars, with_dummy_pos e)
 
 let tappl : phrasenode * tyarg list -> phrasenode = fun (e, tys) ->
   match tys with
     | [] -> e
-    | _ -> `TAppl (with_dummy_pos e, tys)
+    | _  -> TAppl (with_dummy_pos e, tys)
 
 module Freevars =
 struct
@@ -377,118 +354,116 @@ struct
   let union_map f = union_all -<- List.map f
   let option_map f = opt_app f empty
 
-  let rec pattern ({node; _} : pattern) : StringSet.t = match node with
-    | `Any
-    | `Nil
-    | `Constant _
-    | `Negative _            -> empty
-    | `Tuple ps
-    | `List ps               -> union_map pattern ps
-    | `Cons (p1, p2)         -> union (pattern p1) (pattern p2)
-    | `Variant (_, popt)     -> option_map pattern popt
-    | `Effect (_, ps, kopt)  -> union (union_map pattern ps) (pattern kopt)
-    | `Record (fields, popt) ->
-        union (option_map pattern popt)
-          (union_map (snd ->- pattern) fields)
-    | `Variable bndr         -> singleton (name_of_binder bndr)
-    | `As (bndr, pat)        -> add (name_of_binder bndr) (pattern pat)
-    | `HasType (pat, _)      -> pattern pat
+  let rec pattern ({node; _} : Pattern.with_pos) : StringSet.t =
+    let open Pattern in
+    match node with
+    | Any
+    | Nil
+    | Constant _
+    | Negative _            -> empty
+    | Tuple ps
+    | List ps               -> union_map pattern ps
+    | Cons (p1, p2)         -> union (pattern p1) (pattern p2)
+    | Variant (_, popt)     -> option_map pattern popt
+    | Effect (_, ps, kopt)  -> union (union_map pattern ps) (pattern kopt)
+    | Record (fields, popt) ->
+       union (option_map pattern popt)
+         (union_map (snd ->- pattern) fields)
+    | Variable bndr         -> singleton (name_of_binder bndr)
+    | As (bndr, pat)        -> add (name_of_binder bndr) (pattern pat)
+    | HasType (pat, _)      -> pattern pat
 
 
   let rec formlet_bound ({node; _} : phrase) : StringSet.t = match node with
-    | `Xml (_, _, _, children) -> union_map formlet_bound children
-    | `FormBinding (_, pat) -> pattern pat
+    | Xml (_, _, _, children) -> union_map formlet_bound children
+    | FormBinding (_, pat) -> pattern pat
     | _ -> empty
 
   let rec phrase (p : phrase) : StringSet.t =
     let p = p.node in
     match p with
-    | `Var v -> singleton v
-    | `Section (`Name n) -> singleton n
-
-    | `Constant _
-    | `TextNode _
-    | `Section (`Minus|`FloatMinus|`Project _) -> empty
-
-    | `Spawn (_, _, p, _)
-    | `TAbstr (_, p)
-    | `TAppl (p, _)
-    | `FormBinding (p, _)
-    | `Projection (p, _)
-    | `Page p
-    | `PagePlacement p
-    | `Upcast (p, _, _)
-    | `Select (_, p)
-    | `TypeAnnotation (p, _) -> phrase p
-
-    | `ListLit (ps, _)
-    | `TupleLit ps -> union_map phrase ps
-
-    | `LensLit (l, _) -> phrase l
+    | Var v -> singleton v
+    | Section (Section.Name n) -> singleton n
+
+    | Constant _
+    | TextNode _
+    | Section (Section.Minus|Section.FloatMinus|Section.Project _) -> empty
+
+    | Spawn (_, _, p, _)
+    | TAbstr (_, p)
+    | TAppl (p, _)
+    | FormBinding (p, _)
+    | Projection (p, _)
+    | Page p
+    | PagePlacement p
+    | Upcast (p, _, _)
+    | Select (_, p)
+    | TypeAnnotation (p, _) -> phrase p
+
+    | ListLit (ps, _)
+    | TupleLit ps -> union_map phrase ps
+
+    | LensLit (l, _) -> phrase l
     (* this should be converted to `LensLit during typeSugar *)
-    | `LensFunDepsLit _ -> assert false
-    | `LensKeysLit (l, _, _) -> phrase l
-    | `LensSelectLit (l, _, _) -> phrase l
-    | `LensDropLit (l, _, _, _, _) -> phrase l
-    | `LensJoinLit (l1, l2, _, _, _, _) -> union_all [phrase l1; phrase l2]
-
-    | `LensGetLit (l, _) -> phrase l
-    | `LensPutLit (l, data, _) -> union_all [phrase l; phrase data]
-
-    | `Query (None, p, _) -> phrase p
-    | `Query (Some (limit, offset), p, _) -> union_all [phrase limit; phrase offset; phrase p]
-
-    | `Escape (v, p) -> diff (phrase p) (singleton (name_of_binder v))
-    | `FormletPlacement (p1, p2, p3)
-    | `Conditional (p1, p2, p3) -> union_map phrase [p1;p2;p3]
-    | `Block b -> block b
-    | `InfixAppl ((_, `Name n), p1, p2) -> union (singleton n) (union_map phrase [p1;p2])
-    | `InfixAppl (_, p1, p2) -> union_map phrase [p1;p2]
-    | `RangeLit (p1, p2) -> union_map phrase [p1;p2]
-    | `Regex r -> regex r
-    | `UnaryAppl (_, p) -> phrase p
-    | `FnAppl (p, ps) -> union_map phrase (p::ps)
-    | `RecordLit (fields, p) ->
+    | LensFunDepsLit _ -> assert false
+    | LensKeysLit (l, _, _) -> phrase l
+    | LensSelectLit (l, _, _) -> phrase l
+    | LensDropLit (l, _, _, _, _) -> phrase l
+    | LensJoinLit (l1, l2, _, _, _, _) -> union_all [phrase l1; phrase l2]
+
+    | LensGetLit (l, _) -> phrase l
+    | LensPutLit (l, data, _) -> union_all [phrase l; phrase data]
+
+    | Query (None, p, _) -> phrase p
+    | Query (Some (limit, offset), p, _) ->
+       union_all [phrase limit; phrase offset; phrase p]
+
+    | Escape (v, p) -> diff (phrase p) (singleton (name_of_binder v))
+    | FormletPlacement (p1, p2, p3)
+    | Conditional (p1, p2, p3) -> union_map phrase [p1;p2;p3]
+    | Block b -> block b
+    | InfixAppl ((_, BinaryOp.Name n), p1, p2) ->
+       union (singleton n) (union_map phrase [p1;p2])
+    | InfixAppl (_, p1, p2) -> union_map phrase [p1;p2]
+    | RangeLit (p1, p2) -> union_map phrase [p1;p2]
+    | Regex r -> regex r
+    | UnaryAppl (_, p) -> phrase p
+    | FnAppl (p, ps) -> union_map phrase (p::ps)
+    | RecordLit (fields, p) ->
         union (union_map (snd ->- phrase) fields)
           (option_map phrase p)
-    | `With (p, fields) ->
+    | With (p, fields) ->
         union (union_map (snd ->- phrase) fields)
           (phrase p)
-    | `ConstructorLit (_, popt, _) -> option_map phrase popt
-    | `DatabaseLit (p, (popt1, popt2)) ->
+    | ConstructorLit (_, popt, _) -> option_map phrase popt
+    | DatabaseLit (p, (popt1, popt2)) ->
         union_all [phrase p; option_map phrase popt1; option_map phrase popt2]
-    | `DBInsert (p1, _labels, p2, popt) ->
+    | DBInsert (p1, _labels, p2, popt) ->
         union_all [phrase p1; phrase p2; option_map phrase popt]
-    | `TableLit (p1, _, _, _, p2) -> union (phrase p1) (phrase p2)
-    | `Xml (_, attrs, attrexp, children) ->
+    | TableLit (p1, _, _, _, p2) -> union (phrase p1) (phrase p2)
+    | Xml (_, attrs, attrexp, children) ->
         union_all
           [union_map (snd ->- union_map phrase) attrs;
            option_map phrase attrexp;
            union_map phrase children]
-    | `Formlet (xml, yields) ->
+    | Formlet (xml, yields) ->
         let binds = formlet_bound xml in
           union (phrase xml) (diff (phrase yields) binds)
-    | `HandlerLit hnlit -> handlerlit hnlit
-    | `FunLit (_, _, fnlit, _) -> funlit fnlit
-    | `Iteration (generators, body, where, orderby) ->
+    | HandlerLit hnlit -> handlerlit hnlit
+    | FunLit (_, _, fnlit, _) -> funlit fnlit
+    | Iteration (generators, body, where, orderby) ->
         let xs = union_map (function
-                              | `List (_, source)
-                              | `Table (_, source) -> phrase source) generators in
+                             | List (_, source)
+                             | Table (_, source) -> phrase source) generators in
         let pat_bound = union_map (function
-                                     | `List (pat, _)
-                                     | `Table (pat, _) -> pattern pat) generators in
+                                  | List (pat, _)
+                                  | Table (pat, _) -> pattern pat) generators in
           union_all [xs;
                      diff (phrase body) pat_bound;
                      diff (option_map phrase where) pat_bound;
                      diff (option_map phrase orderby) pat_bound]
-            (*     | `Iteration (`List (pat, source), body, where, orderby) *)
-(*     | `Iteration (`Table (pat, source), body, where, orderby) ->  *)
-(*         let pat_bound = pattern pat in *)
-(*           union_all [phrase source; *)
-(*                      diff (phrase body) pat_bound; *)
-(*                      diff (option_map phrase where) pat_bound; *)
-(*                      diff (option_map phrase orderby) pat_bound] *)
-    | `Handle { sh_expr = e; sh_effect_cases = eff_cases; sh_value_cases = val_cases; sh_descr = descr } ->
+    | Handle { sh_expr = e; sh_effect_cases = eff_cases;
+               sh_value_cases = val_cases; sh_descr = descr } ->
        let params_bound =
          option_map
            (fun params -> union_map (snd ->- pattern) params.shp_bindings)
@@ -497,35 +472,39 @@ struct
        union_all [phrase e;
                   union_map case eff_cases;
                   union_map case val_cases;
-                  diff (option_map (fun params -> union_map (fst ->- phrase) params.shp_bindings) descr.shd_params) params_bound]
-    | `Switch (p, cases, _)
-    | `Offer (p, cases, _) -> union (phrase p) (union_map case cases)
-    | `CP cp -> cp_phrase cp
-    | `Receive (cases, _) -> union_map case cases
-    | `DBDelete (pat, p, where) ->
+                  diff (option_map (fun params -> union_map (fst ->- phrase)
+                                                    params.shp_bindings)
+                          descr.shd_params) params_bound]
+    | Switch (p, cases, _)
+    | Offer (p, cases, _) -> union (phrase p) (union_map case cases)
+    | CP cp -> cp_phrase cp
+    | Receive (cases, _) -> union_map case cases
+    | DBDelete (pat, p, where) ->
         union (phrase p)
           (diff (option_map phrase where)
              (pattern pat))
-    | `DBUpdate (pat, from, where, fields) ->
+    | DBUpdate (pat, from, where, fields) ->
         let pat_bound = pattern pat in
           union_all [phrase from;
                      diff (option_map phrase where) pat_bound;
                      diff (union_map (snd ->- phrase) fields) pat_bound]
-    | `DoOperation (_, ps, _) -> union_map phrase ps
-    | `QualifiedVar _ -> empty
-    | `TryInOtherwise (p1, pat, p2, p3, _ty) -> union (union_map phrase [p1; p2; p3]) (pattern pat)
-    | `Raise -> empty
-  and binding ({node = binding; _}: binding) : StringSet.t (* vars bound in the pattern *)
-                                             * StringSet.t (* free vars in the rhs *) =
+    | DoOperation (_, ps, _) -> union_map phrase ps
+    | QualifiedVar _ -> empty
+    | TryInOtherwise (p1, pat, p2, p3, _ty) ->
+       union (union_map phrase [p1; p2; p3]) (pattern pat)
+    | Raise -> empty
+  and binding ({node = binding; _}: binding)
+      : StringSet.t (* vars bound in the pattern *)
+      * StringSet.t (* free vars in the rhs *) =
     match binding with
-    | `Val (pat, (_, rhs), _, _) -> pattern pat, phrase rhs
-    | `Handler (bndr, hnlit, _) ->
+    | Val (pat, (_, rhs), _, _) -> pattern pat, phrase rhs
+    | Handler (bndr, hnlit, _) ->
        let name = singleton (name_of_binder bndr) in
        name, (diff (handlerlit hnlit) name)
-    | `Fun (bndr, _, (_, fn), _, _) ->
+    | Fun (bndr, _, (_, fn), _, _) ->
        let name = singleton (name_of_binder bndr) in
        name, (diff (funlit fn) name)
-    | `Funs funs ->
+    | Funs funs ->
         let names, rhss =
           List.fold_right
             (fun (bndr, _, (_, rhs), _, _, _) (names, rhss) ->
@@ -533,23 +512,24 @@ struct
             funs
             (empty, []) in
           names, union_map (fun rhs -> diff (funlit rhs) names) rhss
-    | `Foreign (bndr, _, _, _, _) -> singleton (name_of_binder bndr), empty
-    | `QualifiedImport _
-    | `Type _
-    | `Infix -> empty, empty
-    | `Exp p -> empty, phrase p
-    | `AlienBlock (_, _, decls) ->
+    | Foreign (bndr, _, _, _, _) -> singleton (name_of_binder bndr), empty
+    | QualifiedImport _
+    | Type _
+    | Infix -> empty, empty
+    | Exp p -> empty, phrase p
+    | AlienBlock (_, _, decls) ->
         let bound_foreigns =
           List.fold_left (fun acc (bndr, _) ->
               StringSet.add (name_of_binder bndr) acc)
             (StringSet.empty) decls in
         bound_foreigns, empty
         (* TODO: this needs to be implemented *)
-    | `Module _ -> failwith "Freevars for modules not implemented yet"
+    | Module _ -> failwith "Freevars for modules not implemented yet"
   and funlit (args, body : funlit) : StringSet.t =
     diff (phrase body) (union_map (union_map pattern) args)
   and handlerlit (_, m, cases, params : handlerlit) : StringSet.t =
-    union_all [diff (union_map case cases) (option_map (union_map (union_map pattern)) params); pattern m]
+    union_all [diff (union_map case cases)
+                 (option_map (union_map (union_map pattern)) params); pattern m]
   and block (binds, expr : binding list * phrase) : StringSet.t =
     ListLabels.fold_right binds ~init:(phrase expr)
       ~f:(fun bind bodyfree ->
@@ -568,21 +548,25 @@ struct
     | Group r
     | Repeat (_, r) -> regex r
     | Splice p -> phrase p
-    | Replace (r, `Literal _) -> regex r
-    | Replace (r, `Splice p) -> union (regex r) (phrase p)
+    | Replace (r, Literal _) -> regex r
+    | Replace (r, SpliceExpr p) -> union (regex r) (phrase p)
   and cp_phrase {node = p; _ } = match p with
-    | Unquote e -> block e
-    | Grab ((c, _t), Some bndr, p) ->
+    | CPUnquote e -> block e
+    | CPGrab ((c, _t), Some bndr, p) ->
       union (singleton c) (diff (cp_phrase p) (singleton (name_of_binder bndr)))
-    | Grab ((c, _t), None, p) -> union (singleton c) (cp_phrase p)
-    | Give ((c, _t), e, p) -> union (singleton c) (union (option_map phrase e) (cp_phrase p))
-    | GiveNothing bndr -> singleton (name_of_binder bndr)
-    | Select (bndr, _label, p) ->
+    | CPGrab ((c, _t), None, p) -> union (singleton c) (cp_phrase p)
+    | CPGive ((c, _t), e, p) -> union (singleton c) (union (option_map phrase e)
+                                                           (cp_phrase p))
+    | CPGiveNothing bndr -> singleton (name_of_binder bndr)
+    | CPSelect (bndr, _label, p) ->
       union (singleton (name_of_binder bndr)) (cp_phrase p)
-    | Offer (bndr, cases) ->
-      union (singleton (name_of_binder bndr)) (union_map (fun (_label, p) -> cp_phrase p) cases)
-    | Link (bndr1, bndr2) ->
-      union (singleton (name_of_binder bndr1)) (singleton (name_of_binder bndr2))
-    | Comp (bndr, left, right) ->
-       diff (union (cp_phrase left) (cp_phrase right)) (singleton (name_of_binder bndr))
+    | CPOffer (bndr, cases) ->
+      union (singleton (name_of_binder bndr))
+            (union_map (fun (_label, p) -> cp_phrase p) cases)
+    | CPLink (bndr1, bndr2) ->
+      union (singleton (name_of_binder bndr1))
+            (singleton (name_of_binder bndr2))
+    | CPComp (bndr, left, right) ->
+       diff (union (cp_phrase left) (cp_phrase right))
+            (singleton (name_of_binder bndr))
 end
diff --git a/core/transformSugar.ml b/core/transformSugar.ml
index e908fd70a..75704037b 100644
--- a/core/transformSugar.ml
+++ b/core/transformSugar.ml
@@ -1,33 +1,36 @@
-open Utility
+open CommonTypes
+open Operators
 open Sugartypes
+open Utility
 
 module TyEnv = Env.String
 
 let type_section env =
-  function
-    | `Minus -> TyEnv.lookup env "-"
-    | `FloatMinus -> TyEnv.lookup env "-."
-    | `Project label ->
-        let ab, a = Types.fresh_type_quantifier (`Any, `Any) in
-        let rhob, (fields, rho, _) = Types.fresh_row_quantifier (`Any, `Any) in
-        let eb, e = Types.fresh_row_quantifier (`Any, `Any) in
-
-        let r = `Record (StringMap.add label (`Present a) fields, rho, false) in
-          `ForAll (Types.box_quantifiers [ab; rhob; eb],
-                   `Function (Types.make_tuple_type [r], e, a))
-    | `Name var -> TyEnv.lookup env var
+  let open Section in function
+  | Minus -> TyEnv.lookup env "-"
+  | FloatMinus -> TyEnv.lookup env "-."
+  | Project label ->
+      let ab, a = Types.fresh_type_quantifier (lin_any, res_any) in
+      let rhob, (fields, rho, _) = Types.fresh_row_quantifier (lin_any, res_any) in
+      let eb, e = Types.fresh_row_quantifier (lin_any, res_any) in
+
+      let r = `Record (StringMap.add label (`Present a) fields, rho, false) in
+        `ForAll (Types.box_quantifiers [ab; rhob; eb],
+                 `Function (Types.make_tuple_type [r], e, a))
+  | Name var -> TyEnv.lookup env var
 
 let type_unary_op env tycon_env =
   let datatype = DesugarDatatypes.read ~aliases:tycon_env in function
-    | `Minus      -> datatype "(Int) -> Int"
-    | `FloatMinus -> datatype "(Float) -> Float"
-    | `Name n     -> TyEnv.lookup env n
+    | UnaryOp.Minus      -> datatype "(Int) -> Int"
+    | UnaryOp.FloatMinus -> datatype "(Float) -> Float"
+    | UnaryOp.Name n     -> TyEnv.lookup env n
 
 let type_binary_op env tycon_env =
+  let open BinaryOp in
   let datatype = DesugarDatatypes.read ~aliases:tycon_env in function
-  | `Minus        -> TyEnv.lookup env "-"
-  | `FloatMinus   -> TyEnv.lookup env "-."
-  | `RegexMatch flags ->
+  | Minus        -> TyEnv.lookup env "-"
+  | FloatMinus   -> TyEnv.lookup env "-."
+  | RegexMatch flags ->
       let nativep  = List.exists ((=) RegexNative)  flags
       and listp    = List.exists ((=) RegexList)    flags
       and replacep = List.exists ((=) RegexReplace) flags in
@@ -37,22 +40,22 @@ let type_binary_op env tycon_env =
            | false, false, false -> (* tilde *)   datatype "(String, Regex) -> Bool"
            | _,     _,     true  -> assert false)
 
-  | `And
-  | `Or           -> datatype "(Bool,Bool) -> Bool"
-  | `Cons         -> TyEnv.lookup env "Cons"
-  | `Name "++"    -> TyEnv.lookup env "Concat"
-  | `Name ">"
-  | `Name ">="
-  | `Name "=="
-  | `Name "<"
-  | `Name "<="
-  | `Name "<>" ->
-      let ab, a = Types.fresh_type_quantifier (`Any, `Any) in
-      let eb, e = Types.fresh_row_quantifier (`Any, `Any) in
+  | And
+  | Or           -> datatype "(Bool,Bool) -> Bool"
+  | Cons         -> TyEnv.lookup env "Cons"
+  | Name "++"    -> TyEnv.lookup env "Concat"
+  | Name ">"
+  | Name ">="
+  | Name "=="
+  | Name "<"
+  | Name "<="
+  | Name "<>" ->
+      let ab, a = Types.fresh_type_quantifier (lin_any, res_any) in
+      let eb, e = Types.fresh_row_quantifier (lin_any, res_any) in
         `ForAll (Types.box_quantifiers [ab; eb],
                  `Function (Types.make_tuple_type [a; a], e, `Primitive `Bool))
-  | `Name "!"     -> TyEnv.lookup env "Send"
-  | `Name n       -> TyEnv.lookup env n
+  | Name "!"     -> TyEnv.lookup env "Send"
+  | Name n       -> TyEnv.lookup env n
 
 let fun_effects t pss =
   let rec get_eff =
@@ -151,7 +154,7 @@ class transform (env : Types.typing_environment) =
     method with_effects : Types.row -> 'self_type = fun effects ->
       {< effect_row = fst (Types.unwrap_row effects) >}
 
-    method sugar_datatype : datatype -> ('self_type * datatype) =
+    method sugar_datatype : Datatype.with_pos -> ('self_type * Datatype.with_pos) =
       fun s -> (o, s)
 
     method datatype : Types.datatype -> ('self_type * Types.datatype) =
@@ -170,17 +173,17 @@ class transform (env : Types.typing_environment) =
     method row : Types.row -> ('self_type * Types.row) =
       fun row -> (o, row)
 
-    method unary_op : unary_op -> ('self_type * unary_op * Types.datatype) =
+    method unary_op : UnaryOp.t -> ('self_type * UnaryOp.t * Types.datatype) =
       fun op ->
         (o, op, type_unary_op var_env tycon_env op)
 
-    method binop : binop -> ('self_type * binop * Types.datatype) =
+    method binop : BinaryOp.t -> ('self_type * BinaryOp.t * Types.datatype) =
       fun op ->
         (o, op, type_binary_op var_env tycon_env op)
 
-    method sec : sec -> ('self_type * sec * Types.datatype) =
-      fun sec ->
-        (o, sec, type_section var_env sec)
+    method section : Section.t -> ('self_type * Section.t * Types.datatype) =
+      fun section ->
+        (o, section, type_section var_env section)
 
     method sentence : sentence -> ('self_type * sentence) =
       function
@@ -204,13 +207,13 @@ class transform (env : Types.typing_environment) =
         | Repeat (repeat, r) ->
             let (o, r) = o#regex r in (o, Repeat (repeat, r))
         | Splice e -> let (o, e, _) = o#phrase e in (o, Splice e)
-        | Replace (r, `Literal s) ->
+        | Replace (r, Literal s) ->
             let (o, r) = o#regex r in
-              (o, Replace (r, `Literal s))
-        | Replace (r, `Splice e) ->
+              (o, Replace (r, Literal s))
+        | Replace (r, SpliceExpr e) ->
             let (o, r) = o#regex r in
             let (o, e, _) = o#phrase e in
-              (o, Replace (r, `Splice e))
+              (o, Replace (r, SpliceExpr e))
 
     method program : program -> ('self_type * program * Types.datatype option) =
       fun (bs, e) ->
@@ -228,9 +231,9 @@ class transform (env : Types.typing_environment) =
 
     method phrasenode : phrasenode -> ('self_type * phrasenode * Types.datatype) =
       function
-      | `Constant c -> let (o, c, t) = o#constant c in (o, (`Constant c), t)
-      | `Var var -> (o, `Var var, o#lookup_type var)
-      | `FunLit (Some argss, lin, lam, location) ->
+      | Constant c -> let (o, c, t) = o#constant c in (o, Constant c, t)
+      | Var var -> (o, Var var, o#lookup_type var)
+      | FunLit (Some argss, lin, lam, location) ->
           let inner_e = snd (try last argss with Invalid_argument s -> raise (Invalid_argument ("@" ^ s))) in
           let (o, lam, rt) = o#funlit inner_e lam in
           let (o, t) =
@@ -242,9 +245,9 @@ class transform (env : Types.typing_environment) =
               argss
               (o, rt)
           in
-            (o, `FunLit (Some argss, lin, lam, location), t)
-      | `HandlerLit _ -> assert false
-      | `Spawn (Wait, loc, body, Some inner_effects) ->
+            (o, FunLit (Some argss, lin, lam, location), t)
+      | HandlerLit _ -> assert false
+      | Spawn (Wait, loc, body, Some inner_effects) ->
           assert (loc = NoSpawnLocation);
           (* bring the inner effects into scope, then restore the
              environments afterwards *)
@@ -253,8 +256,8 @@ class transform (env : Types.typing_environment) =
           let o = o#with_effects inner_effects in
           let (o, body, body_type) = o#phrase body in
           let o = o#restore_envs envs in
-            (o, `Spawn (Wait, loc, body, Some inner_effects), body_type)
-      | `Spawn (k, spawn_loc, body, Some inner_effects) ->
+            (o, Spawn (Wait, loc, body, Some inner_effects), body_type)
+      | Spawn (k, spawn_loc, body, Some inner_effects) ->
           (* bring the inner effects into scope, then restore the
              environments afterwards *)
           let (o, spawn_loc) = o#given_spawn_location spawn_loc in
@@ -264,11 +267,11 @@ class transform (env : Types.typing_environment) =
           let o = o#with_effects inner_effects in
           let (o, body, _) = o#phrase body in
           let o = o#restore_envs envs in
-            (o, (`Spawn (k, spawn_loc, body, Some inner_effects)), process_type)
-      | `Select (l, e) ->
+            (o, Spawn (k, spawn_loc, body, Some inner_effects), process_type)
+      | Select (l, e) ->
          let (o, e, t) = o#phrase e in
-         (o, (`Select (l, e)), TypeUtils.select_type l t)
-      | `Offer (e, bs, Some t) ->
+         (o, Select (l, e), TypeUtils.select_type l t)
+      | Offer (e, bs, Some t) ->
           let (o, e, _) = o#phrase e in
           let (o, bs) =
             listu o
@@ -277,11 +280,11 @@ class transform (env : Types.typing_environment) =
                  let (o, e, _) = o#phrase e in (o, (p, e)))
               bs in
           let (o, t) = o#datatype t in
-            (o, `Offer (e, bs, Some t), t)
-      | `CP p ->
+            (o, Offer (e, bs, Some t), t)
+      | CP p ->
          let (o, p, t) = o#cp_phrase p in
-         (o, `CP p, t)
-      | `Query (range, body, Some t) ->
+         (o, CP p, t)
+      | Query (range, body, Some t) ->
           let (o, range) =
             optionu o
               (fun o (limit, offset) ->
@@ -291,88 +294,88 @@ class transform (env : Types.typing_environment) =
               range in
           let (o, body, _) = o#phrase body in
           let (o, t) = o#datatype t in
-            (o, (`Query (range, body, Some t)), t)
-      | `ListLit (es, Some t) ->
+            (o, Query (range, body, Some t), t)
+      | ListLit (es, Some t) ->
           let (o, es, _) = list o (fun o -> o#phrase) es in
           let (o, t) = o#datatype t in
-            (o, `ListLit (es, Some t), Types.make_list_type t)
-      | `RangeLit (e1, e2) ->
+            (o, ListLit (es, Some t), Types.make_list_type t)
+      | RangeLit (e1, e2) ->
           let (o, e1, _) = o#phrase e1 in
           let (o, e2, _) = o#phrase e2 in
-            (o, `RangeLit (e1, e2), Types.make_list_type Types.int_type)
-      | `Iteration (gens, body, cond, orderby) ->
+            (o, RangeLit (e1, e2), Types.make_list_type Types.int_type)
+      | Iteration (gens, body, cond, orderby) ->
           let (o, gens) = listu o (fun o -> o#iterpatt) gens in
           let (o, body, t) = o#phrase body in
           let (o, cond, _) = option o (fun o -> o#phrase) cond in
           let (o, orderby, _) = option o (fun o -> o#phrase) orderby in
-            (o, `Iteration (gens, body, cond, orderby), t)
-      | `Escape (b, e) ->
+            (o, Iteration (gens, body, cond, orderby), t)
+      | Escape (b, e) ->
           let envs = o#backup_envs in
           let (o, b) = o#binder b in
           let (o, e, t) = o#phrase e in
           let o = o#restore_envs envs in
-            (o, `Escape (b, e), t)
-      | `Section sec -> (o, `Section sec, type_section var_env sec)
-      | `Conditional (p, e1, e2) ->
+            (o, Escape (b, e), t)
+      | Section sec -> (o, Section sec, type_section var_env sec)
+      | Conditional (p, e1, e2) ->
           let (o, p, _) = o#phrase p in
           let (o, e1, t) = o#phrase e1 in
           let (o, e2, _) = o#phrase e2
-          in (o, `Conditional (p, e1, e2), t)
-      | `Block (bs, e) ->
+          in (o, Conditional (p, e1, e2), t)
+      | Block (bs, e) ->
           let envs = o#backup_envs in
           let (o, bs) = listu o (fun o -> o#binding) bs in
           let (o, e, t) = o#phrase e in
           let o = o#restore_envs envs in
-            o, `Block (bs, e), t
-      | `InfixAppl ((tyargs, op), e1, e2) ->
+            o, Block (bs, e), t
+      | InfixAppl ((tyargs, op), e1, e2) ->
           let (o, op, t) = o#binop op in
             check_type_application
-              (`InfixAppl ((tyargs, op), e1, e2), t)
+              (InfixAppl ((tyargs, op), e1, e2), t)
               (fun () ->
                  let t = TypeUtils.return_type (Instantiate.apply_type t tyargs) in
                  let (o, e1, _) = o#phrase e1 in
                  let (o, e2, _) = o#phrase e2 in
-                   (o, `InfixAppl ((tyargs, op), e1, e2), t))
-      | `Regex r ->
+                   (o, InfixAppl ((tyargs, op), e1, e2), t))
+      | Regex r ->
           let (o, r) = o#regex r in
-            (o, `Regex r, Instantiate.alias "Regex" [] tycon_env)
-      | `UnaryAppl ((tyargs, op), e) ->
+            (o, Regex r, Instantiate.alias "Regex" [] tycon_env)
+      | UnaryAppl ((tyargs, op), e) ->
           let (o, op, t) = o#unary_op op in
             check_type_application
-              (`UnaryAppl ((tyargs, op), e), t)
+              (UnaryAppl ((tyargs, op), e), t)
               (fun () ->
                  let t = TypeUtils.return_type (Instantiate.apply_type t tyargs) in
                  let (o, e, _) = o#phrase e in
-                   (o, `UnaryAppl ((tyargs, op), e), t))
-      | `FnAppl (f, args) ->
+                   (o, UnaryAppl ((tyargs, op), e), t))
+      | FnAppl (f, args) ->
          let (o, f, ft) = o#phrase f in
          let (o, args, _) = list o (fun o -> o#phrase) args in
-            (o, `FnAppl (f, args), TypeUtils.return_type ft)
-      | `TAbstr (tyvars, e) ->
+            (o, FnAppl (f, args), TypeUtils.return_type ft)
+      | TAbstr (tyvars, e) ->
           let outer_tyvars = o#backup_quantifiers in
           let (o, qs) = o#quantifiers (Types.unbox_quantifiers tyvars) in
           let (o, e, t) = o#phrase e in
           let o = o#restore_quantifiers outer_tyvars in
           let t = Types.for_all (qs, t) in
             (o, tabstr (qs, e.node), t)
-      | `TAppl (e, tyargs) ->
+      | TAppl (e, tyargs) ->
           let (o, e, t) = o#phrase e in
             check_type_application
-              (`TAppl (e, tyargs), t)
+              (TAppl (e, tyargs), t)
               (fun () ->
                  let t = Instantiate.apply_type t tyargs in
-                   (o, `TAppl (e, tyargs), t))
-      | `TupleLit [e] ->
+                   (o, TAppl (e, tyargs), t))
+      | TupleLit [e] ->
           (* QUESTION:
 
              Why do we type 1-tuples as if they aren't tuples?
           *)
           let (o, e, t) = o#phrase e in
-            (o, `TupleLit [e], t)
-      | `TupleLit es ->
+            (o, TupleLit [e], t)
+      | TupleLit es ->
           let (o, es, ts) = list o (fun o -> o#phrase) es in
-            (o, `TupleLit es, Types.make_tuple_type ts)
-      | `RecordLit (fields, base) ->
+            (o, TupleLit es, Types.make_tuple_type ts)
+      | RecordLit (fields, base) ->
           let (o, fields, field_types) =
             let rec list o =
               function
@@ -399,11 +402,11 @@ class transform (env : Types.typing_environment) =
                           assert false
                   end
           in
-            (o, `RecordLit (fields, base), t)
-      | `Projection (e, name) ->
+            (o, RecordLit (fields, base), t)
+      | Projection (e, name) ->
           let (o, e, t) = o#phrase e in
-          (o, `Projection (e, name), TypeUtils.project_type name t)
-      | `With (e, fields) ->
+          (o, Projection (e, name), TypeUtils.project_type name t)
+      | With (e, fields) ->
           let (o, e, t) = o#phrase e in
           let (o, fields) =
             let rec list o =
@@ -416,26 +419,26 @@ class transform (env : Types.typing_environment) =
             in
               list o fields
           in
-            (o, `With (e, fields), t)
-      | `TypeAnnotation (e, ann_type) ->
+            (o, With (e, fields), t)
+      | TypeAnnotation (e, ann_type) ->
           let (o, e, _) = o#phrase e in
           let (o, ann_type) = o#datatype' ann_type in
           let t = val_of (snd ann_type) in
-          (o, `TypeAnnotation (e, ann_type), t)
-      | `Upcast (e, to_type, from_type) ->
+          (o, TypeAnnotation (e, ann_type), t)
+      | Upcast (e, to_type, from_type) ->
           let (o, e, _) = o#phrase e in
           let (o, to_type) = o#datatype' to_type in
           let (o, from_type) = o#datatype' from_type in
           let t = val_of (snd to_type) in
-            (o, `Upcast (e, to_type, from_type), t)
-      | `ConstructorLit (name, e, Some t) ->
+            (o, Upcast (e, to_type, from_type), t)
+      | ConstructorLit (name, e, Some t) ->
           let (o, e, _) = option o (fun o -> o#phrase) e in
           let (o, t) = o#datatype t in
-          (o, `ConstructorLit (name, e, Some t), t)
-      | `DoOperation (name, ps, Some t) ->
+          (o, ConstructorLit (name, e, Some t), t)
+      | DoOperation (name, ps, Some t) ->
          let (o, ps, _) = list o (fun o -> o#phrase) ps in
-         (o, `DoOperation (name, ps, Some t), t)
-      | `Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
+         (o, DoOperation (name, ps, Some t), t)
+      | Handle { sh_expr; sh_effect_cases; sh_value_cases; sh_descr } ->
          let (input_row, input_t, output_row, output_t) = sh_descr.shd_types in
          let (o, expr, _) = o#phrase sh_expr in
          let envs = o#backup_envs in
@@ -479,16 +482,16 @@ class transform (env : Types.typing_environment) =
            shd_raw_row = raw_row;
            shd_params = params}
          in
-         (o, `Handle { sh_expr = expr; sh_effect_cases = eff_cases; sh_value_cases = val_cases; sh_descr = descr }, output_t)
-      | `TryInOtherwise (try_phr, as_pat, as_phr, otherwise_phr, (Some dt)) ->
+         (o, Handle { sh_expr = expr; sh_effect_cases = eff_cases; sh_value_cases = val_cases; sh_descr = descr }, output_t)
+      | TryInOtherwise (try_phr, as_pat, as_phr, otherwise_phr, (Some dt)) ->
           let (o, try_phr, _) = o#phrase try_phr in
           let (o, as_pat) = o#pattern as_pat in
           let (o, as_phr, _) = o#phrase as_phr in
           let (o, otherwise_phr, _) = o#phrase otherwise_phr in
           let (o, dt) = o#datatype dt in
-          (o, `TryInOtherwise (try_phr, as_pat, as_phr, otherwise_phr, (Some dt)), dt)
-      | `Raise -> (o, `Raise, `Not_typed) (* TEMP *)
-      | `Switch (v, cases, Some t) ->
+          (o, TryInOtherwise (try_phr, as_pat, as_phr, otherwise_phr, (Some dt)), dt)
+      | Raise -> (o, Raise, `Not_typed) (* TEMP *)
+      | Switch (v, cases, Some t) ->
           let (o, v, _) = o#phrase v in
           let (o, cases) =
             listu o
@@ -497,8 +500,8 @@ class transform (env : Types.typing_environment) =
                  let (o, e, _) = o#phrase e in (o, (p, e)))
               cases in
           let (o, t) = o#datatype t in
-            (o, `Switch (v, cases, Some t), t)
-      | `Receive (cases, Some t) ->
+            (o, Switch (v, cases, Some t), t)
+      | Receive (cases, Some t) ->
           let (o, cases) =
             listu o
               (fun o (p, e) ->
@@ -506,49 +509,49 @@ class transform (env : Types.typing_environment) =
                  let (o, e, _) = o#phrase e in (o, (p, e)))
               cases in
           let (o, t) = o#datatype t in
-            (o, `Receive (cases, Some t), t)
-      | `DatabaseLit (name, (driver, args)) ->
+            (o, Receive (cases, Some t), t)
+      | DatabaseLit (name, (driver, args)) ->
           let (o, name, _) = o#phrase name in
           let (o, driver, _) = option o (fun o -> o#phrase) driver in
           let (o, args, _) = option o (fun o -> o#phrase) args in
-            (o, `DatabaseLit (name, (driver, args)), `Primitive `DB)
-      | `LensLit (table, Some t) ->
+            (o, DatabaseLit (name, (driver, args)), `Primitive `DB)
+      | LensLit (table, Some t) ->
          let (o, table, _) = o#phrase table in
          let (o, t) = o#lens_sort t in
-            (o, `LensLit (table, Some t), `Lens (t))
-      | `LensDropLit (lens, drop, key, default, Some t) ->
+            (o, LensLit (table, Some t), `Lens (t))
+      | LensDropLit (lens, drop, key, default, Some t) ->
           let (o, lens, _) = o#phrase lens in
           let (o, t) = o#lens_sort t in
           let (o, default, _) = o#phrase default in
-            (o, `LensDropLit (lens, drop, key, default, Some t), `Lens (t))
-      | `LensSelectLit (lens, predicate, Some t) ->
+            (o, LensDropLit (lens, drop, key, default, Some t), `Lens (t))
+      | LensSelectLit (lens, predicate, Some t) ->
           let (o, lens, _) = o#phrase lens in
           (* let (o, predicate, _) = o#phrase predicate in *)
           let (o, t) = o#lens_sort t in
-            (o, `LensSelectLit (lens, predicate, Some t), `Lens t)
-      | `LensJoinLit (lens1, lens2, on, left, right, Some t) ->
+            (o, LensSelectLit (lens, predicate, Some t), `Lens t)
+      | LensJoinLit (lens1, lens2, on, left, right, Some t) ->
           let (o, lens1, _) = o#phrase lens1 in
           let (o, lens2, _) = o#phrase lens2 in
           let (o, t) = o#lens_sort t in
-            (o, `LensJoinLit (lens1, lens2, on, left, right, Some t), `Lens t)
-      | `LensGetLit (lens, Some t) ->
+            (o, LensJoinLit (lens1, lens2, on, left, right, Some t), `Lens t)
+      | LensGetLit (lens, Some t) ->
           let (o, lens, _) = o#phrase lens in
           let (o, t) = o#datatype t in
-            (o, `LensGetLit (lens, Some t), Types.make_list_type t)
-      | `LensPutLit (lens, data, Some t) ->
+            (o, LensGetLit (lens, Some t), Types.make_list_type t)
+      | LensPutLit (lens, data, Some t) ->
           let (o, lens, _) = o#phrase lens in
           let (o, data, _) = o#phrase data in
           let (o, t) = o#datatype t in
-            (o, `LensPutLit (lens, data, Some t), Types.make_list_type t)
-      | `TableLit (name, (dtype, Some (read_row, write_row, needed_row)), constraints, keys, db) ->
+            (o, LensPutLit (lens, data, Some t), Types.make_list_type t)
+      | TableLit (name, (dtype, Some (read_row, write_row, needed_row)), constraints, keys, db) ->
           let (o, name, _) = o#phrase name in
           let (o, db, _) = o#phrase db in
           let (o, dtype) = o#sugar_datatype dtype in
           let (o, read_row) = o#datatype read_row in
           let (o, write_row) = o#datatype write_row in
           let (o, needed_row) = o#datatype needed_row in
-            (o, `TableLit (name, (dtype, Some (read_row, write_row, needed_row)), constraints, keys, db), `Table (read_row, write_row, needed_row))
-      | `DBDelete (p, from, where) ->
+            (o, TableLit (name, (dtype, Some (read_row, write_row, needed_row)), constraints, keys, db), `Table (read_row, write_row, needed_row))
+      | DBDelete (p, from, where) ->
           let (o, from, _) = o#phrase from in
           let (o, p) = o#pattern p in
             (* BUG:
@@ -556,16 +559,16 @@ class transform (env : Types.typing_environment) =
                We should really reset the environment: variables bound
                by p shouldn't be visible in subsequent expression.
 
-               The same applies to `DBUpdate and `Iteration.
+               The same applies to DBUpdate and Iteration.
             *)
           let (o, where, _) = option o (fun o -> o#phrase) where in
-            (o, `DBDelete (p, from, where), Types.unit_type)
-      | `DBInsert (into, labels, values, id) ->
+            (o, DBDelete (p, from, where), Types.unit_type)
+      | DBInsert (into, labels, values, id) ->
           let (o, into, _) = o#phrase into in
           let (o, values, _) = o#phrase values in
           let (o, id, _) = option o (fun o -> o#phrase) id in
-            (o, `DBInsert (into, labels, values, id), Types.unit_type)
-      | `DBUpdate (p, from, where, set) ->
+            (o, DBInsert (into, labels, values, id), Types.unit_type)
+      | DBUpdate (p, from, where, set) ->
           let (o, from, _) = o#phrase from in
           let (o, p) = o#pattern p in
           let (o, where, _) = option o (fun o -> o#phrase) where in
@@ -575,8 +578,8 @@ class transform (env : Types.typing_environment) =
                  let (o, value, _) = o#phrase value in (o, (name, value)))
               set
           in
-            (o, `DBUpdate (p, from, where, set), Types.unit_type)
-      | `Xml (tag, attrs, attrexp, children) ->
+            (o, DBUpdate (p, from, where, set), Types.unit_type)
+      | Xml (tag, attrs, attrexp, children) ->
           let (o, attrs) =
             listu o
               (fun o (name, value) ->
@@ -585,9 +588,9 @@ class transform (env : Types.typing_environment) =
               attrs in
           let (o, attrexp, _) = option o (fun o -> o#phrase) attrexp in
           let (o, children, _) = list o (fun o -> o#phrase) children in
-            (o, `Xml (tag, attrs, attrexp, children), Types.xml_type)
-      | `TextNode s -> (o, `TextNode s, Types.xml_type)
-      | `Formlet (body, yields) ->
+            (o, Xml (tag, attrs, attrexp, children), Types.xml_type)
+      | TextNode s -> (o, TextNode s, Types.xml_type)
+      | Formlet (body, yields) ->
          let envs = o#backup_envs in
          let (o, body, _) = o#phrase body in
          (* ensure that the formlet bindings are only in scope in the
@@ -595,16 +598,16 @@ class transform (env : Types.typing_environment) =
          let o = o#with_var_env (TyEnv.extend (o#get_var_env ()) (o#get_formlet_env ())) in
          let (o, yields, t) = o#phrase yields in
          let o = o#restore_envs envs in
-         (o, `Formlet (body, yields), Instantiate.alias "Formlet" [`Type t] tycon_env)
-      | `Page e -> let (o, e, _) = o#phrase e in (o, `Page e, Instantiate.alias "Page" [] tycon_env)
-      | `FormletPlacement (f, h, attributes) ->
+         (o, Formlet (body, yields), Instantiate.alias "Formlet" [`Type t] tycon_env)
+      | Page e -> let (o, e, _) = o#phrase e in (o, Page e, Instantiate.alias "Page" [] tycon_env)
+      | FormletPlacement (f, h, attributes) ->
           let (o, f, _) = o#phrase f in
           let (o, h, _) = o#phrase h in
           let (o, attributes, _) = o#phrase attributes in
-            (o, `FormletPlacement (f, h, attributes), Types.xml_type)
-      | `PagePlacement e ->
-          let (o, e, _) = o#phrase e in (o, `PagePlacement e, Types.xml_type)
-      | `FormBinding (f, p) ->
+            (o, FormletPlacement (f, h, attributes), Types.xml_type)
+      | PagePlacement e ->
+          let (o, e, _) = o#phrase e in (o, PagePlacement e, Types.xml_type)
+      | FormBinding (f, p) ->
          let envs = o#backup_envs in
          let (o, f, _) = o#phrase f in
          (* HACK: add the formlet bindings to the formlet environment *)
@@ -614,7 +617,7 @@ class transform (env : Types.typing_environment) =
          let o = o#restore_envs envs in
          let o = o#with_formlet_env formlet_env in
          (* let o = {< formlet_env=TyEnv.extend formlet_env (o#get_var_env()) >} in *)
-         (o, `FormBinding (f, p), Types.xml_type)
+         (o, FormBinding (f, p), Types.xml_type)
       | e -> failwith ("oops: "^show_phrasenode  e)
 
     method phrase : phrase -> ('self_type * phrase * Types.datatype) =
@@ -622,55 +625,56 @@ class transform (env : Types.typing_environment) =
         let (o, node, t) = o#phrasenode node in
         (o, {node;pos}, t)
 
-    method patternnode : patternnode -> ('self_type * patternnode) =
+    method patternnode : Pattern.t -> ('self_type * Pattern.t) =
+      let open Pattern in
       function
-      | `Any -> (o, `Any)
-      | `Nil -> (o, `Nil)
-      | `Cons (p, ps) ->
+      | Any -> (o, Any)
+      | Nil -> (o, Nil)
+      | Cons (p, ps) ->
           let (o, p) = o#pattern p in
-          let (o, ps) = o#pattern ps in (o, `Cons (p, ps))
-      | `List p ->
-          let (o, p) = listu o (fun o -> o#pattern) p in (o, `List p)
-      | `Variant (name, p) ->
+          let (o, ps) = o#pattern ps in (o, Cons (p, ps))
+      | List p ->
+          let (o, p) = listu o (fun o -> o#pattern) p in (o, List p)
+      | Variant (name, p) ->
           let (o, p) = optionu o (fun o -> o#pattern) p
-          in (o, `Variant (name, p))
-      | `Effect (name, ps, k) ->
+          in (o, Variant (name, p))
+      | Effect (name, ps, k) ->
          let (o, ps) = listu o (fun o -> o#pattern) ps in
          let (o, k)  = o#pattern k in
-         (o, `Effect (name, ps, k))
-      | `Negative name -> (o, `Negative name)
-      | `Record (fields, rest) ->
+         (o, Effect (name, ps, k))
+      | Negative name -> (o, Negative name)
+      | Record (fields, rest) ->
           let (o, fields) =
             listu o
               (fun o (name, p) ->
                  let (o, p) = o#pattern p in (o, (name, p)))
               fields in
           let (o, rest) = optionu o (fun o -> o#pattern) rest
-          in (o, `Record (fields, rest))
-      | `Tuple ps ->
-          let (o, ps) = listu o (fun o -> o#pattern) ps in (o, `Tuple ps)
-      | `Constant c -> let (o, c, _) = o#constant c in (o, `Constant c)
-      | `Variable x -> let (o, x) = o#binder x in (o, `Variable x)
-      | `As (x, p) ->
+          in (o, Record (fields, rest))
+      | Tuple ps ->
+          let (o, ps) = listu o (fun o -> o#pattern) ps in (o, Tuple ps)
+      | Constant c -> let (o, c, _) = o#constant c in (o, Constant c)
+      | Variable x -> let (o, x) = o#binder x in (o, Variable x)
+      | As (x, p) ->
           let (o, x) = o#binder x in
-          let (o, p) = o#pattern p in (o, (`As (x, p)))
-      | `HasType (p, t) ->
-          let (o, p) = o#pattern p in (o, (`HasType (p, t)))
+          let (o, p) = o#pattern p in (o, (As (x, p)))
+      | HasType (p, t) ->
+          let (o, p) = o#pattern p in (o, (HasType (p, t)))
 
-    method pattern : pattern -> ('self_type * pattern) =
+    method pattern : Pattern.with_pos -> ('self_type * Pattern.with_pos) =
       fun {node; pos} ->
         let (o, node) = o#patternnode node in (o, {node; pos})
 
     method iterpatt : iterpatt -> ('self_type * iterpatt) =
       function
-      | `List (p, e) ->
+      | List (p, e) ->
           let (o, e, _) = o#phrase e in
           let (o, p) = o#pattern p in
-            (o, `List (p, e))
-      | `Table (p, e) ->
+          (o, List (p, e))
+      | Table (p, e) ->
           let (o, e, _) = o#phrase e in
           let (o, p) = o#pattern p in
-           (o, `Table (p, e))
+          (o, Table (p, e))
 
     method funlit : Types.row -> funlit -> ('self_type * funlit * Types.datatype) =
       fun inner_eff (pss, e) ->
@@ -713,9 +717,9 @@ class transform (env : Types.typing_environment) =
     method restore_quantifiers : IntSet.t -> 'self_type = fun _ -> o
 
     method rec_bodies :
-      (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list ->
+      (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list ->
       ('self_type *
-         (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list) =
+         (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list) =
       let outer_tyvars = o#backup_quantifiers in
       let rec list o =
         function
@@ -733,9 +737,9 @@ class transform (env : Types.typing_environment) =
         list o
 
     method rec_activate_outer_bindings :
-      (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list ->
+      (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list ->
       ('self_type *
-         (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list) =
+         (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list) =
       let rec list o =
         function
           | [] -> o, []
@@ -748,7 +752,7 @@ class transform (env : Types.typing_environment) =
         list o
 
     method rec_activate_inner_bindings :
-      (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list ->
+      (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list ->
       'self_type =
       let rec list o =
         function
@@ -762,15 +766,15 @@ class transform (env : Types.typing_environment) =
 
     method bindingnode : bindingnode -> ('self_type * bindingnode) =
       function
-      | `Val (p, (tyvars, e), location, t) ->
+      | Val (p, (tyvars, e), location, t) ->
          let outer_tyvars = o#backup_quantifiers in
          let (o, tyvars) = o#quantifiers tyvars in
          let (o, e, _) = o#phrase e in
          let o = o#restore_quantifiers outer_tyvars in
          let (o, p) = o#pattern p in
          let (o, t) = optionu o (fun o -> o#datatype') t in
-         (o, `Val (p, (tyvars, e), location, t))
-      | `Fun (bndr, lin, (tyvars, lam), location, t) when binder_has_type bndr ->
+         (o, Val (p, (tyvars, e), location, t))
+      | Fun (bndr, lin, (tyvars, lam), location, t) when binder_has_type bndr ->
          let outer_tyvars = o#backup_quantifiers in
          let (o, tyvars) = o#quantifiers tyvars in
          let inner_effects = fun_effects (type_of_binder_exn bndr) (fst lam) in
@@ -778,9 +782,9 @@ class transform (env : Types.typing_environment) =
          let o = o#restore_quantifiers outer_tyvars in
          let (o, bndr) = o#binder bndr in
          let (o, t) = optionu o (fun o -> o#datatype') t in
-         (o, `Fun (bndr, lin, (tyvars, lam), location, t))
-      | `Fun _ -> failwith "Unannotated non-recursive function binding"
-      | `Funs defs ->
+         (o, Fun (bndr, lin, (tyvars, lam), location, t))
+      | Fun _ -> failwith "Unannotated non-recursive function binding"
+      | Funs defs ->
          (* put the inner bindings in the environment *)
          let o = o#rec_activate_inner_bindings defs in
 
@@ -789,20 +793,20 @@ class transform (env : Types.typing_environment) =
 
          (* put the outer bindings in the environment *)
          let o, defs = o#rec_activate_outer_bindings defs in
-         (o, (`Funs defs))
-      | `Handler _ -> assert false
-      | `Foreign (f, raw_name, language, file, t) ->
+         (o, (Funs defs))
+      | Handler _ -> assert false
+      | Foreign (f, raw_name, language, file, t) ->
          let (o, f) = o#binder f in
-         (o, `Foreign (f, raw_name, language, file, t))
-      | `Type (name, vars, (_, Some dt)) as e ->
+         (o, Foreign (f, raw_name, language, file, t))
+      | Type (name, vars, (_, Some dt)) as e ->
          let tycon_env = TyEnv.bind tycon_env (name, `Alias (List.map (snd ->- val_of) vars, dt)) in
          {< tycon_env=tycon_env >}, e
-      | `Type _ -> failwith "Unannotated type alias"
-      | `Infix -> (o, `Infix)
-      | `Exp e -> let (o, e, _) = o#phrase e in (o, `Exp e)
-      | `AlienBlock _ -> assert false
-      | `Module _ -> assert false
-      | `QualifiedImport _ -> assert false
+      | Type _ -> failwith "Unannotated type alias"
+      | Infix -> (o, Infix)
+      | Exp e -> let (o, e, _) = o#phrase e in (o, Exp e)
+      | AlienBlock _ -> assert false
+      | Module _ -> assert false
+      | QualifiedImport _ -> assert false
 
     method binding : binding -> ('self_type * binding) =
       fun {node; pos} ->
@@ -821,44 +825,44 @@ class transform (env : Types.typing_environment) =
 
     (* TODO: should really invoke o#datatype on type annotations! *)
     method cp_phrasenode : cp_phrasenode -> ('self_type * cp_phrasenode * Types.datatype) = function
-      | Unquote (bs, e) ->
+      | CPUnquote (bs, e) ->
          let envs = o#backup_envs in
          let (o, bs) = listu o (fun o -> o#binding) bs in
          let (o, e, t) = o#phrase e in
          let o = o#restore_envs envs in
-         o, Unquote (bs, e), t
-      | Grab (cbind, None, p) ->
+         o, CPUnquote (bs, e), t
+      | CPGrab (cbind, None, p) ->
          let (o, p, t) = o#cp_phrase p in
-         o, Grab (cbind, None, p), t
-      | Grab ((c, Some (`Input (_a, s), _grab_tyargs) as cbind), Some b, p) -> (* FYI: a = u *)
+         o, CPGrab (cbind, None, p), t
+      | CPGrab ((c, Some (`Input (_a, s), _grab_tyargs) as cbind), Some b, p) -> (* FYI: a = u *)
          let envs = o#backup_envs in
          let (o, b) = o#binder b in
          let venv = TyEnv.bind (o#get_var_env ()) (c, s) in
          let o = {< var_env = venv >} in
          let (o, p, t) = o#cp_phrase p in
          let o = o#restore_envs envs in
-         o, Grab (cbind, Some b, p), t
-      | Give ((c, Some (`Output (_t, s), _tyargs) as cbind), e, p) ->
+         o, CPGrab (cbind, Some b, p), t
+      | CPGive ((c, Some (`Output (_t, s), _tyargs) as cbind), e, p) ->
          let envs = o#backup_envs in
          let o = {< var_env = TyEnv.bind (o#get_var_env ()) (c, s) >} in
          let (o, e, _typ) = option o (fun o -> o#phrase) e in
          let (o, p, t) = o#cp_phrase p in
          let o = o#restore_envs envs in
-         o, Give (cbind, e, p), t
-      | GiveNothing c ->
+         o, CPGive (cbind, e, p), t
+      | CPGiveNothing c ->
          let envs = o#backup_envs in
          let o, c = o#binder c in
          let o = o#restore_envs envs in
-         o, GiveNothing c, Types.make_endbang_type
-      | Grab _ -> failwith "Malformed grab in TransformSugar"
-      | Give _ -> failwith "Malformed give in TransformSugar"
-      | Select (b, label, p) ->
+         o, CPGiveNothing c, Types.make_endbang_type
+      | CPGrab _ -> failwith "Malformed grab in TransformSugar"
+      | CPGive _ -> failwith "Malformed give in TransformSugar"
+      | CPSelect (b, label, p) ->
          let envs = o#backup_envs in
          let o, b = o#binder b in
          let (o, p, t) = o#cp_phrase p in
          let o = o#restore_envs envs in
-         o, Select (b, label, p), t
-      | Offer (b, cases) ->
+         o, CPSelect (b, label, p), t
+      | CPOffer (b, cases) ->
          let (o, cases) = List.fold_right (fun (label, p) (o, cases) ->
                                            let envs = o#backup_envs in
                                            let o, _ = o#binder b in
@@ -867,16 +871,16 @@ class transform (env : Types.typing_environment) =
          begin
            match List.split cases with
            | cases, t :: _ts ->
-              o, Offer (b, cases), t
+              o, CPOffer (b, cases), t
            | _ -> assert false
          end
-      | Link (c, d) -> o, Link (c, d), Types.unit_type
-      | Comp ({node = c, Some s; _} as bndr, left, right) ->
+      | CPLink (c, d) -> o, CPLink (c, d), Types.unit_type
+      | CPComp ({node = c, Some s; _} as bndr, left, right) ->
          let envs = o#backup_envs in
          let (o, left, _typ) = {< var_env = TyEnv.bind (o#get_var_env ()) (c, s) >}#cp_phrase left in
          let whiny_dual_type s = try Types.dual_type s with Invalid_argument _ -> raise (Invalid_argument ("Attempted to dualize non-session type " ^ Types.string_of_datatype s)) in
          let (o, right, t) = {< var_env = TyEnv.bind (o#get_var_env ()) (c, whiny_dual_type s) >}#cp_phrase right in
          let o = o#restore_envs envs in
-         o, Comp (bndr, left, right), t
-      | Comp _ -> assert false
+         o, CPComp (bndr, left, right), t
+      | CPComp _ -> assert false
   end
diff --git a/core/transformSugar.mli b/core/transformSugar.mli
index 942bc9050..3a781a0be 100644
--- a/core/transformSugar.mli
+++ b/core/transformSugar.mli
@@ -1,3 +1,5 @@
+open Operators
+open CommonTypes
 open Sugartypes
 
 (*
@@ -49,7 +51,7 @@ object ('self)
   method binder          : binder -> 'self * binder
   method binding         : binding -> 'self * binding
   method bindingnode     : bindingnode -> 'self * bindingnode
-  method binop           : binop -> 'self * binop * Types.datatype
+  method binop           : BinaryOp.t -> 'self * BinaryOp.t * Types.datatype
   method constant        : constant -> 'self * constant * Types.datatype
   method funlit          : Types.row -> funlit -> 'self * funlit * Types.datatype
   method handlerlit      : Types.datatype -> handlerlit -> 'self * handlerlit * Types.datatype
@@ -60,25 +62,25 @@ object ('self)
   method restore_quantifiers : Utility.IntSet.t -> 'self
 
   method rec_bodies :
-    (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list ->
+    (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list ->
     ('self *
-       (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list)
+       (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list)
   method rec_activate_outer_bindings :
-    (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list ->
+    (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list ->
     ('self *
-       (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list)
+       (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list)
   method rec_activate_inner_bindings :
-    (binder * declared_linearity * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * location * datatype' option * position) list ->
+    (binder * DeclaredLinearity.t * ((tyvar list * (Types.datatype * Types.quantifier option list) option) * funlit) * Location.t * datatype' option * position) list ->
     'self
 
-  method sugar_datatype   : datatype -> 'self * datatype
+  method sugar_datatype   : Datatype.with_pos -> 'self * Datatype.with_pos
   method datatype         : Types.datatype -> 'self * Types.datatype
   method datatype'        : datatype' -> 'self * datatype'
   method lens_sort        : Types.lens_sort -> 'self * Types.lens_sort
   method row              : Types.row -> 'self * Types.row
 
-  method patternnode     : patternnode -> 'self * patternnode
-  method pattern         : pattern -> 'self * pattern
+  method patternnode     : Pattern.t -> 'self * Pattern.t
+  method pattern         : Pattern.with_pos -> 'self * Pattern.with_pos
   method phrase          : phrase -> 'self * phrase * Types.datatype
   method given_spawn_location : given_spawn_location -> 'self * given_spawn_location
   method phrasenode      : phrasenode -> 'self * phrasenode * Types.datatype
@@ -86,13 +88,13 @@ object ('self)
   method cp_phrasenode   : cp_phrasenode -> 'self * cp_phrasenode * Types.datatype
   method program         : program -> 'self * program * Types.datatype option
   method regex           : regex -> 'self * regex
-  method sec             : sec -> 'self * sec * Types.datatype
+  method section         : Section.t -> 'self * Section.t * Types.datatype
   method sentence        : sentence -> 'self * sentence
 (*
   method sentence'       : sentence' -> 'self * sentence'
   method directive       : directive -> 'self * directive
 *)
-  method unary_op        : unary_op -> 'self * unary_op * Types.datatype
+  method unary_op        : UnaryOp.t -> 'self * UnaryOp.t * Types.datatype
 end
 
-val fun_effects : Types.datatype -> Sugartypes.pattern list list -> Types.row
+val fun_effects : Types.datatype -> Sugartypes.Pattern.with_pos list list -> Types.row
diff --git a/core/typeSugar.ml b/core/typeSugar.ml
index b8dee8b7f..5cd03382f 100644
--- a/core/typeSugar.ml
+++ b/core/typeSugar.ml
@@ -1,5 +1,6 @@
+open CommonTypes
 open Utility
-open Types
+open Operators
 open Sugartypes
 
 (* let constrain_absence_types = Basicsettings.Typing.contrain_absence_types *)
@@ -36,106 +37,106 @@ struct
 
   let rec opt_generalisable o = opt_app is_pure true o
   and is_pure p = match p.node with
-    | `Constant _
-    | `Var _
-    | `QualifiedVar _
-    | `FunLit _
-    | `DatabaseLit _
-    | `TableLit _
-    | `TextNode _
-    | `HandlerLit _
-    | `Section _ -> true
-
-    | `ListLit (ps, _)
-    | `TupleLit ps -> List.for_all is_pure ps
-    | `RangeLit (e1, e2) -> is_pure e1 && is_pure e2
-    | `TAbstr (_, p)
-    | `TAppl (p, _)
-    | `Projection (p, _)
-    | `TypeAnnotation (p, _)
-    | `Upcast (p, _, _)
-    | `Escape (_, p) -> is_pure p
-    | `ConstructorLit (_, p, _) -> opt_generalisable p
-    | `RecordLit (fields, p) ->
-        List.for_all (snd ->- is_pure) fields && opt_generalisable p
-    | `With (p, fields) ->
-        List.for_all (snd ->- is_pure) fields && is_pure p
-    | `Block (bindings, e) ->
-        List.for_all is_pure_binding bindings && is_pure e
-    | `Conditional (p1, p2, p3) ->
+    | QualifiedVar _
+    | Constant _
+    | Var _
+    | FunLit _
+    | DatabaseLit _
+    | TableLit _
+    | TextNode _
+    | HandlerLit _
+    | Section _ -> true
+
+    | ListLit (ps, _)
+    | TupleLit ps -> List.for_all is_pure ps
+    | RangeLit (e1, e2) -> is_pure e1 && is_pure e2
+    | TAbstr (_, p)
+    | TAppl (p, _)
+    | Projection (p, _)
+    | TypeAnnotation (p, _)
+    | Upcast (p, _, _)
+    | Escape (_, p) -> is_pure p
+    | ConstructorLit (_, p, _) -> opt_generalisable p
+    | RecordLit (fields, p) ->
+       List.for_all (snd ->- is_pure) fields && opt_generalisable p
+    | With (p, fields) ->
+       List.for_all (snd ->- is_pure) fields && is_pure p
+    | Block (bindings, e) ->
+       List.for_all is_pure_binding bindings && is_pure e
+    | Conditional (p1, p2, p3) ->
         is_pure p1
      && is_pure p2
      && is_pure p3
-    | `Xml (_, attrs, attrexp, children) ->
+    | Xml (_, attrs, attrexp, children) ->
         List.for_all (snd ->- List.for_all is_pure) attrs
      && opt_generalisable attrexp
      && List.for_all (is_pure) children
-    | `Formlet (p1, p2) ->
+    | Formlet (p1, p2) ->
         is_pure p1 && is_pure p2
-    | `Regex r -> is_pure_regex r
-    | `Iteration _ (* could do a little better in some of these cases *)
-    | `Page _
-    | `FormletPlacement _
-    | `PagePlacement _
-    | `UnaryAppl _
-    | `FormBinding _
-    | `InfixAppl _
-    | `Spawn _
-    | `Query _
-    | `FnAppl _
-    | `Handle _
-    | `Switch _
-    | `Receive _
-    | `Select _
-    | `Offer _
-    | `CP _
-    (* | `Fork _ *)
-    | `LensLit _
-    | `LensKeysLit _
-    | `LensFunDepsLit _
-    | `LensDropLit _
-    | `LensSelectLit _
-    | `LensJoinLit _
-    | `LensGetLit _
-    | `LensPutLit _
-    | `DoOperation _
-    | `DBDelete _
-    | `DBInsert _
-    | `TryInOtherwise _
-    | `Raise
-    | `DBUpdate _ -> false
+    | Regex r -> is_pure_regex r
+    | Iteration _ (* could do a little better in some of these cases *)
+    | Page _
+    | FormletPlacement _
+    | PagePlacement _
+    | UnaryAppl _
+    | FormBinding _
+    | InfixAppl _
+    | Spawn _
+    | Query _
+    | FnAppl _
+    | Handle _
+    | Switch _
+    | Receive _
+    | Select _
+    | Offer _
+    | CP _
+    | LensLit _
+    | LensKeysLit _
+    | LensFunDepsLit _
+    | LensDropLit _
+    | LensSelectLit _
+    | LensJoinLit _
+    | LensGetLit _
+    | LensPutLit _
+    | DoOperation _
+    | DBDelete _
+    | DBInsert _
+    | TryInOtherwise _
+    | Raise
+    | DBUpdate _ -> false
   and is_pure_binding ({node ; _ }: binding) = match node with
       (* need to check that pattern matching cannot fail *)
-    | `QualifiedImport _
-    | `AlienBlock _
-    | `Module _
-    | `Fun _
-    | `Funs _
-    | `Infix
-    | `Type _
-    | `Handler _
-    | `Foreign _ -> true
-    | `Exp p -> is_pure p
-    | `Val (pat, (_, rhs), _, _) ->
+    | QualifiedImport _
+    | AlienBlock _
+    | Module _
+    | Fun _
+    | Funs _
+    | Infix
+    | Type _
+    | Handler _
+    | Foreign _ -> true
+    | Exp p -> is_pure p
+    | Val (pat, (_, rhs), _, _) ->
         is_safe_pattern pat && is_pure rhs
-  and is_safe_pattern {node = pat; _} = match pat with
+  and is_safe_pattern {node = pat; _} = let open Pattern in
+    match pat with
       (* safe patterns cannot fail *)
-    | `Nil
-    | `Cons _
-    | `List _
-    | `Constant _ -> false
+    | Nil
+    | Cons _
+    | List _
+    | Constant _ -> false
     (* NOTE: variant assigment is typed such that it must always succeed *)
-    | `Variant (_, None) -> true
-    | `Variant (_, Some p) -> is_safe_pattern p
-    | `Negative _ -> true
-    | `Any
-    | `Variable _ -> true
-    | `Record (ps, None) -> List.for_all (snd ->- is_safe_pattern) ps
-    | `Record (ps, Some p) -> List.for_all (snd ->- is_safe_pattern) ps && is_safe_pattern p
-    | `Tuple ps -> List.for_all is_safe_pattern ps
-    | `HasType (p, _)
-    | `As (_, p) -> is_safe_pattern p
-    | `Effect (_, ps, k) ->
+    | Variant (_, None) -> true
+    | Variant (_, Some p) -> is_safe_pattern p
+    | Negative _ -> true
+    | Any
+    | Variable _ -> true
+    | Record (ps, None) -> List.for_all (snd ->- is_safe_pattern) ps
+    | Record (ps, Some p) -> List.for_all (snd ->- is_safe_pattern) ps && is_safe_pattern p
+    | Tuple ps -> List.for_all is_safe_pattern ps
+    | HasType (p, _)
+    | As (_, p) -> is_safe_pattern p
+    | Effect (_, ps, k) ->
        List.for_all is_safe_pattern ps && is_safe_pattern k
   and is_pure_regex = function
       (* don't check whether it can fail; just check whether it
@@ -151,8 +152,8 @@ struct
     | Seq rs -> List.for_all is_pure_regex rs
     | Alternate (r1, r2) -> is_pure_regex r1 && is_pure_regex r2
     | Splice p -> is_pure p
-    | Replace (r, `Literal _) -> is_pure_regex r
-    | Replace (r, `Splice p) -> is_pure_regex r && is_pure p
+    | Replace (r, Literal _) -> is_pure_regex r
+    | Replace (r, SpliceExpr p) -> is_pure_regex r && is_pure p
 
   let is_generalisable = is_pure
 end
@@ -969,8 +970,8 @@ end
     let iteration_table_pattern ~pos ~t1:l ~t2:(rexpr,rt) ~error:_ =
       build_tyvar_names [snd l; rt];
       let rt = Types.make_table_type
-                 (rt, Types.fresh_type_variable (`Any, `Any)
-                    , Types.fresh_type_variable (`Any, `Any)) in
+                 (rt, Types.fresh_type_variable (lin_any, res_any)
+                    , Types.fresh_type_variable (lin_any, res_any)) in
         with_but2things pos
           ("The binding must match the table in a table generator")
           ("pattern", l) ("expression", (rexpr, rt))
@@ -1378,25 +1379,27 @@ let unbind_var context v = {context with var_env = Env.unbind context.var_env v}
 let bind_tycon context (v, t) = {context with tycon_env = Env.bind context.tycon_env (v,t)}
 let bind_effects context r = {context with effect_row = r}
 
-let type_section context (`Section s as s') =
-  let env = context.var_env in
-  let ((tyargs, t), usages) =
-    match s with
-      | `Minus         -> Utils.instantiate env "-", StringMap.empty
-      | `FloatMinus    -> Utils.instantiate env "-.", StringMap.empty
-      | `Project label ->
-          let a = Types.fresh_type_variable (`Any, `Any) in
-          let rho = Types.fresh_row_variable (`Any, `Any) in
-          let effects = Types.make_empty_open_row (`Any, `Any) in (* projection is pure! *)
+let type_section context = function
+  | Section s as s' ->
+     let env = context.var_env in
+     let ((tyargs, t), usages) =
+       let open Section in match s with
+       | Minus         -> Utils.instantiate env "-", StringMap.empty
+       | FloatMinus    -> Utils.instantiate env "-.", StringMap.empty
+       | Project label ->
+          let a = Types.fresh_type_variable (lin_any, res_any) in
+          let rho = Types.fresh_row_variable (lin_any, res_any) in
+          let effects = Types.make_empty_open_row (lin_any, res_any) in (* projection is pure! *)
           let r = `Record (StringMap.add label (`Present a) StringMap.empty, rho, false) in
             ([`Type a; `Row (StringMap.empty, rho, false); `Row effects], `Function (Types.make_tuple_type [r], effects, a)), StringMap.empty
-      | `Name var      -> Utils.instantiate env var, StringMap.singleton var 1
-  in
-    if Settings.get_value Instantiate.quantified_instantiation then
-      let tyvars = Types.quantifiers_of_type_args tyargs in
-        tabstr(tyvars, tappl (s', tyargs)), t, usages
-    else
-      tappl (s', tyargs), t, usages
+       | Name var      -> Utils.instantiate env var, StringMap.singleton var 1
+     in
+     if Settings.get_value Instantiate.quantified_instantiation then
+       let tyvars = Types.quantifiers_of_type_args tyargs in
+       tabstr(tyvars, tappl (s', tyargs)), t, usages
+     else
+       tappl (s', tyargs), t, usages
+  | _ -> assert false
 
 let datatype aliases = Instantiate.typ -<- DesugarDatatypes.read ~aliases
 let add_usages (p, t) m = (p, t, m)
@@ -1405,15 +1408,16 @@ let add_empty_usages (p, t) = (p, t, StringMap.empty)
 let type_unary_op env =
   let datatype = datatype env.tycon_env in
   function
-  | `Minus      -> add_empty_usages (datatype "(Int) -> Int")
-  | `FloatMinus -> add_empty_usages (datatype "(Float) -> Float")
-  | `Name n     -> add_usages (Utils.instantiate env.var_env n) (StringMap.singleton n 1)
+  | UnaryOp.Minus      -> add_empty_usages (datatype "(Int) -> Int")
+  | UnaryOp.FloatMinus -> add_empty_usages (datatype "(Float) -> Float")
+  | UnaryOp.Name n     -> add_usages (Utils.instantiate env.var_env n) (StringMap.singleton n 1)
 
 let type_binary_op ctxt =
+  let open BinaryOp in
   let datatype = datatype ctxt.tycon_env in function
-  | `Minus        -> add_empty_usages (Utils.instantiate ctxt.var_env "-")
-  | `FloatMinus   -> add_empty_usages (Utils.instantiate ctxt.var_env "-.")
-  | `RegexMatch flags ->
+  | Minus        -> add_empty_usages (Utils.instantiate ctxt.var_env "-")
+  | FloatMinus   -> add_empty_usages (Utils.instantiate ctxt.var_env "-.")
+  | RegexMatch flags ->
       let nativep  = List.exists ((=) RegexNative)  flags
       and listp    = List.exists ((=) RegexList)    flags
       and replacep = List.exists ((=) RegexReplace) flags in
@@ -1424,45 +1428,46 @@ let type_binary_op ctxt =
            | false, false, false -> (* tilde *)   add_empty_usages (datatype "(String, Regex) -> Bool")
            | _    , _    , true  -> assert false
         end
-  | `And
-  | `Or           -> add_empty_usages (datatype "(Bool,Bool) -> Bool")
-  | `Cons         -> add_empty_usages (Utils.instantiate ctxt.var_env "Cons")
-  | `Name "++"    -> add_empty_usages (Utils.instantiate ctxt.var_env "Concat")
-  | `Name ">"
-  | `Name ">="
-  | `Name "=="
-  | `Name "<"
-  | `Name "<="
-  | `Name "<>"    ->
-      let a = Types.fresh_type_variable (`Any, `Any) in
-      let eff = (StringMap.empty, Types.fresh_row_variable (`Any, `Any), false) in
+  | And
+  | Or           -> add_empty_usages (datatype "(Bool,Bool) -> Bool")
+  | Cons         -> add_empty_usages (Utils.instantiate ctxt.var_env "Cons")
+  | Name "++"    -> add_empty_usages (Utils.instantiate ctxt.var_env "Concat")
+  | Name ">"
+  | Name ">="
+  | Name "=="
+  | Name "<"
+  | Name "<="
+  | Name "<>"    ->
+      let a = Types.fresh_type_variable (lin_any, res_any) in
+      let eff = (StringMap.empty, Types.fresh_row_variable (lin_any, res_any), false) in
         ([`Type a; `Row eff],
          `Function (Types.make_tuple_type [a; a], eff, `Primitive `Bool),
          StringMap.empty)
-  | `Name "!"     -> add_empty_usages (Utils.instantiate ctxt.var_env "Send")
-  | `Name n       -> add_usages (Utils.instantiate ctxt.var_env n) (StringMap.singleton n 1)
+  | Name "!"     -> add_empty_usages (Utils.instantiate ctxt.var_env "Send")
+  | Name n       -> add_usages (Utils.instantiate ctxt.var_env n) (StringMap.singleton n 1)
 
 (** close a pattern type relative to a list of patterns
 
    If there are no _ or variable patterns at a variant type, then that
    variant will be closed.
 *)
-let close_pattern_type : pattern list -> Types.datatype -> Types.datatype = fun pats t ->
+let close_pattern_type : Pattern.with_pos list -> Types.datatype -> Types.datatype = fun pats t ->
   (* We use a table to keep track of encountered recursive variables
      in order to avert non-termination. *)
   let rec_vars_seen = Hashtbl.create 8 in
-  let rec cpt : pattern list -> Types.datatype -> Types.datatype = fun pats t ->
+  let rec cpt : Pattern.with_pos list -> Types.datatype -> Types.datatype = fun pats t ->
     match t with
       | `Alias (alias, t) -> `Alias (alias, cpt pats t)
       | `Record row when Types.is_tuple row->
           let fields, row_var, dual = fst (Types.unwrap_row row) in
           let rec unwrap_at i p =
+            let open Pattern in
             match p.node with
-              | `Variable _ | `Any | `Constant _ -> p
-              | `As (_, p) | `HasType (p, _) -> unwrap_at i p
-              | `Tuple ps ->
+              | Variable _ | Any | Constant _ -> p
+              | As (_, p) | HasType (p, _) -> unwrap_at i p
+              | Tuple ps ->
                   List.nth ps i
-              | `Nil | `Cons _ | `List _ | `Record _ | `Variant _ | `Negative _ | `Effect _ -> assert false in
+              | Nil | Cons _ | List _ | Record _ | Variant _ | Negative _ | Effect _ -> assert false in
           let fields =
             StringMap.fold(* true if the row variable is dualised *)
 
@@ -1479,10 +1484,11 @@ let close_pattern_type : pattern list -> Types.datatype -> Types.datatype = fun
           let fields, row_var, lr = fst (Types.unwrap_row row) in
           assert (not lr);
           let rec unwrap_at name p =
+            let open Pattern in
             match p.node with
-              | `Variable _ | `Any | `Constant _ -> p
-              | `As (_, p) | `HasType (p, _) -> unwrap_at name p
-              | `Record (ps, default) ->
+              | Variable _ | Any | Constant _ -> p
+              | As (_, p) | HasType (p, _) -> unwrap_at name p
+              | Record (ps, default) ->
                   if List.mem_assoc name ps then
                     List.assoc name ps
                   else
@@ -1491,7 +1497,7 @@ let close_pattern_type : pattern list -> Types.datatype -> Types.datatype = fun
                         | None -> assert false
                         | Some p -> unwrap_at name p
                     end
-              | `Nil | `Cons _ | `List _ | `Tuple _ | `Variant _ | `Negative _ | `Effect _ -> assert false in
+              | Nil | Cons _ | List _ | Tuple _ | Variant _ | Negative _ | Effect _ -> assert false in
           let fields =
             StringMap.fold
               (fun name ->
@@ -1516,24 +1522,26 @@ let close_pattern_type : pattern list -> Types.datatype -> Types.datatype = fun
               *)
               (end_pos, end_pos, buf) in
 
-          let rec unwrap_at : string -> pattern -> pattern list = fun name p ->
+          let rec unwrap_at : string -> Pattern.with_pos -> Pattern.with_pos list = fun name p ->
+            let open Pattern in
             match p.node with
-              | `Variable _ | `Any -> [ with_pos (end_pos p) `Any ]
-              | `As (_, p) | `HasType (p, _) -> unwrap_at name p
-              | `Variant (name', None) when name=name' ->
-                    [with_pos (end_pos p) (`Record ([], None))]
-              | `Variant (name', Some p) when name=name' -> [p]
-              | `Variant _ -> []
-              | `Negative names when List.mem name names -> []
-              | `Negative _ -> [ with_pos (end_pos p) `Any ]
-              | `Nil | `Cons _ | `List _ | `Tuple _ | `Record _ | `Constant _ | `Effect _ -> assert false in
-          let rec are_open : pattern list -> bool =
+              | Variable _ | Any -> [ with_pos (end_pos p) Pattern.Any ]
+              | As (_, p) | HasType (p, _) -> unwrap_at name p
+              | Variant (name', None) when name=name' ->
+                    [with_pos (end_pos p) (Record ([], None))]
+              | Variant (name', Some p) when name=name' -> [p]
+              | Variant _ -> []
+              | Negative names when List.mem name names -> []
+              | Negative _ -> [ with_pos (end_pos p) Pattern.Any ]
+              | Nil | Cons _ | List _ | Tuple _ | Record _ | Constant _ | Effect _ -> assert false in
+          let rec are_open : Pattern.with_pos list -> bool =
+            let open Pattern in
             function
               | [] -> false
-              | {node = (`Variable _ | `Any | `Negative _); _} :: _ -> true
-              | {node = (`As (_, p) | `HasType (p, _)); _} :: ps -> are_open (p :: ps)
-              | {node = (`Variant _); _} :: ps -> are_open ps
-              | {node = (`Nil | `Cons _ | `List _ | `Tuple _ | `Record _ | `Constant _ | `Effect _); _} :: _ -> assert false in
+              | {node = (Variable _ | Any | Negative _); _} :: _ -> true
+              | {node = (As (_, p) | HasType (p, _)); _} :: ps -> are_open (p :: ps)
+              | {node = (Variant _); _} :: ps -> are_open ps
+              | {node = (Nil | Cons _ | List _ | Tuple _ | Record _ | Constant _ | Effect _); _} :: _ -> assert false in
           let fields =
             StringMap.fold
               (fun name field_spec env ->
@@ -1566,12 +1574,13 @@ let close_pattern_type : pattern list -> Types.datatype -> Types.datatype = fun
           let fields, row_var, lr = fst (Types.unwrap_row row) in
           assert (not lr);
 
-          let unwrap_at : string -> pattern -> pattern list = fun name p ->
+          let unwrap_at : string -> Pattern.with_pos -> Pattern.with_pos list = fun name p ->
+            let open Pattern in
             match p.node with
-              | `Effect (name', ps, _) when name=name' -> ps
-              | `Effect _ -> []
-              | `Variable _ | `Any | `As _ | `HasType _ | `Negative _
-              | `Nil | `Cons _ | `List _ | `Tuple _ | `Record _ | `Variant _ | `Constant _ -> assert false in
+              | Effect (name', ps, _) when name=name' -> ps
+              | Effect _ -> []
+              | Variable _ | Any | As _ | HasType _ | Negative _
+              | Nil | Cons _ | List _ | Tuple _ | Record _ | Variant _ | Constant _ -> assert false in
           let fields =
             StringMap.fold
               (fun name field_spec env ->
@@ -1590,7 +1599,7 @@ let close_pattern_type : pattern list -> Types.datatype -> Types.datatype = fun
                        (* Construct an p x n matrix (i.e. the
                           transposition of p x n matrix as it is easier
                           to map column-wise) *)
-                         let pmat : pattern list list =
+                         let pmat : Pattern.with_pos list list =
                            let non_empty ps = ps <> [] in
                            let rows =
                              map_filter
@@ -1632,14 +1641,15 @@ let close_pattern_type : pattern list -> Types.datatype -> Types.datatype = fun
           `Effect row
       | `Application (l, [`Type t])
           when Types.Abstype.equal l Types.list ->
-          let rec unwrap p : pattern list =
+          let rec unwrap p : Pattern.with_pos list =
+            let open Pattern in
             match p.node with
-              | `Variable _ | `Any -> [p]
-              | `Constant _ | `Nil -> []
-              | `Cons (p1, p2) -> p1 :: unwrap p2
-              | `List ps -> ps
-              | `As (_, p) | `HasType (p, _) -> unwrap p
-              | `Variant _ | `Negative _ | `Record _ | `Tuple _ | `Effect _ -> assert false in
+              | Variable _ | Any -> [p]
+              | Constant _ | Nil -> []
+              | Cons (p1, p2) -> p1 :: unwrap p2
+              | List ps -> ps
+              | As (_, p) | HasType (p, _) -> unwrap p
+              | Variant _ | Negative _ | Record _ | Tuple _ | Effect _ -> assert false in
           let pats = concat_map unwrap pats in
             `Application (Types.list, [`Type (cpt pats t)])
       | `ForAll (qs, t) -> `ForAll (qs, cpt pats t)
@@ -1703,7 +1713,7 @@ let unify_or ~(handle:Gripers.griper) ~pos ((_, ltype1), (_, rtype1))
 
 
 (** check for duplicate names in a list of pattern *)
-let check_for_duplicate_names : Sugartypes.position -> pattern list -> string list = fun pos ps ->
+let check_for_duplicate_names : Sugartypes.position -> Pattern.with_pos list -> string list = fun pos ps ->
   let add name binder binderss =
     if StringMap.mem name binderss then
       let (count, binders) = StringMap.find name binderss in
@@ -1711,34 +1721,35 @@ let check_for_duplicate_names : Sugartypes.position -> pattern list -> string li
     else
       StringMap.add name (1, [binder]) binderss in
 
-  let rec gather binderss { node = (p : patternnode); _} =
-    match p with
-      | `Any -> binderss
-      | `Nil -> binderss
-      | `Cons (p, q) ->
+  let rec gather binderss {node; _} =
+    let open Pattern in
+    match node with
+      | Nil -> binderss
+      | Any -> binderss
+      | Cons (p, q) ->
           let binderss = gather binderss p in gather binderss q
-      | `List ps ->
+      | List ps ->
           List.fold_right (fun p binderss -> gather binderss p) ps binderss
-      | `Variant (_, p) ->
+      | Variant (_, p) ->
          opt_app (fun p -> gather binderss p) binderss p
-      | `Effect (_, ps, k) ->
+      | Effect (_, ps, k) ->
          let binderss' =
            List.fold_right (fun p binderss -> gather binderss p) ps binderss
          in
          gather binderss' k
-      | `Negative _ -> binderss
-      | `Record (ps, p) ->
+      | Negative _ -> binderss
+      | Record (ps, p) ->
           let binderss = List.fold_right (fun (_, p) binderss -> gather binderss p) ps binderss in
             opt_app (fun p -> gather binderss p) binderss p
-      | `Tuple ps ->
+      | Tuple ps ->
           List.fold_right (fun p binderss -> gather binderss p) ps binderss
-      | `Constant _ -> binderss
-      | `Variable bndr ->
+      | Constant _ -> binderss
+      | Variable bndr ->
           add (name_of_binder bndr) bndr binderss
-      | `As (bndr, p) ->
+      | As (bndr, p) ->
           let binderss = gather binderss p in
             add (name_of_binder bndr) bndr binderss
-      | `HasType (p, _) -> gather binderss p in
+      | HasType (p, _) -> gather binderss p in
 
   let binderss =
     List.fold_left gather StringMap.empty ps in
@@ -1748,11 +1759,11 @@ let check_for_duplicate_names : Sugartypes.position -> pattern list -> string li
     else
       List.map fst (StringMap.bindings binderss)
 
-let type_pattern closed : pattern -> pattern * Types.environment * Types.datatype =
+let type_pattern closed : Pattern.with_pos -> Pattern.with_pos * Types.environment * Types.datatype =
   let make_singleton_row =
     match closed with
       | `Closed -> Types.make_singleton_closed_row
-      | `Open -> (fun var -> Types.make_singleton_open_row var (`Any, `Any)) in
+      | `Open -> (fun var -> Types.make_singleton_open_row var (lin_any, res_any)) in
 
   (* type_pattern p types the pattern p returning a typed pattern, a
      type environment for the variables bound by the pattern and two
@@ -1764,7 +1775,7 @@ let type_pattern closed : pattern -> pattern * Types.environment * Types.datatyp
      using types from the inner type.
 
   *)
-  let rec type_pattern {node = pattern; pos = pos'} : pattern * Types.environment * (Types.datatype * Types.datatype) =
+  let rec type_pattern {node = pattern; pos = pos'} : Pattern.with_pos * Types.environment * (Types.datatype * Types.datatype) =
     let _UNKNOWN_POS_ = "<unknown>" in
     let tp = type_pattern in
     let unify (l, r) = unify_or_raise ~pos:pos' (l, r)
@@ -1775,31 +1786,32 @@ let type_pattern closed : pattern -> pattern * Types.environment * Types.datatyp
     and pos ({pos = p;_},_,_) = let (_,_,p) = SourceCode.resolve_pos p in p
     and (++) = Env.extend in
     let (p, env, (outer_type, inner_type)) :
-      patternnode * Types.environment * (Types.datatype * Types.datatype) =
+      Pattern.t * Types.environment * (Types.datatype * Types.datatype) =
+      let open Pattern in
       match pattern with
-      | `Any ->
-        let t = Types.fresh_type_variable (`Unl, `Any) in
-        `Any, Env.empty, (t, t)
-      | `Nil ->
-        let t = Types.make_list_type (Types.fresh_type_variable (`Any, `Any)) in
-        `Nil, Env.empty, (t, t)
-      | `Constant c as c' ->
+      | Nil ->
+        let t = Types.make_list_type (Types.fresh_type_variable (lin_any, res_any)) in
+        Nil, Env.empty, (t, t)
+      | Any ->
+        let t = Types.fresh_type_variable (lin_unl, res_any) in
+        Any, Env.empty, (t, t)
+      | Constant c as c' ->
         let t = Constant.constant_type c in
         c', Env.empty, (t, t)
-      | `Variable bndr ->
-        let xtype = Types.fresh_type_variable (`Any, `Any) in
-        (`Variable (set_binder_type bndr xtype),
+      | Variable bndr ->
+        let xtype = Types.fresh_type_variable (lin_any, res_any) in
+        (Variable (set_binder_type bndr xtype),
          Env.bind Env.empty (name_of_binder bndr, xtype),
          (xtype, xtype))
-      | `Cons (p1, p2) ->
+      | Cons (p1, p2) ->
         let p1 = tp p1
         and p2 = tp p2 in
         let () = unify ~handle:Gripers.cons_pattern ((pos p1, Types.make_list_type (ot p1)),
                                                      (pos p2, ot p2)) in
         let () = unify ~handle:Gripers.cons_pattern ((pos p1, Types.make_list_type (it p1)),
                                                      (pos p2, it p2)) in
-        `Cons (erase p1, erase p2), env p1 ++ env p2, (ot p2, it p2)
-      | `List ps ->
+        Cons (erase p1, erase p2), env p1 ++ env p2, (ot p2, it p2)
+      | List ps ->
         let ps' = List.map tp ps in
         let env' = List.fold_right (env ->- (++)) ps' Env.empty in
         let list_type p ps typ =
@@ -1808,41 +1820,42 @@ let type_pattern closed : pattern -> pattern * Types.environment * Types.datatyp
           Types.make_list_type (typ p) in
         let ts =
           match ps' with
-          | [] -> let t = Types.fresh_type_variable (`Any, `Any) in t, t
+          | [] -> let t = Types.fresh_type_variable (lin_any, res_any) in t, t
           | p::ps ->
             list_type p ps ot, list_type p ps it
         in
-        `List (List.map erase ps'), env', ts
-      | `Variant (name, None) ->
+        List (List.map erase ps'), env', ts
+      | Variant (name, None) ->
         let vtype () = `Variant (make_singleton_row (name, `Present Types.unit_type)) in
-        `Variant (name, None), Env.empty, (vtype (), vtype ())
-      | `Variant (name, Some p) ->
+        Variant (name, None), Env.empty, (vtype (), vtype ())
+      | Variant (name, Some p) ->
         let p = tp p in
         let vtype typ = `Variant (make_singleton_row (name, `Present (typ p))) in
-        `Variant (name, Some (erase p)), env p, (vtype ot, vtype it)
-      | `Effect (name, ps, k) ->
+        Variant (name, Some (erase p)), env p, (vtype ot, vtype it)
+      | Effect (name, ps, k) ->
          (* Auxiliary machinery for typing effect patterns *)
-         let rec type_resumption_pat (kpat : pattern) : pattern * Types.environment * (Types.datatype * Types.datatype) =
+         let rec type_resumption_pat (kpat : Pattern.with_pos) : Pattern.with_pos * Types.environment * (Types.datatype * Types.datatype) =
            let fresh_resumption_type () =
-             let domain = Types.fresh_type_variable (`Unl, `Any) in
-             let codomain = Types.fresh_type_variable (`Unl, `Any) in
-             let effrow = Types.make_empty_open_row (`Unl, `Any) in
+             let domain   = Types.fresh_type_variable (lin_unl, res_any) in
+             let codomain = Types.fresh_type_variable (lin_unl, res_any) in
+             let effrow   = Types.make_empty_open_row (lin_unl, res_any) in
              Types.make_function_type [domain] effrow codomain
            in
            let pos' = kpat.pos in
+           let open Pattern in
            match kpat.node with
-           | `Any ->
+           | Any ->
               let t = fresh_resumption_type () in
-              with_pos pos' `Any, Env.empty, (t, t)
-           | `Variable bndr ->
+              with_pos pos' Pattern.Any, Env.empty, (t, t)
+           | Variable bndr ->
               let xtype = fresh_resumption_type () in
-              ( with_pos pos' (`Variable (set_binder_type bndr xtype))
+              ( with_pos pos' (Variable (set_binder_type bndr xtype))
               , Env.bind Env.empty (name_of_binder bndr, xtype), (xtype, xtype))
-           | `As (bndr, pat') ->
+           | As (bndr, pat') ->
               let p = type_resumption_pat pat' in
               let env' = Env.bind (env p) (name_of_binder bndr, it p) in
-              with_pos pos' (`As ((set_binder_type bndr (it p), erase p))), env', (ot p, it p)
-           | `HasType (p, (_, Some t)) ->
+              with_pos pos' (As ((set_binder_type bndr (it p), erase p))), env', (ot p, it p)
+           | HasType (p, (_, Some t)) ->
               let p = type_resumption_pat p in
               let () = unify ~handle:Gripers.type_resumption_with_annotation ((pos p, it p), (_UNKNOWN_POS_, t)) in
               erase p, env p, (ot p, t)
@@ -1876,22 +1889,22 @@ let type_pattern closed : pattern -> pattern * Types.environment * Types.datatyp
            let kenv = env k in
            penv ++ kenv
          in
-         `Effect (name, List.map erase ps, erase k), env, (eff ot, eff it)
-      | `Negative names ->
-        let row_var = Types.fresh_row_variable (`Any, `Any) in
+         Effect (name, List.map erase ps, erase k), env, (eff ot, eff it)
+      | Negative names ->
+        let row_var = Types.fresh_row_variable (lin_any, res_any) in
 
         let positive, negative =
           List.fold_right
             (fun name (positive, negative) ->
-               let a = Types.fresh_type_variable (`Any, `Any) in
+               let a = Types.fresh_type_variable (lin_any, res_any) in
                (StringMap.add name (`Present a) positive,
                 StringMap.add name `Absent negative))
             names (StringMap.empty, StringMap.empty) in
 
         let outer_type = `Variant (positive, row_var, false) in
         let inner_type = `Variant (negative, row_var, false) in
-        `Negative names, Env.empty, (outer_type, inner_type)
-      | `Record (ps, default) ->
+        Negative names, Env.empty, (outer_type, inner_type)
+      | Record (ps, default) ->
         let ps = alistmap tp ps in
         let default = opt_map tp default in
         let initial_outer, initial_inner, denv =
@@ -1905,7 +1918,7 @@ let type_pattern closed : pattern -> pattern * Types.environment * Types.datatyp
                 List.fold_right
                   (fun (label, _) ->
                      Types.row_with (label, `Absent))
-                  ps (Types.make_empty_open_row (`Any, `Any)) in
+                  ps (Types.make_empty_open_row (lin_any, res_any)) in
               let () = unify ~handle:Gripers.record_pattern (("", `Record row),
                                                              (pos r, typ r))
               in
@@ -1919,23 +1932,23 @@ let type_pattern closed : pattern -> pattern * Types.environment * Types.datatyp
         let penv =
           List.fold_right (snd ->- env ->- (++)) ps Env.empty
         in
-        (`Record (alistmap erase ps, opt_map erase default),
+        (Record (alistmap erase ps, opt_map erase default),
          penv ++ denv,
          (rtype ot initial_outer, rtype it initial_inner))
-      | `Tuple ps ->
+      | Tuple ps ->
         let ps' = List.map tp ps in
         let env' = List.fold_right (env ->- (++)) ps' Env.empty in
         let make_tuple typ = Types.make_tuple_type (List.map typ ps') in
-        `Tuple (List.map erase ps'), env', (make_tuple ot, make_tuple it)
-      | `As (bndr, p) ->
+        Tuple (List.map erase ps'), env', (make_tuple ot, make_tuple it)
+      | As (bndr, p) ->
         let p = tp p in
         let env' = Env.bind (env p) (name_of_binder bndr, it p) in
-        `As (set_binder_type bndr (it p), erase p), env', (ot p, it p)
-      | `HasType (p, (_,Some t as t')) ->
+        As (set_binder_type bndr (it p), erase p), env', (ot p, it p)
+      | HasType (p, (_,Some t as t')) ->
         let p = tp p in
         let () = unify ~handle:Gripers.pattern_annotation ((pos p, it p), (_UNKNOWN_POS_, t)) in
-        `HasType (erase p, t'), env p, (ot p, t)
-      | `HasType _ -> assert false in
+        HasType (erase p, t'), env p, (ot p, t)
+      | HasType _ -> assert false in
     with_pos pos' p, env, (outer_type, inner_type)
   in
   fun pattern ->
@@ -1943,51 +1956,53 @@ let type_pattern closed : pattern -> pattern * Types.environment * Types.datatyp
     let pos, env, (outer_type, _) = type_pattern pattern in
     pos, env, outer_type
 
-let rec pattern_env : pattern -> Types.datatype Env.t =
-  fun { node = p; _} -> match p with
-    | `Any
-    | `Nil
-    | `Constant _ -> Env.empty
-
-    | `HasType (p,_) -> pattern_env p
-    | `Variant (_, Some p) -> pattern_env p
-    | `Variant (_, None) -> Env.empty
-    | `Effect (_, ps, k) ->
-       let env = List.fold_right (pattern_env ->- Env.extend) ps Env.empty in
-       Env.extend env (pattern_env k)
-    | `Negative _ -> Env.empty
-    | `Record (ps, Some p) ->
-        List.fold_right (snd ->- pattern_env ->- Env.extend) ps (pattern_env p)
-    | `Record (ps, None) ->
-        List.fold_right (snd ->- pattern_env ->- Env.extend) ps Env.empty
-    | `Cons (h,t) -> Env.extend (pattern_env h) (pattern_env t)
-    | `List ps
-    | `Tuple ps -> List.fold_right (pattern_env ->- Env.extend) ps Env.empty
-    | `Variable {node=v, Some t; _} -> Env.bind Env.empty (v, t)
-    | `Variable {node=_, None; _} -> assert false
-    | `As       ({node=v, Some t; _}, p) -> Env.bind (pattern_env p) (v, t)
-    | `As       ({node=_, None; _}, _) -> assert false
+let rec pattern_env : Pattern.with_pos -> Types.datatype Env.t =
+  fun { node = p; _} -> let open Pattern in
+  match p with
+    | Any
+    | Nil
+    | Constant _ -> Env.empty
+
+    | HasType (p,_) -> pattern_env p
+    | Variant (_, Some p) -> pattern_env p
+    | Variant (_, None) -> Env.empty
+    | Effect (_, ps, k) ->
+      let env = List.fold_right (pattern_env ->- Env.extend) ps Env.empty in
+      Env.extend env (pattern_env k)
+    | Negative _ -> Env.empty
+    | Record (ps, Some p) ->
+       List.fold_right (snd ->- pattern_env ->- Env.extend) ps (pattern_env p)
+    | Record (ps, None) ->
+       List.fold_right (snd ->- pattern_env ->- Env.extend) ps Env.empty
+    | Cons (h,t) -> Env.extend (pattern_env h) (pattern_env t)
+    | List ps
+    | Tuple ps -> List.fold_right (pattern_env ->- Env.extend) ps Env.empty
+    | Variable {node=v, Some t; _} -> Env.bind Env.empty (v, t)
+    | Variable {node=_, None; _} -> assert false
+    | As       ({node=v, Some t; _}, p) -> Env.bind (pattern_env p) (v, t)
+    | As       ({node=_, None; _}, _) -> assert false
 
 
 let update_pattern_vars env =
 (object (self)
   inherit SugarTraversals.map as super
 
-  method! patternnode : patternnode -> patternnode =
+  method! patternnode : Pattern.t -> Pattern.t =
     fun n ->
+      let open Pattern in
       let update bndr =
         let ty = Env.lookup env (name_of_binder bndr) in
         set_binder_type bndr ty
       in match n with
-         | `Variable b -> `Variable (update b)
-         | `As (b, p) -> `As (update b, self#pattern p)
+         | Variable b -> Variable (update b)
+         | As (b, p)  -> As (update b, self#pattern p)
          | _ -> super#patternnode n
  end)#pattern
 
 let rec extract_formlet_bindings : phrase -> Types.datatype Env.t = fun p ->
   match p.node with
-  | `FormBinding (_, pattern) -> pattern_env pattern
-  | `Xml (_, _, _, children) ->
+  | FormBinding (_, pattern) -> pattern_env pattern
+  | Xml (_, _, _, children) ->
       List.fold_right
         (fun child env ->
            Env.extend env (extract_formlet_bindings child))
@@ -2008,11 +2023,11 @@ let make_ft declared_linearity ps effects return_type =
   let pattern_typ (_, _, t) = t in
   let args =
     Types.make_tuple_type -<- List.map pattern_typ in
-  let ftcon = fun p -> if declared_linearity=`Lin then `Lolli p else `Function p in
+  let ftcon = fun p -> if DeclaredLinearity.is_linear declared_linearity then `Lolli p else `Function p in
   let rec ft =
     function
       | [p] -> ftcon (args p, effects, return_type)
-      | p::ps -> ftcon (args p, (StringMap.empty, Types.fresh_row_variable (`Any, `Any), false), ft ps)
+      | p::ps -> ftcon (args p, (StringMap.empty, Types.fresh_row_variable (lin_any, res_any), false), ft ps)
       | [] -> assert false
   in
     ft ps
@@ -2021,13 +2036,13 @@ let make_ft_poly_curry declared_linearity ps effects return_type =
   let pattern_typ (_, _, t) = t in
   let args =
     Types.make_tuple_type -<- List.map pattern_typ in
-  let ftcon = fun p -> if declared_linearity=`Lin then `Lolli p else `Function p in
+  let ftcon = fun p -> if DeclaredLinearity.is_linear declared_linearity then `Lolli p else `Function p in
   let rec ft =
     function
       | [p] -> [], ftcon (args p, effects, return_type)
       | p::ps ->
           let qs, t = ft ps in
-          let q, eff = Types.fresh_row_quantifier (`Any, `Any) in
+          let q, eff = Types.fresh_row_quantifier (lin_any, res_any) in
             q::qs, ftcon (args p, eff, t)
       | [] -> assert false
   in
@@ -2109,8 +2124,8 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
       let (_,_,e) = SourceCode.resolve_pos p.pos in e
     and erase_cases = List.map (fun ((p, _, _t), (e, _, _)) -> p, e) in
     let type_cases binders =
-      let pt = Types.fresh_type_variable (`Any, `Any) in
-      let bt = Types.fresh_type_variable (`Any, `Any) in
+      let pt = Types.fresh_type_variable (lin_any, res_any) in
+      let bt = Types.fresh_type_variable (lin_any, res_any) in
       let binders, pats =
         List.fold_right
           (fun (pat, body) (binders, pats) ->
@@ -2148,29 +2163,29 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
 
     let e, t, usages =
       match (expr : phrasenode) with
-        | `Var v            ->
+        | Var v            ->
             (
               try
                 let (tyargs, t) = Utils.instantiate context.var_env v in
                   if Settings.get_value Instantiate.quantified_instantiation then
                     let tyvars = Types.quantifiers_of_type_args tyargs in
-                      tabstr(tyvars, tappl (`Var v, tyargs)), t, StringMap.singleton v 1
+                      tabstr(tyvars, tappl (Var v, tyargs)), t, StringMap.singleton v 1
                   else
-                    tappl (`Var v, tyargs), t, StringMap.singleton v 1
+                    tappl (Var v, tyargs), t, StringMap.singleton v 1
               with
                   Errors.UndefinedVariable _msg ->
                     Gripers.die pos ("Unknown variable " ^ v ^ ".")
             )
-        | `Section _ as s   -> type_section context s
+        | Section _ as s   -> type_section context s
         (* literals *)
-        | `Constant c as c' -> c', Constant.constant_type c, StringMap.empty
-        | `TupleLit [p] ->
+        | Constant c as c' -> c', Constant.constant_type c, StringMap.empty
+        | TupleLit [p] ->
            let p = tc p in
-              `TupleLit [erase p], typ p, usages p (* When is a tuple not a tuple? *)
-        | `TupleLit ps ->
+              TupleLit [erase p], typ p, usages p (* When is a tuple not a tuple? *)
+        | TupleLit ps ->
             let ps = List.map tc ps in
-              `TupleLit (List.map erase ps), Types.make_tuple_type (List.map typ ps), merge_usages (List.map usages ps)
-        | `RecordLit (fields, rest) ->
+              TupleLit (List.map erase ps), Types.make_tuple_type (List.map typ ps), merge_usages (List.map usages ps)
+        | RecordLit (fields, rest) ->
             let _ =
               (* check that each label only occurs once *)
               List.fold_left
@@ -2192,7 +2207,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                 fields ([], StringMap.empty, StringMap.empty, StringMap.empty) in
               begin match rest with
                 | None ->
-                    `RecordLit (alistmap erase fields, None), `Record (field_env, Unionfind.fresh `Closed, false), field_usages
+                    RecordLit (alistmap erase fields, None), `Record (field_env, Unionfind.fresh `Closed, false), field_usages
                 | Some r ->
                     let r : phrase * Types.datatype * usagemap = tc r in
 
@@ -2214,7 +2229,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
 
                     (* make sure rtype is a record type that doesn't match any of the existing fields *)
                     let () = unify ~handle:Gripers.extend_record
-                      (pos_and_typ r, no_pos (`Record (absent_field_env, Types.fresh_row_variable (`Any, `Any), false))) in
+                      (pos_and_typ r, no_pos (`Record (absent_field_env, Types.fresh_row_variable (lin_any, res_any), false))) in
 
                     let (rfield_env, rrow_var, lr), _ = Types.unwrap_row (TypeUtils.extract_row rtype) in
                     assert (lr = false);
@@ -2240,26 +2255,26 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                                                 StringMap.add label (`Present t) field_env'
                                           | `Var _ -> assert false) rfield_env field_env in
                     let usages = merge_usages [field_usages; usages r] in
-                      `RecordLit (alistmap erase fields, Some (erase r)), `Record (field_env', rrow_var, false), usages
+                      RecordLit (alistmap erase fields, Some (erase r)), `Record (field_env', rrow_var, false), usages
               end
-        | `ListLit (es, _) ->
+        | ListLit (es, _) ->
             begin match List.map tc es with
               | [] ->
-                  let t = Types.fresh_type_variable (`Any, `Any) in
-                    `ListLit ([], Some t), `Application (Types.list, [`Type t]), StringMap.empty
+                  let t = Types.fresh_type_variable (lin_any, res_any) in
+                    ListLit ([], Some t), `Application (Types.list, [`Type t]), StringMap.empty
               | e :: es ->
                   List.iter (fun e' -> unify ~handle:Gripers.list_lit (pos_and_typ e, pos_and_typ e')) es;
-                  `ListLit (List.map erase (e::es), Some (typ e)), `Application (Types.list, [`Type (typ e)]), merge_usages (List.map usages (e::es))
+                  ListLit (List.map erase (e::es), Some (typ e)), `Application (Types.list, [`Type (typ e)]), merge_usages (List.map usages (e::es))
             end
-        | `HandlerLit _ -> assert false (* already desugared at this point *)
-        | `FunLit (_, lin, (pats, body), location) ->
+        | HandlerLit _ -> assert false (* already desugared at this point *)
+        | FunLit (_, lin, (pats, body), location) ->
             let vs = check_for_duplicate_names pos (List.flatten pats) in
             let pats = List.map (List.map tpc) pats in
             let pat_env = List.fold_left (List.fold_left (fun env pat' -> Env.extend env (pattern_env pat'))) Env.empty pats in
             let env' = Env.extend context.var_env pat_env in
 
             (* type of the effects in the body of the lambda *)
-            let effects = (StringMap.empty, Types.fresh_row_variable (`Any, `Any), false) in
+            let effects = (StringMap.empty, Types.fresh_row_variable (lin_any, res_any), false) in
             let body = type_check ({context with
                                       var_env = env';
                                       effect_row = effects}) body in
@@ -2275,7 +2290,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                 pat_env in
 
             let () =
-              if lin=`Unl then
+              if DeclaredLinearity.is_nonlinear lin then
                 StringMap.iter (fun v _ ->
                                 if not (List.mem v vs) then
                                   let t = Env.lookup env' v in
@@ -2312,7 +2327,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
               Needs more thought...
             *)
 
-            let e = `FunLit (Some argss, lin, (List.map (List.map erase_pat) pats, erase body), location) in
+            let e = FunLit (Some argss, lin, (List.map (List.map erase_pat) pats, erase body), location) in
               if Settings.get_value Instantiate.quantified_instantiation then
                 let (qs, _tyargs), ftype = Utils.generalise context.var_env ftype in
                 let _, ftype = Instantiate.typ ftype in
@@ -2320,59 +2335,59 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
               else
                 e, ftype, StringMap.filter (fun v _ -> not (List.mem v vs)) (usages body)
 
-        | `ConstructorLit (c, None, _) ->
+        | ConstructorLit (c, None, _) ->
             let type' = `Variant (Types.make_singleton_open_row
                                     (c, `Present Types.unit_type)
-                                    (`Any, `Any)) in
-              `ConstructorLit (c, None, Some type'), type', StringMap.empty
+                                    (lin_any, res_any)) in
+              ConstructorLit (c, None, Some type'), type', StringMap.empty
 
-        | `ConstructorLit (c, Some v, _) ->
+        | ConstructorLit (c, Some v, _) ->
             let v = tc v in
             let type' = `Variant (Types.make_singleton_open_row
                                     (c, `Present (typ v))
-                                    (`Any, `Any)) in
-              `ConstructorLit (c, Some (erase v), Some type'), type', usages v
+                                    (lin_any, res_any)) in
+              ConstructorLit (c, Some (erase v), Some type'), type', usages v
 
         (* database *)
-        | `DatabaseLit (name, (driver, args)) ->
+        | DatabaseLit (name, (driver, args)) ->
             let driver = opt_map tc driver
             and args   = opt_map tc args
             and name   = tc name in
-              `DatabaseLit (erase name, (opt_map erase driver, opt_map erase args)), `Primitive `DB,
+              DatabaseLit (erase name, (opt_map erase driver, opt_map erase args)), `Primitive `DB,
               merge_usages [from_option StringMap.empty (opt_map usages driver); from_option StringMap.empty (opt_map usages args); usages name]
-        | `TableLit (tname, (dtype, Some (read_row, write_row, needed_row)), constraints, keys, db) ->
+        | TableLit (tname, (dtype, Some (read_row, write_row, needed_row)), constraints, keys, db) ->
             let tname = tc tname
             and db = tc db
             and keys = tc keys in
             let () = unify ~handle:Gripers.table_name (pos_and_typ tname, no_pos Types.string_type)
             and () = unify ~handle:Gripers.table_db (pos_and_typ db, no_pos Types.database_type)
             and () = unify ~handle:Gripers.table_keys (pos_and_typ keys, no_pos Types.keys_type) in
-              `TableLit (erase tname, (dtype, Some (read_row, write_row, needed_row)), constraints, erase keys, erase db),
+              TableLit (erase tname, (dtype, Some (read_row, write_row, needed_row)), constraints, erase keys, erase db),
               `Table (read_row, write_row, needed_row),
               merge_usages [usages tname; usages db]
-        | `TableLit _ -> assert false
-        | `LensLit (table, _) ->
+        | TableLit _ -> assert false
+        | LensLit (table, _) ->
            let open Lens in
            let table = tc table in
            let cols = Types.sort_cols_of_table "" (typ table) in
            let lens_sort = Sort.make cols in
-           `LensLit (erase table, Some (lens_sort)), `Lens (lens_sort), merge_usages [usages table]
-        | `LensKeysLit (table, keys, _) ->
+           LensLit (erase table, Some (lens_sort)), `Lens (lens_sort), merge_usages [usages table]
+        | LensKeysLit (table, keys, _) ->
            let open Lens in
            let table = tc table in
            let cols = Types.sort_cols_of_table "" (typ table) in
            let keys = Types.cols_of_phrase keys in
            let fds = Fun_dep.Set.key_fds ~keys ~cols:(Column.List.present_aliases cols) in
            let lens_sort = Sort.make ~fds cols in
-           `LensLit (erase table, Some (lens_sort)), `Lens (lens_sort), merge_usages [usages table]
-        | `LensFunDepsLit (table, fds, _) ->
+           LensLit (erase table, Some (lens_sort)), `Lens (lens_sort), merge_usages [usages table]
+        | LensFunDepsLit (table, fds, _) ->
            let open Lens in
            let table = tc table in
            let cols = Types.sort_cols_of_table "" (typ table) in
            let fds = Helpers.Incremental.get_fds fds cols in
            let lens_sort = Sort.make ~fds cols in
-           `LensLit (erase table, Some (lens_sort)), `Lens (lens_sort), merge_usages [usages table]
-        | `LensDropLit (lens, drop, key, default, _) ->
+           LensLit (erase table, Some (lens_sort)), `Lens (lens_sort), merge_usages [usages table]
+        | LensDropLit (lens, drop, key, default, _) ->
            let open Lens in
            let lens = tc lens
            and default = tc default in
@@ -2382,12 +2397,12 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                (Alias.Set.singleton drop)
                (Alias.Set.singleton key)
            in
-           `LensDropLit (erase lens, drop, key, erase default, Some (sort)), `Lens (sort), merge_usages [usages lens; usages default]
-        | `LensSelectLit (lens, predicate, _) ->
+           LensDropLit (erase lens, drop, key, erase default, Some (sort)), `Lens (sort), merge_usages [usages lens; usages default]
+        | LensSelectLit (lens, predicate, _) ->
            let lens = tc lens in
            let lens_sort = Lens.Type.sort (typ lens) in
-               `LensSelectLit(erase lens, predicate, Some (lens_sort)), `Lens(lens_sort), merge_usages [usages lens]
-        | `LensJoinLit (lens1, lens2, on, left, right, _) ->
+               LensSelectLit(erase lens, predicate, Some (lens_sort)), `Lens(lens_sort), merge_usages [usages lens]
+        | LensJoinLit (lens1, lens2, on, left, right, _) ->
            let lens1 = tc lens1
            and lens2 = tc lens2 in
            let sort1 = Lens.Type.sort (typ lens1) in
@@ -2398,25 +2413,25 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                sort2
                ~on:(Lens.Types.cols_of_phrase on)
            in
-           `LensJoinLit (erase lens1, erase lens2, on, left, right, Some sort), `Lens(sort), merge_usages [usages lens1; usages lens2]
-        | `LensGetLit (lens, _) ->
+           LensJoinLit (erase lens1, erase lens2, on, left, right, Some sort), `Lens(sort), merge_usages [usages lens1; usages lens2]
+        | LensGetLit (lens, _) ->
            let lens = tc lens in
            let sort = Lens.Type.sort (typ lens) in
            let trowtype = Lens.Sort.record_type sort in
-           `LensGetLit (erase lens, Some trowtype), Types.make_list_type trowtype, merge_usages [usages lens]
-        | `LensPutLit (lens, data, _) ->
+           LensGetLit (erase lens, Some trowtype), Types.make_list_type trowtype, merge_usages [usages lens]
+        | LensPutLit (lens, data, _) ->
            let make_tuple_type = Types.make_tuple_type in
            let lens = tc lens in
            let sort = Lens.Type.sort (typ lens) in
            let trowtype = Lens.Sort.record_type sort in
            let data = tc data in
-           `LensPutLit (erase lens, erase data, Some trowtype), make_tuple_type [], merge_usages [usages lens; usages data]
-        | `DBDelete (pat, from, where) ->
+           LensPutLit (erase lens, erase data, Some trowtype), make_tuple_type [], merge_usages [usages lens; usages data]
+        | DBDelete (pat, from, where) ->
             let pat  = tpc pat in
             let from = tc from in
-            let read  = `Record (Types.make_empty_open_row (`Any, `Base)) in
-            let write = `Record (Types.make_empty_open_row (`Any, `Base)) in
-            let needed = `Record (Types.make_empty_open_row (`Any, `Base)) in
+            let read  = `Record (Types.make_empty_open_row (lin_any, res_base)) in
+            let write = `Record (Types.make_empty_open_row (lin_any, res_base)) in
+            let needed = `Record (Types.make_empty_open_row (lin_any, res_base)) in
             let () = unify ~handle:Gripers.delete_table
               (pos_and_typ from, no_pos (`Table (read, write, needed))) in
             let () = unify ~handle:Gripers.delete_pattern (ppos_and_typ pat, no_pos read) in
@@ -2436,20 +2451,20 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
             (* delete is wild *)
             let () =
               let outer_effects =
-                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (`Any, `Any)
+                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (lin_any, res_any)
               in
                 unify ~handle:Gripers.delete_outer
                   (no_pos (`Record context.effect_row), no_pos (`Record outer_effects))
             in
-              `DBDelete (erase_pat pat, erase from, opt_map erase where), Types.unit_type,
+              DBDelete (erase_pat pat, erase from, opt_map erase where), Types.unit_type,
               merge_usages [usages from; hide (from_option StringMap.empty (opt_map usages where))]
-        | `DBInsert (into, labels, values, id) ->
+        | DBInsert (into, labels, values, id) ->
             let into   = tc into in
             let values = tc values in
             let id = opt_map tc id in
-            let read  = `Record (Types.make_empty_open_row (`Any, `Base)) in
-            let write = `Record (Types.make_empty_open_row (`Any, `Base)) in
-            let needed = `Record (Types.make_empty_open_row (`Any, `Base)) in
+            let read  = `Record (Types.make_empty_open_row (lin_any, res_base)) in
+            let write = `Record (Types.make_empty_open_row (lin_any, res_base)) in
+            let needed = `Record (Types.make_empty_open_row (lin_any, res_base)) in
             let () = unify ~handle:Gripers.insert_table
               (pos_and_typ into, no_pos (`Table (read, write, needed))) in
 
@@ -2459,7 +2474,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                    if StringMap.mem name field_env then
                      Gripers.die pos "Duplicate labels in insert expression."
                    else
-                     StringMap.add name (`Present (Types.fresh_type_variable (`Any, `Base))) field_env)
+                     StringMap.add name (`Present (Types.fresh_type_variable (lin_any, res_base))) field_env)
                 labels StringMap.empty in
 
             (* check that the fields in the type of values match the declared labels *)
@@ -2470,16 +2485,16 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
 
             let needed_env =
               StringMap.map
-                (fun _f -> Types.fresh_presence_variable (`Any, `Base))
+                (fun _f -> Types.fresh_presence_variable (lin_any, res_base))
                 field_env in
 
             (* all fields being inserted must be present in the read row *)
             let () = unify ~handle:Gripers.insert_read
-              (no_pos read, no_pos (`Record (field_env, Types.fresh_row_variable (`Any, `Base), false))) in
+              (no_pos read, no_pos (`Record (field_env, Types.fresh_row_variable (lin_any, res_base), false))) in
 
             (* all fields being inserted must be present in the write row *)
             let () = unify ~handle:Gripers.insert_write
-              (no_pos write, no_pos (`Record (field_env, Types.fresh_row_variable (`Any, `Base), false))) in
+              (no_pos write, no_pos (`Record (field_env, Types.fresh_row_variable (lin_any, res_base), false))) in
 
             (* all fields being inserted must be consistent with the needed row *)
             let () = unify ~handle:Gripers.insert_needed
@@ -2492,7 +2507,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                 | Some ({node=(id : phrasenode); _}, _, _) ->
                     begin
                       match id with
-                        | `Constant (`String id) ->
+                        | Constant (`String id) ->
                             (* HACK: The returned column is encoded as
                                a string.  We check here that it
                                appears as a column in the read type of
@@ -2501,7 +2516,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                             unify
                               ~handle:Gripers.insert_id
                               (no_pos read,
-                               no_pos (`Record (StringMap.singleton id (`Present Types.int_type), Types.fresh_row_variable (`Any, `Base), false)));
+                               no_pos (`Record (StringMap.singleton id (`Present Types.int_type), Types.fresh_row_variable (lin_any, res_base), false)));
                             Types.int_type
                         | _ -> assert false
                     end in
@@ -2509,19 +2524,19 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
             (* insert is wild *)
             let () =
               let outer_effects =
-                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (`Any, `Any)
+                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (lin_any, res_any)
               in
                 unify ~handle:Gripers.insert_outer
                   (no_pos (`Record context.effect_row), no_pos (`Record outer_effects))
             in
-              `DBInsert (erase into, labels, erase values, opt_map erase id), return_type,
+              DBInsert (erase into, labels, erase values, opt_map erase id), return_type,
               merge_usages [usages into; usages values; from_option StringMap.empty (opt_map usages id)]
-        | `DBUpdate (pat, from, where, set) ->
+        | DBUpdate (pat, from, where, set) ->
             let pat  = tpc pat in
             let from = tc from in
-            let read =  `Record (Types.make_empty_open_row (`Any, `Base)) in
-            let write = `Record (Types.make_empty_open_row (`Any, `Base)) in
-            let needed = `Record (Types.make_empty_open_row (`Any, `Base)) in
+            let read =  `Record (Types.make_empty_open_row (lin_any, res_base)) in
+            let write = `Record (Types.make_empty_open_row (lin_any, res_base)) in
+            let needed = `Record (Types.make_empty_open_row (lin_any, res_base)) in
             let () = unify ~handle:Gripers.update_table
               (pos_and_typ from, no_pos (`Table (read, write, needed))) in
 
@@ -2554,43 +2569,43 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
 
             let needed_env =
               StringMap.map
-                (fun _f -> Types.fresh_presence_variable (`Any, `Base))
+                (fun _f -> Types.fresh_presence_variable (lin_any, res_base))
                 field_env in
 
             (* all fields being updated must be present in the read row *)
             let () = unify ~handle:Gripers.update_read
-              (no_pos read, no_pos (`Record (field_env, Types.fresh_row_variable (`Any, `Base), false))) in
+              (no_pos read, no_pos (`Record (field_env, Types.fresh_row_variable (lin_any, res_base), false))) in
 
             (* all fields being updated must be present in the write row *)
             let () = unify ~handle:Gripers.update_write
-              (no_pos write, no_pos (`Record (field_env, Types.fresh_row_variable (`Any, `Base), false))) in
+              (no_pos write, no_pos (`Record (field_env, Types.fresh_row_variable (lin_any, res_base), false))) in
 
             (* all fields being updated must be consistent with the needed row *)
             let () = unify ~handle:Gripers.update_needed
-              (no_pos needed, no_pos (`Record (needed_env, Types.fresh_row_variable (`Any, `Base), false))) in
+              (no_pos needed, no_pos (`Record (needed_env, Types.fresh_row_variable (lin_any, res_base), false))) in
 
             (* update is wild *)
             let () =
               let outer_effects =
-                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (`Any, `Any)
+                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (lin_any, res_any)
               in
                 unify ~handle:Gripers.update_outer
                   (no_pos (`Record context.effect_row), no_pos (`Record outer_effects))
             in
-              `DBUpdate (erase_pat pat, erase from, opt_map erase where, List.map (fun (n,(p,_,_)) -> n, p) set),
+              DBUpdate (erase_pat pat, erase from, opt_map erase where, List.map (fun (n,(p,_,_)) -> n, p) set),
               Types.unit_type,
               merge_usages (usages from :: hide (from_option StringMap.empty (opt_map usages where)) :: List.map hide (List.map (usages -<- snd) set))
-        | `Query (range, p, _) ->
+        | Query (range, p, _) ->
             let range, outer_effects, range_usages =
               match range with
-                | None -> None, Types.make_empty_open_row (`Any, `Any), StringMap.empty
+                | None -> None, Types.make_empty_open_row (lin_any, res_any), StringMap.empty
                 | Some (limit, offset) ->
                     let limit = tc limit in
                     let () = unify ~handle:Gripers.range_bound (pos_and_typ limit, no_pos Types.int_type) in
                     let offset = tc offset in
                     let () = unify ~handle:Gripers.range_bound (pos_and_typ offset, no_pos Types.int_type) in
                     let outer_effects =
-                      Types.make_singleton_open_row ("wild", `Present Types.unit_type) (`Any, `Any)
+                      Types.make_singleton_open_row ("wild", `Present Types.unit_type) (lin_any, res_any)
                     in
                       Some (erase limit, erase offset), outer_effects, merge_usages [usages limit; usages offset] in
             let inner_effects = Types.make_empty_closed_row () in
@@ -2598,26 +2613,26 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
               (no_pos (`Record context.effect_row), no_pos (`Record outer_effects)) in
             let p = type_check (bind_effects context inner_effects) p in
             let () = if Settings.get_value Basicsettings.Shredding.relax_query_type_constraint then ()
-                     else let shape = Types.make_list_type (`Record (StringMap.empty, Types.fresh_row_variable (`Any, `Base), false)) in
+                     else let shape = Types.make_list_type (`Record (StringMap.empty, Types.fresh_row_variable (lin_any, res_base), false)) in
                           unify ~handle:Gripers.query_base_row (pos_and_typ p, no_pos shape) in
-            `Query (range, erase p, Some (typ p)), typ p, merge_usages [range_usages; usages p]
+            Query (range, erase p, Some (typ p)), typ p, merge_usages [range_usages; usages p]
         (* mailbox-based concurrency *)
-        | `Spawn (Wait, l, p, _) ->
+        | Spawn (Wait, l, p, _) ->
             assert (l = NoSpawnLocation);
             (* (() -{b}-> d) -> d *)
-            let inner_effects = Types.make_empty_open_row (`Any, `Any) in
+            let inner_effects = Types.make_empty_open_row (lin_any, res_any) in
             (* TODO: check if pid_type is actually needed somewhere *)
             (* let pid_type = `Application (Types.process, [`Row inner_effects]) in *)
             let () =
               let outer_effects =
-                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (`Any, `Any)
+                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (lin_any, res_any)
               in
                 unify ~handle:Gripers.spawn_wait_outer
                   (no_pos (`Record context.effect_row), no_pos (`Record outer_effects)) in
             let p = type_check (bind_effects context inner_effects) p in
             let return_type = typ p in
-              `Spawn (Wait, l, erase p, Some inner_effects), return_type, usages p
-        | `Spawn (k, given_loc, p, _) ->
+              Spawn (Wait, l, erase p, Some inner_effects), return_type, usages p
+        | Spawn (k, given_loc, p, _) ->
             (* Location -> (() -e-> _) -> Process (e) *)
             (match given_loc with
               | ExplicitSpawnLocation loc_phr ->
@@ -2627,23 +2642,23 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
               | _ -> ());
 
             (* (() -e-> _) -> Process (e) *)
-            let inner_effects = Types.make_empty_open_row (`Any, `Any) in
+            let inner_effects = Types.make_empty_open_row (lin_any, res_any) in
             let pid_type = `Application (Types.process, [`Row inner_effects]) in
             let () =
               let outer_effects =
-                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (`Any, `Any)
+                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (lin_any, res_any)
               in
                 unify ~handle:Gripers.spawn_outer
                   (no_pos (`Record context.effect_row), no_pos (`Record outer_effects)) in
             let p = type_check (bind_effects context inner_effects) p in
             if not (Types.type_can_be_unl (typ p)) then
               Gripers.die pos ("Spawned processes cannot produce values of linear type (here " ^ Types.string_of_datatype (typ p) ^ ")");
-            `Spawn (k, given_loc, erase p, Some inner_effects), pid_type, usages p
-        | `Receive (binders, _) ->
-            let mb_type = Types.fresh_type_variable (`Any, `Any) in
+            Spawn (k, given_loc, erase p, Some inner_effects), pid_type, usages p
+        | Receive (binders, _) ->
+            let mb_type = Types.fresh_type_variable (lin_any, res_any) in
             let effects =
               Types.row_with ("wild", `Present Types.unit_type)
-                (Types.make_singleton_open_row ("hear", `Present mb_type) (`Any, `Any)) in
+                (Types.make_singleton_open_row ("hear", `Present mb_type) (lin_any, res_any)) in
 
             let () = unify ~handle:Gripers.receive_mailbox
               (no_pos (`Record context.effect_row), no_pos (`Record effects)) in
@@ -2652,69 +2667,59 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
             let () = unify ~handle:Gripers.receive_patterns
               (no_pos mb_type, no_pos pattern_type)
             in
-              `Receive (erase_cases binders, Some body_type), body_type, usages_cases binders
+              Receive (erase_cases binders, Some body_type), body_type, usages_cases binders
 
         (* session-based concurrency *)
-        (* | `Link (l, r) -> *)
-        (*   let l = tc l in *)
-        (*   let r = tc r in *)
-        (*     unify ~handle:Gripers.cp_link_session *)
-        (*       (pos_and_typ l, no_pos (Types.fresh_type_variable (`Any, `Session))); *)
-        (*     unify ~handle:Gripers.cp_link_session *)
-        (*       (pos_and_typ r, no_pos (Types.fresh_type_variable (`Any, `Session))); *)
-        (*     unify ~handle:Gripers.cp_link_dual *)
-        (*       ((exp_pos l, Types.dual_type (typ l)), pos_and_typ r); *)
-        (*     `Link (erase l, erase r), Types.unit_type, merge_usages [usages l; usages r] *)
-        | `Select (l, e) ->
+        | Select (l, e) ->
            let e = tc e in
-           let selected_session = Types.fresh_type_variable (`Any, `Session) in
+           let selected_session = Types.fresh_type_variable (lin_any, res_session) in
            unify ~handle:Gripers.selection
                  (pos_and_typ e, no_pos (`Select (Types.make_singleton_open_row
                                                               (l, `Present selected_session)
-                                                              (`Any, `Session))));
-           `Select (l, erase e), selected_session, usages e
-        | `Offer (e, branches, _) ->
+                                                              (lin_any, res_session))));
+           Select (l, erase e), selected_session, usages e
+        | Offer (e, branches, _) ->
            let e = tc e in
            let branches, pattern_type, body_type = type_cases branches in
-           let r = Types.make_empty_open_row (`Any, `Session) in
+           let r = Types.make_empty_open_row (lin_any, res_session) in
              unify ~handle:Gripers.offer_variant (no_pos pattern_type, no_pos (`Variant r));
              unify ~handle:Gripers.offer_patterns (pos_and_typ e, no_pos (`Choice r));
-             `Offer (erase e, erase_cases branches, Some body_type), body_type, merge_usages [usages e; usages_cases branches]
+             Offer (erase e, erase_cases branches, Some body_type), body_type, merge_usages [usages e; usages_cases branches]
 
         (* No comment *)
-        | `CP p ->
+        | CP p ->
            let (p, t, u) = type_cp context p in
-           `CP p, t, u
+           CP p, t, u
 
         (* applications of various sorts *)
-        | `UnaryAppl ((_, op), p) ->
+        | UnaryAppl ((_, op), p) ->
             let tyargs, opt, op_usage = type_unary_op context op
             and p = tc p
-            and rettyp = Types.fresh_type_variable (`Any, `Any) in
+            and rettyp = Types.fresh_type_variable (lin_any, res_any) in
               unify ~handle:Gripers.unary_apply
                 ((string_of_unary_op op, opt),
                  no_pos (`Function (Types.make_tuple_type [typ p], context.effect_row, rettyp)));
-              `UnaryAppl ((tyargs, op), erase p), rettyp, merge_usages [usages p; op_usage]
-        | `InfixAppl ((_, op), l, r) ->
+              UnaryAppl ((tyargs, op), erase p), rettyp, merge_usages [usages p; op_usage]
+        | InfixAppl ((_, op), l, r) ->
             let tyargs, opt, op_usages = type_binary_op context op in
             let l = tc l
             and r = tc r
-            and rettyp = Types.fresh_type_variable (`Any, `Any) in
+            and rettyp = Types.fresh_type_variable (lin_any, res_any) in
               unify ~handle:Gripers.infix_apply
                 ((string_of_binop op, opt),
                  no_pos (`Function (Types.make_tuple_type [typ l; typ r],
                                     context.effect_row, rettyp)));
-              `InfixAppl ((tyargs, op), erase l, erase r), rettyp, merge_usages [usages l; usages r; op_usages]
-        | `RangeLit (l, r) ->
+              InfixAppl ((tyargs, op), erase l, erase r), rettyp, merge_usages [usages l; usages r; op_usages]
+        | RangeLit (l, r) ->
             let l, r = tc l, tc r in
             let () = unify ~handle:Gripers.range_bound  (pos_and_typ l,
                                                          no_pos Types.int_type)
             and () = unify ~handle:Gripers.range_bound  (pos_and_typ r,
                                                          no_pos Types.int_type)
-            in `RangeLit (erase l, erase r),
+            in RangeLit (erase l, erase r),
                Types.make_list_type Types.int_type,
                merge_usages [usages l; usages r]
-        | `FnAppl (f, ps) ->
+        | FnAppl (f, ps) ->
             let f = tc f in
             let ps = List.map (tc) ps in
 
@@ -2789,7 +2794,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                                 let ft = `Function (fps, fe, rettyp) in
                                 let f' = erase f in
                                 let fn, fpos = f'.node, f'.pos in
-                                let e = tabstr (rqs, `FnAppl (with_pos fpos (tappl (fn, tyargs)), List.map erase ps)) in
+                                let e = tabstr (rqs, FnAppl (with_pos fpos (tappl (fn, tyargs)), List.map erase ps)) in
                                   unify ~handle:Gripers.fun_apply
                                     ((exp_pos f, ft), no_pos (`Function (Types.make_tuple_type (List.map typ ps),
                                                                          context.effect_row,
@@ -2800,7 +2805,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                                 let ft = `Function (fps, fe, rettyp) in
                                 let f' = erase f in
                                 let fn, fpos = f'.node, f'.pos in
-                                let e = tabstr (rqs, `FnAppl (with_pos fpos (tappl (fn, tyargs)), List.map erase ps)) in
+                                let e = tabstr (rqs, FnAppl (with_pos fpos (tappl (fn, tyargs)), List.map erase ps)) in
                                   unify ~handle:Gripers.fun_apply
                                     ((exp_pos f, ft), no_pos (`Lolli (Types.make_tuple_type (List.map typ ps),
                                                                       context.effect_row,
@@ -2811,7 +2816,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                         end
 
                   | ft ->
-                      let rettyp = Types.fresh_type_variable (`Any, `Any) in
+                      let rettyp = Types.fresh_type_variable (lin_any, res_any) in
                       begin
                         unify_or ~handle:Gripers.fun_apply ~pos
                                 ((exp_pos f, ft), no_pos (`Function (Types.make_tuple_type (List.map typ ps),
@@ -2819,18 +2824,18 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                                 ((exp_pos f, ft), no_pos (`Lolli (Types.make_tuple_type (List.map typ ps),
                                                                   context.effect_row, rettyp)))
                       end;
-                      `FnAppl (erase f, List.map erase ps), rettyp, merge_usages (usages f :: List.map usages ps)
+                      FnAppl (erase f, List.map erase ps), rettyp, merge_usages (usages f :: List.map usages ps)
               end
-        | `TAbstr (qs, e) ->
+        | TAbstr (qs, e) ->
             let e, t, u = tc e in
             let qs = Types.unbox_quantifiers qs in
             let t = Types.for_all(qs, t) in
               tabstr (qs, e.node), t, u
-        | `TAppl (e, _qs) ->
+        | TAppl (e, _qs) ->
             let e, t, u = tc e in e.node, t, u
 
         (* xml *)
-        | `Xml (tag, attrs, attrexp, children) ->
+        | Xml (tag, attrs, attrexp, children) ->
             let attrs = alistmap (List.map (tc)) attrs
             and attrexp = opt_map tc attrexp
             and children = List.map (tc) children in
@@ -2847,31 +2852,31 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
             and () =
               List.iter (fun child ->
                            unify ~handle:Gripers.xml_child (pos_and_typ child, no_pos Types.xml_type)) children in
-              `Xml (tag,
-                    List.map (fun (x,p) -> (x, List.map erase p)) attrs,
-                    opt_map erase attrexp,
-                    List.map erase children),
+              Xml (tag,
+                   List.map (fun (x,p) -> (x, List.map erase p)) attrs,
+                   opt_map erase attrexp,
+                   List.map erase children),
               Types.xml_type,
               merge_usages (List.concat [ List.concat (List.map snd (alistmap (List.map usages) attrs));
                                           [from_option StringMap.empty (opt_map usages attrexp)];
                                           List.map usages children ])
-        | `TextNode _ as t -> t, Types.xml_type, StringMap.empty
-        | `Formlet (body, yields) ->
+        | TextNode _ as t -> t, Types.xml_type, StringMap.empty
+        | Formlet (body, yields) ->
             let body = tc body in
             let env = extract_formlet_bindings (erase body) in
             let vs = Env.domain env in
             let context' = context ++ env in
             let yields = type_check context' yields in
               unify ~handle:Gripers.formlet_body (pos_and_typ body, no_pos Types.xml_type);
-              (`Formlet (erase body, erase yields),
+              (Formlet (erase body, erase yields),
                Instantiate.alias "Formlet" [`Type (typ yields)] context.tycon_env,
                merge_usages [usages body; StringMap.filter (fun v _ -> not (StringSet.mem v vs)) (usages yields)])
-        | `Page e ->
+        | Page e ->
             let e = tc e in
               unify ~handle:Gripers.page_body (pos_and_typ e, no_pos Types.xml_type);
-              `Page (erase e), Instantiate.alias "Page" [] context.tycon_env, usages e
-        | `FormletPlacement (f, h, attributes) ->
-            let t = Types.fresh_type_variable (`Any, `Any) in
+              Page (erase e), Instantiate.alias "Page" [] context.tycon_env, usages e
+        | FormletPlacement (f, h, attributes) ->
+            let t = Types.fresh_type_variable (lin_any, res_any) in
 
             let f = tc f
             and h = tc h
@@ -2884,27 +2889,27 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
             let () = unify ~handle:Gripers.render_attributes
               (pos_and_typ attributes, no_pos (Instantiate.alias "Attributes" [] context.tycon_env))
             in
-              `FormletPlacement (erase f, erase h, erase attributes), Types.xml_type, merge_usages [usages f; usages h; usages attributes]
-        | `PagePlacement e ->
+              FormletPlacement (erase f, erase h, erase attributes), Types.xml_type, merge_usages [usages f; usages h; usages attributes]
+        | PagePlacement e ->
             let e = tc e in
             let pt = Instantiate.alias "Page" [] context.tycon_env in
               unify ~handle:Gripers.page_placement (pos_and_typ e, no_pos pt);
-              `PagePlacement (erase e), Types.xml_type, usages e
-        | `FormBinding (e, pattern) ->
+              PagePlacement (erase e), Types.xml_type, usages e
+        | FormBinding (e, pattern) ->
             let e = tc e
             and pattern = tpc pattern in
-            let a = Types.fresh_type_variable (`Any, `Any) in
+            let a = Types.fresh_type_variable (lin_any, res_any) in
             let ft = Instantiate.alias "Formlet" [`Type a] context.tycon_env in
               unify ~handle:Gripers.form_binding_body (pos_and_typ e, no_pos ft);
               unify ~handle:Gripers.form_binding_pattern (ppos_and_typ pattern, (exp_pos e, a));
-              `FormBinding (erase e, erase_pat pattern), Types.xml_type, usages e
+              FormBinding (erase e, erase_pat pattern), Types.xml_type, usages e
 
         (* various expressions *)
-        | `Iteration (generators, body, where, orderby) ->
+        | Iteration (generators, body, where, orderby) ->
             let is_query =
               List.exists (function
-                             | `List _ -> false
-                             | `Table _ -> true) generators in
+                             | List  _ -> false
+                             | Table _ -> true) generators in
             let context =
               if is_query then
                 {context with effect_row = Types.make_empty_closed_row ()}
@@ -2914,25 +2919,25 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
               List.fold_left
                 (fun (generators, generator_usages, environments) ->
                    function
-                     | `List (pattern, e) ->
-                         let a = Types.fresh_type_variable (`Any, `Any) in
+                     | List (pattern, e) ->
+                         let a = Types.fresh_type_variable (lin_any, res_any) in
                          let lt = Types.make_list_type a in
                          let pattern = tpc pattern in
                          let e = tc e in
                          let () = unify ~handle:Gripers.iteration_list_body (pos_and_typ e, no_pos lt) in
                          let () = unify ~handle:Gripers.iteration_list_pattern (ppos_and_typ pattern, (exp_pos e, a))
                          in
-                           (`List (erase_pat pattern, erase e) :: generators,
+                           (List (erase_pat pattern, erase e) :: generators,
                             usages e :: generator_usages,
                             pattern_env pattern :: environments)
-                     | `Table (pattern, e) ->
-                         let a = Types.fresh_type_variable (`Any, `Any) in
-                         let tt = Types.make_table_type (a, Types.fresh_type_variable (`Any, `Any), Types.fresh_type_variable (`Any, `Any)) in
+                     | Table (pattern, e) ->
+                         let a = Types.fresh_type_variable (lin_any, res_any) in
+                         let tt = Types.make_table_type (a, Types.fresh_type_variable (lin_any, res_any), Types.fresh_type_variable (lin_any, res_any)) in
                          let pattern = tpc pattern in
                          let e = tc e in
                          let () = unify ~handle:Gripers.iteration_table_body (pos_and_typ e, no_pos tt) in
                          let () = unify ~handle:Gripers.iteration_table_pattern (ppos_and_typ pattern, (exp_pos e, a)) in
-                           (`Table (erase_pat pattern, erase e) :: generators,
+                           (Table (erase_pat pattern, erase e) :: generators,
                             usages e :: generator_usages,
                             pattern_env pattern:: environments))
                 ([], [], []) generators in
@@ -2944,7 +2949,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
             let orderby = opt_map tc orderby in
             let () =
               unify ~handle:Gripers.iteration_body
-                (pos_and_typ body, no_pos (Types.make_list_type (Types.fresh_type_variable (`Any, `Any)))) in
+                (pos_and_typ body, no_pos (Types.make_list_type (Types.fresh_type_variable (lin_any, res_any)))) in
             let () =
               opt_iter (fun where -> unify ~handle:Gripers.iteration_where
                           (pos_and_typ where, no_pos Types.bool_type)) where in
@@ -2953,21 +2958,21 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
               opt_iter
                 (fun order ->
                    unify ~handle:Gripers.iteration_base_order
-                     (pos_and_typ order, no_pos (`Record (Types.make_empty_open_row (`Any, `Base))))) orderby in
+                     (pos_and_typ order, no_pos (`Record (Types.make_empty_open_row (lin_any, res_base))))) orderby in
             let () =
               if is_query && not (Settings.get_value Basicsettings.Shredding.relax_query_type_constraint) then
                 unify ~handle:Gripers.iteration_base_body
-                  (pos_and_typ body, no_pos (Types.make_list_type (`Record (Types.make_empty_open_row (`Any, `Base))))) in
-            let e = `Iteration (generators, erase body, opt_map erase where, opt_map erase orderby) in
+                  (pos_and_typ body, no_pos (Types.make_list_type (`Record (Types.make_empty_open_row (lin_any, res_base))))) in
+            let e = Iteration (generators, erase body, opt_map erase where, opt_map erase orderby) in
             let vs = List.fold_left StringSet.union StringSet.empty (List.map Env.domain environments) in
             let us = merge_usages (List.append generator_usages
                                                (List.map (StringMap.filter (fun v _ -> not (StringSet.mem v vs)))
                                                          [usages body; from_option StringMap.empty (opt_map usages where); from_option StringMap.empty (opt_map usages orderby)])) in
               if is_query then
-                `Query (None, with_pos pos e, Some (typ body)), typ body, us
+                Query (None, with_pos pos e, Some (typ body)), typ body, us
               else
                 e, typ body, us
-        | `Escape (bndr, e) ->
+        | Escape (bndr, e) ->
             (* There's a question here whether to generalise the
                return type of continuations.  With `escape'
                continuations are let-bound, so generalising the return
@@ -2991,10 +2996,10 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                (Also, should the mailbox type be generalised?)
             *)
             let name = name_of_binder bndr in
-            let f = Types.fresh_type_variable (`Any, `Any) in
-            let t = Types.fresh_type_variable (`Any, `Any) in
+            let f = Types.fresh_type_variable (lin_any, res_any) in
+            let t = Types.fresh_type_variable (lin_any, res_any) in
 
-            let eff = Types.make_singleton_open_row ("wild", `Present Types.unit_type) (`Any, `Any) in
+            let eff = Types.make_singleton_open_row ("wild", `Present Types.unit_type) (lin_any, res_any) in
 
             let cont_type = `Function (Types.make_tuple_type [f], eff, t) in
             let context' = {context
@@ -3003,14 +3008,14 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
 
             let () =
               let outer_effects =
-                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (`Any, `Any)
+                Types.make_singleton_open_row ("wild", `Present Types.unit_type) (lin_any, res_any)
               in
                 unify ~handle:Gripers.escape_outer
                   (no_pos (`Record context.effect_row), no_pos (`Record outer_effects)) in
 
             let () = unify ~handle:Gripers.escape (pos_and_typ e, no_pos f) in
-              `Escape (set_binder_type bndr cont_type, erase e), typ e, StringMap.filter (fun v _ -> v <> name) (usages e)
-        | `Conditional (i,t,e) ->
+              Escape (set_binder_type bndr cont_type, erase e), typ e, StringMap.filter (fun v _ -> v <> name) (usages e)
+        | Conditional (i,t,e) ->
             let i = tc i
             and t = tc t
             and e = tc e in
@@ -3018,16 +3023,16 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                 (pos_and_typ i, no_pos (`Primitive `Bool));
               unify ~handle:Gripers.if_branches
                 (pos_and_typ t, pos_and_typ e);
-              `Conditional (erase i, erase t, erase e), (typ t), merge_usages [usages i; usage_compat [usages t; usages e]]
-        | `Block (bindings, e) ->
+              Conditional (erase i, erase t, erase e), (typ t), merge_usages [usages i; usage_compat [usages t; usages e]]
+        | Block (bindings, e) ->
             let context', bindings, usage_builder = type_bindings context bindings in
             let e = type_check (Types.extend_typing_environment context context') e in
-            `Block (bindings, erase e), typ e, usage_builder (usages e)
-        | `Regex r ->
-            `Regex (type_regex context r),
+            Block (bindings, erase e), typ e, usage_builder (usages e)
+        | Regex r ->
+            Regex (type_regex context r),
             Instantiate.alias "Regex" [] context.tycon_env,
             StringMap.empty
-        | `Projection (r,l) ->
+        | Projection (r,l) ->
             (*
               Take advantage of the type isomorphism:
 
@@ -3091,33 +3096,33 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                           unify ~handle:Gripers.projection
                             ((exp_pos r, rt),
                              no_pos (`Record (Types.make_singleton_closed_row
-                                                (l, `Present (Types.fresh_type_variable (`Any, `Any))))));
+                                                (l, `Present (Types.fresh_type_variable (lin_any, res_any))))));
                           let r' = erase r in
                           let rn, rpos = r'.node, r'.pos in
-                          let e = tabstr (pqs, `Projection (with_pos rpos (tappl (rn, tyargs)), l)) in
+                          let e = tabstr (pqs, Projection (with_pos rpos (tappl (rn, tyargs)), l)) in
                           e, fieldtype, usages r
                         | Some (`Absent | `Var _)
                         | None ->
-                          let fieldtype = Types.fresh_type_variable (`Any, `Any) in
+                          let fieldtype = Types.fresh_type_variable (lin_any, res_any) in
                           unify ~handle:Gripers.projection
                             ((exp_pos r, rt),
                              no_pos (`Record (Types.make_singleton_open_row
                                                 (l, `Present fieldtype)
-                                                (`Unl, `Any))));
+                                                (lin_unl, res_any))));
                           let r' = erase r in
                           let rn, rpos = r'.node, r'.pos in
-                          let e = `Projection (with_pos rpos (tappl (rn, tyargs)), l) in
+                          let e = Projection (with_pos rpos (tappl (rn, tyargs)), l) in
                           e, fieldtype, usages r
                       end
                   | _ ->
-                      let fieldtype = Types.fresh_type_variable (`Any, `Any) in
+                      let fieldtype = Types.fresh_type_variable (lin_any, res_any) in
                         unify ~handle:Gripers.projection
                           (pos_and_typ r, no_pos (`Record (Types.make_singleton_open_row
                                                              (l, `Present fieldtype)
-                                                             (`Unl, `Any))));
-                        `Projection (erase r, l), fieldtype, usages r
+                                                             (lin_unl, res_any))));
+                        Projection (erase r, l), fieldtype, usages r
               end
-        | `With (r, fields) ->
+        | With (r, fields) ->
             let r = tc r in
             let fields = alistmap tc fields in
 
@@ -3125,8 +3130,8 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
               let fields_type =
                 `Record (List.fold_right
                            (fun (lab, _) row ->
-                              Types.row_with (lab, `Present (Types.fresh_type_variable (`Unl, `Any))) row)
-                           fields (Types.make_empty_open_row (`Any, `Any))) in
+                              Types.row_with (lab, `Present (Types.fresh_type_variable (lin_unl, res_any))) row)
+                           fields (Types.make_empty_open_row (lin_any, res_any))) in
                 unify ~handle:Gripers.record_with (pos_and_typ r, no_pos fields_type) in
             let (rfields, row_var, lr), _ = Types.unwrap_row (TypeUtils.extract_row (typ r)) in
             assert (not lr);
@@ -3138,23 +3143,23 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                    else t)
                 rfields
             in
-              `With (erase r, alistmap erase fields), `Record (rfields, row_var, false), merge_usages (usages r :: List.map usages (range fields))
-        | `TypeAnnotation (e, (_, Some t as dt)) ->
+              With (erase r, alistmap erase fields), `Record (rfields, row_var, false), merge_usages (usages r :: List.map usages (range fields))
+        | TypeAnnotation (e, (_, Some t as dt)) ->
             let e = tc e in
               unify ~handle:Gripers.type_annotation (pos_and_typ e, no_pos t);
-              `TypeAnnotation (erase e, dt), t, usages e
-        | `TypeAnnotation _ -> assert false
-        | `Upcast (e, (_, Some t1 as t1'), (_, Some t2 as t2')) ->
+              TypeAnnotation (erase e, dt), t, usages e
+        | TypeAnnotation _ -> assert false
+        | Upcast (e, (_, Some t1 as t1'), (_, Some t2 as t2')) ->
             let e = tc e in
               if Types.is_sub_type (t2, t1) then
                 begin
                   unify ~handle:Gripers.upcast_source (pos_and_typ e, no_pos t2);
-                  `Upcast (erase e, t1', t2'), t1, usages e
+                  Upcast (erase e, t1', t2'), t1, usages e
                 end
               else
                 Gripers.upcast_subtype pos t2 t1
-        | `Upcast _ -> assert false
-        | `Handle { sh_expr = m; sh_value_cases = val_cases; sh_effect_cases = eff_cases; sh_descr = descr; } ->
+        | Upcast _ -> assert false
+        | Handle { sh_expr = m; sh_value_cases = val_cases; sh_effect_cases = eff_cases; sh_descr = descr; } ->
            let rec pop_last = function
              | [] -> assert false
              | [x] -> x, []
@@ -3171,15 +3176,17 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
            (** returns a pair of lists whose first component is the
                value clauses, while the second component is the
                operation clauses *)
-           let split_handler_cases : (pattern * phrase) list -> (pattern * phrase) list * (pattern * phrase) list
+           let split_handler_cases : (Pattern.with_pos * phrase) list -> (Pattern.with_pos * phrase) list * (Pattern.with_pos * phrase) list
              = fun cases ->
              let ret, ops =
                List.fold_left
                  (fun (val_cases, eff_cases) (pat, body) ->
                    match pat.node with
-                   | `Variant ("Return", None)     -> Gripers.die pat.pos "Improper pattern-matching on return value"
-                   | `Variant ("Return", Some pat) -> (pat, body) :: val_cases, eff_cases
-                   | _                             -> val_cases, (pat, body) :: eff_cases)
+                   | Pattern.Variant ("Return", None) ->
+                      Gripers.die pat.pos "Improper pattern-matching on return value"
+                   | Pattern.Variant ("Return", Some pat) ->
+                      (pat, body) :: val_cases, eff_cases
+                   | _ -> val_cases, (pat, body) :: eff_cases)
                  ([], []) cases
              in
              List.rev ret, List.rev ops
@@ -3214,11 +3221,11 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
            in
            let type_cases val_cases eff_cases =
              let wild_row () =
-               let fresh_row = Types.make_empty_open_row (`Unl, `Any) in
+               let fresh_row = Types.make_empty_open_row (lin_unl, res_any) in
                allow_wild fresh_row
              in
-             let rt = Types.fresh_type_variable (`Unl, `Any) in
-             let bt = Types.fresh_type_variable (`Unl, `Any) in
+             let rt = Types.fresh_type_variable (lin_unl, res_any) in
+             let bt = Types.fresh_type_variable (lin_unl, res_any) in
              let inner_eff = wild_row () in
              let outer_eff = wild_row () in
              (* Type value patterns *)
@@ -3239,19 +3246,19 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                List.fold_right
                  (fun (pat, body) cases ->
                    let pat =
+                     let open Pattern in
                      match pat with
-                     | { node = `Variant (opname, Some pat'); pos } ->
+                     | { node = Variant (opname, Some pat'); pos } ->
                         begin match pat'.node with
-                        | `Tuple [] ->
-                           with_pos pos (`Effect (opname, [], with_dummy_pos `Any))
-                        | `Tuple ps ->
+                        | Tuple [] ->
+                           with_pos pos (Effect (opname, [], with_dummy_pos Pattern.Any))
+                        | Tuple ps ->
                            let kpat, pats = pop_last ps in
-                           let eff = `Effect (opname, pats, kpat) in
-                           with_pos pos eff
-                        | _ -> with_pos pos (`Effect (opname, [], pat'))
+                           with_pos pos (Effect (opname, pats, kpat))
+                        | _ -> with_pos pos (Effect (opname, [], pat'))
                         end
-                     | { node = `Variant (opname, None); pos } ->
-                        with_pos pos (`Effect (opname, [], with_dummy_pos `Any))
+                     | { node = Variant (opname, None); pos } ->
+                        with_pos pos (Effect (opname, [], with_dummy_pos Pattern.Any))
                      | {pos;_} -> Gripers.die pos "Improper pattern matching"
                    in
                    let pat = tpo pat in
@@ -3267,7 +3274,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                    let (pat, env, effrow) = pat in
                    let effname, kpat =
                      match pat.node with
-                     | `Effect (name, _, kpat) -> name, kpat
+                     | Pattern.Effect (name, _, kpat) -> name, kpat
                      | _ -> assert false
                    in
                    let pat, kpat =
@@ -3283,19 +3290,20 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                      match descr.shd_params with
                      | Some params when descr.shd_depth = Deep ->
                         let handler_params = params.shp_types in
+                        let open Pattern in
                         begin match kpat.node with
-                        | `Any ->
+                        | Any ->
                            let kt =
                              let domain =
-                               (Types.fresh_type_variable (`Unl, `Any)) :: handler_params
+                               (Types.fresh_type_variable (lin_unl, res_any)) :: handler_params
                              in
-                             let effects = Types.make_empty_open_row (`Unl, `Any) in
-                             let codomain =  Types.fresh_type_variable (`Unl, `Any) in
+                             let effects = Types.make_empty_open_row (lin_unl, res_any) in
+                             let codomain =  Types.fresh_type_variable (lin_unl, res_any) in
                              Types.make_function_type domain effects codomain
                            in
                            (pat, env, effrow), (kpat, Env.empty, kt)
-                        | `As (bndr,_)
-                        | `Variable bndr ->
+                        | As (bndr,_)
+                        | Variable bndr ->
                            let kname = name_of_binder bndr in
                            let kt =
                              let (fields,_,_) = TypeUtils.extract_row effrow in
@@ -3316,9 +3324,10 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                         | _ -> assert false
                         end
                      | _ ->
+                        let open Pattern in
                         match kpat.node with
-                        | `As (bndr,_)
-                        | `Variable bndr ->
+                        | As (bndr,_)
+                        | Variable bndr ->
                            let kname = name_of_binder bndr in
                            let kt =
                              match Env.find env kname with
@@ -3327,12 +3336,12 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                            in
                            let env' = Env.bind Env.empty (kname, kt) in
                            (pat, env, effrow), (kpat, env', kt)
-                        | `Any ->
+                        | Any ->
                            let kt =
                              Types.make_function_type
-                               [Types.fresh_type_variable (`Unl, `Any)]
-                               (Types.make_empty_open_row (`Unl, `Any))
-                               (Types.fresh_type_variable (`Unl, `Any))
+                               [Types.fresh_type_variable (lin_unl, res_any)]
+                               (Types.make_empty_open_row (lin_unl, res_any))
+                               (Types.fresh_type_variable (lin_unl, res_any))
                            in
                            (pat, env, effrow), (kpat, Env.empty, kt)
                         | _ -> assert false
@@ -3358,7 +3367,7 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
              (* Type operation clause bodies and resumptions *)
              let eff_cases =
                List.fold_right
-                 (fun (pat, (kpat : pattern * Types.datatype Env.t * Types.datatype), body) cases ->
+                 (fun (pat, (kpat : Pattern.with_pos * Types.datatype Env.t * Types.datatype), body) cases ->
                    let body = type_check (henv ++ pattern_env pat) body in
                    let () = unify ~handle:Gripers.handle_branches
                               (pos_and_typ body, no_pos bt)
@@ -3397,13 +3406,13 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                  (fun name p ->
                    if TypeUtils.is_builtin_effect name
                    then p
-                   else Types.fresh_presence_variable (`Unl, `Any)) (* It is questionable whether it is ever correct to
+                   else Types.fresh_presence_variable (lin_unl, res_any)) (* It is questionable whether it is ever correct to
                                                                        make absent operations polymorphic in their presence. *)
                  operations
              in
 	     (operations', rho, dual)
            in
-           let m_context = { context with effect_row = Types.make_empty_open_row (`Unl, `Any) } in
+           let m_context = { context with effect_row = Types.make_empty_open_row (lin_unl, res_any) } in
            let m = type_check m_context m in (* Type-check the input computation m under current context *)
            let m_effects = `Effect m_context.effect_row in
            (** Most of the work is done by `type_cases'. *)
@@ -3440,11 +3449,11 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
                          shd_types = (Types.flatten_row inner_eff, typ m, Types.flatten_row outer_eff, body_type);
                          shd_raw_row = Types.make_empty_closed_row (); }
            in
-           `Handle { sh_expr = erase m;
-                     sh_effect_cases = erase_cases eff_cases;
-                     sh_value_cases = erase_cases val_cases;
-                     sh_descr = descr }, body_type, merge_usages [usage_compat (List.map (fun ((_, _, m),_) -> m) params); usages m; usages_cases eff_cases; usages_cases val_cases]
-        | `DoOperation (opname, args, _) ->
+           Handle { sh_expr = erase m;
+                    sh_effect_cases = erase_cases eff_cases;
+                    sh_value_cases = erase_cases val_cases;
+                    sh_descr = descr }, body_type, merge_usages [usage_compat (List.map (fun ((_, _, m),_) -> m) params); usages m; usages_cases eff_cases; usages_cases val_cases]
+        | DoOperation (opname, args, _) ->
            (* Strategy:
               1. List.map tc args
               2. Construct operation type
@@ -3457,25 +3466,25 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
 	     let (row, return_type, args) =
 	       let ps     = List.map tc args in
 	       let inp_t  = List.map typ ps in
-	       let out_t  = Types.fresh_type_variable (`Unl, `Any) in
+	       let out_t  = Types.fresh_type_variable (lin_unl, res_any) in
 	       let optype = Types.make_pure_function_type inp_t out_t in
-               let effrow = Types.make_singleton_open_row (opname, `Present optype) (`Unl, `Effect) in
+               let effrow = Types.make_singleton_open_row (opname, `Present optype) (lin_unl, res_effect) in
 	       (effrow, out_t, ps)
 	     in
 	     let (_,_,p) = SourceCode.resolve_pos pos in
 	     let () = unify ~handle:Gripers.do_operation
 	       (no_pos (`Effect context.effect_row), (p, `Effect row))
 	     in
-             (`DoOperation (opname, List.map erase args, Some return_type), return_type, StringMap.empty)
-        | `Switch (e, binders, _) ->
+             (DoOperation (opname, List.map erase args, Some return_type), return_type, StringMap.empty)
+        | Switch (e, binders, _) ->
             let e = tc e in
             let binders, pattern_type, body_type = type_cases binders in
             let () = unify ~handle:Gripers.switch_pattern (pos_and_typ e, no_pos pattern_type) in
-              `Switch (erase e, erase_cases binders, Some body_type), body_type, merge_usages [usages e; usages_cases binders]
-        | `TryInOtherwise (try_phrase, pat, in_phrase, unless_phrase, _) ->
+              Switch (erase e, erase_cases binders, Some body_type), body_type, merge_usages [usages e; usages_cases binders]
+        | TryInOtherwise (try_phrase, pat, in_phrase, unless_phrase, _) ->
             let try_phrase = tc try_phrase in
 
-            (* Pattern type variable *)
+            (* Pattern.with_posype variable *)
             let pat = tpc pat in
 
             (* Check whether pattern corresponds to try_phrase *)
@@ -3538,11 +3547,11 @@ let rec type_check : context -> phrase -> phrase * Types.datatype * usagemap =
 
             let return_type = typ in_phrase in
 
-            `TryInOtherwise
+            TryInOtherwise
               (erase try_phrase, erase_pat pat, erase in_phrase,
                 erase unless_phrase, Some return_type), return_type, usages_res
-        | `QualifiedVar _ -> assert false
-        | `Raise -> (`Raise, Types.fresh_type_variable (`Any, `Any), StringMap.empty)
+        | QualifiedVar _ -> assert false
+        | Raise -> (Raise, Types.fresh_type_variable (lin_any, res_any), StringMap.empty)
     in with_pos pos e, t, usages
 
 (** [type_binding] takes XXX YYY (FIXME)
@@ -3578,7 +3587,7 @@ and type_binding : context -> binding -> binding * context * usagemap =
     let empty_context = empty_context (context.Types.effect_row) in
 
     let typed, ctxt, usage = match def with
-      | `Val (pat, (_, body), location, datatype) ->
+      | Val (pat, (_, body), location, datatype) ->
           let body = tc body in
           let pat = tpc pat in
           let penv = pattern_env pat in
@@ -3607,17 +3616,17 @@ and type_binding : context -> binding -> binding * context * usagemap =
               else
                 [], erase_pat pat, penv
           in
-            `Val (pat, (tyvars, body), location, datatype),
+            Val (pat, (tyvars, body), location, datatype),
             {empty_context with
               var_env = penv},
             usage
-      | `Fun (bndr, lin, (_, (pats, body)), location, t) ->
+      | Fun (bndr, lin, (_, (pats, body)), location, t) ->
           let name = name_of_binder bndr in
           let vs = name :: check_for_duplicate_names pos (List.flatten pats) in
           let pats = List.map (List.map tpc) pats in
 
-          let effects = Types.make_empty_open_row (`Any, `Any) in
-          let return_type = Types.fresh_type_variable (`Any, `Any) in
+          let effects = Types.make_empty_open_row (lin_any, res_any) in
+          let return_type = Types.fresh_type_variable (lin_any, res_any) in
 
           (** Check that any annotation matches the shape of the function *)
           let context', ft =
@@ -3665,7 +3674,7 @@ and type_binding : context -> binding -> binding * context * usagemap =
                      (List.flatten pats) in
 
           let () =
-            if lin = `Unl then
+            if DeclaredLinearity.is_nonlinear lin then
               StringMap.iter (fun v _ ->
                               if not (List.mem v vs) then
                                 let t = Env.lookup context'.var_env v in
@@ -3680,14 +3689,14 @@ and type_binding : context -> binding -> binding * context * usagemap =
           (* generalise*)
           let (tyvars, _tyargs), ft = Utils.generalise context.var_env ft in
           let ft = Instantiate.freshen_quantifiers ft in
-            (`Fun (set_binder_type bndr ft,
+            (Fun (set_binder_type bndr ft,
                    lin,
                    (tyvars, (List.map (List.map erase_pat) pats, erase body)),
                    location, t),
              {empty_context with
                 var_env = Env.bind Env.empty (name, ft)},
              StringMap.filter (fun v _ -> not (List.mem v vs)) (usages body))
-      | `Funs defs ->
+      | Funs defs ->
           (*
             Compute initial types for the functions using
             - the patterns
@@ -3701,7 +3710,7 @@ and type_binding : context -> binding -> binding * context * usagemap =
             As well as the function types, the typed patterns are also
             returned here as a simple optimisation.  *)
 
-          let fresh_wild () = Types.make_singleton_open_row ("wild", (`Present Types.unit_type)) (`Any, `Any) in
+          let fresh_wild () = Types.make_singleton_open_row ("wild", (`Present Types.unit_type)) (lin_any, res_any) in
 
           let inner_env, patss =
             List.fold_left
@@ -3723,10 +3732,10 @@ and type_binding : context -> binding -> binding * context * usagemap =
                             f(x1)...(xk)
                             }
                          *)
-                         make_ft_poly_curry lin pats (fresh_wild ()) (Types.fresh_type_variable (`Any, `Any))
+                         make_ft_poly_curry lin pats (fresh_wild ()) (Types.fresh_type_variable (lin_any, res_any))
                      | Some (_, Some t) ->
                          (* Debug.print ("t: " ^ Types.string_of_datatype t); *)
-                         let shape = make_ft lin pats (fresh_wild ()) (Types.fresh_type_variable (`Any, `Any)) in
+                         let shape = make_ft lin pats (fresh_wild ()) (Types.fresh_type_variable (lin_any, res_any)) in
                          let (_, ft) = Generalise.generalise_rigid context.var_env t in
                          (* Debug.print ("ft: " ^ Types.string_of_datatype ft); *)
                            (* make sure the annotation has the right shape *)
@@ -3770,7 +3779,7 @@ and type_binding : context -> binding -> binding * context * usagemap =
                           pat_env in
                       let used =
                         let vs = StringSet.add name (Env.domain pat_env) in
-                        if lin=`Unl then
+                        if DeclaredLinearity.is_nonlinear lin then
                           StringMap.iter (fun v _ ->
                                           if not (StringSet.mem v vs) then
                                             let t = Env.lookup context'.var_env v in
@@ -3837,29 +3846,29 @@ and type_binding : context -> binding -> binding * context * usagemap =
           let defined = List.map (fun (bndr, _, _, _, _, _) -> name_of_binder bndr) defs
 
           in
-            `Funs defs, {empty_context with var_env = outer_env}, (StringMap.filter (fun v _ -> not (List.mem v defined)) (merge_usages used))
+            Funs defs, {empty_context with var_env = outer_env}, (StringMap.filter (fun v _ -> not (List.mem v defined)) (merge_usages used))
 
-      | `Foreign (bndr, raw_name, language, file, (dt1, Some datatype)) ->
+      | Foreign (bndr, raw_name, language, file, (dt1, Some datatype)) ->
           (* Ensure that we quantify FTVs *)
           let (_tyvars, _args), datatype = Utils.generalise context.var_env datatype in
           let datatype = Instantiate.freshen_quantifiers datatype in
-          (`Foreign (set_binder_type bndr datatype, raw_name, language, file, (dt1, Some datatype)),
+          (Foreign (set_binder_type bndr datatype, raw_name, language, file, (dt1, Some datatype)),
            (bind_var empty_context (name_of_binder bndr, datatype)),
            StringMap.empty)
-      | `Foreign _ -> assert false
-      | `Type (name, vars, (_, Some dt)) as t ->
+      | Foreign _ -> assert false
+      | Type (name, vars, (_, Some dt)) as t ->
           t, bind_tycon empty_context (name, `Alias (List.map (snd ->- val_of) vars, dt)), StringMap.empty
-      | `Type _ -> assert false
-      | `Infix -> `Infix, empty_context, StringMap.empty
-      | `Exp e ->
+      | Type _ -> assert false
+      | Infix -> Infix, empty_context, StringMap.empty
+      | Exp e ->
           let e = tc e in
           let () = unify pos ~handle:Gripers.bind_exp
             (pos_and_typ e, no_pos Types.unit_type) in
-          `Exp (erase e), empty_context, usages e
-      | `Handler _
-      | `QualifiedImport _
-      | `AlienBlock _
-      | `Module _ -> assert false
+          Exp (erase e), empty_context, usages e
+      | Handler _
+      | QualifiedImport _
+      | AlienBlock _
+      | Module _ -> assert false
     in
       {node = typed; pos}, ctxt, usage
 and type_regex typing_env : regex -> regex =
@@ -3881,8 +3890,8 @@ and type_regex typing_env : regex -> regex =
            let () = unify_or_raise ~pos:pos ~handle:Gripers.splice_exp
                       (no_pos (typ e), no_pos Types.string_type)
            in Splice (erase e)
-        | Replace (r, `Literal s) -> Replace (tr r, `Literal s)
-        | Replace (r, `Splice e)  -> Replace (tr r, `Splice (erase (type_check typing_env e)))
+        | Replace (r, Literal s) -> Replace (tr r, Literal s)
+        | Replace (r, SpliceExpr e)  -> Replace (tr r, SpliceExpr (erase (type_check typing_env e)))
 and type_bindings (globals : context)  bindings =
   let tyenv, (bindings, uinf) =
     List.fold_left
@@ -3921,23 +3930,23 @@ and type_cp (context : context) = fun {node = p; pos} ->
   let unify ~pos ~handle (t, u) = unify_or_raise ~pos:pos ~handle:handle (("<unknown>", t), ("<unknown>", u)) in
 
   let (p, t, u) = match p with
-    | Unquote (bindings, e) ->
+    | CPUnquote (bindings, e) ->
        let context', bindings, usage_builder = type_bindings context bindings in
        let (e, t, u) = type_check (Types.extend_typing_environment context context') e in
          if Settings.get_value endbang_antiquotes then
            unify ~pos:pos ~handle:Gripers.cp_unquote (t, Types.make_endbang_type);
-         Unquote (bindings, e), t, usage_builder u
-    | Grab ((c, _), None, p) ->
-       let (_, t, _) = type_check context (with_pos pos (`Var c)) in
+         CPUnquote (bindings, e), t, usage_builder u
+    | CPGrab ((c, _), None, p) ->
+       let (_, t, _) = type_check context (with_pos pos (Sugartypes.Var c)) in
        let ctype = `Alias (("EndQuery", []), `Input (Types.unit_type, `End)) in
        unify ~pos:pos ~handle:(Gripers.cp_grab c) (t, ctype);
        let (p, pt, u) = type_cp (unbind_var context c) p in
-       Grab ((c, Some (ctype, [])), None, p), pt, use c u
-    | Grab ((c, _), Some bndr, p) ->
+       CPGrab ((c, Some (ctype, [])), None, p), pt, use c u
+    | CPGrab ((c, _), Some bndr, p) ->
        let x = name_of_binder bndr in
-       let (_, t, _) = type_check context (with_pos pos (`Var c)) in
-       let a = Types.fresh_type_variable (`Any, `Any) in
-       let s = Types.fresh_session_variable `Any in
+       let (_, t, _) = type_check context (with_pos pos (Sugartypes.Var c)) in
+       let a = Types.fresh_type_variable (lin_any, res_any) in
+       let s = Types.fresh_session_variable lin_any in
        let ctype = `Input (a, s) in
        unify ~pos:pos ~handle:(Gripers.cp_grab c)
              (t, ctype);
@@ -3948,7 +3957,7 @@ and type_cp (context : context) = fun {node = p; pos} ->
            Types.make_type_unl a
          else
            Gripers.non_linearity pos uses x a;
-       let (_, grab_ty, _) = type_check context (with_pos pos (`Var "receive")) in
+       let (_, grab_ty, _) = type_check context (with_pos pos (Sugartypes.Var "receive")) in
        let tyargs =
          match Types.concrete_type grab_ty with
          | `ForAll (qs, _t) ->
@@ -3962,23 +3971,23 @@ and type_cp (context : context) = fun {node = p; pos} ->
               | _ -> assert false
             end
          | _ -> assert false in
-       Grab ((c, Some (ctype, tyargs)), Some (set_binder_type bndr a), p), pt, use c (StringMap.remove x u)
-    | Give ((c, _), None, p) ->
-       let (_, t, _) = type_check context (with_pos pos (`Var c)) in
+       CPGrab ((c, Some (ctype, tyargs)), Some (set_binder_type bndr a), p), pt, use c (StringMap.remove x u)
+    | CPGive ((c, _), None, p) ->
+       let (_, t, _) = type_check context (with_pos pos (Sugartypes.Var c)) in
        let ctype = `Output (Types.unit_type, `End) in
        unify ~pos:pos ~handle:(Gripers.cp_give c) (t, ctype);
        let (p, t, u) = type_cp (unbind_var context c) p in
-       Give ((c, Some (ctype, [])), None, p), t, use c u
-    | Give ((c, _), Some e, p) ->
-       let (_, t, _) = type_check context (with_pos pos (`Var c)) in
+       CPGive ((c, Some (ctype, [])), None, p), t, use c u
+    | CPGive ((c, _), Some e, p) ->
+       let (_, t, _) = type_check context (with_pos pos (Sugartypes.Var c)) in
        let (e, t', u) = type_check context e in
-       let s = Types.fresh_session_variable `Any in
+       let s = Types.fresh_session_variable lin_any in
        let ctype = `Output (t', s) in
        unify ~pos:pos ~handle:(Gripers.cp_give c)
              (t, ctype);
        let (p, t, u') = with_channel c s (type_cp (bind_var context (c, s)) p) in
 
-       let (_, give_ty, _) = type_check context (with_pos pos (`Var "send")) in
+       let (_, give_ty, _) = type_check context (with_pos pos (Sugartypes.Var "send")) in
        let tyargs =
          match Types.concrete_type give_ty with
          | `ForAll (qs, _t) ->
@@ -3992,61 +4001,61 @@ and type_cp (context : context) = fun {node = p; pos} ->
               | _ -> assert false
             end
          | _ -> assert false in
-       Give ((c, Some (ctype, tyargs)), Some e, p), t, use c (merge_usages [u; u'])
-    | GiveNothing bndr ->
+       CPGive ((c, Some (ctype, tyargs)), Some e, p), t, use c (merge_usages [u; u'])
+    | CPGiveNothing bndr ->
        let c = name_of_binder bndr in
        let binder_pos = bndr.pos in
-       let _, t, _ = type_check context (with_pos binder_pos (`Var c)) in
+       let _, t, _ = type_check context (with_pos binder_pos (Sugartypes.Var c)) in
        unify ~pos:pos ~handle:Gripers.(cp_give c) (t, Types.make_endbang_type);
-       GiveNothing (set_binder_type bndr t), t, StringMap.singleton c 1
-    | Select (bndr, label, p) ->
+       CPGiveNothing (set_binder_type bndr t), t, StringMap.singleton c 1
+    | CPSelect (bndr, label, p) ->
        let c = name_of_binder bndr in
-       let (_, t, _) = type_check context (with_pos pos  (`Var c)) in
-       let s = Types.fresh_session_variable `Any in
-       let r = Types.make_singleton_open_row (label, `Present s) (`Any, `Session) in
+       let (_, t, _) = type_check context (with_pos pos  (Sugartypes.Var c)) in
+       let s = Types.fresh_session_variable lin_any in
+       let r = Types.make_singleton_open_row (label, `Present s) (lin_any, res_session) in
        let ctype = `Select r in
        unify ~pos:pos ~handle:(Gripers.cp_select c)
              (t, ctype);
        let (p, t, u) = with_channel c s (type_cp (bind_var context (c, s)) p) in
-       Select (set_binder_type bndr ctype, label, p), t, use c u
-    | Offer (bndr, branches) ->
+       CPSelect (set_binder_type bndr ctype, label, p), t, use c u
+    | CPOffer (bndr, branches) ->
        let c = name_of_binder bndr in
-       let (_, t, _) = type_check context (with_pos pos (`Var c)) in
+       let (_, t, _) = type_check context (with_pos pos (Sugartypes.Var c)) in
        (*
-       let crow = Types.make_empty_open_row (`Any, `Session) in
+       let crow = Types.make_empty_open_row (lin_any, res_session) in
        let ctype = `Choice crow in
        unify ~pos:pos ~handle:(Gripers.cp_offer_choice c)
              (t, ctype);
         *)
        let check_branch (label, body) =
-         let s = Types.fresh_type_variable (`Any, `Session) in
-         let r = Types.make_singleton_open_row (label, `Present s) (`Any, `Session) in
+         let s = Types.fresh_type_variable (lin_any, res_session) in
+         let r = Types.make_singleton_open_row (label, `Present s) (lin_any, res_session) in
          unify ~pos:pos ~handle:(Gripers.cp_offer_choice c) (t, `Choice r);
          let (p, t, u) = with_channel c s (type_cp (bind_var context (c, s)) body) in
          (label, p), t, u in
        let branches = List.map check_branch branches in
-       let t' = Types.fresh_type_variable (`Any, `Any) in
+       let t' = Types.fresh_type_variable (lin_any, res_any) in
        List.iter (fun (_, t, _) -> unify ~pos:pos ~handle:Gripers.cp_offer_branches (t, t')) branches;
        let u = usage_compat (List.map (fun (_, _, u) -> u) branches) in
-       Offer (set_binder_type bndr t, List.map (fun (x, _, _) -> x) branches), t', use c u
-    | Link (bndr1, bndr2) ->
+       CPOffer (set_binder_type bndr t, List.map (fun (x, _, _) -> x) branches), t', use c u
+    | CPLink (bndr1, bndr2) ->
       let c = name_of_binder bndr1 in
       let d = name_of_binder bndr2 in
-      let (_, tc, uc) = type_check context (with_pos pos (`Var c)) in
-      let (_, td, ud) = type_check context (with_pos pos (`Var d)) in
+      let (_, tc, uc) = type_check context (with_pos pos (Sugartypes.Var c)) in
+      let (_, td, ud) = type_check context (with_pos pos (Sugartypes.Var d)) in
         unify ~pos:pos ~handle:Gripers.cp_link_session
-          (tc, Types.fresh_type_variable (`Any, `Session));
+          (tc, Types.fresh_type_variable (lin_any, res_session));
         unify ~pos:pos ~handle:Gripers.cp_link_session
-          (td, Types.fresh_type_variable (`Any, `Session));
+          (td, Types.fresh_type_variable (lin_any, res_session));
         unify ~pos:pos ~handle:Gripers.cp_link_dual (Types.dual_type tc, td);
-        Link (set_binder_type bndr1 tc, set_binder_type bndr1 td), Types.make_endbang_type, merge_usages [uc; ud]
-    | Comp (bndr, left, right) ->
+        CPLink (set_binder_type bndr1 tc, set_binder_type bndr1 td), Types.make_endbang_type, merge_usages [uc; ud]
+    | CPComp (bndr, left, right) ->
        let c = name_of_binder bndr in
-       let s = Types.fresh_session_variable `Any in
+       let s = Types.fresh_session_variable lin_any in
        let left, t, u = with_channel c s (type_cp (bind_var context (c, s)) left) in
        let right, t', u' = with_channel c (`Dual s) (type_cp (bind_var context (c, `Dual s)) right) in
        unify ~pos:pos ~handle:Gripers.cp_comp_left (Types.make_endbang_type, t);
-       Comp (set_binder_type bndr s, left, right), t', merge_usages [u; u'] in
+       CPComp (set_binder_type bndr s, left, right), t', merge_usages [u; u'] in
   {node = p; pos}, t, u
 
 let show_pre_sugar_typing = Basicsettings.TypeSugar.show_pre_sugar_typing
diff --git a/core/typeUtils.ml b/core/typeUtils.ml
index d3345655c..fa6e44b19 100644
--- a/core/typeUtils.ml
+++ b/core/typeUtils.ml
@@ -1,3 +1,4 @@
+open CommonTypes
 open Utility
 open Types
 
@@ -214,7 +215,7 @@ let rec table_needed_type t = match concrete_type t with
       error ("Attempt to take needed type of non-table: " ^ string_of_datatype t)
 
 let inject_type name t =
-  `Variant (make_singleton_open_row (name, `Present t) (`Any, `Any))
+  `Variant (make_singleton_open_row (name, `Present t) (lin_any, res_any))
 
 let abs_type _ = assert false
 let app_type _ _ = assert false
diff --git a/core/types.ml b/core/types.ml
index baf896634..ec9646d92 100644
--- a/core/types.ml
+++ b/core/types.ml
@@ -1,4 +1,5 @@
 open Utility
+open CommonTypes
 
 [@@@ocaml.warning "-32"] (** disable warnings about unused functions in this module**)
 
@@ -18,21 +19,13 @@ type 'a point = 'a Unionfind.point [@@deriving show]
 type primitive = [ `Bool | `Int | `Char | `Float | `XmlItem | `DB | `String]
     [@@deriving show]
 
-type linearity   = [ `Any | `Unl ]
-    [@@deriving eq,show]
-type restriction = [ `Any | `Base | `Session | `Effect ]
-    [@@deriving eq,show]
-
-type subkind = linearity * restriction
+type subkind = Linearity.t * Restriction.t
     [@@deriving eq,show]
 
 type freedom = [`Rigid | `Flexible]
     [@@deriving eq,show]
 
-type primary_kind = [ `Type | `Row | `Presence ]
-    [@@deriving eq,show]
-
-type kind = primary_kind * subkind
+type kind = PrimaryKind.t * subkind
     [@@deriving eq,show]
 
 type 't meta_type_var_non_rec_basis =
@@ -74,7 +67,7 @@ end
 let process  = {
   Abstype.id = "Process" ;
   name       = "Process" ;
-  arity      = [`Row, (`Any, `Any)] ;
+  arity      = [pk_row, (lin_any, res_any)] ;
 }
 
 (* Lists are currently unlimited because the only deconstructors are
@@ -83,7 +76,7 @@ let process  = {
 let list     = {
   Abstype.id = "List" ;
   name       = "List" ;
-  arity      = [`Type, (`Unl, `Any)] ;
+  arity      = [pk_type, (lin_unl, res_any)] ;
 }
 
 let event    = {
@@ -100,7 +93,7 @@ let dom_node = {
 let access_point = {
   Abstype.id = "AP" ;
   name       = "AP" ;
-  arity      = [`Type, (`Any, `Session)] ;
+  arity      = [pk_type, (lin_any, res_session)] ;
 }
 
 let socket = {
@@ -266,7 +259,7 @@ struct
             (IntMap.find var rec_types), o
           else
             let var' = fresh_raw_variable () in
-            let point' : meta_type_var = Unionfind.fresh (`Var (var', (`Any, `Any), `Flexible)) in
+            let point' : meta_type_var = Unionfind.fresh (`Var (var', (lin_any, res_any), `Flexible)) in
             let rec_types' : (meta_type_var) IntMap.t = IntMap.add var point' rec_types in
             let o_extended_rec_env = {< rec_vars = (rec_types', rec_rows) >} in
             let (t', o') = o_extended_rec_env#typ t in
@@ -286,7 +279,7 @@ struct
             (IntMap.find var rec_rows), o
           else
             let var' = fresh_raw_variable () in
-            let point' = Unionfind.fresh (`Var (var', (`Any, `Any), `Flexible)) in
+            let point' = Unionfind.fresh (`Var (var', (lin_any, res_any), `Flexible)) in
             let rec_rows' = IntMap.add var point' rec_rows in
             let o_extended_rec_env = {< rec_vars = (rec_types, rec_rows') >} in
             let (r', o') = o_extended_rec_env#row r in
@@ -439,7 +432,7 @@ struct
         method! meta_type_var point = match Unionfind.find point with
           | `Recursive (id, t) ->
              if Utility.IntSet.mem id mu_vars then
-               let newvar = `Var (id, (`Any, `Any), `Rigid) in
+               let newvar = `Var (id, (lin_any, res_any), `Rigid) in
                (* Debug.print (Printf.sprintf "Saw rec  var %d" id); *)
                (Unionfind.fresh newvar, o)
              else
@@ -452,7 +445,7 @@ struct
         method! meta_row_var point = match Unionfind.find point with
           | `Recursive (id, t) ->
              if Utility.IntSet.mem id mu_vars then
-               let newvar = `Var (id, (`Any, `Any), `Rigid) in
+               let newvar = `Var (id, (lin_any, res_any), `Rigid) in
                (* Debug.print (Printf.sprintf "Saw rec  var %d" id); *)
                (Unionfind.fresh newvar, o)
              else
@@ -494,7 +487,7 @@ let rec is_base_type : typ -> bool =
     | `MetaTypeVar point ->
         begin
           match Unionfind.find point with
-            | `Var (_, (_, `Base), _) -> true
+            | `Var (_, (_, Restriction.Base), _) -> true
             | `Var _ -> false
             | `Body t -> is_base_type t
             | `Recursive _ -> false
@@ -505,7 +498,7 @@ let rec is_base_row (fields, row_var, _) =
   let base_row_var =
     match Unionfind.find row_var with
       | `Closed
-      | `Var (_, (_, `Base), _) -> true
+      | `Var (_, (_, Restriction.Base), _) -> true
       | `Var _ -> false
       | `Body row -> is_base_row row
       | `Recursive _ -> false in
@@ -527,7 +520,7 @@ let rec is_baseable_type : typ -> bool =
     | `MetaTypeVar point ->
         begin
           match Unionfind.find point with
-            | `Var (_, (_, `Base), `Rigid)
+            | `Var (_, (_, Restriction.Base), `Rigid)
             | `Var (_, _, `Flexible) -> true
             | `Var (_, _, `Rigid) -> false
             | `Body t -> is_baseable_type t
@@ -539,7 +532,7 @@ let rec is_baseable_row (fields, row_var, _) =
   let base_row_var =
     match Unionfind.find row_var with
       | `Closed
-      | `Var (_, (_, `Base), `Rigid)
+      | `Var (_, (_, Restriction.Base), `Rigid)
       | `Var (_, _, `Flexible) -> true
       | `Var (_, _, `Rigid) -> false
       | `Body row -> is_baseable_row row
@@ -562,9 +555,9 @@ let rec basify_type : typ -> unit =
     | `MetaTypeVar point ->
         begin
           match Unionfind.find point with
-            | `Var (_, (_, `Base), _) -> ()
+            | `Var (_, (_, Restriction.Base), _) -> ()
             | `Var (_, _, `Rigid) -> assert false
-            | `Var (var, (lin, `Any), `Flexible) -> Unionfind.change point (`Var (var, (lin, `Base), `Flexible))
+            | `Var (var, (lin, Restriction.Any), `Flexible) -> Unionfind.change point (`Var (var, (lin, res_base), `Flexible))
             | `Var (_, _, `Flexible) -> assert false
             | `Body t -> basify_type t
             | `Recursive _ -> assert false
@@ -575,8 +568,8 @@ let rec basify_row (fields, row_var, _) =
   begin
     match Unionfind.find row_var with
       | `Closed
-      | `Var (_, (_, `Base), _) -> ()
-      | `Var (var, (lin, `Any), `Flexible) -> Unionfind.change row_var (`Var (var, (lin, `Base), `Flexible))
+      | `Var (_, (_, Restriction.Base), _) -> ()
+      | `Var (var, (lin, Restriction.Any), `Flexible) -> Unionfind.change row_var (`Var (var, (lin, res_base), `Flexible))
       | `Var _ -> assert false
       | `Body row -> basify_row row
       | `Recursive _ -> assert false
@@ -609,9 +602,9 @@ let var_of_quantifier : quantifier -> int =
 
 let kind_of_quantifier : quantifier -> kind =
   function
-  | _, sk, `Type _     -> `Type, sk
-  | _, sk, `Row _      -> `Row, sk
-  | _, sk, `Presence _ -> `Presence, sk
+  | _, sk, `Type _     -> pk_type, sk
+  | _, sk, `Row _      -> pk_row, sk
+  | _, sk, `Presence _ -> pk_presence, sk
 
 let type_arg_of_quantifier : quantifier -> type_arg =
   function
@@ -619,21 +612,21 @@ let type_arg_of_quantifier : quantifier -> type_arg =
     | _, _, `Row row_var    -> `Row (FieldEnv.empty, row_var, false)
     | _, _, `Presence point -> `Presence (`Var point)
 
-let primary_kind_of_quantifier : quantifier -> primary_kind =
+let primary_kind_of_quantifier : quantifier -> PrimaryKind.t =
   function
-  | _, _, `Type _     -> `Type
-  | _, _, `Row _      -> `Row
-  | _, _, `Presence _ -> `Presence
+  | _, _, `Type _     -> pk_type
+  | _, _, `Row _      -> pk_row
+  | _, _, `Presence _ -> pk_presence
 
 let subkind_of_quantifier : quantifier -> subkind
   = fun q ->
     snd (kind_of_quantifier q)
 
-let primary_kind_of_type_arg : type_arg -> primary_kind =
+let primary_kind_of_type_arg : type_arg -> PrimaryKind.t =
   function
-  | `Type _     -> `Type
-  | `Row _      -> `Row
-  | `Presence _ -> `Presence
+  | `Type _     -> pk_type
+  | `Row _      -> pk_row
+  | `Presence _ -> pk_presence
 
 let add_quantified_vars qs vars =
   List.fold_right IntSet.add (List.map var_of_quantifier qs) vars
@@ -645,7 +638,7 @@ let is_unl_point =
     begin
       match Unionfind.find point with
       | `Closed -> true
-      | `Var (var, (lin, _), _) -> IntSet.mem var quant_vars || lin=`Unl
+      | `Var (var, (lin, _), _) -> IntSet.mem var quant_vars || Linearity.is_nonlinear lin
       | `Body t -> f (rec_vars, quant_vars) t
       | `Recursive (var, t) ->
         check_rec var rec_vars true (fun rec_vars' -> f (rec_vars', quant_vars) t)
@@ -694,7 +687,7 @@ let point_can_be_unl =
     begin
         match Unionfind.find point with
         | `Closed -> true
-        | `Var (v, (lin, _), `Rigid) -> IntSet.mem v quant_vars || lin=`Unl
+        | `Var (v, (lin, _), `Rigid) -> IntSet.mem v quant_vars || Linearity.is_nonlinear lin
         | `Var (_, _, `Flexible)     -> true
         | `Body t -> f vars t
         | `Recursive (var, t) ->
@@ -748,8 +741,8 @@ let make_point_unl : ((var_set * var_set) -> 'a -> unit) -> (var_set * var_set)
   fun f ((rec_vars, quant_vars) as vars) point ->
     match Unionfind.find point with
     | `Closed -> ()
-    | `Var (v, (lin, _), `Rigid)       -> if IntSet.mem v quant_vars || lin = `Unl then () else assert false
-    | `Var (var, (_, rest), `Flexible) -> Unionfind.change point (`Var (var, (`Unl, rest), `Flexible))
+    | `Var (v, (lin, _), `Rigid)       -> if IntSet.mem v quant_vars || Linearity.is_nonlinear lin then () else assert false
+    | `Var (var, (_, rest), `Flexible) -> Unionfind.change point (`Var (var, (lin_unl, rest), `Flexible))
     | `Body t -> f vars t
     | `Recursive (var, t) ->
       check_rec var rec_vars () (fun rec_vars' -> f (rec_vars', quant_vars) t)
@@ -783,7 +776,7 @@ let is_session_point : (var_set -> 'a -> bool) -> var_set -> [< 'a meta_max_basi
   fun f rec_vars point ->
     match Unionfind.find point with
     | `Closed
-    | `Var (_, (_, `Session), _) -> true
+    | `Var (_, (_, Restriction.Session), _) -> true
     | `Var _ -> false
     | `Body t -> f rec_vars t
     | `Recursive (var, t) ->
@@ -818,13 +811,13 @@ let is_sessionable_point : (var_set -> 'a -> bool) -> var_set -> [< 'a meta_max_
   fun f rec_vars point ->
     match Unionfind.find point with
     | `Closed
-    | `Var (_, (_, `Session), _)
-    | `Var (_, (_, `Any),     `Flexible) -> true
-    | `Var (_, (_, `Base),    `Rigid)
-    | `Var (_, (_, `Any),     `Rigid)
-    | `Var (_, (_, `Effect),  `Rigid)
-    | `Var (_, (_, `Effect),  `Flexible)
-    | `Var (_, (_, `Base),    `Flexible) -> false
+    | `Var (_, (_, Restriction.Session), _)
+    | `Var (_, (_, Restriction.Any),     `Flexible) -> true
+    | `Var (_, (_, Restriction.Base),    `Rigid)
+    | `Var (_, (_, Restriction.Any),     `Rigid)
+    | `Var (_, (_, Restriction.Effect),  `Rigid)
+    | `Var (_, (_, Restriction.Effect),  `Flexible)
+    | `Var (_, (_, Restriction.Base),    `Flexible) -> false
     | `Body t -> f rec_vars t
     | `Recursive (var, t) ->
       check_rec var rec_vars true (flip f t)
@@ -858,8 +851,9 @@ let sessionify_point : (var_set -> 'a -> unit) -> var_set -> [< 'a meta_max_basi
   fun f rec_vars point ->
     match Unionfind.find point with
     | `Closed
-    | `Var (_,   (_,   `Session), _)     -> ()
-    | `Var (var, (lin, `Any), `Flexible) -> Unionfind.change point (`Var (var, (lin, `Session), `Flexible))
+    | `Var (_,   (_,   Restriction.Session), _)     -> ()
+    | `Var (var, (lin, Restriction.Any), `Flexible) ->
+       Unionfind.change point (`Var (var, (lin, Restriction.Session), `Flexible))
     | `Var _                             -> assert false
     | `Body t                            -> f rec_vars t
     | `Recursive (var, t)                -> check_rec var rec_vars () (flip f t)
@@ -958,7 +952,7 @@ module Env = Env.String
   let fresh_rigid_type_variable subkind = make_rigid_type_variable (fresh_raw_variable ()) subkind
   let fresh_row_variable subkind = make_row_variable (fresh_raw_variable ()) subkind
   let fresh_rigid_row_variable subkind = make_rigid_row_variable (fresh_raw_variable ()) subkind
-  let fresh_session_variable linearity = make_type_variable (fresh_raw_variable ()) (linearity, `Session)
+  let fresh_session_variable linearity = make_type_variable (fresh_raw_variable ()) (linearity, res_session)
 
   let fresh_presence_variable subkind = make_presence_variable (fresh_raw_variable ()) subkind
   let fresh_rigid_presence_variable subkind = make_rigid_presence_variable (fresh_raw_variable ()) subkind
@@ -1403,7 +1397,7 @@ and flatten_row : row -> row = fun (field_env, row_var, dual) ->
               else
                 (let row_var' =
                    Unionfind.fresh (`Recursive (var, (FieldEnv.empty,
-                                                      Unionfind.fresh (`Var (var, (`Any, `Any), `Flexible)),
+                                                      Unionfind.fresh (`Var (var, (lin_any, res_any), `Flexible)),
                                                       false))) in
                  let rec_row' = flatten_row' (IntMap.add var row_var' rec_env) rec_row in
                    Unionfind.change row_var' (`Recursive (var, rec_row'));
@@ -1670,7 +1664,7 @@ let show_raw_type_vars = Basicsettings.Types.show_raw_type_vars
 module Vars =
 struct
   type flavour = [`Rigid | `Flexible | `Recursive]
-  type kind    = primary_kind
+  type kind    = PrimaryKind.t
   type scope   = [`Free | `Bound]
   type spec    = flavour * kind * int
 
@@ -1706,12 +1700,12 @@ struct
             begin
               match Unionfind.find point with
                 | `Var (var, _, freedom) ->
-                      [var, ((freedom :> flavour), `Type, `Free)]
+                      [var, ((freedom :> flavour), pk_type, `Free)]
                 | `Recursive (var, body) ->
                     if TypeVarSet.mem var bound_vars then
-                      [var, (`Recursive, `Type, `Bound)]
+                      [var, (`Recursive, pk_type, `Bound)]
                     else
-                      (var, (`Recursive, `Type, `Bound))::(free_bound_type_vars ~include_aliases (TypeVarSet.add var bound_vars) body)
+                      (var, (`Recursive, pk_type, `Bound))::(free_bound_type_vars ~include_aliases (TypeVarSet.add var bound_vars) body)
                 | `Body t -> fbtv t
             end
         | `Function (f, m, t) ->
@@ -1753,7 +1747,7 @@ struct
           begin
             match Unionfind.find point with
               | `Var (var, _, freedom) ->
-                    [var, ((freedom :> flavour), `Presence, `Free)]
+                    [var, ((freedom :> flavour), pk_presence, `Free)]
               | `Body f -> free_bound_field_spec_type_vars ~include_aliases bound_vars f
           end
   and free_bound_row_type_vars ~include_aliases bound_vars (field_env, row_var, _) =
@@ -1768,12 +1762,12 @@ struct
     match Unionfind.find row_var with
       | `Closed -> []
       | `Var (var, _, freedom) ->
-            [var, ((freedom :> flavour), `Row, `Free)]
+            [var, ((freedom :> flavour), pk_row, `Free)]
       | `Recursive (var, row) ->
           if TypeVarSet.mem var bound_vars then
-            [var, (`Recursive, `Row, `Bound)]
+            [var, (`Recursive, pk_row, `Bound)]
           else
-            (var, (`Recursive, `Row, `Bound))::(free_bound_row_type_vars ~include_aliases (TypeVarSet.add var bound_vars) row)
+            (var, (`Recursive, pk_row, `Bound))::(free_bound_row_type_vars ~include_aliases (TypeVarSet.add var bound_vars) row)
       | `Body row -> free_bound_row_type_vars ~include_aliases bound_vars row
   and free_bound_tyarg_vars ~include_aliases bound_vars =
     function
@@ -1890,16 +1884,8 @@ struct
     | s -> "::" ^ s
 
   let subkind : (policy * names) -> subkind -> string =
-    let linearity = function
-      | `Any -> "Any"
-      | `Unl -> "Unl" in
-    let restriction = function
-      | `Any -> "Any"
-      | `Base -> "Base"
-      | `Session -> "Session"
-      | `Effect -> "Eff"
-    in
-    let full (l, r) = "(" ^ linearity l ^ "," ^ restriction r ^ ")" in
+    let full (l, r) = "(" ^ Linearity.to_string l ^ "," ^
+                        Restriction.to_string r ^ ")" in
 
     fun (policy, _vars) ->
     if policy.kinds = "full" then
@@ -1908,43 +1894,38 @@ struct
       function (_, _) -> ""
     else
       function
-      | (`Unl, `Any) -> ""
-      | (`Any, `Any) -> "Any"
-      | (`Unl, `Base) -> restriction `Base
-      | (`Any, `Session) -> restriction `Session
-      | (`Unl, `Effect) -> restriction `Effect
+      | (Linearity.Unl, Restriction.Any)     -> ""
+      | (Linearity.Any, Restriction.Any)     -> "Any"
+      | (Linearity.Unl, Restriction.Base)    -> Restriction.to_string res_base
+      | (Linearity.Any, Restriction.Session) -> Restriction.to_string res_session
+      | (Linearity.Unl, Restriction.Effect)  -> Restriction.to_string res_effect
       | (l, r) -> full (l, r)
 
-  let primary_kind : primary_kind -> string = function
-    | `Type -> "Type"
-    | `Row -> "Row"
-    | `Presence -> "Presence"
-
   let kind : (policy * names) -> kind -> string =
-    let restriction = function
-      | `Any -> "Any"
-      | `Base -> "Base"
-      | `Session -> "Session"
-      | `Effect -> "Eff"
-    in
     let full (policy, _vars) (k, sk) =
-      primary_kind k ^ subkind (policy, _vars) sk in
+      PrimaryKind.to_string k ^ subkind (policy, _vars) sk in
     fun (policy, _vars) (k, sk) ->
     if policy.kinds = "full" then
       full (policy, _vars) (k, sk)
     else if policy.kinds = "hide" then
-      primary_kind k
+      PrimaryKind.to_string k
     else
       match (k, sk) with
-      | `Type, (`Unl, `Any) -> ""
-      | `Type, (`Unl, `Base) -> restriction `Base
-      | `Type, (`Any, `Session) -> restriction `Session
-      | `Type, sk -> subkind ({policy with kinds="full"}, _vars) sk
-      | `Row, (`Unl, `Any) -> primary_kind `Row
-      | `Row, (`Unl, `Effect) -> primary_kind `Row
-      | `Presence, (`Unl, `Any) -> primary_kind `Presence
-      | `Row, _
-      | `Presence, _ -> full ({policy with kinds="full"}, _vars) (k, sk)
+      | PrimaryKind.Type, (Linearity.Unl, Restriction.Any) -> ""
+      | PrimaryKind.Type, (Linearity.Unl, Restriction.Base) ->
+         Restriction.to_string res_base
+      | PrimaryKind.Type, (Linearity.Any, Restriction.Session) ->
+         Restriction.to_string res_session
+      | PrimaryKind.Type, sk ->
+         subkind ({policy with kinds="full"}, _vars) sk
+      | PrimaryKind.Row, (Linearity.Unl, Restriction.Any) ->
+         PrimaryKind.to_string pk_row
+      | PrimaryKind.Row, (Linearity.Unl, Restriction.Effect) ->
+         PrimaryKind.to_string pk_row
+      | PrimaryKind.Presence, (Linearity.Unl, Restriction.Any) ->
+         PrimaryKind.to_string pk_presence
+      | PrimaryKind.Row, _ | PrimaryKind.Presence, _ ->
+         full ({policy with kinds="full"}, _vars) (k, sk)
 
   let quantifier : (policy * names) -> quantifier -> string =
     fun (policy, vars) q ->
@@ -2400,9 +2381,6 @@ let string_of_tycon_spec ?(policy=Print.default_policy) ?(refresh_tyvar_names=tr
     build_tyvar_names (fun x -> free_bound_tycon_type_vars x) [tycon];
   Print.tycon_spec TypeVarSet.empty (policy (), Vars.tyvar_name_map) tycon
 
-let string_of_primary_kind primary_kind =
-  Print.primary_kind primary_kind
-
 let string_of_quantifier ?(policy=Print.default_policy) ?(refresh_tyvar_names=true) (quant : quantifier) =
   if refresh_tyvar_names then
     build_tyvar_names (fun x -> free_bound_quantifier_vars x) [quant];
@@ -2524,15 +2502,15 @@ let make_fresh_envs : datatype -> datatype IntMap.t * row IntMap.t * field_spec
 
 let make_rigid_envs datatype : datatype IntMap.t * row IntMap.t * field_spec Utility.IntMap.t =
   let tenv, renv, penv = make_fresh_envs datatype in
-    (IntMap.map (fun _ -> fresh_rigid_type_variable (`Any, `Any)) tenv,
-     IntMap.map (fun _ -> (StringMap.empty, fresh_rigid_row_variable (`Any, `Any), false)) renv,
-     IntMap.map (fun _ -> fresh_rigid_presence_variable (`Any, `Any)) penv)
+    (IntMap.map (fun _ -> fresh_rigid_type_variable (lin_any, res_any)) tenv,
+     IntMap.map (fun _ -> (StringMap.empty, fresh_rigid_row_variable (lin_any, res_any), false)) renv,
+     IntMap.map (fun _ -> fresh_rigid_presence_variable (lin_any, res_any)) penv)
 
 let make_wobbly_envs datatype : datatype IntMap.t * row IntMap.t * field_spec Utility.IntMap.t =
   let tenv, renv, penv = make_fresh_envs datatype in
-    (IntMap.map (fun _ -> fresh_type_variable (`Any, `Any)) tenv,
-     IntMap.map (fun _ -> (StringMap.empty, fresh_row_variable (`Any, `Any), false)) renv,
-     IntMap.map (fun _ -> fresh_presence_variable (`Any, `Any)) penv)
+    (IntMap.map (fun _ -> fresh_type_variable (lin_any, res_any)) tenv,
+     IntMap.map (fun _ -> (StringMap.empty, fresh_row_variable (lin_any, res_any), false)) renv,
+     IntMap.map (fun _ -> fresh_presence_variable (lin_any, res_any)) penv)
 
 
 (* subtyping *)
diff --git a/core/types.mli b/core/types.mli
index 90cc1b9bb..75c1e916b 100644
--- a/core/types.mli
+++ b/core/types.mli
@@ -1,4 +1,5 @@
 (** Core types *)
+open CommonTypes
 
 (* field environments *)
 type 'a stringmap = 'a Utility.StringMap.t [@@deriving show]
@@ -14,21 +15,13 @@ type 'a point = 'a Unionfind.point
 type primitive = [ `Bool | `Int | `Char | `Float | `XmlItem | `DB | `String ]
     [@@deriving show]
 
-type restriction = [ `Any | `Base | `Session | `Effect ]
-    [@@deriving eq,show]
-type linearity   = [ `Any | `Unl ]
-    [@@deriving eq,show]
-
-type subkind = linearity * restriction
+type subkind = Linearity.t * Restriction.t
     [@@deriving eq,show]
 
 type freedom = [`Rigid | `Flexible]
     [@@deriving eq,show]
 
-type primary_kind = [ `Type | `Row | `Presence ]
-    [@@deriving eq,show]
-
-type kind = primary_kind * subkind
+type kind = PrimaryKind.t * subkind
     [@@deriving eq,show]
 
 type 't meta_type_var_non_rec_basis =
@@ -57,7 +50,7 @@ end
 
 module Vars : sig
   type flavour = [`Rigid | `Flexible | `Recursive]
-  type kind    = primary_kind
+  type kind    = PrimaryKind.t
   type scope   = [`Free | `Bound]
   type vars_list = (int * (flavour * kind * scope)) list
 end
@@ -233,14 +226,14 @@ val free_bound_type_vars     : ?include_aliases:bool -> typ -> Vars.vars_list
 val free_bound_row_type_vars : ?include_aliases:bool -> row -> Vars.vars_list
 
 val var_of_quantifier : quantifier -> int
-val primary_kind_of_quantifier : quantifier -> primary_kind
+val primary_kind_of_quantifier : quantifier -> PrimaryKind.t
 val kind_of_quantifier : quantifier -> kind
 val subkind_of_quantifier : quantifier -> subkind
 val type_arg_of_quantifier : quantifier -> type_arg
 val freshen_quantifier : quantifier -> quantifier * type_arg
 val freshen_quantifier_flexible : quantifier -> quantifier * type_arg
 
-val primary_kind_of_type_arg : type_arg -> primary_kind
+val primary_kind_of_type_arg : type_arg -> PrimaryKind.t
 
 val quantifiers_of_type_args : type_arg list -> quantifier list
 
@@ -263,7 +256,7 @@ val fresh_rigid_type_variable : subkind -> datatype
 val fresh_row_variable : subkind -> row_var
 val fresh_rigid_row_variable : subkind -> row_var
 
-val fresh_session_variable : linearity -> datatype
+val fresh_session_variable : CommonTypes.Linearity.t -> datatype
 
 val fresh_presence_variable : subkind -> field_spec
 val fresh_rigid_presence_variable : subkind -> field_spec
@@ -382,7 +375,6 @@ val string_of_row_var    : ?policy:(unit -> Print.policy)
                         -> ?refresh_tyvar_names:bool -> row_var    -> string
 val string_of_tycon_spec : ?policy:(unit -> Print.policy)
                         -> ?refresh_tyvar_names:bool -> tycon_spec -> string
-val string_of_primary_kind : primary_kind -> string
 val string_of_environment        : environment -> string
 val string_of_typing_environment : typing_environment -> string
 
diff --git a/core/unify.ml b/core/unify.ml
index b13356845..2e0aa65f3 100644
--- a/core/unify.ml
+++ b/core/unify.ml
@@ -1,3 +1,4 @@
+open CommonTypes
 open Utility
 open Types
 open Typevarcheck
@@ -312,19 +313,17 @@ let rec unify' : unify_env -> (datatype * datatype) -> unit =
               begin
                 let lin =
                   match llin, rlin with
-                  | `Unl, _
-                    | _, `Unl -> `Unl
+                  | Linearity.Unl, _ | _, Linearity.Unl -> Linearity.Unl
                   | _       -> llin in
                 let rest =
+                  let open Restriction in
                   match lrest, rrest with
-                  | `Base, `Any
-                    | `Any, `Base -> `Base
-                  | `Any, `Session
-                    | `Session, `Any -> `Session
-                  | `Base, `Session ->
+                  | Base, Any | Any, Base       -> Base
+                  | Any, Session | Session, Any -> Session
+                  | Base, Session ->
                      raise (Failure (`Msg ("Cannot unify base type variable " ^ string_of_int lvar ^
                                              " with session type variable " ^ string_of_int rvar)))
-                  | `Session, `Base ->
+                  | Session, Base ->
                      raise (Failure (`Msg ("Cannot unify session type variable " ^ string_of_int lvar ^
                                              " with base type variable " ^ string_of_int rvar)))
                   (* in the default case lrest and rrest must be identical *)
@@ -363,7 +362,7 @@ let rec unify' : unify_env -> (datatype * datatype) -> unit =
                     | Some t2 -> unify' rec_env (t1, t2); false
                     | None ->
                        Debug.if_set (show_recursion) (fun () -> "rec intro1 (" ^ (string_of_int var) ^ ")");
-                       if rest = `Base then
+                       if Restriction.is_base rest then
                          raise (Failure (`Msg ("Cannot infer a recursive type for the base type variable "^ string_of_int var ^
                                                  " with the body "^ string_of_datatype t2)));
                        rec_intro rpoint (var, Types.concrete_type t2);
@@ -374,19 +373,19 @@ let rec unify' : unify_env -> (datatype * datatype) -> unit =
               (* FIXME: does this really still need to happen if we've just introduced a recursive type? *)
               if tidy then
                 begin
-                  if rest = `Base then
+                  if Restriction.is_base rest then
                     if Types.is_baseable_type t2 then
                       Types.basify_type t2
                     else
                       raise (Failure (`Msg ("Cannot unify the base type variable "^ string_of_int var ^
                                               " with the non-base type "^ string_of_datatype t2)));
-                  if lin = `Unl then
+                  if Linearity.is_nonlinear lin then
                     if Types.type_can_be_unl t2 then
                       Types.make_type_unl t2
                     else
                       raise (Failure (`Msg ("Cannot unify the unlimited type variable " ^ string_of_int var ^
                                               " with the linear type " ^ string_of_datatype t2)));
-                  if rest = `Session then
+                  if Restriction.is_session rest then
                     if Types.is_sessionable_type t2 then
                       Types.sessionify_type t2
                     else
@@ -403,7 +402,7 @@ let rec unify' : unify_env -> (datatype * datatype) -> unit =
                     | Some t1 -> unify' rec_env (t1, t2); false
                     | None ->
                        Debug.if_set (show_recursion) (fun () -> "rec intro2 (" ^ (string_of_int var) ^ ")");
-                       if rest = `Base then
+                       if Restriction.is_base rest then
                          raise (Failure (`Msg ("Cannot infer a recursive type for the base type variable "^ string_of_int var ^
                                                  " with the body "^ string_of_datatype t1)));
                        rec_intro lpoint (var, Types.concrete_type t1);
@@ -414,19 +413,19 @@ let rec unify' : unify_env -> (datatype * datatype) -> unit =
               (* FIXME: does this really still need to happen if we've just introduced a recursive type? *)
               if tidy then
                 begin
-                  if rest = `Base then
+                  if Restriction.is_base rest then
                     if Types.is_baseable_type t1 then
                       Types.basify_type t1
                     else
                       raise (Failure (`Msg ("Cannot unify the base type variable "^ string_of_int var ^
                                               " with the non-base type "^ string_of_datatype t1)));
-                  if lin = `Unl then
+                  if Linearity.is_nonlinear lin then
                     if Types.type_can_be_unl t1 then
                       Types.make_type_unl t1
                     else
                       raise (Failure (`Msg ("Cannot unify the unlimited type variable " ^ string_of_int var ^
                                               " with the linear type " ^ string_of_datatype t1)));
-                  if rest = `Session then
+                  if Restriction.is_session rest then
                     if Types.is_sessionable_type t1 then
                       Types.sessionify_type t1
                     else
@@ -519,7 +518,7 @@ let rec unify' : unify_env -> (datatype * datatype) -> unit =
                    Debug.if_set
                      (show_recursion)
                      (fun () -> "rec intro3 ("^string_of_int var^","^string_of_datatype t^")");
-                   if rest = `Base then
+                   if Restriction.is_base rest then
                      raise (Failure (`Msg ("Cannot infer a recursive type for the type variable "^ string_of_int var ^
                                              " with the body "^ string_of_datatype t)));
                    let point' = Unionfind.fresh (`Body t) in
@@ -528,19 +527,19 @@ let rec unify' : unify_env -> (datatype * datatype) -> unit =
               end
             else
               (Debug.if_set (show_recursion) (fun () -> "non-rec intro (" ^ string_of_int var ^ ")");
-               if rest = `Base then
+               if Restriction.is_base rest then
                  if Types.is_baseable_type t then
                    Types.basify_type t
                  else
                    raise (Failure (`Msg ("Cannot unify the base type variable "^ string_of_int var ^
                                            " with the non-base type "^ string_of_datatype t)));
-               if lin = `Unl then
+               if Linearity.is_nonlinear lin then
                  if Types.type_can_be_unl t then
                    Types.make_type_unl t
                  else
                    raise (Failure (`Msg ("Cannot unify the unlimited type variable " ^ string_of_int var ^
                                            " with the linear type "^ string_of_datatype t)));
-               if rest = `Session then
+               if Restriction.is_session rest then
                  if Types.is_sessionable_type t then
                    Types.sessionify_type t
                  else
@@ -980,7 +979,7 @@ and unify_rows' : unify_env -> ((row * row) -> unit) =
       | `Closed ->
          raise (Failure (`Msg ("Rigid row var cannot be unified with empty closed row\n")))
       | `Var (_, (_, rest'), `Flexible) ->
-         if rest = `Any && rest' = `Base then
+         if Restriction.is_any rest && Restriction.is_base rest' then
            raise (Failure (`Msg ("Rigid non-base row var cannot be unified with empty base row\n")));
          Unionfind.change point' (`Var (var, (lin, rest), `Rigid))
       | `Var (var', _, `Rigid) when var=var' -> ()
@@ -1009,27 +1008,27 @@ and unify_rows' : unify_env -> ((row * row) -> unit) =
          if not (StringMap.is_empty extension_field_env) &&
               TypeVarSet.mem var (free_row_type_vars extension_row) then
            begin
-             if rest = `Base then
+             if Restriction.is_base rest then
                raise (Failure (`Msg ("Cannot infer a recursive type for the base row variable "^ string_of_int var ^
                                        " with the body "^ string_of_row extension_row)));
              rec_row_intro point (var, extension_row)
            end
          else
            begin
-             if rest = `Base then
+             if Restriction.is_base rest then
                if Types.is_baseable_row extension_row then
                  Types.basify_row extension_row
                else
                  raise (Failure (`Msg ("Cannot unify the base row variable "^ string_of_int var ^
                                          " with the non-base row "^ string_of_row extension_row)));
-             if rest = `Session then
+             if Restriction.is_session rest then
                if Types.is_sessionable_row extension_row then
                  Types.sessionify_row extension_row
                else
                  raise (Failure (`Msg ("Cannot unify the session row variable "^ string_of_int var ^
                                          " with the non-session row "^ string_of_row extension_row)));
 
-             if lin = `Unl then
+             if Linearity.is_nonlinear lin then
                if Types.row_can_be_unl extension_row then
                  Types.make_row_unl extension_row
                else
@@ -1210,7 +1209,7 @@ and unify_rows' : unify_env -> ((row * row) -> unit) =
            unify_field_envs ~closed:false ~rigid:false rec_env (lfield_env', rfield_env');
 
            (* a fresh row variable common to the left and the right *)
-           let fresh_row_var = fresh_row_variable (`Any, `Any) in
+           let fresh_row_var = fresh_row_variable (lin_any, res_any) in
 
            (* each row can contain fields missing from the other *)
            let rextension = StringMap.filter (fun label _ -> not (StringMap.mem label rfield_env')) lfield_env' in