From f228c2eb94346fb3b538d63d95fdd8ab2c0f8795 Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Mon, 27 Nov 2017 15:05:14 -0500 Subject: allow :: and , as infix ops --- plugins/extraction/ocaml.ml | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) (limited to 'plugins/extraction') diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml index fb8dfb459..5d0f9c167 100644 --- a/plugins/extraction/ocaml.ml +++ b/plugins/extraction/ocaml.ml @@ -107,6 +107,11 @@ let infix_symbols = let operator_chars = [ '!' ; '$' ; '%' ; '&' ; '*' ; '+' ; '-' ; '.' ; '/' ; ':' ; '<' ; '=' ; '>' ; '?' ; '@' ; '^' ; '|' ; '~' ] +(* infix ops in OCaml, but disallowed by preceding grammar *) + +let builtin_infixes = + [ "::" ; "," ] + let substring_all_opchars s start stop = let rec check_char i = if i >= stop then true @@ -120,15 +125,16 @@ let is_infix r = (let s = find_custom r in let len = String.length s in len >= 3 && - (* parenthesized *) - (s.[0] == '(' && s.[len-1] == ')' && - let inparens = String.trim (String.sub s 1 (len - 2)) in - let inparens_len = String.length inparens in - (* either, begins with infix symbol, any remainder is all operator chars *) - (List.mem inparens.[0] infix_symbols && substring_all_opchars inparens 1 inparens_len) - || - (* or, starts with #, at least one more char, all are operator chars *) - (inparens.[0] == '#' && inparens_len >= 2 && substring_all_opchars inparens 1 inparens_len))) + (* parenthesized *) + (s.[0] == '(' && s.[len-1] == ')' && + let inparens = String.trim (String.sub s 1 (len - 2)) in + let inparens_len = String.length inparens in + (* either, begins with infix symbol, any remainder is all operator chars *) + (List.mem inparens.[0] infix_symbols && substring_all_opchars inparens 1 inparens_len) || + (* or, starts with #, at least one more char, all are operator chars *) + (inparens.[0] == '#' && inparens_len >= 2 && substring_all_opchars inparens 1 inparens_len) || + (* or, is an OCaml built-in infix *) + (List.mem inparens builtin_infixes))) let get_infix r = let s = find_custom r in -- cgit v1.2.3