@@ -718,142 +718,192 @@ and parse_negation_pexp (ps:pstate) : pexp =
718
718
719
719
(* Binops are all left-associative, *)
720
720
(* so we factor out some of the parsing code here. *)
721
- and binop_rhs
721
+ and binop_build
722
722
(ps :pstate )
723
723
(name :string )
724
724
(apos :pos )
725
- (lhs :pexp )
726
725
(rhs_parse_fn :pstate -> pexp )
726
+ (lhs :pexp )
727
+ (step_fn :pexp -> pexp )
727
728
(op :Ast.binop )
728
729
: pexp =
729
730
bump ps;
730
731
let rhs = (ctxt (name ^ " rhs" ) rhs_parse_fn ps) in
731
732
let bpos = lexpos ps in
732
- span ps apos bpos (PEXP_binop (op, lhs, rhs))
733
+ let node = span ps apos bpos (PEXP_binop (op, lhs, rhs)) in
734
+ step_fn node
733
735
734
736
735
737
and parse_factor_pexp (ps :pstate ) : pexp =
736
738
let name = " factor pexp" in
737
739
let apos = lexpos ps in
738
740
let lhs = ctxt (name ^ " lhs" ) parse_negation_pexp ps in
741
+ let build = binop_build ps name apos parse_negation_pexp in
742
+ let rec step accum =
739
743
match peek ps with
740
- STAR -> binop_rhs ps name apos lhs parse_factor_pexp Ast. BINOP_mul
741
- | SLASH -> binop_rhs ps name apos lhs parse_factor_pexp Ast. BINOP_div
742
- | PERCENT -> binop_rhs ps name apos lhs parse_factor_pexp Ast. BINOP_mod
743
- | _ -> lhs
744
+ STAR -> build accum step Ast. BINOP_mul
745
+ | SLASH -> build accum step Ast. BINOP_div
746
+ | PERCENT -> build accum step Ast. BINOP_mod
747
+ | _ -> accum
748
+ in
749
+ step lhs
744
750
745
751
746
752
and parse_term_pexp (ps :pstate ) : pexp =
747
753
let name = " term pexp" in
748
754
let apos = lexpos ps in
749
755
let lhs = ctxt (name ^ " lhs" ) parse_factor_pexp ps in
756
+ let build = binop_build ps name apos parse_factor_pexp in
757
+ let rec step accum =
750
758
match peek ps with
751
- PLUS -> binop_rhs ps name apos lhs parse_term_pexp Ast. BINOP_add
752
- | MINUS -> binop_rhs ps name apos lhs parse_term_pexp Ast. BINOP_sub
753
- | _ -> lhs
759
+ PLUS -> build accum step Ast. BINOP_add
760
+ | MINUS -> build accum step Ast. BINOP_sub
761
+ | _ -> accum
762
+ in
763
+ step lhs
754
764
755
765
756
766
and parse_shift_pexp (ps :pstate ) : pexp =
757
767
let name = " shift pexp" in
758
768
let apos = lexpos ps in
759
769
let lhs = ctxt (name ^ " lhs" ) parse_term_pexp ps in
770
+ let build = binop_build ps name apos parse_term_pexp in
771
+ let rec step accum =
760
772
match peek ps with
761
- LSL -> binop_rhs ps name apos lhs parse_shift_pexp Ast. BINOP_lsl
762
- | LSR -> binop_rhs ps name apos lhs parse_shift_pexp Ast. BINOP_lsr
763
- | ASR -> binop_rhs ps name apos lhs parse_shift_pexp Ast. BINOP_asr
764
- | _ -> lhs
773
+ LSL -> build accum step Ast. BINOP_lsl
774
+ | LSR -> build accum step Ast. BINOP_lsr
775
+ | ASR -> build accum step Ast. BINOP_asr
776
+ | _ -> accum
777
+ in
778
+ step lhs
765
779
766
780
767
781
and parse_and_pexp (ps :pstate ) : pexp =
768
782
let name = " and pexp" in
769
783
let apos = lexpos ps in
770
784
let lhs = ctxt (name ^ " lhs" ) parse_shift_pexp ps in
785
+ let build = binop_build ps name apos parse_shift_pexp in
786
+ let rec step accum =
771
787
match peek ps with
772
- AND -> binop_rhs ps name apos lhs parse_and_pexp Ast. BINOP_and
773
- | _ -> lhs
788
+ AND -> build accum step Ast. BINOP_and
789
+ | _ -> accum
790
+ in
791
+ step lhs
774
792
775
793
776
794
and parse_xor_pexp (ps :pstate ) : pexp =
777
795
let name = " xor pexp" in
778
796
let apos = lexpos ps in
779
797
let lhs = ctxt (name ^ " lhs" ) parse_and_pexp ps in
798
+ let build = binop_build ps name apos parse_and_pexp in
799
+ let rec step accum =
780
800
match peek ps with
781
- CARET -> binop_rhs ps name apos lhs parse_xor_pexp Ast. BINOP_xor
782
- | _ -> lhs
801
+ CARET -> build accum step Ast. BINOP_xor
802
+ | _ -> accum
803
+ in
804
+ step lhs
783
805
784
806
785
807
and parse_or_pexp (ps :pstate ) : pexp =
786
808
let name = " or pexp" in
787
809
let apos = lexpos ps in
788
810
let lhs = ctxt (name ^ " lhs" ) parse_xor_pexp ps in
811
+ let build = binop_build ps name apos parse_xor_pexp in
812
+ let rec step accum =
789
813
match peek ps with
790
- OR -> binop_rhs ps name apos lhs parse_or_pexp Ast. BINOP_or
791
- | _ -> lhs
814
+ OR -> build accum step Ast. BINOP_or
815
+ | _ -> accum
816
+ in
817
+ step lhs
792
818
793
819
794
820
and parse_relational_pexp (ps :pstate ) : pexp =
795
821
let name = " relational pexp" in
796
822
let apos = lexpos ps in
797
823
let lhs = ctxt (name ^ " lhs" ) parse_or_pexp ps in
824
+ let build = binop_build ps name apos parse_or_pexp in
825
+ let rec step accum =
798
826
match peek ps with
799
- LT -> binop_rhs ps name apos lhs parse_relational_pexp Ast. BINOP_lt
800
- | LE -> binop_rhs ps name apos lhs parse_relational_pexp Ast. BINOP_le
801
- | GE -> binop_rhs ps name apos lhs parse_relational_pexp Ast. BINOP_ge
802
- | GT -> binop_rhs ps name apos lhs parse_relational_pexp Ast. BINOP_gt
803
- | _ -> lhs
827
+ LT -> build accum step Ast. BINOP_lt
828
+ | LE -> build accum step Ast. BINOP_le
829
+ | GE -> build accum step Ast. BINOP_ge
830
+ | GT -> build accum step Ast. BINOP_gt
831
+ | _ -> accum
832
+ in
833
+ step lhs
804
834
805
835
806
836
and parse_equality_pexp (ps :pstate ) : pexp =
807
837
let name = " equality pexp" in
808
838
let apos = lexpos ps in
809
839
let lhs = ctxt (name ^ " lhs" ) parse_relational_pexp ps in
840
+ let build = binop_build ps name apos parse_relational_pexp in
841
+ let rec step accum =
810
842
match peek ps with
811
- EQEQ -> binop_rhs ps name apos lhs parse_equality_pexp Ast. BINOP_eq
812
- | NE -> binop_rhs ps name apos lhs parse_equality_pexp Ast. BINOP_ne
813
- | _ -> lhs
843
+ EQEQ -> build accum step Ast. BINOP_eq
844
+ | NE -> build accum step Ast. BINOP_ne
845
+ | _ -> accum
846
+ in
847
+ step lhs
814
848
815
849
816
850
and parse_andand_pexp (ps :pstate ) : pexp =
817
851
let name = " andand pexp" in
818
852
let apos = lexpos ps in
819
853
let lhs = ctxt (name ^ " lhs" ) parse_equality_pexp ps in
854
+ let rec step accum =
820
855
match peek ps with
821
856
ANDAND ->
822
857
bump ps;
823
- let rhs = parse_andand_pexp ps in
858
+ let rhs = parse_equality_pexp ps in
824
859
let bpos = lexpos ps in
825
- span ps apos bpos (PEXP_lazy_and (lhs, rhs))
860
+ let node = span ps apos bpos (PEXP_lazy_and (accum, rhs)) in
861
+ step node
826
862
827
- | _ -> lhs
863
+ | _ -> accum
864
+ in
865
+ step lhs
828
866
829
867
830
868
and parse_oror_pexp (ps :pstate ) : pexp =
831
869
let name = " oror pexp" in
832
870
let apos = lexpos ps in
833
871
let lhs = ctxt (name ^ " lhs" ) parse_andand_pexp ps in
872
+ let rec step accum =
834
873
match peek ps with
835
874
OROR ->
836
875
bump ps;
837
- let rhs = parse_oror_pexp ps in
876
+ let rhs = parse_andand_pexp ps in
838
877
let bpos = lexpos ps in
839
- span ps apos bpos (PEXP_lazy_or (lhs, rhs))
878
+ let node = span ps apos bpos (PEXP_lazy_or (accum, rhs)) in
879
+ step node
880
+
881
+ | _ -> accum
882
+ in
883
+ step lhs
840
884
841
- | _ -> lhs
842
885
843
886
and parse_as_pexp (ps :pstate ) : pexp =
844
887
let apos = lexpos ps in
845
888
let pexp = ctxt " as pexp" parse_oror_pexp ps in
889
+ let rec step accum =
846
890
match peek ps with
847
891
AS ->
848
892
bump ps;
849
893
let tapos = lexpos ps in
850
894
let t = parse_ty ps in
851
895
let bpos = lexpos ps in
852
896
let t = span ps tapos bpos t in
897
+ let node =
853
898
span ps apos bpos
854
- (PEXP_unop ((Ast. UNOP_cast t), pexp))
899
+ (PEXP_unop ((Ast. UNOP_cast t), accum))
900
+ in
901
+ step node
902
+
903
+ | _ -> accum
904
+ in
905
+ step pexp
855
906
856
- | _ -> pexp
857
907
858
908
and parse_pexp (ps :pstate ) : pexp =
859
909
parse_as_pexp ps
0 commit comments