Skip to content

Commit

Permalink
Remove support for tuples and variants
Browse files Browse the repository at this point in the history
  • Loading branch information
@Leonidas-from-XIV
Leonidas-from-XIV committed Dec 27, 2022
1 parent a3fbc94 commit f916c96
Show file tree
Hide file tree
Showing 14 changed files with 7 additions and 372 deletions.
1 change: 0 additions & 1 deletion lib/common.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,6 @@ let json_error s = raise (Json_error s)

exception End_of_array
exception End_of_object
exception End_of_tuple
exception End_of_input

type in_param = { string_buf : Buffer.t }
Expand Down
1 change: 0 additions & 1 deletion lib/common.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,6 @@ val init_lexer :

exception End_of_array
exception End_of_object
exception End_of_tuple
exception End_of_input

(* end undocumented section *)
Expand Down
41 changes: 0 additions & 41 deletions lib/monomorphic.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -67,34 +67,6 @@ let rec pp fmt =
true) false xs);
Format.fprintf fmt "@,]@]";
Format.fprintf fmt "@])"
#ifdef TUPLE
| `Tuple tup ->
Format.fprintf fmt "`Tuple (@[<hov>";
Format.fprintf fmt "@[<2>[";
ignore (List.fold_left
(fun sep e ->
if sep then
Format.fprintf fmt ";@ ";
pp fmt e;
true) false tup);
Format.fprintf fmt "@,]@]";
Format.fprintf fmt "@])"
#endif
#ifdef VARIANT
| `Variant (name, value) ->
Format.fprintf fmt "`Variant (@[<hov>";
Format.fprintf fmt "(@[";
Format.fprintf fmt "%S" name;
Format.fprintf fmt ",@ ";
(match value with
| None -> Format.pp_print_string fmt "None"
| Some x ->
Format.pp_print_string fmt "(Some ";
pp fmt x;
Format.pp_print_string fmt ")");
Format.fprintf fmt "@])";
Format.fprintf fmt "@])"
#endif

let show x =
Format.asprintf "%a" pp x
Expand Down Expand Up @@ -133,23 +105,10 @@ let rec equal a b =
| exception Invalid_argument _ ->
(* the lists were of different lengths, thus unequal *)
false)
#ifdef TUPLE
| `Tuple xs, `Tuple ys
#endif
| `List xs, `List ys ->
(match List.for_all2 equal xs ys with
| result -> result
| exception Invalid_argument _ ->
(* the lists were of different lengths, thus unequal *)
false)
#ifdef VARIANT
| `Variant (name, value), `Variant (name', value') ->
(match name = name' with
| false -> false
| true ->
match value, value' with
| None, None -> true
| Some x, Some y -> equal x y
| _ -> false)
#endif
| _ -> false
37 changes: 0 additions & 37 deletions lib/pretty.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -115,43 +115,6 @@ let rec format ~inside_box std (out:Format.formatter) (x:t) : unit =
if not inside_box then Format.fprintf out "@[<hv2>";
Format.fprintf out "{@;<1 0>%a@;<1 -2>}" (pp_list "," (format_field std)) l;
if not inside_box then Format.fprintf out "@]";
#ifdef TUPLE
| `Tuple l ->
if std then
format ~inside_box std out (`List l)
else
if l = [] then
Format.pp_print_string out "()"
else (
if not inside_box then Format.fprintf out "@[<hov2>";
Format.fprintf out "(@,%a@;<0 -2>)" (pp_list "," (format ~inside_box:false std)) l;
if not inside_box then Format.fprintf out "@]";
)
#endif
#ifdef VARIANT
| `Variant (s, None) ->
if std then
#ifdef STRING
let representation = `String s in
#elif defined STRINGLIT
let representation = `Stringlit s in
#endif
format ~inside_box std out representation
else
Format.fprintf out "<%s>" (json_string_of_string s)

| `Variant (s, Some x) ->
if std then
#ifdef STRING
let representation = `String s in
#elif defined STRINGLIT
let representation = `Stringlit s in
#endif
format ~inside_box std out (`List [ representation; x ])
else
let op = json_string_of_string s in
Format.fprintf out "<@[<hv2>%s: %a@]>" op (format ~inside_box:true std) x
#endif

and format_field std out (name, x) =
Format.fprintf out "@[<hv2>%s: %a@]" (json_string_of_string name) (format ~inside_box:true std) x
Expand Down
13 changes: 0 additions & 13 deletions lib/read.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -146,8 +146,6 @@ val map_ident :
type variant_kind = [ `Edgy_bracket | `Square_bracket | `Double_quote ]

val start_any_variant : lexer_state -> Lexing.lexbuf -> variant_kind
val finish_variant : lexer_state -> Lexing.lexbuf -> t option
val finish_skip_variant : lexer_state -> Lexing.lexbuf -> unit
val read_lt : lexer_state -> Lexing.lexbuf -> unit
val read_gt : lexer_state -> Lexing.lexbuf -> unit
val read_comma : lexer_state -> Lexing.lexbuf -> unit
Expand Down Expand Up @@ -195,20 +193,9 @@ val read_array :
Lexing.lexbuf ->
'a array

val read_tuple :
(int -> 'a -> lexer_state -> Lexing.lexbuf -> 'a) ->
'a ->
lexer_state ->
Lexing.lexbuf ->
'a

val start_any_tuple : lexer_state -> Lexing.lexbuf -> bool
val read_lpar : lexer_state -> Lexing.lexbuf -> unit
val read_rpar : lexer_state -> Lexing.lexbuf -> unit
val read_tuple_end : Lexing.lexbuf -> unit
val read_tuple_end2 : lexer_state -> bool -> Lexing.lexbuf -> unit
val read_tuple_sep : lexer_state -> Lexing.lexbuf -> unit
val read_tuple_sep2 : lexer_state -> bool -> Lexing.lexbuf -> unit
val read_lbr : lexer_state -> Lexing.lexbuf -> unit
val read_rbr : lexer_state -> Lexing.lexbuf -> unit

Expand Down
175 changes: 6 additions & 169 deletions lib/read.mll
View file
Original file line number Diff line number Diff line change
Expand Up @@ -268,35 +268,11 @@ rule read_json v = parse
}

| '(' {
#ifdef TUPLE
let acc = ref [] in
try
read_space v lexbuf;
read_tuple_end lexbuf;
acc := read_json v lexbuf :: !acc;
while true do
read_space v lexbuf;
read_tuple_sep v lexbuf;
read_space v lexbuf;
acc := read_json v lexbuf :: !acc;
done;
assert false
with End_of_tuple ->
`Tuple (List.rev !acc)
#else
long_error "Invalid token" v lexbuf
#endif
long_error "Invalid token" v lexbuf
}

| '<' {
#ifdef VARIANT
read_space v lexbuf;
let cons = read_ident v lexbuf in
read_space v lexbuf;
`Variant (cons, finish_variant v lexbuf)
#else
long_error "Invalid token" v lexbuf
#endif
long_error "Invalid token" v lexbuf
}

| "//"[^'\n']* { read_json v lexbuf }
Expand Down Expand Up @@ -372,15 +348,6 @@ and finish_stringlit v = parse
| _ { long_error "Invalid string literal" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

and finish_variant v = parse
':' { let x = read_json v lexbuf in
read_space v lexbuf;
read_gt v lexbuf;
Some x }
| '>' { None }
| _ { long_error "Expected ':' or '>' but found" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

and read_lt v = parse
'<' { () }
| _ { long_error "Expected '<' but found" v lexbuf }
Expand Down Expand Up @@ -608,68 +575,6 @@ and read_array_sep v = parse
| _ { long_error "Expected ',' or ']' but found" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }


and read_tuple read_cell init_acc v = parse
'(' {
#ifdef TUPLE
let pos = ref 0 in
let acc = ref init_acc in
try
read_space v lexbuf;
read_tuple_end lexbuf;
acc := read_cell !pos !acc v lexbuf;
incr pos;
while true do
read_space v lexbuf;
read_tuple_sep v lexbuf;
read_space v lexbuf;
acc := read_cell !pos !acc v lexbuf;
incr pos;
done;
assert false
with End_of_tuple ->
!acc
#else
long_error "Invalid token" v lexbuf
#endif
}
| _ { long_error "Expected ')' but found" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

and read_tuple_end = parse
')' { raise End_of_tuple }
| "" { () }

and read_tuple_end2 v std = parse
')' { if std then
long_error "Expected ')' or '' but found" v lexbuf
else
raise End_of_tuple }
| ']' { if std then
raise End_of_tuple
else
long_error "Expected ']' or '' but found" v lexbuf }
| "" { () }

and read_tuple_sep v = parse
',' { () }
| ')' { raise End_of_tuple }
| _ { long_error "Expected ',' or ')' but found" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

and read_tuple_sep2 v std = parse
',' { () }
| ')' { if std then
long_error "Expected ',' or ']' but found" v lexbuf
else
raise End_of_tuple }
| ']' { if std then
raise End_of_tuple
else
long_error "Expected ',' or ')' but found" v lexbuf }
| _ { long_error "Expected ',' or ')' but found" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

(* Read a JSON object, reading the keys using a custom parser *)
and read_abstract_fields read_key read_field init_acc v = parse
'{' { let acc = ref init_acc in
Expand Down Expand Up @@ -797,34 +702,11 @@ and skip_json v = parse
}

| '(' {
#ifdef TUPLE
try
read_space v lexbuf;
read_tuple_end lexbuf;
skip_json v lexbuf;
while true do
read_space v lexbuf;
read_tuple_sep v lexbuf;
read_space v lexbuf;
skip_json v lexbuf;
done;
assert false
with End_of_tuple ->
()
#else
long_error "Invalid token" v lexbuf
#endif
long_error "Invalid token" v lexbuf
}

| '<' {
#ifdef VARIANT
read_space v lexbuf;
skip_ident v lexbuf;
read_space v lexbuf;
finish_skip_variant v lexbuf
#else
long_error "Invalid token" v lexbuf
#endif
long_error "Invalid token" v lexbuf
}

| "//"[^'\n']* { skip_json v lexbuf }
Expand All @@ -842,14 +724,6 @@ and finish_skip_stringlit v = parse
| _ { long_error "Invalid string literal" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

and finish_skip_variant v = parse
':' { skip_json v lexbuf;
read_space v lexbuf;
read_gt v lexbuf }
| '>' { () }
| _ { long_error "Expected ':' or '>' but found" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

and skip_ident v = parse
'"' { finish_skip_stringlit v lexbuf }
| ident { () }
Expand Down Expand Up @@ -911,36 +785,11 @@ and buffer_json v = parse
}

| '(' {
#ifdef TUPLE
try
Buffer.add_char v.buf '(';
buffer_space v lexbuf;
buffer_tuple_end v lexbuf;
buffer_json v lexbuf;
while true do
buffer_space v lexbuf;
buffer_tuple_sep v lexbuf;
buffer_space v lexbuf;
buffer_json v lexbuf;
done;
assert false
with End_of_tuple ->
()
#else
long_error "Invalid token" v lexbuf
#endif
long_error "Invalid token" v lexbuf
}

| '<' {
#ifdef VARIANT
Buffer.add_char v.buf '<';
buffer_space v lexbuf;
buffer_ident v lexbuf;
buffer_space v lexbuf;
finish_buffer_variant v lexbuf
#else
long_error "Invalid token" v lexbuf
#endif
long_error "Invalid token" v lexbuf
}

| "//"[^'\n']* { add_lexeme v.buf lexbuf; buffer_json v lexbuf }
Expand Down Expand Up @@ -1019,18 +868,6 @@ and buffer_array_sep v = parse
| _ { long_error "Expected ',' or ']' but found" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

and buffer_tuple_end v = parse
')' {
Buffer.add_char v.buf ')';
raise End_of_tuple }
| "" { () }

and buffer_tuple_sep v = parse
',' { Buffer.add_char v.buf ',' }
| ')' { Buffer.add_char v.buf ')'; raise End_of_tuple }
| _ { long_error "Expected ',' or ')' but found" v lexbuf }
| eof { custom_error "Unexpected end of input" v lexbuf }

and buffer_colon v = parse
':' { Buffer.add_char v.buf ':' }
| _ { long_error "Expected ':' but found" v lexbuf }
Expand Down
4 changes: 1 addition & 3 deletions lib/safe.ml
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,6 @@
let rec to_basic : t -> Basic.t = function
| (`Null | `Bool _ | `Int _ | `Float _ | `String _) as x -> x
| `Intlit s -> `String s
| `List l | `Tuple l -> `List (List.rev (List.rev_map to_basic l))
| `List l -> `List (List.rev (List.rev_map to_basic l))
| `Assoc l ->
`Assoc (List.rev (List.rev_map (fun (k, v) -> (k, to_basic v)) l))
| `Variant (k, None) -> `String k
| `Variant (k, Some v) -> `List [ `String k; to_basic v ]
Loading

0 comments on commit f916c96

Please sign in to comment.