+(* ----------------------------------------------------------------------- *)
+
+(* In a nest, if the nest is -, all of the nested code must also be -.
+All are converted to context, because the next takes care of the -. *)
+let check_nests tokens =
+ let is_minus t =
+ let (line_type,a,b,c,d,e,f,g) = get_clt t in
+ List.mem line_type [D.MINUS;D.OPTMINUS;D.UNIQUEMINUS] in
+ let drop_minus t =
+ let clt = try Some(get_clt t) with Failure _ -> None in
+ match clt with
+ Some (line_type,a,b,c,d,e,f,g) ->
+ (match line_type with
+ D.MINUS -> update_clt t (D.CONTEXT,a,b,c,d,e,f,g)
+ | D.OPTMINUS -> update_clt t (D.OPT,a,b,c,d,e,f,g)
+ | D.UNIQUEMINUS -> update_clt t (D.UNIQUE,a,b,c,d,e,f,g)
+ | _ -> failwith "minus token expected")
+ | None -> t in
+ let rec outside = function
+ [] -> []
+ | ((PC.TPOEllipsis(clt),q) as t)::r when is_minus t -> t :: inside 0 r
+ | t::r -> t :: outside r
+ and inside stack = function
+ [] -> failwith "missing nest end"
+ | ((PC.TPCEllipsis(clt),q) as t)::r ->
+ (drop_minus t)
+ :: (if stack = 0 then outside r else inside (stack - 1) r)
+ | ((PC.TPOEllipsis(clt),q) as t)::r ->
+ (drop_minus t) :: (inside (stack + 1) r)
+ | t :: r -> (drop_minus t) :: (inside stack r) in
+ outside tokens
+
+let check_parentheses tokens =
+ let clt2line (_,line,_,_,_,_,_,_) = line in
+ let rec loop seen_open = function
+ [] -> tokens
+ | (PC.TOPar(clt),q) :: rest
+ | (PC.TDefineParam(clt,_,_,_),q) :: rest ->
+ loop (Common.Left (clt2line clt) :: seen_open) rest
+ | (PC.TOPar0(clt),q) :: rest ->
+ loop (Common.Right (clt2line clt) :: seen_open) rest
+ | (PC.TCPar(clt),q) :: rest ->
+ (match seen_open with
+ [] ->
+ failwith
+ (Printf.sprintf
+ "unexpected close parenthesis in line %d\n" (clt2line clt))
+ | Common.Left _ :: seen_open -> loop seen_open rest
+ | Common.Right open_line :: _ ->
+ failwith
+ (Printf.sprintf
+ "disjunction parenthesis in line %d column 0 matched to normal parenthesis on line %d\n" open_line (clt2line clt)))
+ | (PC.TCPar0(clt),q) :: rest ->
+ (match seen_open with
+ [] ->
+ failwith
+ (Printf.sprintf
+ "unexpected close parenthesis in line %d\n" (clt2line clt))
+ | Common.Right _ :: seen_open -> loop seen_open rest
+ | Common.Left open_line :: _ ->
+ failwith
+ (Printf.sprintf
+ "normal parenthesis in line %d matched to disjunction parenthesis on line %d column 0\n" open_line (clt2line clt)))
+ | x::rest -> loop seen_open rest in
+ loop [] tokens
+