diff options
| -rw-r--r-- | perl_checker.src/Makefile | 92 | ||||
| -rw-r--r-- | perl_checker.src/OCamlMakefile | 912 | ||||
| -rw-r--r-- | perl_checker.src/common.ml | 5 | ||||
| -rw-r--r-- | perl_checker.src/common.mli | 4 | ||||
| -rw-r--r-- | perl_checker.src/lexer.mll | 50 | ||||
| -rw-r--r-- | perl_checker.src/parser.mly | 291 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.ml | 139 | ||||
| -rw-r--r-- | perl_checker.src/parser_helper.mli | 44 | ||||
| -rw-r--r-- | perl_checker.src/types.mli | 25 |
9 files changed, 1276 insertions, 286 deletions
diff --git a/perl_checker.src/Makefile b/perl_checker.src/Makefile index 6318ac5..5d28fa6 100644 --- a/perl_checker.src/Makefile +++ b/perl_checker.src/Makefile @@ -1,84 +1,14 @@ -CSLC = ocamlcp -p a -CSLC = ocamlc -CSLOPT = ocamlopt -CSLDEP = ocamldep -CSLLEX = ocamllex -CSLYACC = ocamlyacc -v -CSLFLAGS = -w A -g -CSLOPTFLAGS = +# OCAMLC = ocamlcp -p a +OCAMLBCFLAGS = -w A +YFLAGS = -v +TRASH = parser.output +RESULT = perl_checker +BCSUFFIX = _debug +SOURCES = common.ml types.mli info.ml parser_helper.ml parser.mly lexer.mll perl_checker.ml +LIBS = unix -LEX_FILES = $(wildcard *.mll) -YACC_FILES = $(wildcard *.mly) -TMP_FILES = $(YACC_FILES:%.mly=%.mli) $(YACC_FILES:%.mly=%.output) $(YACC_FILES:%.mly=%.ml) $(LEX_FILES:%.mll=%.ml) +NAME = shyant -ALL_PROGS = perl_checker_debug perl_checker +default: debug-code native-code -PROG_OBJS_WITH_CMI = parser_helper.cmo parser.cmo print.cmo perl_checker.cmo -PROG_OBJS = common.cmo flags.cmo info.cmo $(LEX_FILES:%.mll=%.cmo) $(PROG_OBJS_WITH_CMI) -CMA_FILES = unix.cma - -PROG_OBJX_WITH_CMI = $(PROG_OBJS_WITH_CMI:%.cmo=%.cmx) -PROG_OBJX = $(PROG_OBJS:%.cmo=%.cmx) -CMXA_FILES = $(CMA_FILES:%.cma=%.cmxa) - -.PHONY: depend tags clean - -default: .compiling TAGS $(ALL_PROGS) - rm -f .compiling - -all: perl_checker - -perl_checker_debug: .depend $(PROG_OBJS) - $(CSLC) -custom $(CSLFLAGS) $(LIBDIRS) -o $@ $(CMA_FILES) $(PROG_OBJS) - -perl_checker: .depend $(PROG_OBJX) - $(CSLOPT) $(CSLOPTFLAGS) $(LIBDIRS) -o $@ $(CMXA_FILES) $(PROG_OBJX) - -.compiling: - touch $@ - -# Common rules -.SUFFIXES: .ml .mli .cmo .cmi .cmx .mll .mly - -%.ml: %.mll types.cmi parser.cmi - $(CSLLEX) $< - -%.mli %.ml: %.mly - $(CSLYACC) $< - -$(PROG_OBJS_WITH_CMI): %.cmo: %.cmi - -$(PROG_OBJX_WITH_CMI): %.cmx: %.cmi - -%.cmo: %.ml - $(CSLC) $(CSLFLAGS) -c $< - -%.cmx: %.ml - $(CSLOPT) $(CSLOPTFLAGS) -c $< - -.mli.cmi: - $(CSLC) $(CSLFLAGS) -c $< - -clean: - rm -f $(ALL_PROGS) *~ *.o *.cm[iox] $(TMP_FILES) .depend .compiling TAGS gmon.out ocamlprof.dump - -tags: - ocamltags *.ml - -TAGS: - ocamltags *.ml - -# Dependencies -depend: .depend -.depend: - $(CSLDEP) $(INCLUDES) *.mli *.mll *.ml > .depend - -# missing dependencies: -perl_checker.cmo: lexer.cmi parser.cmi -perl_checker.cmx: lexer.cmi parser.cmi -lexer.cmx: common.cmi parser.cmi -lexer.cmo: common.cmi parser.cmi -parser.cmo: parser_helper.cmi -parser.cmx: parser_helper.cmi - --include .depend +-include OCamlMakefile
\ No newline at end of file diff --git a/perl_checker.src/OCamlMakefile b/perl_checker.src/OCamlMakefile new file mode 100644 index 0000000..95df83f --- /dev/null +++ b/perl_checker.src/OCamlMakefile @@ -0,0 +1,912 @@ +########################################################################### +# OCamlMakefile +# Copyright (C) 1999-2002 Markus Mottl +# +# For updates see: +# http://www.oefai.at/~markus/ocaml_sources +# +# $Id$ +# +########################################################################### + +# Set these variables to the names of the sources to be processed and +# the result variable. Order matters during linkage! + +ifndef SOURCES + SOURCES := foo.ml +endif +export SOURCES + +ifndef RES_CLIB_SUF + RES_CLIB_SUF := _stubs +endif +export RES_CLIB_SUF + +ifndef RESULT + RESULT := foo +endif +export RESULT + +ifndef DOC_FILES + DOC_FILES := $(filter %.mli, $(SOURCES)) +endif +export DOC_FILES + +export BCSUFFIX +export NCSUFFIX + +ifndef TOPSUFFIX + TOPSUFFIX := .top +endif + +export TOPSUFFIX + +# Eventually set include- and library-paths, libraries to link, +# additional compilation-, link- and ocamlyacc-flags +# Path- and library information needs not be written with "-I" and such... +# Define THREADS if you need it, otherwise leave it unset (same for +# USE_CAMLP4)! + +export THREADS +export USE_CAMLP4 + +export INCDIRS +export LIBDIRS +export EXTLIBDIRS +export OCAML_DEFAULT_DIRS +export OCAML_LIB_INSTALL + +export LIBS +export CLIBS + +export OCAMLFLAGS +export OCAMLNCFLAGS +export OCAMLBCFLAGS + +export OCAMLLDFLAGS +export OCAMLNLDFLAGS +export OCAMLBLDFLAGS + +ifndef OCAMLCPFLAGS + OCAMLCPFLAGS := a +endif + +export OCAMLCPFLAGS + +export YFLAGS +export IDLFLAGS + +export OCAMLDOCFLAGS + +export DVIPSFLAGS + +export STATIC + +# Add a list of optional trash files that should be deleted by "make clean" +export TRASH + +#################### variables depending on your OCaml-installation + +ifdef MINGW + export MINGW + WIN32 := 1 +endif +ifdef MSVC + export MSVC + WIN32 := 1 + EXT_OBJ := obj + EXT_LIB := lib + ifeq ($(CC),gcc) + # work around GNU Make default value + ifdef THREADS + CC := cl /MT + else + CC := cl + endif + endif + ifeq ($(CXX),g++) + # work around GNU Make default value + CXX := $(CC) + endif + CFLAG_O := -Fo +endif +ifdef WIN32 + EXT_CXX := cpp + EXE := .exe +endif + +ifndef EXT_OBJ + EXT_OBJ := o +endif +ifndef EXT_LIB + EXT_LIB := a +endif +ifndef EXT_CXX + EXT_CXX := cc +endif +ifndef EXE + EXE := # empty +endif +ifndef CFLAG_O + CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! +endif + +export CC +export CXX +export CFLAGS +export CXXFLAGS +export LDFLAGS + +BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) +NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) +TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) + +ifndef OCAMLC + OCAMLC := ocamlc +endif + +export OCAMLC + +ifndef OCAMLOPT + OCAMLOPT := ocamlopt +endif + +export OCAMLOPT + +ifndef OCAMLMKTOP + OCAMLMKTOP := ocamlmktop +endif + +export OCAMLMKTOP + +ifndef OCAMLCP + OCAMLCP := ocamlcp +endif + +export OCAMLCP + +ifndef OCAMLDEP + OCAMLDEP := ocamldep +endif + +export OCAMLDEP + +ifndef OCAMLLEX + OCAMLLEX := ocamllex +endif + +export OCAMLLEX + +ifndef OCAMLYACC + OCAMLYACC := ocamlyacc +endif + +export OCAMLYACC + +ifndef CAMELEON_REPORT + CAMELEON_REPORT := report +endif + +ifndef CAMELEON_REPORT_FLAGS + CAMELEON_REPORT_FLAGS := +endif + +ifndef CAMELEON_ZOGGY + CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo +endif + +ifndef CAMELEON_ZOGGY_FLAGS + CAMELEON_ZOGGY_FLAGS := +endif + +ifndef CAMLIDL + CAMLIDL := camlidl +endif + +export CAMLIDL + +ifndef CAMLIDLDLL + CAMLIDLDLL := camlidldll +endif + +export CAMLIDLDLL + +ifndef NOIDLHEADER + MAYBE_IDL_HEADER := -header +endif + +export NOIDLHEADER + +ifndef CAMLP4 + CAMLP4 := camlp4 +endif + +export CAMLP4 + +ifndef OCAMLDOC + OCAMLDOC := ocamldoc +endif + +export OCAMLDOC + +ifndef LATEX + LATEX := latex +endif + +export LATEX + +ifndef DVIPS + DVIPS := dvips +endif + +export DVIPS + +ifndef PS2PDF + PS2PDF := ps2pdf +endif + +export PS2PDF + +ifndef OCAMLMAKEFILE + OCAMLMAKEFILE := OCamlMakefile +endif + +export OCAMLMAKEFILE + +ifndef OCAMLLIBPATH + OCAMLLIBPATH := \ + $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) +endif + +export OCAMLLIBPATH + +ifndef OCAML_LIB_INSTALL + OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib +endif + +export OCAML_LIB_INSTALL + +########################################################################### + +#################### change following sections only if +#################### you know what you are doing! + +# delete target files when a build command fails +.PHONY: .DELETE_ON_ERROR +.DELETE_ON_ERROR: + +# for pedants using "--warn-undefined-variables" +export MAYBE_IDL +export REAL_RESULT +export CAMLIDLFLAGS +export THREAD_FLAG +export RES_CLIB +export MAKEDLL + +SHELL := /bin/sh + +MLDEPDIR := ._d +BCDIDIR := ._bcdi +NCDIDIR := ._ncdi + +FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.c %.$(EXT_CXX) %.rep %.zog + +FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) +SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) + +FILTERED_REP := $(filter %.rep, $(FILTERED)) +DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) +AUTO_REP := $(FILTERED_REP:.rep=.ml) + +FILTERED_ZOG := $(filter %.zog, $(FILTERED)) +DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) +AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) + +FILTERED_ML := $(filter %.ml, $(FILTERED)) +DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) + +FILTERED_MLI := $(filter %.mli, $(FILTERED)) +DEP_MLI := $(FILTERED_MLI:.mli=.di) + +FILTERED_MLL := $(filter %.mll, $(FILTERED)) +DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) +AUTO_MLL := $(FILTERED_MLL:.mll=.ml) + +FILTERED_MLY := $(filter %.mly, $(FILTERED)) +DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) +AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) + +FILTERED_IDL := $(filter %.idl, $(FILTERED)) +DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) +C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) $(FILTERED_IDL:.idl=.h) +OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) +AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) + +FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) +OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) +OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) + +PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_ZOG) $(AUTO_REP) + +ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_ZOG) $(DEP_REP) + +MLDEPS := $(filter %.d, $(ALL_DEPS)) +MLIDEPS := $(filter %.di, $(ALL_DEPS)) +BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) +NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) + +ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.rep %.zog, $(FILTERED)) + +IMPLO_INTF := $(ALLML:%.mli=%.mli.__) +IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ + $(basename $(file)).cmi $(basename $(file)).cmo) +IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) +IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) + +IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) + +INTF := $(filter %.cmi, $(IMPLO_INTF)) +IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) +IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) + +OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) +OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) + +EXECS := $(addsuffix $(EXE), \ + $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) +ifdef WIN32 + EXECS += $(BCRESULT).dll $(NCRESULT).dll +endif + +CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) +ifneq ($(strip $(OBJ_LINK)),) + RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) +endif + +ifndef MSVC +DLLSONAME := dll$(CLIB_BASE).so +endif + +NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(OBJ_FILES) $(PRE_TARGETS) \ + $(BCRESULT).cma $(NCRESULT).cmxa $(NCRESULT).$(EXT_LIB) \ + $(BCRESULT).cmi $(BCRESULT).cmo \ + $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ + $(RES_CLIB) + +ifndef MSVC + NONEXECS += $(DLLSONAME) +endif + +ifndef LIBINSTALL_FILES + LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ + $(RESULT).cmxa $(RESULT).a $(RES_CLIB) +endif + +ifndef MSVC + LIBINSTALL_FILES += $(DLLSONAME) +endif + +export LIBINSTALL_FILES + +ifdef WIN32 + # some extra stuff is created while linking DLLs + NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp +endif + +TARGETS := $(EXECS) $(NONEXECS) + +# handle ocamlfind +ifdef USING_OCAMLFIND + PACKOPT := -pack +else + PACKOPT := -passopt "-pack" +endif + +# If there are IDL-files +ifneq ($(strip $(FILTERED_IDL)),) + MAYBE_IDL := -cclib -lcamlidl +endif + +ifdef USE_CAMLP4 + CAMLP4PATH := \ + $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) + INCFLAGS := -I $(CAMLP4PATH) + CINCFLAGS := -I$(CAMLP4PATH) +endif + +INCFLAGS += $(SOURCE_DIRS:%=-I %) $(INCDIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) +CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) +CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ + $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-R%) \ + $(OCAML_DEFAULT_DIRS:%=-L%) + +ifndef PROFILING + INTF_OCAMLC := $(OCAMLC) +else + ifndef THREADS + INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) + else + # OCaml does not support profiling byte code + # with threads (yet), therefore we force an error. + ifndef REAL_OCAMLC + $(error Profiling of multithreaded byte code not yet supported by OCaml) + endif + endif +endif + +ifndef MSVC + COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ + $(LIBDIRS:%=-ccopt -L%) \ + $(EXTLIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -R%) \ + $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) +else + # currenly MSVC-build ocamlc/ocamlopt cannot pass any option to C linker :-( + COMMON_LDFLAGS := +endif + +ifndef MSVC + CLIBS_OPTS := $(CLIBS:%=-cclib -l%) +else + # MSVC libraries do not have 'lib' prefix + CLIBS_OPTS := $(CLIBS:%=-ccopt %) +endif +ifneq ($(strip $(OBJ_LINK)),) + ifdef CREATE_LIB + OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) + else + OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) + endif +else + OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) +endif + +# If we have to make byte-code +ifndef REAL_OCAMLC + # EXTRADEPS is added dependencies we have to insert for all + # executable files we generate. Ideally it should be all of the + # libraries we use, but it's hard to find the ones that get searched on + # the path since I don't know the paths built into the compiler, so + # just include the ones with slashes in their names. + EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) + + REAL_OCAMLC := $(INTF_OCAMLC) + + REAL_IMPL := $(IMPL_CMO) + REAL_IMPL_INTF := $(IMPLO_INTF) + IMPL_SUF := .cmo + + DEPFLAGS := + MAKE_DEPS := $(MLDEPS) $(BCDEPIS) + + ifdef CREATE_LIB + ifndef STATIC + ifneq ($(strip $(OBJ_LINK)),) + MAKEDLL := $(DLLSONAME) + ALL_LDFLAGS := -dllib $(DLLSONAME) + endif + endif + endif + + ifndef NO_CUSTOM + ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" + ALL_LDFLAGS += -custom + endif + endif + + ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ + $(COMMON_LDFLAGS) $(LIBS:%=%.cma) + CAMLIDLDLLFLAGS := + + ifdef THREADS + ALL_LDFLAGS := -thread $(ALL_LDFLAGS) + ifndef CREATE_LIB + ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) + endif + THREAD_FLAG := -thread + endif + +# we have to make native-code +else + EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) + ifndef PROFILING + SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) + PLDFLAGS := + else + SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) + PLDFLAGS := -p + endif + + REAL_IMPL := $(IMPL_CMX) + REAL_IMPL_INTF := $(IMPLX_INTF) + IMPL_SUF := .cmx + + CFLAGS := -DNATIVE_CODE $(CFLAGS) + + DEPFLAGS := -native + MAKE_DEPS := $(MLDEPS) $(NCDEPIS) + + ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ + $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) + CAMLIDLDLLFLAGS := -opt + + ifndef CREATE_LIB + ALL_LDFLAGS += $(LIBS:%=%.cmxa) + endif + + ifdef THREADS + ALL_LDFLAGS := -thread $(ALL_LDFLAGS) + ifndef CREATE_LIB + ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) + endif + THREAD_FLAG := -thread + endif +endif + +export MAKE_DEPS + +ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(OCAMLFLAGS) \ + $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) + +ifdef make_deps + -include $(MAKE_DEPS) + PRE_TARGETS := +endif + +########################################################################### +# USER RULES + +# Call "OCamlMakefile QUIET=" to get rid of all of the @'s. +QUIET=@ + +# generates byte-code (default) +byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bc: byte-code + +byte-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(BCRESULT)" make_deps=yes +bcnl: byte-code-nolink + +top: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes + +# generates native-code + +native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +nc: native-code + +native-code-nolink: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncnl: native-code-nolink + +# generates byte-code libraries +byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" \ + CREATE_LIB=yes \ + make_deps=yes +bcl: byte-code-library + +# generates native-code libraries +native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +ncl: native-code-library + +ifdef WIN32 +# generates byte-code dll +byte-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).dll \ + REAL_RESULT="$(BCRESULT)" \ + make_deps=yes +bcd: byte-code-dll + +# generates native-code dll +native-code-dll: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).dll \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + make_deps=yes +ncd: native-code-dll +endif + +# generates byte-code with debugging information +debug-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dc: debug-code + +# generates byte-code libraries with debugging information +debug-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" make_deps=yes \ + CREATE_LIB=yes \ + OCAMLFLAGS="-g $(OCAMLFLAGS)" \ + OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" +dcl: debug-code-library + +# generates byte-code for profiling +profiling-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + make_deps=yes +pbc: profiling-byte-code + +# generates native-code + +profiling-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PROFILING="y" \ + make_deps=yes +pnc: profiling-native-code + +# generates byte-code libraries +profiling-byte-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(BCRESULT).cma \ + REAL_RESULT="$(BCRESULT)" PROFILING="y" \ + CREATE_LIB=yes \ + make_deps=yes +pbcl: profiling-byte-code-library + +# generates native-code libraries +profiling-native-code-library: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(RES_CLIB) $(NCRESULT).cmxa \ + REAL_RESULT="$(NCRESULT)" PROFILING="y" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + CREATE_LIB=yes \ + make_deps=yes +pncl: profiling-native-code-library + +# packs byte-code objects +pack-byte-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ + REAL_RESULT="$(BCRESULT)" \ + PACK_LIB=yes make_deps=yes +pabc: pack-byte-code + +# packs native-code objects +pack-native-code: $(PRE_TARGETS) + $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ + $(NCRESULT).cmx $(NCRESULT).o \ + REAL_RESULT="$(NCRESULT)" \ + REAL_OCAMLC="$(OCAMLOPT)" \ + PACK_LIB=yes make_deps=yes +panc: pack-native-code + +# generates HTML-documentation +htdoc: doc/html + +# generates Latex-documentation +ladoc: doc/latex + +# generates PostScript-documentation +psdoc: doc/latex/doc.ps + +# generates PDF-documentation +pdfdoc: doc/latex/doc.pdf + +# generates all supported forms of documentation +doc: htdoc ladoc psdoc pdfdoc + +########################################################################### +# LOW LEVEL RULES + +$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(REAL_OCAMLC) $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ + $(REAL_IMPL) +ifdef MSVC +# work around the bug in ocamlc -- it should delete this file itself + rm -f camlprim?.$(EXT_OBJ) +endif + +nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) + +ifdef WIN32 +$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) + $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ + -o $@ $(REAL_IMPL) +endif + +%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(OCAMLMKTOP) $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ + $(REAL_IMPL) +ifdef MSVC +# work around the bug in ocamltop -- it should delete this file itself + rm -f camlprim?.$(EXT_OBJ) +endif + +.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ + .mly .di .d .$(EXT_LIB) .idl .c .$(EXT_CXX) .h .so \ + .rep .zog +ifndef MSVC +$(DLLSONAME): $(OBJ_LINK) + $(CC) -shared $(CINCFLAGS) $(CLIBFLAGS) \ + -o $@ $(OBJ_LINK) $(CLIBS:%=-l%) +endif + +$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) + $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) + +$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) + $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ + $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) + +$(RES_CLIB): $(OBJ_LINK) +ifndef MSVC + ifneq ($(strip $(OBJ_LINK)),) + ar rc $@ $(OBJ_LINK) + ranlib $@ + endif +else + ifneq ($(strip $(OBJ_LINK)),) + lib /nologo /debugtype:cv /out:$(RES_CLIB) $(OBJ_LINK) + endif +endif + +.mli.cmi: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(INTF_OCAMLC) -c $(THREAD_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(INTF_OCAMLC) -c $(THREAD_FLAG) $(OCAMLFLAGS) \ + $(INCFLAGS) $<; \ + else \ + echo $(INTF_OCAMLC) -c -pp \"$$pp\" $(THREAD_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + $(INTF_OCAMLC) -c -pp "$$pp" $(THREAD_FLAG) \ + $(OCAMLFLAGS) $(INCFLAGS) $<; \ + fi + +.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) + $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + echo $(REAL_OCAMLC) -c $(ALL_OCAMLCFLAGS) $<; \ + $(REAL_OCAMLC) -c $(ALL_OCAMLCFLAGS) $<; \ + else \ + echo $(REAL_OCAMLC) -c -pp \"$$pp\" \ + $(ALL_OCAMLCFLAGS) $<; \ + $(REAL_OCAMLC) -c -pp "$$pp" $(ALL_OCAMLCFLAGS) $<; \ + fi + +ifdef PACK_LIB +$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) + $(REAL_OCAMLC) $(PACKOPT) $(ALL_LDFLAGS) \ + $(OBJS_LIBS) -o $@ $(REAL_IMPL) +endif + +.PRECIOUS: %.ml +%.ml: %.mll + $(OCAMLLEX) $< + +.PRECIOUS: %.ml %.mli +%.ml %.mli: %.mly + $(OCAMLYACC) $(YFLAGS) $< + +.PRECIOUS: %.ml +%.ml : %.rep + $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< + +.PRECIOUS: %.ml +%.ml : %.zog + $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ + +.PRECIOUS: %.ml %.mli %_stubs.c %.h +%.ml %.mli %_stubs.c %.h: %.idl + $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ + $(CAMLIDLFLAGS) $< + $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi + +.c.$(EXT_OBJ): + $(CC) -c $(CFLAGS) $(CINCFLAGS) -I$(OCAMLLIBPATH) \ + $< $(CFLAG_O)$@ + +.$(EXT_CXX).$(EXT_OBJ): + $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) -I$(OCAMLLIBPATH) \ + $< $(CFLAG_O)$@ + +$(MLDEPDIR)/%.d: %.ml + $(QUIET)echo making $@ from $< + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(OCAMLDEP) $(INCFLAGS) $< > $@; \ + else \ + $(OCAMLDEP) -pp "$$pp" $(INCFLAGS) $< > $@; \ + fi + +$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli + $(QUIET)echo making $@ from $< + $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi + $(QUIET)pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ + if [ -z "$$pp" ]; then \ + $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< > $@; \ + else \ + $(OCAMLDEP) $(DEPFLAGS) \ + -pp "$$pp" $(INCFLAGS) $< > $@; \ + fi + +doc/html: $(DOC_FILES) + rm -rf $@ + mkdir -p $@ + $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) + +doc/latex: $(DOC_FILES) + rm -rf $@ + mkdir -p $@ + $(OCAMLDOC) -latex -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) -o doc.tex + +doc/latex/doc.ps: doc/latex + cd doc/latex && \ + $(LATEX) doc.tex && \ + $(LATEX) doc.tex && \ + $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) + +doc/latex/doc.pdf: doc/latex/doc.ps + cd doc/latex && $(PS2PDF) $(<F) + +########################################################################### +# (UN)INSTALL RULES FOR LIBRARIES + +.PHONY: libinstall +libinstall: all + $(QUIET)printf "\nInstalling library to: $(OCAML_LIB_INSTALL)\n" + -install -d $(OCAML_LIB_INSTALL) + for i in $(LIBINSTALL_FILES); do \ + if [ -f $$i ]; then \ + install -c -m 0644 $$i $(OCAML_LIB_INSTALL); \ + fi; \ + done + $(QUIET)printf "\nInstallation successful.\n" + +.PHONY: libuninstall +libuninstall: + $(QUIET)printf "\nUninstalling library from: $(OCAML_LIB_INSTALL)\n" + cd $(OCAML_LIB_INSTALL); rm $(notdir $(LIBINSTALL_FILES)) + $(QUIET)printf "\nUninstallation successful.\n" + +########################################################################### +# MAINTAINANCE RULES + +.PHONY: clean +clean: + rm -f $(TARGETS) $(TRASH) + rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR) + +.PHONY: cleanup +cleanup: + rm -f $(NONEXECS) $(TRASH) + rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR) + +.PHONY: clean-doc +clean-doc: + rm -rf doc + +.PHONY: nobackup +nobackup: + rm -f *.bak *~ *.dup diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml index f600e01..45e6ec1 100644 --- a/perl_checker.src/common.ml +++ b/perl_checker.src/common.ml @@ -16,6 +16,11 @@ let id x = x let double a = a,a let swap (x,y) = (y,x) let safe_tl l = try tl l with _ -> [] +let fstfst ((e, _), _) = e +let sndfst ((_, e), _) = e +let fstsnd (_, (e, _)) = e +let sndsnd (_, (_, e)) = e + let o f g x = f (g x) let curry f x y = f (x,y) diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli index ccf6587..ec9c8ce 100644 --- a/perl_checker.src/common.mli +++ b/perl_checker.src/common.mli @@ -8,6 +8,10 @@ val id : 'a -> 'a val double : 'a -> 'a * 'a val swap : 'a * 'b -> 'b * 'a val safe_tl : 'a list -> 'a list +val fstfst : ('a * 'b) * 'c -> 'a +val sndfst : ('a * 'b) * 'c -> 'b +val fstsnd : 'a * ('b * 'c) -> 'b +val sndsnd : 'a * ('b * 'c) -> 'c val o : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index d25e63c..4e19647 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -37,10 +37,10 @@ type raw_token = | NEW of (raw_pos) | FORMAT of (raw_pos) | AT of raw_pos | DOLLAR of raw_pos | PERCENT of raw_pos | AMPERSAND of raw_pos | STAR of raw_pos | ARRAYLEN of raw_pos | SEMI_COLON of raw_pos | PKG_SCOPE of raw_pos | PAREN of raw_pos | PAREN_END of raw_pos | BRACKET of raw_pos | BRACKET_END of raw_pos | BRACKET_HASHREF of raw_pos | ARRAYREF of raw_pos | ARRAYREF_END of raw_pos | ARROW of raw_pos | INCR of raw_pos | DECR of raw_pos - | POWER of raw_pos | TIGHT_NOT of raw_pos | BIT_NEG of raw_pos | REF of raw_pos | PATTERN_MATCH of raw_pos | PATTERN_MATCH_NOT of raw_pos | MULT of raw_pos - | DIVISION of raw_pos | MODULO of raw_pos | REPLICATE of raw_pos | PLUS of raw_pos | MINUS of raw_pos | CONCAT of raw_pos | BIT_SHIFT_LEFT of raw_pos - | BIT_SHIFT_RIGHT of raw_pos | LT of raw_pos | GT of raw_pos | COMPARE_OP of (string * raw_pos) | EQ_OP of (string * raw_pos) - | BIT_AND of raw_pos | BIT_OR of raw_pos | BIT_XOR of raw_pos | AND_TIGHT of raw_pos | OR_TIGHT of raw_pos | DOTDOT of raw_pos | DOTDOTDOT of raw_pos + | POWER of raw_pos | TIGHT_NOT of raw_pos | BIT_NEG of raw_pos | REF of raw_pos | DEFINED of raw_pos | PATTERN_MATCH of raw_pos | PATTERN_MATCH_NOT of raw_pos | MULT of (string * raw_pos) + | PLUS of (string * raw_pos) | BIT_SHIFT of (string * raw_pos) + | LT of raw_pos | GT of raw_pos | COMPARE_OP of (string * raw_pos) | EQ_OP of (string * raw_pos) + | BIT_AND of raw_pos | BIT_OR of raw_pos | BIT_XOR of raw_pos | AND_TIGHT of raw_pos | OR_TIGHT of raw_pos | DOTDOT of (string * raw_pos) | QUESTION_MARK of raw_pos | COLON of raw_pos | ASSIGN of (string * raw_pos) | COMMA of raw_pos | RIGHT_ARROW of raw_pos | NOT of raw_pos | AND of raw_pos | OR of raw_pos | XOR of raw_pos let saved_token = ref None @@ -111,6 +111,11 @@ let rec concat_spaces get_token lexbuf = | ASSIGN(s, pos) -> Parser.ASSIGN(s, (spaces, pos)) | FOR(s, pos) -> Parser.FOR(s, (spaces, pos)) + | DOTDOT(s, pos) -> Parser.DOTDOT(s, (spaces, pos)) + | MULT(s, pos) -> Parser.MULT(s, (spaces, pos)) + | BIT_SHIFT(s, pos) -> Parser.BIT_SHIFT(s, (spaces, pos)) + | PLUS(s, pos) -> Parser.PLUS(s, (spaces, pos)) + | EOF (pos) -> Parser.EOF ((), (spaces, pos)) | IF (pos) -> Parser.IF ((), (spaces, pos)) | ELSIF (pos) -> Parser.ELSIF ((), (spaces, pos)) @@ -151,15 +156,6 @@ let rec concat_spaces get_token lexbuf = | REF (pos) -> Parser.REF ((), (spaces, pos)) | PATTERN_MATCH (pos) -> Parser.PATTERN_MATCH ((), (spaces, pos)) | PATTERN_MATCH_NOT(pos) -> Parser.PATTERN_MATCH_NOT((), (spaces, pos)) - | MULT (pos) -> Parser.MULT ((), (spaces, pos)) - | DIVISION (pos) -> Parser.DIVISION ((), (spaces, pos)) - | MODULO (pos) -> Parser.MODULO ((), (spaces, pos)) - | REPLICATE (pos) -> Parser.REPLICATE ((), (spaces, pos)) - | PLUS (pos) -> Parser.PLUS ((), (spaces, pos)) - | MINUS (pos) -> Parser.MINUS ((), (spaces, pos)) - | CONCAT (pos) -> Parser.CONCAT ((), (spaces, pos)) - | BIT_SHIFT_LEFT (pos) -> Parser.BIT_SHIFT_LEFT ((), (spaces, pos)) - | BIT_SHIFT_RIGHT (pos) -> Parser.BIT_SHIFT_RIGHT ((), (spaces, pos)) | LT (pos) -> Parser.LT ((), (spaces, pos)) | GT (pos) -> Parser.GT ((), (spaces, pos)) | BIT_AND (pos) -> Parser.BIT_AND ((), (spaces, pos)) @@ -167,8 +163,6 @@ let rec concat_spaces get_token lexbuf = | BIT_XOR (pos) -> Parser.BIT_XOR ((), (spaces, pos)) | AND_TIGHT (pos) -> Parser.AND_TIGHT ((), (spaces, pos)) | OR_TIGHT (pos) -> Parser.OR_TIGHT ((), (spaces, pos)) - | DOTDOT (pos) -> Parser.DOTDOT ((), (spaces, pos)) - | DOTDOTDOT (pos) -> Parser.DOTDOTDOT ((), (spaces, pos)) | QUESTION_MARK (pos) -> Parser.QUESTION_MARK ((), (spaces, pos)) | COLON (pos) -> Parser.COLON ((), (spaces, pos)) | COMMA (pos) -> Parser.COMMA ((), (spaces, pos)) @@ -177,6 +171,7 @@ let rec concat_spaces get_token lexbuf = | AND (pos) -> Parser.AND ((), (spaces, pos)) | OR (pos) -> Parser.OR ((), (spaces, pos)) | XOR (pos) -> Parser.XOR ((), (spaces, pos)) + | DEFINED (pos) -> Parser.DEFINED ((), (spaces, pos)) | SPACE _ | CR -> internal_error "raw_token_to_token" @@ -311,14 +306,14 @@ rule token = parse | "~" { BIT_NEG(pos lexbuf) } | "=~" { PATTERN_MATCH(pos lexbuf) } | "!~" { PATTERN_MATCH_NOT(pos lexbuf) } -| "*" { MULT(pos lexbuf) } -| "%" { MODULO(pos lexbuf) } -| "x" { REPLICATE(pos lexbuf) } -| "+" { PLUS(pos lexbuf) } -| "-" { MINUS(pos lexbuf) } -| "." { CONCAT(pos lexbuf) } -| "<<" { BIT_SHIFT_LEFT(pos lexbuf) } -| ">>" { BIT_SHIFT_RIGHT(pos lexbuf) } +| "*" { MULT(lexeme lexbuf, pos lexbuf) } +| "%" { MULT(lexeme lexbuf, pos lexbuf) } +| "x" { MULT(lexeme lexbuf, pos lexbuf) } +| "+" { PLUS(lexeme lexbuf, pos lexbuf) } +| "-" { PLUS(lexeme lexbuf, pos lexbuf) } +| "." { PLUS(lexeme lexbuf, pos lexbuf) } +| "<<" { BIT_SHIFT(lexeme lexbuf, pos lexbuf) } +| ">>" { BIT_SHIFT(lexeme lexbuf, pos lexbuf) } | "<" { LT(pos lexbuf) } | ">" { GT(pos lexbuf) } | "<=" | ">=" | "lt" | "gt" | "le" | "ge" { COMPARE_OP(lexeme lexbuf, pos lexbuf) } @@ -328,8 +323,8 @@ rule token = parse | "^" { BIT_XOR(pos lexbuf) } | "&&" { AND_TIGHT(pos lexbuf) } | "||" { OR_TIGHT(pos lexbuf) } -| ".." { DOTDOT(pos lexbuf) } -| "..." { DOTDOTDOT(pos lexbuf) } +| ".." { DOTDOT(lexeme lexbuf, pos lexbuf) } +| "..." { DOTDOT(lexeme lexbuf, pos lexbuf) } | "?" { QUESTION_MARK(pos lexbuf) } | ":" { COLON(pos lexbuf) } | "::" { PKG_SCOPE(pos lexbuf) } @@ -363,6 +358,7 @@ rule token = parse | "print" { PRINT(lexeme lexbuf, pos lexbuf) } | "new" { NEW(pos lexbuf) } | "format" { let _ = here_doc_next_line "." false in FORMAT(pos lexbuf) } +| "defined" { DEFINED(pos lexbuf) } | "split" | "grep" { (* ok_for_match! *) BAREWORD(lexeme lexbuf, pos lexbuf) } @@ -394,7 +390,7 @@ rule token = parse | '$' '#' { ARRAYLEN(pos lexbuf) } | '%' ['$' '{'] { putback lexbuf 1; PERCENT(pos lexbuf) } | '&' ['$' '{'] { putback lexbuf 1; AMPERSAND(pos lexbuf) } -| '*' ['$' '{'] { putback lexbuf 1; if lexeme_start lexbuf = !not_ok_for_match then MULT(pos lexbuf) else STAR(pos lexbuf) } +| '*' ['$' '{'] { putback lexbuf 1; if lexeme_start lexbuf = !not_ok_for_match then MULT("*", pos lexbuf) else STAR(pos lexbuf) } | ';' { SEMI_COLON(pos lexbuf) } @@ -407,7 +403,7 @@ rule token = parse | ']' { not_ok_for_match := lexeme_end lexbuf; ARRAYREF_END(pos lexbuf) } | "/" { - if lexeme_start lexbuf = !not_ok_for_match then DIVISION(pos lexbuf) + if lexeme_start lexbuf = !not_ok_for_match then MULT("/", pos lexbuf) else ( delimit_char := '/' ; current_string_start_line := !current_file_current_line; diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly index 20d9229..8352c97 100644 --- a/perl_checker.src/parser.mly +++ b/perl_checker.src/parser.mly @@ -8,7 +8,7 @@ %} -%token <unit * (Types.spaces * Types.raw_pos)> EOF +%token <unit * (Types.spaces * Types.raw_pos)> EOF DEFINED %token <string * (Types.spaces * Types.raw_pos)> NUM STRING BAREWORD BAREWORD_PAREN REVISION COMMENT POD LABEL PRINT_TO_STAR PRINT_TO_SCALAR %token <string * (Types.spaces * Types.raw_pos)> COMMAND_STRING QUOTEWORDS COMPACT_HASH_SUBSCRIPT @@ -37,15 +37,15 @@ %token <unit * (Types.spaces * Types.raw_pos)> POWER %token <unit * (Types.spaces * Types.raw_pos)> TIGHT_NOT BIT_NEG REF %token <unit * (Types.spaces * Types.raw_pos)> PATTERN_MATCH PATTERN_MATCH_NOT -%token <unit * (Types.spaces * Types.raw_pos)> MULT DIVISION MODULO REPLICATE -%token <unit * (Types.spaces * Types.raw_pos)> PLUS MINUS CONCAT -%token <unit * (Types.spaces * Types.raw_pos)> BIT_SHIFT_LEFT BIT_SHIFT_RIGHT +%token <string * (Types.spaces * Types.raw_pos)> MULT +%token <string * (Types.spaces * Types.raw_pos)> PLUS +%token <string * (Types.spaces * Types.raw_pos)> BIT_SHIFT %token <unit * (Types.spaces * Types.raw_pos)> LT GT %token <unit * (Types.spaces * Types.raw_pos)> BIT_AND %token <unit * (Types.spaces * Types.raw_pos)> BIT_OR BIT_XOR %token <unit * (Types.spaces * Types.raw_pos)> AND_TIGHT %token <unit * (Types.spaces * Types.raw_pos)> OR_TIGHT -%token <unit * (Types.spaces * Types.raw_pos)> DOTDOT DOTDOTDOT +%token <string * (Types.spaces * Types.raw_pos)> DOTDOT %token <unit * (Types.spaces * Types.raw_pos)> QUESTION_MARK COLON %token <unit * (Types.spaces * Types.raw_pos)> COMMA RIGHT_ARROW %token <unit * (Types.spaces * Types.raw_pos)> NOT @@ -63,7 +63,7 @@ %right ASSIGN %right QUESTION_MARK COLON -%nonassoc DOTDOT DOTDOTDOT +%nonassoc DOTDOT %left OR_TIGHT %left AND_TIGHT %left BIT_OR BIT_XOR @@ -71,9 +71,9 @@ %nonassoc EQ_OP %nonassoc LT GT COMPARE_OP %nonassoc UNIOP -%left BIT_SHIFT_LEFT BIT_SHIFT_RIGHT -%left PLUS MINUS CONCAT -%left MULT DIVISION MODULO REPLICATE +%left BIT_SHIFT +%left PLUS +%left MULT %left PATTERN_MATCH PATTERN_MATCH_NOT %right TIGHT_NOT BIT_NEG REF UNARY_MINUS %right POWER @@ -85,13 +85,13 @@ %left ARRAYREF BRACKET %type <Types.fromparser list> prog -%type <Types.fromparser * (Types.spaces * Types.raw_pos)> expr +%type <(Types.priority * Types.fromparser) * (Types.spaces * Types.raw_pos)> expr %start prog %% -prog: lines EOF { fst $1 } +prog: lines EOF {check_package (fst $1); fst $1} lines: /* A collection of "lines" in the program */ | {[], (Space_none, bpos)} @@ -108,23 +108,23 @@ line: | BRACKET lines BRACKET_END {sp_p($2); sp_p($3); Block(fst $2), snd $1} if_then_else: /* Real conditional expressions */ -| IF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); Call_op("if", fst $3 :: Block(fst $6) :: fst $8 @ fst $9), snd $1} -| UNLESS PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); Call_op("unless", fst $3 :: Block(fst $6) :: fst $8 @ fst $9), snd $1} +| IF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); Call_op("if", prio_lo P_loose $3 :: Block(fst $6) :: fst $8 @ fst $9), snd $1} +| UNLESS PAREN expr PAREN_END BRACKET lines BRACKET_END elsif else_ {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); Call_op("unless", prio_lo P_loose $3 :: Block(fst $6) :: fst $8 @ fst $9), snd $1} elsif: | {[], (Space_none, bpos)} -| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); fst $3 :: Block(fst $6) :: fst $8, snd $1} +| ELSIF PAREN expr PAREN_END BRACKET lines BRACKET_END elsif {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); prio_lo P_loose $3 :: Block(fst $6) :: fst $8, snd $1} else_: | { [], (Space_none, bpos) } | ELSE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); sp_p($3); sp_p($4); [ Block(fst $3) ], snd $1 } loop: -| WHILE PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); Call_op("while", fst $3 :: fst $6), snd $1} -| UNTIL PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); Call_op("until", fst $3 :: fst $6), snd $1} -| FOR MY SCALAR_IDENT PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); check_foreach($1); sp_n($4); sp_0($5); sp_0_or_cr($6); sp_p($7); sp_p($8); sp_p($9); Call_op("foreach my", to_Ident $3 :: fst $5 :: fst $8), snd $1} +| WHILE PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); Call_op("while", prio_lo P_loose $3 :: fst $6), snd $1} +| UNTIL PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); Call_op("until", prio_lo P_loose $3 :: fst $6), snd $1} +| FOR MY SCALAR_IDENT PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); check_foreach($1); sp_n($4); sp_0($5); sp_0_or_cr($6); sp_p($7); sp_p($8); sp_p($9); Call_op("foreach my", to_Ident $3 :: prio_lo P_loose $5 :: fst $8), snd $1} | FOR SCALAR_IDENT PAREN expr PAREN_END BRACKET lines BRACKET_END cont { die_rule "don't use for without \"my\"ing the iteration variable" } -| FOR PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); check_foreach($1); Call_op("foreach", fst $3 :: fst $6), snd $1} +| FOR PAREN expr PAREN_END BRACKET lines BRACKET_END cont {sp_p($1); sp_n($2); sp_0($3); sp_0_or_cr($4); sp_p($5); sp_p($6); sp_p($7); check_foreach($1); Call_op("foreach", prio_lo P_loose $3 :: fst $6), snd $1} | FOR PAREN expr_or_empty semi_colon expr_or_empty semi_colon expr_or_empty PAREN_END BRACKET lines BRACKET_END {sp_p($1); sp_n($2); sp_0($3); check_for($1); Call_op("for", fst $3 :: fst $5 :: fst $7 :: fst $10), snd $1} cont: /* Continue blocks */ @@ -132,28 +132,28 @@ cont: /* Continue blocks */ | CONTINUE BRACKET lines BRACKET_END {sp_p($1); sp_n($2); sp_p($3); sp_p($4); (), snd $1} sideff: /* An expression which may have a side-effect */ -| expr {$1} -| expr IF expr {let f = "if" in sp_p($2); sp_p($3); check_no_paren f $3; Call_op(f ^ " infix", [ fst $1 ; fst $3 ]), snd $1} -| expr UNLESS expr {let f = "unless" in sp_p($2); sp_p($3); check_no_paren f $3; Call_op(f ^ " infix", [ fst $1 ; fst $3 ]), snd $1} -| expr WHILE expr {let f = "while" in sp_p($2); sp_p($3); check_no_paren f $3; Call_op(f ^ " infix", [ fst $1 ; fst $3 ]), snd $1} -| expr UNTIL expr {let f = "until" in sp_p($2); sp_p($3); check_no_paren f $3; Call_op(f ^ " infix", [ fst $1 ; fst $3 ]), snd $1} -| expr FOR expr {let f = "for" in sp_p($2); sp_p($3); check_foreach($2); check_no_paren f $3; Call_op(f ^ " infix", [ fst $1 ; fst $3 ]), snd $1} +| expr {sndfst $1, snd $1} +| expr IF expr {sp_p($2); sp_p($3); Call_op("if infix" , [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), snd $1} +| expr UNLESS expr {sp_p($2); sp_p($3); Call_op("unless infix", [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), snd $1} +| expr WHILE expr {sp_p($2); sp_p($3); Call_op("while infix" , [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), snd $1} +| expr UNTIL expr {sp_p($2); sp_p($3); Call_op("until infix" , [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), snd $1} +| expr FOR expr {sp_p($2); sp_p($3); check_foreach($2); Call_op("for infix" , [ prio_lo P_loose $1 ; prio_lo P_loose $3 ]), snd $1} decl: | FORMAT BAREWORD ASSIGN {Too_complex, snd $1} | FORMAT ASSIGN {Too_complex, snd $1} -| func_decl semi_colon {die_rule (if snd (fst $1) = "" then "there is no need to pre-declare in Perl!" else "please don't use prototype pre-declaration") } +| func_decl semi_colon {die_rule (if sndfst $1 = "" then "there is no need to pre-declare in Perl!" else "please don't use prototype pre-declaration") } | func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = fst $1 in sub_declaration (name, proto) [], snd $1} | func_decl BRACKET lines BRACKET_END {sp_n($2); check_lines_after_BRACKET($3); sp_p($4); sub_declaration (fst $1) (fst $3), snd $1} -| func_decl BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sub_declaration (fst $1) [Ref(I_hash, fst $4)], snd $1} -| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); sub_declaration (fst $1) [Ref(I_hash, fst $4)], snd $1} +| func_decl BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sub_declaration (fst $1) [Ref(I_hash, prio_lo P_loose $4)], snd $1} +| func_decl BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); sub_declaration (fst $1) [Ref(I_hash, prio_lo P_loose $4)], snd $1} | PACKAGE word semi_colon {sp_0_or_cr($1); sp_1($2); Package(fst $2), snd $1} | BEGIN BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); sp_p($3); sp_p($4); Sub_declaration(Ident(None, "BEGIN", get_pos $1), "", fst $3), snd $1} | END BRACKET lines BRACKET_END {sp_0_or_cr($1); sp_1($2); sp_p($3); sp_p($4); Sub_declaration(Ident(None, "END", get_pos $1), "", fst $3), snd $1} | use {$1} use: -| use_word listexpr semi_colon {sp_n($2); Use(fst $1, fst $2), snd $1} +| use_word listexpr semi_colon {sp_n($2); Use(fst $1, sndfst $2), snd $1} use_word: | use_revision word comma {fst $2, snd $1} @@ -167,146 +167,176 @@ use_revision: func_decl: | SUB word {(fst $2, ""), snd $1} -| FUNC_DECL_WITH_PROTO {(Ident(None, fst(fst $1), get_pos $1), snd(fst $1)), snd $1} +| FUNC_DECL_WITH_PROTO {(Ident(None, fstfst $1, get_pos $1), sndfst $1), snd $1} listexpr: /* Basic list expressions */ -| %prec PREC_LOW {[], (Space_none, bpos)} +| %prec PREC_LOW {(P_tok, []), (Space_none, bpos)} | argexpr %prec PREC_LOW {$1} expr: /* Ordinary expressions; logical combinations */ -| expr AND expr {sp_p($2); sp_p($3); Call_op("and", [ fst $1; fst $3 ]), snd $1} -| expr OR expr {sp_p($2); sp_p($3); Call_op("or", [ fst $1; fst $3 ]), snd $1} -| argexpr %prec PREC_LOW {List(fst $1), snd $1} +| expr AND expr {sp_p($2); sp_p($3); (P_and, Call_op("and", [ prio_lo P_and $1; prio_lo_after P_and $3 ])), snd $1} +| expr OR expr {sp_p($2); sp_p($3); (P_or, Call_op("or", [ prio_lo P_or $1; prio_lo_after P_or $3 ])), snd $1} +| argexpr %prec PREC_LOW {(fstfst $1, List(sndfst $1)), snd $1} argexpr: /* Expressions are a list of terms joined by commas */ -| argexpr comma {fst $1, snd $1} -| argexpr comma term {if not_simple (fst $3) then sp_p($3); fst $1 @ [fst $3], snd $1} -| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); fst $1 @ [ Ref(I_hash, fst $4) ], snd $1} -| term %prec PREC_LOW {[fst $1], snd $1} +| argexpr comma {(P_comma, sndfst $1), snd $1} +| argexpr comma term {if not_simple (sndfst $3) then sp_p($3); (P_comma, sndfst $1 @ [sndfst $3]), snd $1} +| argexpr comma BRACKET expr BRACKET_END {sp_p($3); sp_p($5); (P_comma, sndfst $1 @ [ Ref(I_hash, sndfst $4) ]), snd $1} +| term %prec PREC_LOW {(fstfst $1, [sndfst $1]), snd $1} /********************************************************************************/ term: -| term binop term {call_op(fst $2, $3, [fst $1 ; fst $3]), snd $1} -| term binop BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op(fst $2, $3, [fst $1 ; Ref(I_hash, fst $4)]), snd $1} -| term LT term {sp_n($2); sp_p($3); Call_op("<", [fst $1 ; fst $3]), snd $1} -| term GT term {sp_n($2); sp_p($3); Call_op(">", [fst $1 ; fst $3]), snd $1} +| term ASSIGN term {let pri = P_assign in call_op(op_p pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term PLUS term {let pri = P_add in call_op(op pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term COMPARE_OP term {let pri = P_cmp in call_op(op_p pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term LT term {let pri = P_cmp in call_op(op_p pri "<" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term GT term {let pri = P_cmp in call_op(op_p pri ">" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term EQ_OP term {let pri = P_eq in call_op(op_p pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term POWER term {let pri = P_tight in call_op(op pri "**" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term BIT_AND term {let pri = P_expr in call_op(op_p pri "&" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term BIT_OR term {let pri = P_expr in call_op(op pri "|" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term BIT_XOR term {let pri = P_expr in call_op(op_p pri "^" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term AND_TIGHT term {let pri = P_tight_and in call_op(op_p pri "&&" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term OR_TIGHT term {let pri = P_tight_or in call_op(op_p pri "||" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term MULT term {let pri = P_mul in call_op(op pri (fst $2) $2, $3, [prio_lo_concat $1; prio_lo_after pri $3]), snd $1} +| term DOTDOT term {let pri = P_paren_wanted P_expr in call_op(op pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term BIT_SHIFT term {let pri = P_paren_wanted P_tight in call_op(op pri (fst $2) $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} +| term XOR term {let pri = P_paren_wanted P_expr in call_op(op_p pri "xor" $2, $3, [prio_lo pri $1; prio_lo_after pri $3]), snd $1} -| term PATTERN_MATCH PATTERN {sp_n($2); sp_p($3); Call_op("m//", fst $1 :: from_PATTERN $3), snd $1} -| term PATTERN_MATCH_NOT PATTERN {sp_n($2); sp_p($3); Call_op("!m//", fst $1 :: from_PATTERN $3), snd $1} -| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); Call_op("s///", fst $1 :: from_PATTERN_SUBST $3), snd $1} +| term ASSIGN BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op(op_p P_assign (fst $2) $2, $3, [prio_lo P_assign $1; Ref(I_hash, sndfst $4)]), snd $1} +| term AND_TIGHT BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op(op_p P_tight_and "&&" $2, $3, [prio_lo P_assign $1; Ref(I_hash, sndfst $4)]), snd $1} +| term OR_TIGHT BRACKET expr BRACKET_END {sp_p($3); sp_p($4); sp_p($5); call_op(op_p P_tight_or "||" $2, $3, [prio_lo P_assign $1; Ref(I_hash, sndfst $4)]), snd $1} -| term PATTERN_MATCH scalar { Too_complex, snd $1 } -| term PATTERN_MATCH_NOT scalar { Too_complex, snd $1 } -| term PATTERN_MATCH STRING {failwith (msg_with_pos (snd (snd $3)) "use a regexp, not a string")} -| term PATTERN_MATCH_NOT STRING {failwith (msg_with_pos (snd (snd $3)) "use a regexp, not a string")} +| term PATTERN_MATCH PATTERN {sp_n($2); sp_p($3); (P_expr, Call_op("m//", sndfst $1 :: from_PATTERN $3)), snd $1} +| term PATTERN_MATCH_NOT PATTERN {sp_n($2); sp_p($3); (P_expr, Call_op("!m//", sndfst $1 :: from_PATTERN $3)), snd $1} +| term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); (P_expr, Call_op("s///", sndfst $1 :: from_PATTERN_SUBST $3)), snd $1} + +| term PATTERN_MATCH scalar { (P_expr, Too_complex), snd $1 } +| term PATTERN_MATCH_NOT scalar { (P_expr, Too_complex), snd $1 } + +| term PATTERN_MATCH STRING {failwith (msg_with_pos (sndsnd $3) "use a regexp, not a string")} +| term PATTERN_MATCH_NOT STRING {failwith (msg_with_pos (sndsnd $3) "use a regexp, not a string")} + + +| term QUESTION_MARK term COLON term {sp_n($2); sp_p($3); sp_p($4); sp_p($5); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; prio_lo_after P_ternary $5])), snd $1} +| term QUESTION_MARK term COLON BRACKET expr BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; prio_lo_after P_ternary $3; sndfst $6])), snd $1} +| term QUESTION_MARK BRACKET expr BRACKET_END COLON term {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; sndfst $4; prio_lo_after P_ternary $7])), snd $1} +| term QUESTION_MARK BRACKET expr BRACKET_END COLON BRACKET expr BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); sp_p($7); sp_p($8); sp_p($9); (P_ternary, Call_op("?:", [ prio_lo P_ternary $1 ; sndfst $4; sndfst $8])), snd $1} + /* Unary operators and terms */ -| MINUS term %prec UNARY_MINUS {sp_0($2); Call_op("- unary", [fst $2]), snd $1} -| TIGHT_NOT term {Call_op("not", [fst $2]), snd $1} -| BIT_NEG term {Call_op("~", [fst $2]), snd $1} -| INCR term {sp_0($2); Call_op("++", [fst $2]), snd $1} -| DECR term {sp_0($2); Call_op("--", [fst $2]), snd $1} -| term INCR {sp_0($2); Call_op("++ post", [fst $1]), snd $1} -| term DECR {sp_0($2); Call_op("-- post", [fst $1]), snd $1} +| PLUS term %prec UNARY_MINUS {if fst $1 <> "-" then die_rule "syntax error"; sp_0($2); (P_tight, Call_op("- unary", [sndfst $2])), snd $1} +| TIGHT_NOT term {(P_tight, Call_op("not", [sndfst $2])), snd $1} +| BIT_NEG term {(P_expr, Call_op("~", [sndfst $2])), snd $1} +| INCR term {sp_0($2); (P_tight, Call_op("++", [sndfst $2])), snd $1} +| DECR term {sp_0($2); (P_tight, Call_op("--", [sndfst $2])), snd $1} +| term INCR {sp_0($2); (P_tight, Call_op("++ post", [sndfst $1])), snd $1} +| term DECR {sp_0($2); (P_tight, Call_op("-- post", [sndfst $1])), snd $1} + +| DEFINED scalar {(P_expr, Call(Ident(None, "defined", get_pos $1), [fst $2])), snd $1} +| DEFINED subscripted {(P_expr, Call(Ident(None, "defined", get_pos $1), [fst $2])), snd $1} +| DEFINED parenthesized {(P_expr, Call(Ident(None, "defined", get_pos $1), sndfst $2)), snd $1} +| DEFINED word_paren parenthesized {(P_expr, Call(Ident(None, "defined", get_pos $1), [Call(fst $2, sndfst $3)])), snd $1} -| NOT argexpr {Call_op("not", fst $2), snd $1} +| NOT argexpr {(P_and, Call_op("not", sndfst $2)), snd $1} /* Constructors for anonymous data */ -| ARRAYREF ARRAYREF_END {sp_0($2); Ref(I_array, List[]), snd $1} -| arrayref_start ARRAYREF_END {Ref(I_array, List(fst $1)), snd $1} -| arrayref_start expr ARRAYREF_END {Ref(I_array, List(fst $1 @ [fst $2])), snd $1} -| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {Ref(I_array, List(fst $1 @ [Ref(I_hash, fst $3)])), snd $1} +| ARRAYREF ARRAYREF_END {sp_0($2); (P_expr, Ref(I_array, List[])), snd $1} +| arrayref_start ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1))), snd $1} +| arrayref_start expr ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1 @ [sndfst $2]))), snd $1} +| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {(P_expr, Ref(I_array, List(fst $1 @ [Ref(I_hash, sndfst $3)]))), snd $1} -| BRACKET BRACKET_END {Ref(I_hash, List []), snd $1} /* empty hash */ -| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); Ref(I_hash, fst $2), snd $1} /* { foo => "Bar" } */ -| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); Anonymous_sub(Block[]), snd $1} -| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_lines_after_BRACKET($3); sp_p($4); Anonymous_sub(Block(fst $3)), snd $1} +| BRACKET BRACKET_END {(P_expr, Ref(I_hash, List [])), snd $1} /* empty hash */ +| BRACKET_HASHREF expr BRACKET_END %prec PREC_HIGH {sp_p($3); (P_expr, Ref(I_hash, sndfst $2)), snd $1} /* { foo => "Bar" } */ +| SUB BRACKET BRACKET_END %prec PREC_HIGH {sp_n($2); sp_0($3); (P_expr, Anonymous_sub(Block[])), snd $1} +| SUB BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_lines_after_BRACKET($3); sp_p($4); (P_expr, Anonymous_sub(Block(fst $3))), snd $1} -| termdo {$1} -| term question_mark_ colon_ { Call_op("?:", [ fst $1 ; fst $2; fst $3]), snd $1} -| REF term { Ref(I_scalar, fst $2), snd $1} /* \$x, \@y, \%z */ -| my %prec UNIOP {List(fst $1), snd $1} -| LOCAL term %prec UNIOP {sp_n($2); Local(fst $2), snd $1} +| termdo {(P_tok, fst $1), snd $1} +| REF term {(P_expr, Ref(I_scalar, sndfst $2)), snd $1} /* \$x, \@y, \%z */ +| my %prec UNIOP {(P_expr, List(fst $1)), snd $1} +| LOCAL term %prec UNIOP {sp_n($2); (P_expr, Local(sndfst $2)), snd $1} -| parenthesized {List(fst $1), snd $1} /* (1, 2) */ -| parenthesized arrayref {sp_0($2); Deref_with(I_array, List(fst $1), List(fst $2)), snd $1} /* list slice */ +| parenthesized {(fstfst $1, List(sndfst $1)), snd $1} /* (1, 2) */ +| parenthesized arrayref {sp_0($2); (P_tok, Deref_with(I_array, List(sndfst $1), List(fst $2))), snd $1} /* list slice */ -| variable {$1} +| variable {(P_tok, fst $1), snd $1} -| subscripted {$1} +| subscripted {(P_tok, fst $1), snd $1} -| array arrayref { Deref_with(I_array, fst $1, List(fst $2)), snd $1} /* array slice: @array[vals] */ -| array BRACKET expr BRACKET_END {sp_0($2); sp_0($3); sp_0($4); Deref_with(I_hash, array_ident_to_hash_ident $1, fst $3), snd $1} /* hash slice: @hash{@keys} */ +| array arrayref {(P_expr, Deref_with(I_array, fst $1, List(fst $2))), snd $1} /* array slice: @array[vals] */ +| array BRACKET expr BRACKET_END {sp_0($2); sp_0($3); sp_0($4); (P_expr, Deref_with(I_hash, array_ident_to_hash_ident $1, sndfst $3)), snd $1} /* hash slice: @hash{@keys} */ /* function_calls */ -| func parenthesized {sp_0($2); Call(fst $1, fst $2), snd $1} /* &foo(@args) */ -| word argexpr {check_parenthesized_first_argexpr (string_of_Ident (fst $1)) $2; Call(fst $1, fst $2), snd $1} /* foo $a, $b */ -| word_paren parenthesized {Call(fst $1, fst $2), snd $1} /* foo(@args) */ -| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_lines_after_BRACKET($3); sp_p($4); Call(fst $1, Anonymous_sub(Block(fst $3)) :: fst $5), snd $1} /* map { foo } @bar */ -| word BRACKET BRACKET expr BRACKET_END BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); Call(fst $1, Anonymous_sub(Ref(I_hash, fst $4)) :: fst $7), snd $1} /* map { { foo } } @bar */ -| word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); Call(fst $1, Anonymous_sub(Ref(I_hash, fst $4)) :: fst $8), snd $1} /* map { { foo }; } @bar */ - -| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); Method_call(fst $1, fst $3, fst $4), snd $1} /* $foo->bar(list) */ -| term ARROW word_or_scalar {sp_0($2); sp_0($3); Method_call(fst $1, fst $3, []), snd $1} /* $foo->bar */ - -| NEW word listexpr { Method_call(fst $2, Ident(None, "new", get_pos $1), fst $3), snd $1} /* new Class @args */ - -| PRINT { Call_op("print", var_STDOUT :: [ var_dollar_ ]), snd $1 } -| PRINT argexpr {check_parenthesized_first_argexpr (fst $1) $2; Call_op("print", var_STDOUT :: fst $2), snd $1 } -| PRINT_TO_STAR { Call_op("print", Deref(I_star, Ident(None, fst $1, get_pos $1)) :: [ var_dollar_ ]), snd $1 } -| PRINT_TO_STAR argexpr { Call_op("print", Deref(I_star, Ident(None, fst $1, get_pos $1)) :: fst $2), snd $1 } -| PRINT_TO_SCALAR { Call_op("print", var_STDOUT :: [ Deref(I_scalar, Ident(None, fst $1, get_pos $1)) ]), snd $1 } -| PRINT_TO_SCALAR argexpr { Call_op("print", Deref(I_scalar, Ident(None, fst $1, get_pos $1)) :: fst $2), snd $1 } - -| word {check_word_alone $1, snd $1} - -| NUM {Num(fst $1, get_pos $1), snd $1} -| STRING {to_String $1, snd $1} -| REVISION {to_String $1, snd $1} -| COMMAND_STRING {Call_op("``", [to_String $1]), snd $1} -| QUOTEWORDS {Call_op("qw", [to_String $1]), snd $1} -| HERE_DOC {String(fst!(fst $1), get_pos $1), snd $1} -| PATTERN {Call_op("m//", var_dollar_ :: from_PATTERN $1), snd $1} -| PATTERN_SUBST {Call_op("s///", var_dollar_ :: from_PATTERN_SUBST $1), snd $1} -| diamond {$1} +| func parenthesized {sp_0($2); (P_tok, call(fst $1, sndfst $2)), snd $1} /* &foo(@args) */ +| word argexpr {check_parenthesized_first_argexpr (string_of_Ident (fst $1)) $2; (P_call_no_paren, call(fst $1, sndfst $2)), snd $1} /* foo $a, $b */ +| word_paren parenthesized {(P_tok, call(fst $1, sndfst $2)), snd $1} /* foo(@args) */ +| word BRACKET lines BRACKET_END listexpr %prec LSTOP {sp_n($2); check_lines_after_BRACKET($3); sp_p($4); ((if sndfst $5 = [] then P_tok else P_call_no_paren), call(fst $1, Anonymous_sub(Block(fst $3)) :: sndfst $5)), snd $1} /* map { foo } @bar */ +| word BRACKET BRACKET expr BRACKET_END BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); ((if sndfst $7 = [] then P_tok else P_call_no_paren), call(fst $1, Anonymous_sub(Ref(I_hash, sndfst $4)) :: sndfst $7)), snd $1} /* map { { foo } } @bar */ +| word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); ((if sndfst $8 = [] then P_tok else P_call_no_paren), call(fst $1, Anonymous_sub(Ref(I_hash, sndfst $4)) :: sndfst $8)), snd $1} /* map { { foo }; } @bar */ + +| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); (P_tok, Method_callP(sndfst $1, fst $3, sndfst $4)), snd $1} /* $foo->bar(list) */ +| term ARROW word_or_scalar {sp_0($2); sp_0($3); (P_tok, Method_callP(sndfst $1, fst $3, [])), snd $1} /* $foo->bar */ + +| NEW word listexpr { (P_call_no_paren, Method_call(fst $2, Ident(None, "new", get_pos $1), sndfst $3)), snd $1} /* new Class @args */ + +| PRINT { (P_call_no_paren, Call_op("print", var_STDOUT :: [ var_dollar_ ])), snd $1 } +| PRINT argexpr {check_parenthesized_first_argexpr (fst $1) $2; (P_call_no_paren, Call_op("print", var_STDOUT :: sndfst $2)), snd $1 } +| PRINT_TO_STAR { (P_call_no_paren, Call_op("print", Deref(I_star, Ident(None, fst $1, get_pos $1)) :: [ var_dollar_ ])), snd $1 } +| PRINT_TO_STAR argexpr { (P_call_no_paren, Call_op("print", Deref(I_star, Ident(None, fst $1, get_pos $1)) :: sndfst $2)), snd $1 } +| PRINT_TO_SCALAR { (P_call_no_paren, Call_op("print", var_STDOUT :: [ Deref(I_scalar, Ident(None, fst $1, get_pos $1)) ])), snd $1 } +| PRINT_TO_SCALAR argexpr { (P_call_no_paren, Call_op("print", Deref(I_scalar, Ident(None, fst $1, get_pos $1)) :: sndfst $2)), snd $1 } + +| hash PKG_SCOPE {sp_0($2); (P_tok, Too_complex), snd $1} + +| word {(P_tok, check_word_alone $1), snd $1} + +| NUM {(P_tok, Num(fst $1, get_pos $1)), snd $1} +| STRING {(P_tok, to_String $1), snd $1} +| REVISION {(P_tok, to_String $1), snd $1} +| COMMAND_STRING {(P_expr, Call_op("``", [to_String $1])), snd $1} +| QUOTEWORDS {(P_tok, Call_op("qw", [to_String $1])), snd $1} +| HERE_DOC {(P_tok, String(fst!(fst $1), get_pos $1)), snd $1} +| PATTERN {(P_expr, Call_op("m//", var_dollar_ :: from_PATTERN $1)), snd $1} +| PATTERN_SUBST {(P_expr, Call_op("s///", var_dollar_ :: from_PATTERN_SUBST $1)), snd $1} +| diamond {(P_expr, fst $1), snd $1} diamond: | LT GT {sp_0($2); Call_op("<>", []), snd $1} -| LT term GT {sp_0($2); sp_0($3); Call_op("<>", [fst $2]), snd $1} +| LT term GT {sp_0($2); sp_0($3); Call_op("<>", [sndfst $2]), snd $1} subscripted: /* Some kind of subscripted expression */ | variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); Too_complex, snd $1} /* $foo::{something} */ | scalar bracket_subscript {sp_0($2); Deref_with(I_hash , fst $1, fst $2), snd $1} /* $foo{bar} */ | scalar arrayref {sp_0($2); Deref_with(I_array, fst $1, only_one $2), snd $1} /* $array[$element] */ -| term ARROW bracket_subscript {sp_0($2); sp_0($3); Deref_with(I_hash , fst $1, fst $3), snd $1} /* somehref->{bar} */ -| term ARROW arrayref {sp_0($2); sp_0($3); Deref_with(I_array, fst $1, only_one $3), snd $1} /* somearef->[$element] */ -| term ARROW parenthesized {sp_0($2); sp_0($3); Deref_with(I_func , fst $1, List(fst $3)), snd $1} /* $subref->(@args) */ +| term ARROW bracket_subscript {sp_0($2); sp_0($3); Deref_with(I_hash , sndfst $1, fst $3), snd $1} /* somehref->{bar} */ +| term ARROW arrayref {sp_0($2); sp_0($3); Deref_with(I_array, sndfst $1, only_one $3), snd $1} /* somearef->[$element] */ +| term ARROW parenthesized {sp_0($2); sp_0($3); Deref_with(I_func , sndfst $1, List(sndfst $3)), snd $1} /* $subref->(@args) */ | subscripted bracket_subscript {sp_0($2); Deref_with(I_hash , fst $1, fst $2), snd $1} /* $foo->[bar]{baz} */ | subscripted arrayref {sp_0($2); Deref_with(I_array, fst $1, only_one $2), snd $1} /* $foo->[$bar][$baz] */ -| subscripted parenthesized {sp_0($2); Deref_with(I_func , fst $1, List(fst $2)), snd $1} /* $foo->{bar}(@args) */ +| subscripted parenthesized {sp_0($2); Deref_with(I_func , fst $1, List(sndfst $2)), snd $1} /* $foo->{bar}(@args) */ arrayref: | arrayref_start ARRAYREF_END {sp_0($2); fst $1, snd $1} -| arrayref_start expr ARRAYREF_END {sp_0($3); fst $1 @ [fst $2], snd $1} -| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_p($2); sp_p($4); sp_0($5); fst $1 @ [Ref(I_hash, fst $3)], snd $1} +| arrayref_start expr ARRAYREF_END {sp_0($3); fst $1 @ [sndfst $2], snd $1} +| arrayref_start BRACKET expr BRACKET_END ARRAYREF_END {sp_p($2); sp_p($4); sp_0($5); fst $1 @ [Ref(I_hash, sndfst $3)], snd $1} parenthesized: -| parenthesized_start PAREN_END {sp_0_or_cr($2); fst $1, snd $1} -| parenthesized_start expr PAREN_END {sp_0_or_cr($3); fst $1 @ [fst $2], snd $1} -| parenthesized_start BRACKET expr BRACKET_END PAREN_END {sp_p($4); sp_0_or_cr($5); fst $1 @ [Ref(I_hash, fst $3)], snd $1} +| parenthesized_start PAREN_END {sp_0_or_cr($2); ((if fst $1 = [] then P_tok else P_paren P_comma), fst $1), snd $1} +| parenthesized_start expr PAREN_END {sp_0_or_cr($3); (P_paren(if fst $1 = [] then fstfst $2 else P_comma), fst $1 @ [sndfst $2]), snd $1} +| parenthesized_start BRACKET expr BRACKET_END PAREN_END {sp_p($4); sp_0_or_cr($5); (P_paren(if fst $1 = [] then P_expr else P_comma), fst $1 @ [Ref(I_hash, sndfst $3)]), snd $1} arrayref_start: | ARRAYREF {[], snd $1} -| arrayref_start BRACKET expr BRACKET_END comma {sp_p($2); sp_p($3); sp_p($4); fst $1 @ [Ref(I_hash, fst $3)], snd $1} +| arrayref_start BRACKET expr BRACKET_END comma {sp_p($2); sp_p($3); sp_p($4); fst $1 @ [Ref(I_hash, sndfst $3)], snd $1} parenthesized_start: | PAREN {[], snd $1} -| parenthesized_start BRACKET expr BRACKET_END comma {(if fst $1 = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); fst $1 @ [Ref(I_hash, fst $3)], snd $1} +| parenthesized_start BRACKET expr BRACKET_END comma {(if fst $1 = [] then sp_0_or_cr else sp_p)($2); sp_p($3); sp_p($4); fst $1 @ [Ref(I_hash, sndfst $3)], snd $1} my: /* Things that can be "my"'d */ -| MY parenthesized {List.map (fun e -> My e) (fst $2), snd $1} +| MY parenthesized {List.map (fun e -> My e) (sndfst $2), snd $1} | MY scalar {[My(fst $2)], snd $1} | MY hash {[My(fst $2)], snd $1} | MY array {[My(fst $2)], snd $1} @@ -315,31 +345,10 @@ termdo: /* Things called with "do" */ | DO term %prec UNIOP { die_rule "\"do EXPR\" not allowed" } /* do $filename */ | DO BRACKET lines BRACKET_END %prec PREC_HIGH {sp_n($2); check_lines_after_BRACKET($3); sp_p($4); Block(fst $3), snd $1} /* do { code */ -question_mark_: -| QUESTION_MARK term {sp_n($1); fst $2, snd $1} -| QUESTION_MARK BRACKET expr BRACKET_END {sp_n($1); sp_p($2); sp_p($4); Ref(I_hash, fst $3), snd $1} -colon_: -| COLON term {sp_p($1); fst $2, snd $1} -| COLON BRACKET expr BRACKET_END {sp_p($1); sp_p($2); sp_p($3); sp_p($4); Ref(I_hash, fst $3), snd $1} - bracket_subscript: | BRACKET expr BRACKET_END {sp_0($1); sp_0($2); sp_0($3); only_one_in_List $2, snd $1} | COMPACT_HASH_SUBSCRIPT {sp_0($1); to_String $1, snd $1} -binop: -| ASSIGN {op_p "=" $1, snd $1} -| POWER {op "**" $1, snd $1} -| MULT {op "*" $1, snd $1} | DIVISION {op "/" $1, snd $1} | MODULO {op "%" $1, snd $1} | REPLICATE {op_p "x" $1, snd $1} -| PLUS {op "+" $1, snd $1} | MINUS {op "-" $1, snd $1} | CONCAT {op "." $1, snd $1} -| BIT_SHIFT_LEFT {op "<<" $1, snd $1} | BIT_SHIFT_RIGHT {op ">>" $1, snd $1} -| COMPARE_OP {op_p (fst $1) $1, snd $1} -| EQ_OP {op_p (fst $1) $1, snd $1} -| BIT_AND {op_p "&" $1, snd $1} -| BIT_OR {op "|" $1, snd $1} | BIT_XOR {op_p "^" $1, snd $1} -| DOTDOT {op ".." $1, snd $1} | DOTDOTDOT {op_p "..." $1, snd $1} -| AND_TIGHT {op_p "&&" $1, snd $1} -| OR_TIGHT {op_p "||" $1, snd $1} | XOR {op_p "xor" $1, snd $1} - variable: | scalar %prec PREC_HIGH {$1} | star %prec PREC_HIGH {$1} @@ -371,10 +380,10 @@ word_paren: | RAW_IDENT_PAREN { to_Ident $1, snd $1 } arraylen: ARRAYLEN_IDENT {Deref(I_arraylen, to_Ident $1), snd $1} | ARRAYLEN scalar {sp_0($2); Deref(I_arraylen, fst $2), snd $1} | ARRAYLEN BRACKET lines BRACKET_END {sp_0($2); sp_same $3 $4; Deref(I_arraylen, Block(fst $3)), snd $1} -scalar: SCALAR_IDENT {Deref(I_scalar , to_Ident $1), snd $1} | DOLLAR scalar {sp_0($2); Deref(I_scalar , fst $2), snd $1} | DOLLAR BRACKET lines BRACKET_END {sp_0($2); sp_same $3 $4; Deref(I_scalar , Block(fst $3)), snd $1} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); Deref(I_scalar, Ref(I_hash, fst $4)), snd $1} +scalar: SCALAR_IDENT {Deref(I_scalar , to_Ident $1), snd $1} | DOLLAR scalar {sp_0($2); Deref(I_scalar , fst $2), snd $1} | DOLLAR BRACKET lines BRACKET_END {sp_0($2); sp_same $3 $4; Deref(I_scalar , Block(fst $3)), snd $1} | DOLLAR BRACKET BRACKET expr BRACKET_END BRACKET_END {sp_0($2); sp_0($3); sp_p($5); sp_0($6); Deref(I_scalar, Ref(I_hash, sndfst $4)), snd $1} func: FUNC_IDENT {Deref(I_func , to_Ident $1), snd $1} | AMPERSAND scalar {sp_0($2); Deref(I_func , fst $2), snd $1} | AMPERSAND BRACKET lines BRACKET_END {sp_0($2); sp_same $3 $4; Deref(I_func , Block(fst $3)), snd $1} array: ARRAY_IDENT {Deref(I_array , to_Ident $1), snd $1} | AT scalar {sp_0($2); Deref(I_array , fst $2), snd $1} | AT BRACKET lines BRACKET_END {sp_0($2); sp_same $3 $4; Deref(I_array , Block(fst $3)), snd $1} hash: HASH_IDENT {Deref(I_hash , to_Ident $1), snd $1} | PERCENT scalar {sp_0($2); Deref(I_hash , fst $2), snd $1} | PERCENT BRACKET lines BRACKET_END {sp_0($2); sp_same $3 $4; Deref(I_hash , Block(fst $3)), snd $1} star: STAR_IDENT {Deref(I_star , to_Ident $1), snd $1} | STAR scalar {sp_0($2); Deref(I_star , fst $2), snd $1} | STAR BRACKET lines BRACKET_END {sp_0($2); sp_same $3 $4; Deref(I_star , Block(fst $3)), snd $1} -expr_or_empty: {Block [], (Space_none, bpos)} | expr {$1} +expr_or_empty: {Block [], (Space_none, bpos)} | expr {sndfst $1, snd $1} diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml index 9cef1f8..4be59a0 100644 --- a/perl_checker.src/parser_helper.ml +++ b/perl_checker.src/parser_helper.ml @@ -1,12 +1,33 @@ open Types open Common +open Printf let bpos = -1, -1 +let raw_pos2pos(a, b) = !Info.current_file, a, b +let get_pos (_, (_, pos)) = raw_pos2pos pos +let var_dollar_ = Deref(I_scalar, Ident(None, "_", raw_pos2pos bpos)) +let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos)) -let not_complex = function - | Call_op("?:", _) -> false - | _ -> true +let is_parenthesized = function + | List[List[_]] -> true + | _ -> false + +let un_parenthesize = function + | List[List[e]] -> e + | _ -> internal_error "un_parenthesize" + +let rec un_parenthesize_full = function + | List[e] -> un_parenthesize_full e + | e -> e + +let not_complex e = + if is_parenthesized e then true else + let rec not_complex_ op = function + | Call_op("?:", _) -> false + | Call_op(op', l) -> op <> op' && List.for_all (not_complex_ op') l + | e -> not (is_parenthesized e) + in not_complex_ "" (un_parenthesize_full e) let not_simple = function | Num _ | Ident _ | Deref(_, Ident _) -> false @@ -25,14 +46,74 @@ let warn raw_pos msg = prerr_endline (msg_with_pos raw_pos msg) let die_rule msg = die_with_pos (Parsing.symbol_start(), Parsing.symbol_end()) msg let debug msg = if false then prerr_endline msg -let raw_pos2pos(a, b) = !Info.current_file, a, b -let get_pos (_, (_, pos)) = raw_pos2pos pos - let warn_too_many_space start = warn (start, start) "you should have only one space here" let warn_no_space start = warn (start, start) "you should have a space here" let warn_cr start = warn (start, start) "you should not have a carriage-return (\\n) here" let warn_space start = warn (start, start) "you should not have a space here" +let rec prio_less = function + | P_paren_wanted prio1, prio2 + | prio1, P_paren_wanted prio2 -> prio_less(prio1, prio2) + + | P_ternary, P_or -> false + | P_ternary, P_and -> false + + | _, P_loose -> true + | P_loose, _ -> false + | _, P_or -> true + | P_or, _ -> false + + | _, P_and -> true + | P_and, _ -> false + | _, P_comma -> true + | P_comma, _ -> false + | _, P_call_no_paren -> true + | P_call_no_paren, _ -> false + | _, P_assign -> true + | P_assign, _ -> false + | _, P_ternary -> true + | P_ternary, _ -> false + + | _, P_tight_or -> true + | P_tight_or, _ -> false + | _, P_tight_and -> true + | P_tight_and, _ -> false + + | _, P_expr -> true + | P_expr, _ -> false + + | _, P_eq -> true + | P_eq, _ -> false + | _, P_cmp -> true + | P_cmp, _ -> false + | _, P_add -> true + | P_add, _ -> false + | _, P_mul -> true + | P_mul, _ -> false + | _, P_tight -> true + | P_tight, _ -> false + + | _, P_paren _ -> true + | P_paren _, _ -> true + | P_tok, _ -> true + +let prio_lo pri_out ((pri_in, e), (_, pos)) = + if prio_less(pri_in, pri_out) then + (match pri_in with + | P_paren (P_paren_wanted _) -> () + | P_paren pri_in' -> + if pri_in' <> pri_out && + pri_out <> P_assign && + prio_less(pri_in', pri_out) && not_complex (un_parenthesize e) then + warn pos "unneeded parentheses" + | _ -> ()) + else warn pos "missing parentheses (needed for clarity)" ; + e + +let prio_lo_after pri_out ((pri_in, e), _ as para) = + if pri_in = P_call_no_paren then e else prio_lo pri_out para + +let prio_lo_concat ((pri_in, e), both) = prio_lo P_mul ((P_paren_wanted pri_in, e), both) let sp_0(_, (spaces, (start, _))) = match spaces with @@ -86,12 +167,12 @@ let sp_same (_, (spaces1, _) as ter1) (_, (spaces2, _) as ter2) = if spaces1 <> Space_0 then sp_p ter2 else if spaces2 <> Space_0 then sp_p ter1 -let op s (_, both) = ((), both), s -let op_p s e = sp_p e ; op s e +let op prio s (_, both) = prio, (((), both), s) +let op_p prio s e = sp_p e ; op prio s e -let call_op((prev_ter, op), ter, para) = +let call_op((prio, (prev_ter, op)), ter, para) = sp_same prev_ter ter ; - Call_op(op, para) + prio, Call_op(op, para) let check_lines_after_BRACKET (l, both) = (match l with Semi_colon :: _ -> sp_0 | _ -> sp_p)(l, both) @@ -100,14 +181,17 @@ let check_word_alone (word, _) = if string_of_Ident word = "time" then die_rule "please use time() instead of time"; word -let check_parenthesized_first_argexpr word (e, (_, (start, _)) as ex) = +let check_parenthesized_first_argexpr word ((_, e), (_, (start, _)) as ex) = let want_space = word.[0] = '-' in + if word = "return" then () else match e with - | List[List[_]] :: l -> - if want_space then - if l = [] then sp_n(ex) else die_with_pos (start, start) "can't handle this nicely" - else - if l = [] then sp_0(ex) else die_with_pos (start, start) "you must not have a space here" + | [ Call_op(_, (e' :: l)) ] + | e' :: l -> + if is_parenthesized e' then + if want_space then + if l = [] then sp_n(ex) else die_with_pos (start, start) "can't handle this nicely" + else + if l = [] then sp_0(ex) else die_with_pos (start, start) "you must not have a space here" | _ -> if word = "time" then die_rule "please use time() instead of time"; sp_p(ex) @@ -115,10 +199,11 @@ let check_parenthesized_first_argexpr word (e, (_, (start, _)) as ex) = let check_foreach (s, (_, pos)) = if s = "for" then warn pos "write \"foreach\" instead of \"for\"" let check_for (s, (_, pos)) = if s = "foreach" then warn pos "write \"for\" instead of \"foreach\"" -let check_no_paren f_name (e, (_, pos)) = - match e with - | List[List[List[e]]] when not_complex e -> warn pos (Printf.sprintf "''... %s (...)'' can be written ''... %s ...''" f_name f_name) - | _ -> () +let check_package t = + if str_ends_with !Info.current_file ".pm" then + match t with + | Package _ :: _ -> () + | _ -> warn (0, 0) (sprintf "module %s does not have \"package xxxx;\" on its first line" !Info.current_file) let to_Ident ((fq, name), (_, pos)) = Ident(fq, name, raw_pos2pos pos) let to_String (s, (_, pos)) = String(s, raw_pos2pos pos) @@ -130,7 +215,7 @@ let rec only_one (l, (spaces, pos)) = | [] -> die_with_pos pos "you must give one argument" | _ -> die_with_pos pos "you must give only one argument" -let only_one_in_List (e, both) = +let only_one_in_List ((_, e), both) = match e with | List l -> only_one(l, both) | _ -> e @@ -149,5 +234,13 @@ let to_List = function let sub_declaration (name, proto) body = Sub_declaration(name, proto, body) -let var_dollar_ = Deref(I_scalar, Ident(None, "_", raw_pos2pos bpos)) -let var_STDOUT = Deref(I_star, Ident(None, "STDOUT", raw_pos2pos bpos)) +let call(e, para) = + (match e with + | Ident(None, "require", _) -> + (match para with + | [ Ident _ ] -> () + | [ String _ ] -> () + | _ -> die_rule "use either \"require PACKAGE\" or \"require 'PACKAGE.pm'\"") + | _ -> ()); + Call(e, para) + diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli index 304f592..ad0a5db 100644 --- a/perl_checker.src/parser_helper.mli +++ b/perl_checker.src/parser_helper.mli @@ -1,4 +1,11 @@ val bpos : int * int +val raw_pos2pos : 'a * 'b -> string * 'a * 'b +val get_pos : 'a * ('b * ('c * 'd)) -> string * 'c * 'd +val var_dollar_ : Types.fromparser +val var_STDOUT : Types.fromparser +val is_parenthesized : Types.fromparser -> bool +val un_parenthesize : Types.fromparser -> Types.fromparser +val un_parenthesize_full : Types.fromparser -> Types.fromparser val not_complex : Types.fromparser -> bool val not_simple : Types.fromparser -> bool val string_of_Ident : Types.fromparser -> string @@ -7,12 +14,22 @@ val die_with_pos : int * int -> string -> 'a val warn : int * int -> string -> unit val die_rule : string -> 'a val debug : string -> unit -val raw_pos2pos : 'a * 'b -> string * 'a * 'b -val get_pos : 'a * ('b * ('c * 'd)) -> string * 'c * 'd val warn_too_many_space : int -> unit val warn_no_space : int -> unit val warn_cr : int -> unit val warn_space : int -> unit +val prio_less : Types.priority * Types.priority -> bool +val prio_lo : + Types.priority -> + (Types.priority * Types.fromparser) * ('a * (int * int)) -> + Types.fromparser +val prio_lo_after : + Types.priority -> + (Types.priority * Types.fromparser) * ('a * (int * int)) -> + Types.fromparser +val prio_lo_concat : + (Types.priority * Types.fromparser) * ('a * (int * int)) -> + Types.fromparser val sp_0 : 'a * (Types.spaces * (int * 'b)) -> unit val sp_0_or_cr : 'a * (Types.spaces * (int * 'b)) -> unit val sp_1 : 'a * (Types.spaces * (int * 'b)) -> unit @@ -22,29 +39,31 @@ val sp_cr : 'a * (Types.spaces * (int * 'b)) -> unit val sp_same : 'a * (Types.spaces * (int * 'b)) -> 'c * (Types.spaces * (int * 'd)) -> unit -val op : 'a -> 'b * 'c -> (unit * 'c) * 'a +val op : 'a -> 'b -> 'c * 'd -> 'a * ((unit * 'd) * 'b) val op_p : 'a -> - 'b * (Types.spaces * (int * 'c)) -> - (unit * (Types.spaces * (int * 'c))) * 'a + 'b -> + 'c * (Types.spaces * (int * 'd)) -> + 'a * ((unit * (Types.spaces * (int * 'd))) * 'b) val call_op : - (('a * (Types.spaces * (int * 'b))) * string) * - ('c * (Types.spaces * (int * 'd))) * Types.fromparser list -> - Types.fromparser + ('a * (('b * (Types.spaces * (int * 'c))) * string)) * + ('d * (Types.spaces * (int * 'e))) * Types.fromparser list -> + 'a * Types.fromparser val check_lines_after_BRACKET : Types.fromparser list * (Types.spaces * (int * 'a)) -> unit val check_word_alone : Types.fromparser * 'a -> Types.fromparser val check_parenthesized_first_argexpr : - string -> Types.fromparser list * (Types.spaces * (int * 'a)) -> unit + string -> + ('a * Types.fromparser list) * (Types.spaces * (int * 'b)) -> unit val check_foreach : string * ('a * (int * int)) -> unit val check_for : string * ('a * (int * int)) -> unit -val check_no_paren : string -> Types.fromparser * ('a * (int * int)) -> unit +val check_package : Types.fromparser list -> unit val to_Ident : (string option * string) * ('a * (int * int)) -> Types.fromparser val to_String : string * ('a * (int * int)) -> Types.fromparser val only_one : Types.fromparser list * ('a * (int * int)) -> Types.fromparser val only_one_in_List : - Types.fromparser * ('a * (int * int)) -> Types.fromparser + ('a * Types.fromparser) * ('b * (int * int)) -> Types.fromparser val array_ident_to_hash_ident : Types.fromparser * ('a * (int * int)) -> Types.fromparser val from_PATTERN : @@ -54,5 +73,4 @@ val from_PATTERN_SUBST : val to_List : Types.fromparser list -> Types.fromparser val sub_declaration : Types.fromparser * string -> Types.fromparser list -> Types.fromparser -val var_dollar_ : Types.fromparser -val var_STDOUT : Types.fromparser +val call : Types.fromparser * Types.fromparser list -> Types.fromparser diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli index b53ed0e..6d61303 100644 --- a/perl_checker.src/types.mli +++ b/perl_checker.src/types.mli @@ -29,9 +29,11 @@ type fromparser = | List of fromparser list | Block of fromparser list - | Call of fromparser * fromparser list | Call_op of string * fromparser list + | Call of fromparser * fromparser list + | CallP of fromparser * fromparser list | Method_call of fromparser * fromparser * fromparser list + | Method_callP of fromparser * fromparser * fromparser list | Anonymous_sub of fromparser | My of fromparser @@ -43,3 +45,24 @@ type fromparser = | Too_complex | Semi_colon + +type priority = +| P_tok +| P_tight +| P_mul +| P_add +| P_cmp +| P_eq +| P_expr +| P_tight_and +| P_tight_or +| P_ternary +| P_assign +| P_call_no_paren +| P_comma +| P_and +| P_or +| P_loose + +| P_paren_wanted of priority +| P_paren of priority |