Skip to content

Commit

Permalink
Update Pratter from 2 to 3 (#1019)
Browse files Browse the repository at this point in the history
Co-authored-by: Gabriel Hondet <gl_ht/dev@aleeas.com>
  • Loading branch information
gabrielhdt and Gabriel Hondet authored Nov 11, 2023
1 parent bfa7a56 commit 3067faf
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 37 deletions.
2 changes: 1 addition & 1 deletion dune-project
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ the Why3 platform.")
(dedukti (and :with-test (>= 2.7)))
(bindlib (>= 5.0.1))
(timed (>= 1.0))
(pratter (and (>= 2.0.0) (< 3)))
(pratter (and (>= 3.0.0) (< 4)))
(camlp-streams (>= 5.0))
(why3 (and (>= 1.6.0) (< 1.7~)))
(yojson (>= 1.6.0))
Expand Down
2 changes: 1 addition & 1 deletion lambdapi.opam
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@ depends: [
"dedukti" {with-test & >= "2.7"}
"bindlib" {>= "6.0.0"}
"timed" {>= "1.0"}
"pratter" {>= "2.0.0" & < "3"}
"pratter" {>= "3.0.0" & < "4"}
"camlp-streams" {>= "5.0"}
"why3" {>= "1.6.0" & < "1.7~"}
"yojson" {>= "1.6.0"}
Expand Down
64 changes: 29 additions & 35 deletions src/parsing/pratt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -8,61 +8,55 @@ open Core
open Syntax

module Pratt : sig
val parse : ?find_sym:Core.Sig_state.find_sym -> Sig_state.t -> Env.t
val parse : ?find_sym:Sig_state.find_sym -> Sig_state.t -> Env.t
-> p_term -> p_term
(** [parse ~find_sym ss env t] Pratt parses term [t], unsugaring infix
operators and prefix operators using signature state [ss] and
environment [env] to determine which term is an operator, and to build
new terms. Note that it doesn't recurse into abstractions or
implications and alike. [~find_sym] is used to scope symbol
new terms. Note that it doesn't recurse into abstractions or
implications and alike. [~find_sym] is used to scope symbol
identifiers. *)
end = struct

open Lplib
open Pos

module Pratt_terms : Pratter.SUPPORT
with type term = p_term
and type table = Core.Sig_state.find_sym * Sig_state.t * Env.t
= struct
type term = p_term
type table = Core.Sig_state.find_sym * Sig_state.t * Env.t
let is_op : Sig_state.find_sym -> Sig_state.t -> Env.t -> p_term
-> (Pratter.fixity * float) option =
fun find_sym ss env t ->
match t.elt with
| P_Iden({elt=(mp, s); _} as id, false) ->
let open Option.Monad in
let* sym =
try (* Look if [id] is in [env]... *)
if mp <> [] then raise Not_found;
ignore (Env.find s env); None
with Not_found -> (* ... or look into the signature *)
Some(find_sym ~prt:true ~prv:true ss id)
in
(match Term.SymMap.find_opt sym ss.notations with
| Some(Infix(assoc, prio)) -> Some(Pratter.Infix assoc, prio)
| Some(Prefix(prio)) | Some(Succ(Some(Prefix(prio)))) ->
Some(Pratter.Prefix, prio)
| Some(Postfix(prio)) | Some(Succ(Some(Postfix(prio)))) ->
Some(Pratter.Postfix, prio)
| Some (Zero | Succ _ | Quant) | None -> None)
| _ -> None

(* Get properties of term [t] if its an operator. *)
let get ((find_sym : Core.Sig_state.find_sym), tbl, env) t =
match t.elt with
| P_Iden({elt=(mp, s); _} as id, false) ->
let open Option.Monad in
let* sym =
try (* Look if [id] is in [env]... *)
if mp <> [] then raise Not_found;
ignore (Env.find s env); None
with Not_found -> (* ... or look into the signature *)
Some(find_sym ~prt:true ~prv:true tbl id)
in
(match Term.SymMap.find_opt sym tbl.notations with
| Some(Infix(assoc, prio)) -> Some(Pratter.Infix assoc, prio)
| Some(Prefix(prio)) | Some(Succ(Some(Prefix(prio)))) ->
Some(Pratter.Prefix, prio)
| Some(Postfix(prio)) | Some(Succ(Some(Postfix(prio)))) ->
Some(Pratter.Postfix, prio)
| Some (Zero | Succ _ | Quant) | None -> None)
| _ -> None

let make_appl t u = Pos.make (Pos.cat t.pos u.pos) (P_Appl(t, u))
end
let appl : p_term -> p_term -> p_term = fun t u ->
Pos.make (Pos.cat t.pos u.pos) (P_Appl(t, u))

(* NOTE the term is converted from appl nodes to list in [Pratt.parse],
rebuilt into appl nodes by [Pratt.parse], and then decomposed again into a
list by [get_args]. We could make [Pratt.parse] return a list of terms
instead. *)
let parse : ?find_sym:Core.Sig_state.find_sym ->
let parse : ?find_sym:Sig_state.find_sym ->
Sig_state.t -> Env.t -> p_term -> p_term =
fun ?(find_sym=Sig_state.find_sym) st env t ->
let h, args = Syntax.p_get_args t in
let strm = Stream.of_list (h :: args) in
let module Parse = Pratter.Make(Pratt_terms) in
match Parse.expression (find_sym, st, env) strm with
let is_op = is_op find_sym st env in
match Pratter.expression ~is_op ~appl strm with
| Ok e -> e
| Error `TooFewArguments ->
Error.fatal t.pos "Malformed application in \"%a\"" Pretty.term t
Expand Down

0 comments on commit 3067faf

Please sign in to comment.