Projects
Kolab:Winterfell
erlang-lfe
Log In
Username
Password
We truncated the diff of some files because they were too big. If you want to see the full diff for every file,
click here
.
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
Expand all
Collapse all
Changes of Revision 2
View file
erlang-lfe.spec
Changed
@@ -1,30 +1,24 @@ %global realname lfe %global upstream rvirding -%global git_tag 0b728d4 -%global debug_package %{nil} Name: erlang-%{realname} -Version: 0.9.2 -Release: 1%{?dist} +Version: 1.0 +Release: 2%{?dist} Summary: Lisp Flavoured Erlang Group: Development/Languages License: BSD -URL: http://github.com/rvirding/lfe +URL: https://github.com/%{upstream}/%{realname} %if 0%{?el7}%{?fedora} -VCS: scm:git:https://github.com/rvirding/lfe.git +VCS: scm:git:https://github.com/%{upstream}/%{realname}.git %endif -Source0: https://github.com/rvirding/lfe/archive/v%{version}/%{realname}-%{version}.tar.gz -BuildRequires: erlang-rebar +Source0: https://github.com/%{upstream}/%{realname}/archive/%{version}/%{realname}-%{version}.tar.gz + +BuildRequires: erlang-rebar >= 2.6.1 BuildRequires: pkgconfig BuildRequires: emacs BuildRequires: emacs-el - -Requires: erlang-compiler%{?_isa} -Requires: erlang-erts%{?_isa} -Requires: erlang-kernel%{?_isa} -# Error:erlang(unicode:characters_to_list/1) in R12B and earlier -Requires: erlang-stdlib%{?_isa} >= R13B +%{?__erlang_drv_version:Requires: %{__erlang_drv_version}} %description @@ -59,48 +53,81 @@ %prep %setup -q -n %{realname}-%{version} + iconv -f iso-8859-1 -t UTF-8 examples/core-macros.lfe > examples/core-macros.lfe.utf8 mv -f examples/core-macros.lfe.utf8 examples/core-macros.lfe %build -rebar compile -v -emacs -batch -f batch-byte-compile emacs/lfe-mode.el +ERL_LIBS=. %{rebar_compile} +emacs -L emacs/ -batch -f batch-byte-compile emacs/inferior-lfe.el emacs/lfe-mode.el emacs/lfe-indent.el %install -install -p -m 0644 -D ebin/%{realname}.app %{buildroot}%{_libdir}/erlang/lib/%{realname}-%{version}/ebin/%{realname}.app -install -p -m 0644 ebin/%{realname}_*.beam %{buildroot}%{_libdir}/erlang/lib/%{realname}-%{version}/ebin +install -m 0755 -d %{buildroot}%{_libdir}/erlang/lib/%{realname}-%{version}/{bin,ebin,priv} +install -p -m 0755 -D ebin/* %{buildroot}%{_libdir}/erlang/lib/%{realname}-%{version}/ebin/ +install -p -m 0755 -D bin/* %{buildroot}%{_libdir}/erlang/lib/%{realname}-%{version}/bin/ +install -p -m 0755 priv/%{realname}_drv.so %{buildroot}%{_libdir}/erlang/lib/%{realname}-%{version}/priv/ +install -m 0755 -d %{buildroot}/%{_bindir} +ln -s %{_libdir}/erlang/lib/%{realname}-%{version}/bin/{lfe,lfec,lfescript} %{buildroot}%{_bindir}/ + mkdir -p %{buildroot}%{_emacs_sitelispdir} mkdir -p %{buildroot}%{_emacs_sitestartdir} +install -p -m 0644 emacs/inferior-lfe.el %{buildroot}%{_emacs_sitelispdir} +install -p -m 0644 emacs/inferior-lfe.elc %{buildroot}%{_emacs_sitelispdir} install -p -m 0644 emacs/lfe-mode.el %{buildroot}%{_emacs_sitelispdir} install -p -m 0644 emacs/lfe-mode.elc %{buildroot}%{_emacs_sitelispdir} +install -p -m 0644 emacs/lfe-indent.el %{buildroot}%{_emacs_sitelispdir} +install -p -m 0644 emacs/lfe-indent.elc %{buildroot}%{_emacs_sitelispdir} install -p -m 0644 emacs/lfe-start.el %{buildroot}%{_emacs_sitestartdir} %check -rm -rf test/visual/test_map_e.erl -rebar skip_deps=true eunit -v +rebar eunit -vv %files -%doc LICENSE README.md doc/ examples/ -%dir %{_libdir}/erlang/lib/%{realname}-%{version} -%dir %{_libdir}/erlang/lib/%{realname}-%{version}/ebin -%{_libdir}/erlang/lib/%{realname}-%{version}/ebin/%{realname}.app -%{_libdir}/erlang/lib/%{realname}-%{version}/ebin/%{realname}_*.beam +%if 0%{?fedora} +%license LICENSE +%else +%doc LICENSE +%endif +%doc README.md doc/ examples/ +%{_bindir}/lfe +%{_bindir}/lfec +%{_bindir}/lfescript +%{_erllibdir}/%{realname}-%{version} %files -n emacs-erlang-lfe %{_emacs_sitestartdir}/lfe-start.el +%{_emacs_sitelispdir}/inferior-lfe.elc %{_emacs_sitelispdir}/lfe-mode.elc +%{_emacs_sitelispdir}/lfe-indent.elc %files -n emacs-erlang-lfe-el +%{_emacs_sitelispdir}/inferior-lfe.el %{_emacs_sitelispdir}/lfe-mode.el +%{_emacs_sitelispdir}/lfe-indent.el %changelog +* Thu Mar 17 2016 Jeroen van Meeuwen <vanmeeuwen@kolabsys.com> - 1.0-1 +- Version 1.0 + +* Tue Mar 1 2016 Peter Lemenkov <lemenkov@gmail.com> - 0.10.1-2 +- Install CLI tools as well + +* Tue Mar 1 2016 Peter Lemenkov <lemenkov@gmail.com> - 0.10.1-1 +- Ver. 0.10.1 + +* Wed Feb 03 2016 Fedora Release Engineering <releng@fedoraproject.org> - 0.9.0-4 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_24_Mass_Rebuild + +* Wed Jun 17 2015 Fedora Release Engineering <rel-eng@lists.fedoraproject.org> - 0.9.0-3 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_23_Mass_Rebuild + * Sun Nov 16 2014 Peter Lemenkov <lemenkov@gmail.com> - 0.9.0-2 - Disable debuginfo
View file
lfe-0.9.2.tar.gz/package.exs
Deleted
@@ -1,7 +0,0 @@ -Expm.Package.new(name: "lfe", - description: "Lisp Flavored Erlang", - version: "0.10.0-dev", - keywords: ["LFE", "Lisp", "Languages", "BEAM", "Erlang VM"], - maintainers: [[name: "Robert Virding", - email: "rvirding@gmail.com"]], - repositories: [[github: "rvirding/lfe"]])
View file
lfe-0.9.2.tar.gz/.gitignore -> lfe-1.0.tar.gz/.gitignore
Changed
@@ -2,9 +2,14 @@ .DS_Store *.beam maps.mk -bin/lfeexec -src/lfe_scan.erl erl_crash.dump *.elc *.o -*.rebar +/_build/ +/c_src/*.d +/priv/ +/src/lfe_scan.erl +.rebar/* +bin/lfeexec +maps_opts.mk +ebin/*
View file
lfe-0.9.2.tar.gz/.travis.yml -> lfe-1.0.tar.gz/.travis.yml
Changed
@@ -1,10 +1,13 @@ language: erlang +before_install: echo "#!/usr/bin/env bash" > `which rebar` +script: make travis notifications: disabled: true otp_release: - - R15B02 - - R15B01 - - R15B + - 18.2 + - 18.0 + - 17.5 + - 17.1 + - R16B03 + - R15B03 - R14B04 - - R14B03 - - R14B02
View file
lfe-0.9.2.tar.gz/Dockerfile -> lfe-1.0.tar.gz/Dockerfile
Changed
@@ -1,21 +1,32 @@ # Base image # -# VERSION 0.1 -FROM debian:jessie +# VERSION 0.2 +FROM debian:latest MAINTAINER LFE Maintainers <maintainers@lfe.io> +ENV DEBIAN_FRONTEND noninteractive RUN apt-get update && apt-get install -y --no-install-recommends \ apt-utils \ build-essential \ - erlang \ ca-certificates \ libcurl4-openssl-dev \ curl \ + wget \ git +ENV ERLANG_DEB1 erlang-solutions_1.0_all.deb +ENV ERLANG_DEB2 esl-erlang_18.1-1~debian~jessie_amd64.deb +ENV ERLANG_HOST https://packages.erlang-solutions.com +ENV ERLANG_PATH erlang/esl-erlang/FLAVOUR_1_general +RUN curl -L -O $ERLANG_HOST/$ERLANG_DEB1 +RUN dpkg -i $ERLANG_DEB1 && rm $ERLANG_DEB1 +RUN apt-get update +RUN curl -L -O $ERLANG_HOST/$ERLANG_PATH/$ERLANG_DEB2 +RUN dpkg -i --force-depends $ERLANG_DEB2 && rm $ERLANG_DEB2 + ENV REBAR_REPO https://github.com/rebar/rebar.git RUN git clone $REBAR_REPO && cd rebar && \ - git checkout tags/2.5.1 && \ + git checkout tags/2.6.0 && \ ./bootstrap && \ cp rebar /usr/local/bin @@ -23,4 +34,5 @@ RUN cd /opt/erlang/lfe && make install ENV ERL_LIBS=$ERL_LIBS:/opt/erlang/lfe -CMD /usr/bin/lfe -eval "(io:format \"~p~n\" (list (* 2 (lists:foldl (lambda (n acc) (+ n acc)) 0 (lists:seq 1 6)))))" +ENV DEBIAN_FRONTEND "" +CMD /usr/bin/lfe -eval "(io:format \"~p~n\" (list (* 2 (lists:foldl #'+/2 0 (lists:seq 1 6)))))"
View file
lfe-0.9.2.tar.gz/Makefile -> lfe-1.0.tar.gz/Makefile
Changed
@@ -1,11 +1,10 @@ # Makefile for LFE -# This simple Makefile uses rebar (in Unix) or rebar.cmd (in Windows) -# to compile/clean if it exists, else does it explicitly. BINDIR = bin EBINDIR = ebin SRCDIR = src CSRCDIR = c_src +LSRCDIR = src INCDIR = include DOCDIR = doc EMACSDIR = emacs @@ -15,17 +14,16 @@ ERLCFLAGS = -W1 ERLC = erlc -EXPM=$(BINDIR)/expm +LFECFLAGS = -pa ../lfe +LFEC = $(BINDIR)/lfe $(BINDIR)/lfec +APP_SRC = lfe.app + LIB=lfe # To run erl as bash FINISH=-run init stop -noshell # Scripts to be evaluated -MAPS_MK = 'Has=erl_internal:bif(is_map,1), \ - HasMaps=if Has -> "-DHAS_MAPS=true\n" ; true -> "\n" end, \ - file:write_file("maps.mk", "HAS_MAPS = " ++ HasMaps)' \ - $(FINISH) GET_VERSION = '{ok,[App]}=file:consult("src/$(LIB).app.src"), \ V=proplists:get_value(vsn,element(3,App)), \ @@ -37,11 +35,16 @@ ESRCS = $(notdir $(wildcard $(SRCDIR)/*.erl)) XSRCS = $(notdir $(wildcard $(SRCDIR)/*.xrl)) YSRCS = $(notdir $(wildcard $(SRCDIR)/*.yrl)) +LSRCS = $(notdir $(wildcard $(LSRCDIR)/*.lfe)) EBINS = $(ESRCS:.erl=.beam) $(XSRCS:.xrl=.beam) $(YSRCS:.yrl=.beam) +LBINS = $(LSRCS:.lfe=.beam) CSRCS = $(notdir $(wildcard $(CSRCDIR)/*.c)) BINS = $(CSRCS:.c=) +EMACSRCS = $(notdir $(wildcard $(EMACSDIR)/*.el)) +ELCS = $(EMACSRCS:.el=.elc) + ## Where we install links to the LFE binaries. DESTBINDIR = $(PREFIX)$(shell dirname `which erl` 2> /dev/null || echo "/usr/local/bin" ) @@ -51,7 +54,8 @@ cc -o $@ $< $(EBINDIR)/%.beam: $(SRCDIR)/%.erl - $(ERLC) -I $(INCDIR) -o $(EBINDIR) $(HAS_MAPS) $(ERLCFLAGS) $< + @mkdir -p $(EBINDIR) + $(ERLC) -I $(INCDIR) -o $(EBINDIR) $(MAPS_OPTS) $(ERLCFLAGS) $< %.erl: %.xrl $(ERLC) -o $(SRCDIR) $< @@ -59,43 +63,45 @@ %.erl: %.yrl $(ERLC) -o $(SRCDIR) $< +$(EBINDIR)/%.beam: $(LSRCDIR)/%.lfe + $(LFEC) -I $(INCDIR) -o $(EBINDIR) $(LFECFLAGS) $< + all: compile docs -.PHONY: compile erlc_compile install docs clean +.PHONY: compile erlc-compile lfec-compile erlc-lfec emacs install docs clean docker-build docker-push docker -## Compile using rebar if it exists else using make -compile: maps.mk - if which rebar.cmd > /dev/null; \ - then rebar.cmd compile; \ - elif which rebar > /dev/null; \ - then rebar compile; \ - else $(MAKE) $(MFLAGS) erlc_compile; \ - fi +compile: maps_opts.mk + $(MAKE) $(MFLAGS) erlc-lfec ## Compile using erlc -erlc_compile: $(addprefix $(EBINDIR)/, $(EBINS)) $(addprefix $(BINDIR)/, $(BINS)) +erlc-compile: $(addprefix $(EBINDIR)/, $(EBINS)) $(addprefix $(BINDIR)/, $(BINS)) + +## Compile using lfec +lfec-compile: $(addprefix $(EBINDIR)/, $(LBINS)) -maps.mk: - erl -eval $(MAPS_MK) +$(APP_SRC): + cp src/$(APP_SRC).src $(EBINDIR)/$(APP_SRC) --include maps.mk +erlc-lfec: erlc-compile lfec-compile $(APP_SRC) + +emacs: + cd $(EMACSDIR) ; \ + emacs -L . -batch -f batch-byte-compile inferior-lfe.el lfe-mode.el lfe-indent.el + +maps_opts.mk: + escript get_maps_opts.escript + +-include maps_opts.mk install: - ln -s `pwd`/bin/lfe $(DESTBINDIR) - ln -s `pwd`/bin/lfec $(DESTBINDIR) - ln -s `pwd`/bin/lfescript $(DESTBINDIR) + ln -sf `pwd`/bin/lfe $(DESTBINDIR) + ln -sf `pwd`/bin/lfec $(DESTBINDIR) + ln -sf `pwd`/bin/lfescript $(DESTBINDIR) docs: clean: - if which rebar.cmd > /dev/null; \ - then rebar.cmd clean; \ - elif which rebar > /dev/null; \ - then rebar clean; \ - else rm -rf $(EBINDIR)/*.beam; \ - fi - rm maps.mk - rm -rf erl_crash.dump + rm -rf $(EBINDIR)/*.beam erl_crash.dump maps_opts.mk echo: @ echo $(ESRCS) @@ -103,28 +109,31 @@ @ echo $(YSRCS) @ echo $(EBINS) -$(EXPM): $(BINDIR) - curl -o $(EXPM) http://expm.co/__download__/expm - chmod +x $(EXPM) - -get-deps: $(EXPM) - if which rebar.cmd > /dev/null; \ - then rebar.cmd get-deps; \ - elif which rebar > /dev/null; \ - then rebar get-deps; \ - fi - get-version: @echo @echo "Getting version info ..." @echo @echo -n app.src: '' @erl -eval $(GET_VERSION) - @echo -n package.exs: '' - @grep version package.exs | awk '{print $$2}'| sed -e 's/,//g' -upload: get-deps get-version - @echo - @echo "Continue with upload? " - @read - $(EXPM) publish +# Target to regenerate the src/lfe_parse.erl file from its original +# src/lfe_parse.spell1 definition. You will need to have spell1 +# installed somewhere in your $ERL_LIBS path. +regenerate-parser: + erl -noshell -eval 'spell1:file("src/lfe_parse", [report,verbose,{outdir,"./src/"},{includefile,code:lib_dir(spell1,include) ++ "/spell1inc.hrl"}]), init:stop().' + +docker-build: + docker build -t lfex/lfe:latest . + +docker-run: + docker run -i -t lfex/lfe:latest lfe + +docker-push: + docker push lfex/lfe:latest + +docker: docker-build docker-push + +travis: + @echo "Building for Travis CI ..." + @make +
View file
lfe-0.9.2.tar.gz/README.md -> lfe-1.0.tar.gz/README.md
Changed
@@ -5,15 +5,9 @@ code. An LFE evaluator and shell is also included. -## Installation - -LFE can be installed in different ways depending on how it is intended -to be used: +## Building -* use [lfetool](https://github.com/lfe/lfetool) to create projects (which will - automatically have LFE as a dependency when it creates skeleton libraries, - OTP apps, etc.; or -* use LFE directly in a working dir, e.g.: +To compile LFE, simple clone it and compile: ```shell $ git clone https://github.com/rvirding/lfe.git @@ -21,9 +15,14 @@ $ make compile ``` -The second alternative compiles all the files. After this has been -done programs for starting the REPL and compiling LFE files can be -installed with: +LFE requires Erlang be installed on the system and that the ``erl`` binary is +in ``$PATH``. + + +## Installation + +Should you wish to have LFE available system-wide, you can run +the following ``make`` target: ```shell $ make install @@ -42,23 +41,18 @@ ## REPL -If you have used ``lfetool`` to set up your project, you can simply do this to -start a REPL: +If you're running LFE from a git clone working dir, you can start the REPL +like so after compiling: ```shell - $ make shell + $ ./bin/lfe Erlang 17 (erts-6.0) [source] [64-bit] [smp:8:8] ... - LFE Shell 6.0 (abort with ^G) + LFE Shell V6.0 (abort with ^G) > ``` -Note that this will recompile all the deps (often useful for projects with -changing dependencies). If you would prefer to only recompile code for the -project itself, you can use ``make shell-no-deps`` instead. - -If you're running LFE from a git clone working dir, you can start the REPL -like so: +If you have installed LFE, then you may start the REPL from any location: ```shell $ lfe @@ -68,7 +62,14 @@ > ``` -and run an LFE shell script in the same style as shell scripts with: +Likewise, you may run an LFE shell script in the same style as shell scripts +with: + +```shell + $ ./bin/lfe script-name script-arg-1 ... +``` + +or ```shell $ lfe script-name script-arg-1 ... @@ -84,7 +85,7 @@ ```cl > (* 2 (+ 1 2 3 4 5 6)) 42 - > (* 2 (lists:foldl (lambda (n acc) (+ n acc)) 0 (lists:seq 1 6))) + > (* 2 (lists:foldl #'+/2 0 (lists:seq 1 6))) 42 ``` @@ -109,7 +110,12 @@ ```bash $ docker run lfex/lfe 42 -$ docker run -t -i lfex/lfe /usr/bin/lfe + +$ docker run -i -t lfex/lfe lfe +Erlang/OTP 18 [erts-7.0] [source-4d83b58] [64-bit] [smp:8:8] ... + +LFE Shell V7.0 (abort with ^G) +> ``` That last command will dump you into the LFE REPL on a running container
View file
lfe-0.9.2.tar.gz/VERSION -> lfe-1.0.tar.gz/VERSION
Changed
@@ -1,1 +1,1 @@ -0.9.2 +1.0
View file
lfe-0.9.2.tar.gz/bin/lfe -> lfe-1.0.tar.gz/bin/lfe
Changed
@@ -20,14 +20,24 @@ cd "$(dirname "$1")" > /dev/null filename="$(basename "$1")" if [ -h "$filename" ]; then - follow_symlink "$(readlink "$filename")" + follow_symlink "$(readlink "$filename")" else - echo "`pwd -P`/$filename" + echo "$(pwd -P)/$filename" fi } +show_help () { + echo "Usage: `basename $0` [flags] file [args] + + -h | --help Print this help and exit + -e | -eval \"sexp\" Evaluates the given sexpr + -- | -extra \"switches\" Send misc configuration switches to the Erlang VM + -flag | +flag Enables/disables configuration flags to be + used by the Erlang VM" >&2 +} + SELF=$(follow_symlink "$0") -LFE_PROGNAME=`echo $0 | sed 's/.*\///'` # Basically basename +LFE_PROGNAME=$(echo "$0" | sed 's/.*\///') # Basically basename LFE_BINDIR=$(dirname "$SELF") LFE_ROOTDIR=$(dirname "$LFE_BINDIR") @@ -35,57 +45,91 @@ export LFE_BINDIR export LFE_PROGNAME -i="$#" # Counter -e="" # Eval flag/value +i="$#" # Counter +e="" # Eval flag/value # First step over the flag section adding them to the end. -while [ $i -gt 0 ]; do +while [ "$i" -gt 0 ]; do case "$1" in - -eval | -lfe_eval) # We are going to eval - e="-lfe_eval" - break ;; # delay removing this - -extra | --) # We are explicitly done - shift ; i=`expr $i - 1` - break ;; - -* | +*) # Flags - if [ "$1" = "-erl_eval" ]; then - set -- "$@" "-eval" - else - set -- "$@" "$1" - fi - shift ; i=`expr $i - 1` - while [ $i -gt 0 ]; do - case "$1" in - -* | +*) - break ;; - *) - set -- "$@" "$1" - shift ; i=`expr $i - 1` - esac - done ;; - *) # Plain argument - break ;; + -e | -eval) # We are going to eval + e="-lfe_eval" + break ;; # delay removing this + -h | --help) + $(show_help) # Show help + exit 1 ;; + -extra | --) # We are explicitly done + shift ; i=`expr $i - 1` + break ;; + -* | +*) # Flags + if [ "$1" = "-erl_eval" ]; then + set -- "$@" "-eval" + else + set -- "$@" "$1" + fi + + shift ; i=`expr $i - 1` + + while [ "$i" -gt 0 ]; do + case "$1" in + -* | +*) + break ;; + *) + set -- "$@" "$1" + shift ; i=`expr $i - 1` + esac + done ;; + *) # Plain argument + break ;; esac done # Add the middle bit to the end, a -noshell flag if there are # more arguments. -if [ $i -gt 0 ]; then +if [ "$i" -gt 0 ]; then set -- "$@" "-noshell" fi + set -- "$@" "-user" "lfe_init" "-extra" # Check if we are 'eval'ing and add -lfe_eval flag if [ "$e" != "" ]; then - shift ; i=`expr $i - 1` # Now we remove it as it has -noshell'ed + shift ; i=`expr $i - 1` # Now we remove it as it has -noshell'ed set -- "$@" "-lfe_eval" fi # Step over the arg section adding them to the end. -while [ $i -gt 0 ]; do +while [ "$i" -gt 0 ]; do set -- "$@" "$1" shift ; i=`expr $i - 1` done +# The order of precedence for LFE libraries is as follows: +# 1) The LFE_ROOTDIR for the current bin/lfe being executed is unusurpable; +# allowing anything else would leave LFE open to instabilities where it +# could be executed with libraries of a different release. +# 2) A user/developer should be allowed to override anything else by updating +# ERL_LIBS as they see fit. +# 3) A project's libraries (current directory) should be loaded automatically, +# if they exist, but not override the previous two. +# 4) If a default library is installed in ~/.lfe/libs, then that will be added +# last, in the event that the sought library is not picked up in any of the +# other locations. +# # Note that ERL_LIBS will find *either* an ebin subdir *or* lib subdir -ERL_LIBS="$HOME"/.lfe/lib:"$LFE_ROOTDIR":"$LFE_ROOTDIR"/lib:"$ERL_LIBS" exec erl "$@" + +# Find application ebin directories in lib if lib exists. + +find_libs () { + if [ -d "$1" ]; then + echo $(find "$1" -maxdepth 1 -mindepth 1 -exec printf "%s:" {} \;) + fi +} + +# The following works for rebar and erl.mk +PROJ_LIBS=$(find_libs "./deps") +# The following works for rebar3 +R3_PROJ_LIBS=$(find_libs "./_build/default/deps"):$(find_libs "./_build/default/lib") +LFE_HOME_LIBS=$(find_libs "$HOME"/.lfe/lib) +ALL_LIBS="$LFE_ROOTDIR":"$ERL_LIBS":"$PROJ_LIBS""$R3_PROJ_LIBS""$LFE_HOME_LIBS" +ERL_LIBS="$ALL_LIBS" exec erl "$@" +
View file
lfe-0.9.2.tar.gz/bin/lfe-first-try -> lfe-1.0.tar.gz/bin/lfe-first-try
Changed
@@ -15,14 +15,14 @@ follow_symlink () { if [ -h "$1" ]; then - follow_symlink $(readlink "$1") + follow_symlink "$(readlink "$1")" else - echo "$1" + echo "$1" fi } SELF=$(follow_symlink "$0") -LFE_PROGNAME=`echo $0 | sed 's/.*\///'` +LFE_PROGNAME=$(echo "$0" | sed 's/.*\///') LFE_BINDIR=$(dirname "$SELF") LFE_ROOTDIR=$(dirname "$LFE_BINDIR") @@ -65,4 +65,4 @@ lflags="-noshell $lflags" # To avoid getting a shell process fi -echo $flags $lflags -user lfe_init -extra "$@" +echo "$flags" "$lflags" -user lfe_init -extra "$@"
View file
lfe-0.9.2.tar.gz/bin/lfec -> lfe-1.0.tar.gz/bin/lfec
Changed
@@ -16,63 +16,91 @@ (defun fix-code-path () (let* ((p0 (code:get_path)) - (p1 (lists:delete "." p0))) + (p1 (lists:delete "." p0))) (code:set_path p1))) (defun parse-opts - ([(list* "-I" idir as) opts] ;Keep these in order + ([(cons "-h" as) opts] + (usage) + (tuple as opts)) + ([(list* "-I" idir as) opts] ;Keep these in order (parse-opts as (++ opts `(#(i ,idir))))) - ([(list* "-o" odir as) opts] ;Last is first + ([(list* "-o" odir as) opts] ;Last is first (parse-opts as (cons `#(outdir ,odir) opts))) ([(list* "-pa" dir as) opts] (code:add_patha dir) (parse-opts as opts)) - ([(list* "-pa" dir as) opts] + ([(list* "-pz" dir as) opts] (code:add_pathz dir) (parse-opts as opts)) ([(cons "-v" as) opts] (parse-opts as (cons 'verbose opts))) + ([(cons "-D" as) opts] + (parse-opts as (cons 'debug_print opts))) ([(cons "-Werror" as) opts] (parse-opts as (cons 'warnings_as_errors opts))) - ([(cons (++ "-W" _) as) opts] ;Ignore this here + ([(cons (++ "-W" _) as) opts] ;Ignore this here (parse-opts as opts)) + ([(cons "-D" as) opts] + (parse-opts as (cons 'debug_print opts))) ([(cons "-E" as) opts] (parse-opts as (cons 'to_exp opts))) - ([(cons "-P" as) opts] ;Ignore as no LFE counterpart - (parse-opts as opts)) + ([(cons "-L" as) opts] + (parse-opts as (cons 'to_lint opts))) ([(cons "-S" as) opts] (parse-opts as (cons 'to_asm opts))) + ([(cons "-P" as) opts] ;Ignore as no LFE counterpart + (parse-opts as opts)) ([(cons "--" as) opts] (tuple as opts)) - ([(cons (++ "+" s) as) opts] + ([(cons (cons #\+ s) as) opts] (let ((`#(ok ,t) (lfe_io:read_string s))) (parse-opts as (cons t opts)))) ([as opts] (tuple as opts))) (defun usage () - (let ((usage (++ "Usage: lfec [options] file ...\n" - "Options:\n" - "-I name Name of include directory\n" - "-o name Name of output directory\n" - "-pa path Add path to the front of LFE's code path\n" - "-pz path Add path to the end of LFE's code path\n" - "-v Verbose compiler output\n" - "-Werror Make all warnings into errors\n" - "-Wnumber Set warning level (ignored)\n" - "-E Equivalent to +to_exp\n" - "-S Equivalent to +to_asm\n" - "-- No more options, only file names follow\n" - "+term Term will be added to options\n" ))) + (let ((usage (++ "Usage: lfec [options] file ...\n\n" + "Options:\n" + "-h Print usage and exit\n" + "-I name Name of include directory\n" + "-o name Name of output directory\n" + "-pa path Add path to the front of LFE's code path\n" + "-pz path Add path to the end of LFE's code path\n" + "-v Verbose compiler output\n" + "-Werror Make all warnings into errors\n" + "-Wnumber Set warning level (ignored)\n" + "-D Equivalent to +debug_print\n" + "-L Equivalent to +to_lint\n" + "-E Equivalent to +to_exp\n" + "-S Equivalent to +to_asm\n" + "-- No more options, only file names follow\n" + "+term Term will be added to options\n\n" + "Terms include:\n\n" + "+binary, +to_exp, +to_lint, +to_core0, +to_core, +to_kernel, +to_asm\n" + "+{outdir, Dir}, +report, +return, +debug_print\n"))) (io:put_chars usage))) -;; Parse the arguments and compile the files. +(defun compile-file (file opts) + (case (lfe_comp:file file opts) ;Catch all the return values + (`#(ok ,_) 'ok) ;Just as long as it worked + (`#(ok ,_ ,_) 'ok) + ('error 'error) ;Or any error + (`#(error ,_ ,_ ,_) 'error))) + +(defun compile-files + ([(cons file files) opts] + (case (compile-file file opts) + ('ok (compile-files files opts)) + (_ 'error))) + ([() _] 'ok)) +;; Parse the arguments and compile the files. (case script-args (() (usage)) (as0 (fix-code-path) - (let ((`#(,as1 ,opts1) (parse-opts as0 ()))) - ;; (pp (list as1 opts1)) - (lists:map (lambda (a) (lfe_comp:file a (list* 'verbose 'report opts1))) - as1)))) + (let ((`#(,files ,opts1) (parse-opts as0 ()))) + (case (compile-files files (list* 'verbose 'report opts1)) + ('error (halt 1)) + ('ok 'ok)))))
View file
lfe-0.9.2.tar.gz/bin/lfescript -> lfe-1.0.tar.gz/bin/lfescript
Changed
@@ -22,14 +22,21 @@ cd "$(dirname "$1")" > /dev/null filename="$(basename "$1")" if [ -h "$filename" ]; then - follow_symlink "$(readlink "$filename")" + follow_symlink "$(readlink "$filename")" else - echo "`pwd -P`/$filename" + echo "$(pwd -P)/$filename" fi } +show_help () { + echo "Usage: `basename $0` [flags] file [args] + + -h | --help Print this help and exit + -flag Passes configuration flags to be used on startup" >&2 +} + SELF=$(follow_symlink "$0") -LFE_PROGNAME=`echo $0 | sed 's/.*\///'` # Basically basename +LFE_PROGNAME=$(echo "$0" | sed 's/.*\///') # Basically basename LFE_BINDIR=$(dirname "$SELF") LFE_ROOTDIR=$(dirname "$LFE_BINDIR") @@ -43,17 +50,20 @@ # Collect any script options starting with '-' upto the script name. # Valid script options are only flags without arguments. -i="$#" # Counter +i="$#" # Counter -while [ $i -gt 0 ]; do +while [ "$i" -gt 0 ]; do case "$1" in - -*) # Flags - arg=`echo $1 | sed 's/^-//'` - set -- "$@" "$arg" - shift ; i=`expr $i - 1` - ;; - *) # Plain argument - break ;; + -h | --help) # Help + $(show_help) + exit 1 ;; + -*) # Flags + arg=`echo $1 | sed 's/^-//'` + set -- "$@" "$arg" + shift ; i=`expr $i - 1` + ;; + *) # Plain argument + break ;; esac done @@ -64,7 +74,7 @@ set -- "$@" "-extra" # Step over the args section adding them to the end. -while [ $i -gt 0 ]; do +while [ "$i" -gt 0 ]; do set -- "$@" "$1" shift ; i=`expr $i - 1` done @@ -75,16 +85,43 @@ # Read the first three lines of the script file. if [ -z "$scriptname" ]; then echo "lfescript: Missing filename" ; exit 127 -elif [ -f "$scriptname" -a -r "$scriptname" ]; then - { read line1; read line2; read line3; } < $scriptname +elif [ -f "$scriptname" -a -r "$scriptname" ]; then + { read line1; read line2; read line3; } < "$scriptname" else echo "lfescript: Failed to open file: $scriptname" ; exit 127 fi # Search for explicit emulator flag option line. -shebangs=`expr "$line2" : '^;;! *\(.*\)'` -if [ -z "$shebangs" ] ; then shebangs=`expr "$line3" : '^;;! *\(.*\)'` ; fi +shebangs=$(expr "$line2" : '^;;! *\(.*\)') +if [ -z "$shebangs" ] ; then shebangs=$(expr "$line3" : '^;;! *\(.*\)') ; fi # Done, now just run the emulator. +# The order of precedence for LFE libraries is as follows: +# 1) The LFE_ROOTDIR for the current bin/lfe being executed is unusurpable; +# allowing anything else would leave LFE open to instabilities where it +# could be executed with libraries of a different release. +# 2) A user/developer should be allowed to override anything else by updating +# ERL_LIBS as they see fit. +# 3) A project's libraries (current directory) should be loaded automatically, +# if they exist, but not override the previous two. +# 4) If a default library is installed in ~/.lfe/libs, then that will be added +# last, in the event that the sought library is not picked up in any of the +# other locations. +# # Note that ERL_LIBS will find *either* an ebin subdir *or* lib subdir -ERL_LIBS="$HOME"/.lfe/lib:"$LFE_ROOTDIR":"$LFE_ROOTDIR"/lib:"$ERL_LIBS" exec $emulator +B -boot start_clean $shebangs "-noshell" "-run" "lfescript" "start" "$@" + +# Find application ebin directories in lib if lib exists. + +find_libs () { + if [ -d "$1" ]; then + echo $(find "$1" -maxdepth 1 -mindepth 1 -exec printf "%s:" {} \;) + fi +} + +# The following works for rebar and erl.mk +PROJ_LIBS=$(find_libs "./deps") +# The following works for rebar3 +R3_PROJ_LIBS=$(find_libs "./_build/default/deps"):$(find_libs "./_build/default/lib") +LFE_HOME_LIBS=$(find_libs "$HOME"/.lfe/lib) +ALL_LIBS="$LFE_ROOTDIR":"$ERL_LIBS":"$PROJ_LIBS""$R3_PROJ_LIBS""$LFE_HOME_LIBS" +ERL_LIBS="$ALL_LIBS" exec "$emulator" +B -boot start_clean "$shebangs" "-noshell" "-run" "lfescript" "start" "$@"
View file
lfe-0.9.2.tar.gz/c_src/lfeexec.c -> lfe-1.0.tar.gz/c_src/lfeexec.c
Changed
@@ -47,7 +47,8 @@ int main(int argc, char **argv) { char *emu; /* Emulator */ - char pa[1024]; /* Path */ + char *rootdir; /* $LFE_ROOTDIR */ + char *pa; /* Path */ char *arg; int i; int eval = 0; /* Are 'eval'ing? */ @@ -55,10 +56,15 @@ /* The erl program and the ebin directory */ emu = DEFAULT_PROGNAME; - sprintf(pa, "%s/ebin", getenv("LFE_ROOTDIR")); + rootdir = getenv("LFE_ROOTDIR"); + if (rootdir == NULL) { + error("LFE_ROOTDIR envionment variable is not set"); + } + pa = emalloc(strlen(rootdir) + 6); + sprintf(pa, "%s/ebin", rootdir); /* Allocate and initialise the erl argument array. */ - Eargv = malloc(sizeof(*argv) * (argc + 16)); + Eargv = (char **)emalloc(sizeof(*argv) * (argc + 16)); Eargc = 0; PUSH(emu); /* The program we are going to run */
View file
lfe-0.9.2.tar.gz/doc/lfe_bits.txt -> lfe-1.0.tar.gz/doc/lfe_bits.txt
Changed
@@ -1,35 +1,35 @@ MODULE - lfe_bits + lfe_bits MODULE SUMMARY - Lisp Flavoured Erlang (LFE) common binary functions + Lisp Flavoured Erlang (LFE) common binary functions DESCRIPTION - This module contains a collection of library functions for for - handling binaries. They are generally not called by the user. + This module contains a collection of library functions for for + handling binaries. They are generally not called by the user. EXPORTS parse_bitspecs(Specs) -> - {ok,Size,{Type,Unit,Sign,Endian}} | - {error,Error}. + {ok,Size,{Type,Unit,Sign,Endian}} | + {error,Error}. - Parse a bitspec and return the data. Unmentioned fields get - the value 'default'. + Parse a bitspec and return the data. Unmentioned fields get + the value 'default'. get_bitspecs(Specs) -> - {ok,Size,{Type,Unit,Sign,Endian}} | - {error,Error}. + {ok,Size,{Type,Unit,Sign,Endian}} | + {error,Error}. - Parse a bitspec, apply defaults and return the - data. Unmentioned fields get the value 'default'. + Parse a bitspec, apply defaults and return the + data. Unmentioned fields get the value 'default'. Error Information - The following error values are returned: + The following error values are returned: - {undefined_bittype,Type} - bittype_unit + {undefined_bittype,Type} + bittype_unit
View file
lfe-0.9.2.tar.gz/doc/lfe_comp.txt -> lfe-1.0.tar.gz/doc/lfe_comp.txt
Changed
@@ -1,130 +1,153 @@ MODULE - lfe_comp + lfe_comp MODULE SUMMARY - Lisp Flavoured Erlang (LFE) compiler + Lisp Flavoured Erlang (LFE) compiler DESCRIPTION - This module provides an interface to the standard LFE - compiler. It can generate either a new file which contains the - object code, or return a binary which can be loaded directly. + This module provides an interface to the standard LFE + compiler. The compiler can handle files which contain multiple + modules. It can generate either new files which contain the + object code, or return binaries which can be loaded directly. EXPORTS file(FileName) -> CompRet - Is the same as file(FileName, [report]). + Is the same as file(FileName, [report]). file(FileName, Options) -> CompRet - where - CompRet = ModRet | BinRet | ErrRet - ModRet = {ok,ModuleName} | {ok,ModuleName,Warnings} - BinRet = {ok,ModuleName,Binary} | {ok,ModuleName,Binary,Warnings} - ErrRet = error | {error,Errors,Warnings} - - Compile an LFE file, either writing the generated module to a - file or returning it as a binary. The generated module is - ready to be loaded into Erlang. - - The currently recognised options are: - - binary - Return the binary of the module and do not save it in - a file. - - to_exp - Print a listing of the macro expanded LFE code in the - file <File>.expand. No object file is produced. Mainly - useful for debugging and interest. - - to_lint - Print a listing of the macro expanded and linted LFE - code in the file <File>.lint. No object file is - produced. Mainly useful for debugging and interest. - - to_core0 - to_core - Print a listing of the Core Erlang code before/after - being optimised in the file <File>.core. No object - file is produced. Mainly useful for debugging and - interest. - - to_kernel - Print a listing of the Kernel Erlang code in the file - <File>.kernel. No object file is produced. Mainly - useful for debugging and interest. - - to_asm - Print a listing of the Beam code in the file - <File>.S. No object file is produced. Mainly - useful for debugging and interest. - - {outdir,Dir} - Save the generated files in directory Dir instead of - the current directory. - - report - Print the errors and warnings as they occur. - - return - Return an extra return field containing Warnings on - success or the errors and warnings in - {error,Errors,Warnings} when there are errors. - - debug_print - Causes the compiler to print a lot of debug - information. - - If the binary option is given then options that produce a - listing file will cause the internal format for that compiler - pass to be returned. - - Both Warnings and Errors have the following format: - - [{FileName,[ErrorInfo]}] - - ErrorInfo is described below. When generating Errors and - Warnings the line number is the line of the start of the form - in which the error occurred. The file name has been included - here to be compatible with the Erlang compiler. As yet there - is no extra information about included files. + where + CompRet = ModRet | BinRet | ErrRet + ModRet = {ok,[ModOk]} | {ok,[ModOk],Warnings} + ModOk = {ok,ModuleName} | {ok,ModuleName,Warnings} + BinRet = {ok,[ModBin]} | {ok,[ModBin],Warnings} + ModBin = {ok,ModuleName,Binary} | {ok,ModuleName,Binary,Warnings} + ErrRet = error | {error,[ModErr],Errors,Warnings} + ModErr = {error,Errors,Warnings} + + Compile an LFE file, either writing the generated modules to + files or returning them as binaries. The generated modules are + ready to be loaded into Erlang. + + The currently recognised options are: + + binary + Return the binary of the module and do not save it in + a file. + + to_exp + to-exp + Print a listing of the macro expanded LFE code in the + file <File>.expand. No object file is produced. Mainly + useful for debugging and interest. + + to_lint + to-lint + Print a listing of the macro expanded and linted LFE + code in the files <Module>.lint. No object files are + produced. Mainly useful for debugging and interest. + + to_core0 + to-core0 + to_core + to-core + Print a listing of the Core Erlang code before/after + being optimised in the files <Module>.core. No object + files are produced. Mainly useful for debugging and + interest. + + to_kernel + to-kernel + Print a listing of the Kernel Erlang code in the files + <Module>.kernel. No object files are produced. Mainly + useful for debugging and interest. + + to_asm + to-asm + Print a listing of the Beam code in the files + <Module>.S. No object files are produced. Mainly + useful for debugging and interest. + + {outdir,Dir} + [outdir,Dir] + Save the generated files in directory Dir instead of + the current directory. + + {i,Dir} + [i,Dir] + Add dir to the list of directories to be searched when + including a file. + + report + Print the errors and warnings as they occur. + + return + Return an extra return field containing Warnings on + success or the errors and warnings in + {error,Errors,Warnings} when there are errors. + + debug_print + debug-print + Causes the compiler to print a lot of debug + information. + + warnings_as_errors + warnings-as-errors + Causes warnings to be treated as errors. + + If the binary option is given then options that produce + listing files will cause the internal formats for that + compiler pass to be returned. + + Both Warnings and Errors have the following format: + + [{FileName,[ErrorInfo]}] + + ErrorInfo is described below. When generating Errors and + Warnings the line number is the line of the start of the form + in which the error occurred. The file name has been included + here to be compatible with the Erlang compiler. As yet there + is no extra information about included files. forms(Forms) -> CompRet - Is the same as forms(Forms, [report]). + Is the same as forms(Forms, [report]).
View file
lfe-0.9.2.tar.gz/doc/lfe_gen.txt -> lfe-1.0.tar.gz/doc/lfe_gen.txt
Changed
@@ -1,44 +1,44 @@ MODULE - lfe_gen + lfe_gen MODULE SUMMARY - Lisp Flavoured Erlang (LFE) dynamic code generator + Lisp Flavoured Erlang (LFE) dynamic code generator DESCRIPTION - This module provides an experimental interface for dynamically - generating modules. + This module provides an experimental interface for dynamically + generating modules. DATA TYPES - sexpr() - An LFE s-expression, a list structure. + sexpr() + An LFE s-expression, a list structure. EXPORTS compile_forms(Forms) -> CompRet - where - Forms = [sexpr()] - CompRet = BinRet | ErrRet - BinRet = {ok,ModuleName,Binary,Warnings} - ErrRet = {error,Errors,Warnings} + where + Forms = [sexpr()] + CompRet = BinRet | ErrRet + BinRet = {ok,ModuleName,Binary,Warnings} + ErrRet = {error,Errors,Warnings} - Compile a list of LFE forms which comprise an LFE module. For - example: + Compile a list of LFE forms which comprise an LFE module. For + example: - lfe_gen:compile_forms([[defmodule,foo,[export,[a,0]]], - [defun,a,[],[quote,yes]]]) + lfe_gen:compile_forms([[defmodule,foo,[export,[a,0]]], + [defun,a,[],[quote,yes]]]) - Both WarningList and ErrorList have the following format: + Both WarningList and ErrorList have the following format: - [{FileName,[ErrorInfo]}] + [{FileName,[ErrorInfo]}] - ErrorInfo is described below. When generating Errors and - Warnings the "line number" is the index of the form in which - the error occured. + ErrorInfo is described below. When generating Errors and + Warnings the "line number" is the index of the form in which + the error occured. new_module(Name) -> ModDef. add_exports([{Name,Arity}], ModDef) -> ModDef. @@ -47,92 +47,92 @@ print_mod(ModDef) -> iolist(). compile_mod(Mod) -> CompRet - where - CompRet = BinRet | ErrRet - BinRet = {ok,ModuleName,Binary,Warnings} - ErrRet = {error,Errors,Warnings} + where + CompRet = BinRet | ErrRet + BinRet = {ok,ModuleName,Binary,Warnings} + ErrRet = {error,Errors,Warnings} - These functions are used to incrementally create a module - which can at the end be compiled by compile_mod/1. The same - example as above could be written: + These functions are used to incrementally create a module + which can at the end be compiled by compile_mod/1. The same + example as above could be written: - M0 = lfe_gen:new_module(foo), - M1 = lfe_gen:add_exports([{a,0}], M0), - M2 = lfe_gen:add_form([defun,a,[],[quote,yes]], M1), - lfe_gen:compile_mod(M2) + M0 = lfe_gen:new_module(foo), + M1 = lfe_gen:add_exports([{a,0}], M0), + M2 = lfe_gen:add_form([defun,a,[],[quote,yes]], M1), + lfe_gen:compile_mod(M2) Example - In this example we build a module of parameters where each - parameter has a number of features which each have a value. We - will create one function for each parameter and the feature is - the functions argument. The value for each feature is - returned. + In this example we build a module of parameters where each + parameter has a number of features which each have a value. We + will create one function for each parameter and the feature is + the functions argument. The value for each feature is + returned. - We are creating code equivalent to: + We are creating code equivalent to: - -module(Name). - -export([<param1>/1,...]). + -module(Name). + -export([<param1>/1,...]). - <param1>(Feature) -> - case Feature of - <feature1> -> <value1>; - ... - _ -> erlang:error({unknown_feature,<param1>,Feature) - end. - ... + <param1>(Feature) -> + case Feature of + <feature1> -> <value1>; + ... + _ -> erlang:error({unknown_feature,<param1>,Feature) + end. + ... - but generating it and compiling it directly in memory without - generating a text file. We assume that we have collected the - data and have it in the form: + but generating it and compiling it directly in memory without + generating a text file. We assume that we have collected the + data and have it in the form: - Params = [{Parameter,[{Feature,Value}]}] + Params = [{Parameter,[{Feature,Value}]}] - The equivalent LFE code which we will be generating is: + The equivalent LFE code which we will be generating is: - (defmodule Name - (export (<param1> 1) (<param2> 1) ... )) + (defmodule Name + (export (<param1> 1) (<param2> 1) ... )) - (defun <param1> (f) - (case f - ('<feature1> '<value1>) - ... - (f (: erlang error (tuple 'unknown_feature '<param1> f))))) + (defun <param1> (f) + (case f + ('<feature1> '<value1>) + ... + (f (: erlang error (tuple 'unknown_feature '<param1> f))))) - ... + ... - The following code builds and compiles a module from the - parameter data: + The following code builds and compiles a module from the + parameter data: - make_module(Name, Params) -> - Mod0 = lfe_gen:new_module(Name), - Exps = map(fun ({F,_}) -> {F,1} end, Params), - Mod1 = lfe_gen:add_exports(Exps, Mod0), - Mod2 = make_funcs(Params, Mod1), - lfe_gen:compile_mod(Mod2). + make_module(Name, Params) -> + Mod0 = lfe_gen:new_module(Name), + Exps = map(fun ({F,_}) -> {F,1} end, Params), + Mod1 = lfe_gen:add_exports(Exps, Mod0), + Mod2 = make_funcs(Params, Mod1), + lfe_gen:compile_mod(Mod2). - make_funcs([{Param,Fs}|Ps], Mod) -> - %% Define catch-all which generates more explicit exit value. - CatchAll = [f,[':',erlang,error, - [tuple,unknown_feature,[quote,Param],f]]], - %% Build case clauses - Cls = foldr(fun ({Feature,Value}, Cls) -> - [[[quote,Feature],[quote,Value]]|Cls] - end, [CatchAll], Params), - %% Build function. - Func = [defun,Param,[f],['case',f,Cls]], - make_funcs(Ps, lfe_gen:add_form(Func, Mod)); - make_funcs([], Mod) -> Mod. %All done + make_funcs([{Param,Fs}|Ps], Mod) -> + %% Define catch-all which generates more explicit exit value. + CatchAll = [f,[':',erlang,error, + [tuple,unknown_feature,[quote,Param],f]]], + %% Build case clauses + Cls = foldr(fun ({Feature,Value}, Cls) -> + [[[quote,Feature],[quote,Value]]|Cls] + end, [CatchAll], Params),
View file
lfe-0.9.2.tar.gz/doc/lfe_io.txt -> lfe-1.0.tar.gz/doc/lfe_io.txt
Changed
@@ -42,32 +42,23 @@ Print the s-expr Sexpr to the standard output (IoDevice). -prettyprint([IoDevice,] Sexpr) -> ok - - Pretty print the s-expr Sexpr to the standard output - (IoDevice). Assume we start with no indentation. - print1(Sexpr) -> DeepCharList Return the list of characters which represent the s-expr Sexpr. -prettyprint1(Sexpr, CurrentIndentation) -> DeepCharList +prettyprint1(Sexpr) -> DeepCharList +prettyprint1(Sexpr, Depth) -> DeepCharList +prettyprint1(Sexpr, Depth, Indentation) -> DeepCharList +prettyprint1(Sexpr, Depth, Indentation, LineLength) -> DeepCharList Return the lost of characters which represents the prettyprinted s-expr Sexpr. Assume we start at indentation - CurrentIndentation. - -print1_symb(Symbol) -> DeepCharList. - - Return the list of characters needed to print the symbol Symbol. - -print1_string(String) -> DeepCharList. - - Return the list of characters needed to print the string - String as a string. + Indentation or 0. format([IoDevice,] Format, Args) -> ok +fwrite([IoDevice,] Format, Args) -> ok format1(Format, Args) -> DeepCharList +fwrite1(Format, Args) -> DeepCharList Print formatted output. The following commands are valid in the format string:
View file
lfe-0.9.2.tar.gz/doc/lfe_lib.txt -> lfe-1.0.tar.gz/doc/lfe_lib.txt
Changed
@@ -1,32 +1,32 @@ MODULE - lfe_lib + lfe_lib MODULE SUMMARY - Lisp Flavoured Erlang (LFE) library + Lisp Flavoured Erlang (LFE) library DESCRIPTION - This module contains a collection of library functions for - implementing LFE. They are generally not called by the user. + This module contains a collection of library functions for + implementing LFE. They are generally not called by the user. EXPORTS new_env() -> Environment. - Create a new environment for the evaluator. + Create a new environment for the evaluator. add_env(Env1, Env2) -> Env. - Add environment Env1 to Env2 such that Env1 shadows Env2. + Add environment Env1 to Env2 such that Env1 shadows Env2. is_erl_bif(Name, Arity) -> bool(). is_guard_bif(Name, Arity) -> bool(). - Test whether a Name/Arity is a BIF or guard BIF. This works - for functions and operators. + Test whether a Name/Arity is a BIF or guard BIF. This works + for functions and operators. is_core_form(Name) -> bool(). - Test whether Name is one the LFE core forms. + Test whether Name is one the LFE core forms.
View file
lfe-0.9.2.tar.gz/doc/lfe_macro.txt -> lfe-1.0.tar.gz/doc/lfe_macro.txt
Changed
@@ -1,65 +1,65 @@ MODULE - lfe_macro + lfe_macro MODULE SUMMARY - Lisp Flavoured Erlang (LFE) macro expander + Lisp Flavoured Erlang (LFE) macro expander DESCRIPTION - This module provides an interface to the LFE macro expander. - The expander is used by the LFE compile and in the shell but - can also be used by applications explicitly wanting to handle - a file. + This module provides an interface to the LFE macro expander. + The expander is used by the LFE compile and in the shell but + can also be used by applications explicitly wanting to handle + a file. DATA TYPES - sexpr() - An LFE s-expression, a list structure. - filesexpr() = {Sexpr,Line} - This is the format returned by lfe_io:parse_file/1 and - is used by the compiler to give better error - information. - env() - This is an macro and evaluation environment as created - by lfe_lib:new_env(). + sexpr() + An LFE s-expression, a list structure. + filesexpr() = {Sexpr,Line} + This is the format returned by lfe_io:parse_file/1 and + is used by the compiler to give better error + information. + env() + This is an macro and evaluation environment as created + by lfe_lib:new_env(). EXPORTS expand_forms([FileSexpr], Env) -> ExpRet - where - FileSexpr = filesexpr() - Env = env() - ExpRet = {yes,[FileSexpr],Env,Warnings} | {error,Errors,Warnings} + where + FileSexpr = filesexpr() + Env = env() + ExpRet = {yes,[FileSexpr],Env,Warnings} | {error,Errors,Warnings} macro_forms([FileSexpr], Env) -> {[FileSexpr],Env}. - where - FileSexpr = filesexpr() - Env = env() + where + FileSexpr = filesexpr() + Env = env() expand_expr_all(Sexpr, Env) -> Sexpr. - where - Sexpr = sexpr() - Env = env() + where + Sexpr = sexpr() + Env = env() - Expand all macros in Sexpr either using the definitions in Env - or just the default macros. Note that any eventual new macro - definitions will be lost. + Expand all macros in Sexpr either using the definitions in Env + or just the default macros. Note that any eventual new macro + definitions will be lost. expand_expr(Sexpr, Env) -> {yes,Exp} | no. expand_expr_1(Sexpr, Env) -> {yes,Exp} | no. - where - Sexpr = Exp = sexpr() - Env = env() + where + Sexpr = Exp = sexpr() + Env = env() - Test if the top s-expression here is a macro call, if so - expand it and return {yes,Expansion}, if not then return no. - expand_expr/2 will expand the top s-expression as much as - possible while expand_expr_1/2 will only try it once. These - functions use the macro definitions in the environment and the - standard pre-defined macros. + Test if the top s-expression here is a macro call, if so + expand it and return {yes,Expansion}, if not then return no. + expand_expr/2 will expand the top s-expression as much as + possible while expand_expr_1/2 will only try it once. These + functions use the macro definitions in the environment and the + standard pre-defined macros.
View file
lfe-0.9.2.tar.gz/doc/user_guide.txt -> lfe-1.0.tar.gz/doc/user_guide.txt
Changed
@@ -3,14 +3,229 @@ Note {{ ... }} is use to denote optional syntax. -Special syntactic rules ------------------------ +Literals and Special Syntactic Rules +==================================== + +Integers +~~~~~~~~ + +Integers can be written in various forms and number bases: + + +Regular decimal notation: + 1234 -123 0 +Binary notation: + #b0 #b10101 #b-1100 +Binary notation (alternative form): + #*0 #b*10101 #*-1100 +Octal notation: + #o377 #o-111 +Explicitly decimal notation: + #d1234 #d-123 #d0 +Hexadecimal notation: + #xc0ffe 0x-01 +Notation with explicit base (up to 36): + #2r1010 #8r377 #36rhelloworld +Character notation (the value is the Unicode code point of the character + #\a #\$ #\ä #\🐭 +Character notation with the value in hexadecimal: + #\x1f42d; + +In all these forms, the case of the indicating letter is not +significant, i.e. #b1010 and #B1010 are identical as are #16rf00 and +#16Rf00. + +Similarly, the case is not significant for digits beyond 9 (i.e. 'a', +'b', 'c', … for number bases larger than 10), e.g. #xabcd is the same as +#xABCD and can even be mixed in the same number, e.g. #36rHelloWorld is +valid and the same number as #36Rhelloworld and #36rHELLOWORLD. + +The character notation using hexadecimal code representation (#\x....;) +is basically the same thing as the regular hexadecimal notation +#x.... except that it conveys to the reader that a character is intended +and that it does a sanity check on the value (e.g. negative numbers and +value outside the Unicode range are not permitted). + + +Floating point numbers +~~~~~~~~~~~~~~~~~~~~~~ + +There is only one type of floating point numbers and the literals are +written in the usual way, e.g. these are all valid floating point +numbers: + 1.0 +1.0 -1.0 1.0e10 1.111e-10 + +The one thing to watch out for is that you cannot omit the the part +before or after the decimal point if it is zero. E.g. the following are +not valid forms: 100. or .125. + + +Strings +~~~~~~~ + +There are two forms of strings: list strings and binary strings. + + +List Strings +............ + +List strings are just lists of integers (where the values have to be +from a certain set of numbers that are considered valid characters) but +they have their own syntax for literals (which will also be used for +integer lists as an output representation if the list contents looks +like it is meant to be a string): "any text between double quotes where +\" and other special characters like \n can be escaped". + +As a special case you can also write out the character number in the +form \xHHH; (where "HHH" is an integer in hexadecimal notation), +e.g. "\x61;\x62;\x63;" is a complicated way of writing "abc". This can +be convenient when writing Unicode letters not easily typeable or +viewable with regular fonts. E.g. "Cat: \x1f639;" might be easier to +type (and view on output devices without a Unicode font) than "Cat: 😹". + + +Binary Strings +.............. + +Binary strings are just like list strings but they are represented +differently in the virtual machine. The simple syntax is #"...", +e.g. #"This is a binary string \n with some \"escaped\" and quoted +(\x1f639;) characters" + +You can also use the general format for creating binaries (#B(...), +described below), e.g. #B("a"), #"a", and #B(97) are all the same binary +string. + + +Character Escaping +.................. + +Certain control characters can be more readably included by using their +escaped name: + | Escaped name | Character | + |--------------+-----------------| + | \b | Backspace | + | \t | Tab | + | \n | Newline | + | \v | Vertical tab | + | \f | Form Feed | + | \r | Carriage Return | + | \e | Escape | + | \s | Space | + | \d | Delete | + +Alternatively you can also use the hexadecimal character encoding, +e.g. "a\nb" and "a\x0a;b" are the same string. + + +Binaries +~~~~~~~~ + +We have already seen binary strings, but the #B(...) syntax can be used +to create binaries with any contents. Unless the contents is a simple +integer you need to annotate it with a type and/or size. + +Example invocations are that show the various annotations: + #B(42 (42 (size 16)) (42 (size 32))) ⇨ #B(42 0 42 0 0 0 42) + #B(-42 111 (-42 (size 16)) 111 (-42 (size 32))) ⇨ + #B(-42 111 (-42 (size 16)) 111 (-42 (size 32))) + #B((42 (size 32) big-endian) (42 (size 32) little-endian)) ⇨ + #B(0 0 0 42 42 0 0 0) + #B((1.23 float) (1.23 (size 32) float) (1.23 (size 64) float)) ⇨ + #B(63 243 174 20 122 225 71 174 63 157 112 164 63 243 174 20 122 + 225 71 174) + #B((#"a" binary) (#"b" binary)) ⇨ #"ab" + #B("Cat:" #\ (128569 utf-8)) ⇨ #"Cat: 😹" + +Learn more about "segments" of binary data e.g. in "Learn You Some +Erlang" +(http://learnyousomeerlang.com/starting-out-for-real#bit-syntax). + + +Lists +~~~~~ + +Lists are formed either as ( ... ) or [ ... ] where the optional +elements of the list are separated by some form or whitespace. + +E.g. () (the empty list), (foo bar baz), or + (foo + bar + baz) + + +Tuples +~~~~~~ + +Tuples are written as #(value1 value2 ...). The empty tuple #() is also +valid. + + +Maps +~~~~ + +Maps are written as #M(key1 value1 key2 value2 ...) (again, the empty +map is also valid and written as #M(). + + +Symbols +~~~~~~~ + +Things that cannot be parsed as any of the above are usually considered +as a symbol. + +Simple examples are foo, Foo, foo-bar, :foo. But also somewhat +surprisingly 123foo and 1.23e4extra (but note that illegal digits don't +make a number a symbol when using the explicit number base notation, +e.g. #b10foo gives an error). + +Symbol names can contain a surprising breadth or characters: + +!, #, $, %, &, ', *, +, ,, -, ., /, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, :, <, +=, >, ?, @, A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, +U, V, W, X, Y, Z, \, ^, _, , a, b, c, d, e, f, g, h, i, j, k, l, m, n, +o, p, q, r, s, t, u, v, w, x, y, z, |, ~, \ , ¡, ¢, £, ¤, ¥, ¦, §, ¨, +©, ª, «, ¬, \, ®, ¯, °, ±, ², ³, ´, µ, ¶, ·, ¸, ¹, º, », ¼, ½, ¾, ¿, À, +Á, Â, Ã, Ä, Å, Æ, Ç, È, É, Ê, Ë, Ì, Í, Î, Ï, Ð, Ñ, Ò, Ó, Ô, Õ, Ö, ×, Ø, +Ù, Ú, Û, Ü, Ý, Þ, ß, à, á, â, ã, ä, å, æ, ç, è, é, ê, ë, ì, í, î, ï, ð, +ñ, ò, ó, ô, õ, ö, ÷, ø, ù, ú, û, ü, ý, þ, ÿ + +(This is basically all of the latin-1 character set without control +character, whitespace, the various brackets, double quotes and +semicolon). + +Of these, only |, \', ', ,, and # may not be the first character of the +symbol's name (but they *are* allowed as subsequent letters). +
View file
lfe-0.9.2.tar.gz/ebin/lfe.app -> lfe-1.0.tar.gz/ebin/lfe.app
Changed
@@ -1,10 +1,11 @@ {application,lfe, [{description,"Lisp Flavored Erlang (LFE)"}, - {vsn,"0.9.2"}, - {modules,[lfe_bits,lfe_codegen,lfe_comp,lfe_env,lfe_eval, - lfe_gen,lfe_init,lfe_io,lfe_io_format,lfe_io_pretty, - lfe_lib,lfe_lint,lfe_macro,lfe_macro_include, - lfe_macro_record,lfe_ms,lfe_parse,lfe_pmod,lfe_qlc, - lfe_scan,lfe_shell,lfe_trans,lfescript]}, + {vsn,"0.10.1"}, + {modules,[cl,lfe_bits,lfe_codegen,lfe_comp,lfe_edlin_expand, + lfe_env,lfe_eval,lfe_gen,lfe_init,lfe_io, + lfe_io_format,lfe_io_pretty,lfe_io_write,lfe_lib, + lfe_lint,lfe_macro,lfe_macro_include,lfe_macro_record, + lfe_ms,lfe_parse,lfe_pmod,lfe_qlc,lfe_scan,lfe_shell, + lfe_trans,lfescript,sune]}, {registered,[]}, {applications,[kernel,stdlib,compiler]}]}.
View file
lfe-0.9.2.tar.gz/emacs/inferior-lfe.el -> lfe-1.0.tar.gz/emacs/inferior-lfe.el
Changed
@@ -1,3 +1,5 @@ +;;; inferior-lfe.el --- Inferior Lisp Flavoured Erlang mode + ;; Copyright (c) 2012-2013 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); @@ -12,10 +14,10 @@ ;; See the License for the specific language governing permissions and ;; limitations under the License. -;;; inferior-lfe.el --- Inferior Lisp Flavoured Erlang mode ;;; Author Robert Virding -;;; -;;; Copied from inf-lisp and modified for LFE. + +;;; Commentary: +;; Copied from inf-lisp and modified for LFE. ;;; Code: @@ -26,6 +28,7 @@ (let ((map (copy-keymap comint-mode-map))) (set-keymap-parent map lisp-mode-shared-map) (define-key map "\C-x\C-e" 'lfe-eval-last-sexp) + (define-key map "\C-c\M-o" 'inferior-lfe-clear-buffer) map) "Keymap for inferior LFE mode.") @@ -35,7 +38,7 @@ ;; (set-keymap-parent inferior-lfe-mode-map lisp-mode-shared-map) ;; (define-key inferior-lfe-mode-map "\C-x\C-e" 'lfe-eval-last-sexp)) -(define-key lfe-mode-map "\C-x\C-e" 'lfe-eval-last-sexp) ;Gnu convention +(define-key lfe-mode-map "\C-x\C-e" 'lfe-eval-last-sexp) ; GNU convention (define-key lfe-mode-map "\C-c\C-r" 'lfe-eval-region) (define-key lfe-mode-map "\C-c\C-z" 'switch-to-lfe) @@ -68,8 +71,7 @@ \\{inferior-lfe-mode-map} Customization: Entry to this mode runs the hooks on `comint-mode-hook' and -`inferior-lfe-mode-hook' (in that order). -" +`inferior-lfe-mode-hook' (in that order)." (interactive) (delay-mode-hooks (comint-mode)) (setq major-mode 'inferior-lfe-mode) @@ -78,12 +80,15 @@ (lfe-mode-variables) (use-local-map inferior-lfe-mode-map) (setq comint-prompt-regexp inferior-lfe-prompt) + (setq comint-prompt-read-only t) (setq comint-input-filter (function lfe-input-filter)) (setq comint-get-old-input (function lfe-get-old-input)) (setq comint-process-echoes t) (run-mode-hooks 'inferior-lfe-mode-hook)) (defun lfe-input-filter (str) + "Predicate for filtering additions to input history. +Return nil if `STR` matches `inferior-lfe-filter-regexp', otherwise t." (not (string-match inferior-lfe-filter-regexp str))) (defun lfe-get-old-input () @@ -95,28 +100,30 @@ ;;;###autoload (defun inferior-lfe (cmd) - "Run an inferior LFE process, input and output via a buffer `*inferior-lfe*'." -;; (interactive (list (if current-prefix-arg -;; (read-string "Run LFE: " inferior-lfe-program) -;; inferior-lfe-program))) -;; (if (not (comint-check-proc "*inferior-lfe*")) -;; (let ((cmdlist (split-string cmd))) -;; (set-buffer (apply (function make-comint) -;; "inferior-lfe" (car cmdlist) nil (cdr cmdlist))) -;; (inferior-lfe-mode))) + "Run an inferior LFE process, input and output via a buffer `*inferior-lfe*'. +If `CMD' is given, use it to start the shell, otherwise: +`inferior-lfe-program' `inferior-lfe-program-options' -env TERM vt100." + ;; (interactive (list (if current-prefix-arg + ;; (read-string "Run LFE: " inferior-lfe-program) + ;; inferior-lfe-program))) + ;; (if (not (comint-check-proc "*inferior-lfe*")) + ;; (let ((cmdlist (split-string cmd))) + ;; (set-buffer (apply (function make-comint) + ;; "inferior-lfe" (car cmdlist) nil (cdr cmdlist))) + ;; (inferior-lfe-mode))) (interactive (list (if current-prefix-arg - (read-string "Run LFE: ") - ()))) + (read-string "Run LFE: ") + ()))) (let (prog opts) (if cmd - (setq prog "sh" - opts (list "-i" "-c" cmd)) + (setq prog "sh" + opts (list "-i" "-c" cmd)) (setq prog inferior-lfe-program - opts (append inferior-lfe-program-options - '("-env" "TERM" "vt100")))) - (when (not (comint-check-proc "*inferior-lfe*")) + opts (append inferior-lfe-program-options + '("-env" "TERM" "vt100")))) + (unless (comint-check-proc "*inferior-lfe*") (set-buffer (apply (function make-comint) - "inferior-lfe" prog nil opts)) + "inferior-lfe" prog nil opts)) (inferior-lfe-mode)) (setq inferior-lfe-buffer "*inferior-lfe*") (pop-to-buffer "*inferior-lfe*"))) @@ -129,8 +136,8 @@ (defalias 'run-lfe 'inferior-lfe) (defun lfe-eval-region (start end &optional and-go) - "Send the current region to the inferior LFE process. -Prefix argument means switch to the LFE buffer afterwards." + "Send the current region (from `START' to `END') to the inferior LFE process. +`AND-GO' means switch to the LFE buffer afterwards." (interactive "r\nP") (comint-send-region (inferior-lfe-proc) start end) (comint-send-string (inferior-lfe-proc) "\n") @@ -138,37 +145,45 @@ (defun lfe-eval-last-sexp (&optional and-go) "Send the previous sexp to the inferior LFE process. -Prefix argument means switch to the LFE buffer afterwards." +`AND-GO' means switch to the LFE buffer afterwards." (interactive "P") (lfe-eval-region (save-excursion (backward-sexp) (point)) (point) and-go)) (defun switch-to-lfe (eob-p) "Switch to the inferior Lisp process buffer. -With argument, positions cursor at end of buffer." +When `EOB-P' is given, position cursor at end of buffer." (interactive "P") (if (get-buffer-process inferior-lfe-buffer) (let ((pop-up-frames - ;; Be willing to use another frame - ;; that already has the window in it. - (or pop-up-frames - (get-buffer-window inferior-lfe-buffer t)))) - (pop-to-buffer inferior-lfe-buffer)) - (run-lfe inferior-lfe-program)) + ;; Be willing to use another frame + ;; that already has the window in it. + (or pop-up-frames + (get-buffer-window inferior-lfe-buffer t)))) + (pop-to-buffer inferior-lfe-buffer)) + (run-lfe inferior-lfe-program)) (when eob-p - (push-mark) + (push-mark) (goto-char (point-max)))) +(defun inferior-lfe-clear-buffer () + "Delete the output generated by the LFE process." + (interactive) + (let ((comint-buffer-maximum-size 0)) + (comint-truncate-buffer))) + (defun inferior-lfe-proc () + "Get the LFE subprocess." (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lfe-mode) - (current-buffer) - inferior-lfe-buffer)))) + (current-buffer) + inferior-lfe-buffer)))) (or proc - (error "No LFE subprocess; see variable `inferior-lfe-buffer'")))) + (error "No LFE subprocess; see variable `inferior-lfe-buffer'")))) ;; The end. (provide 'inferior-lfe) (defvar inferior-lfe-load-hook nil - "*Functions to run when Erlang mode is loaded.") + "*Functions to run when Inferior LFE mode is loaded.") (run-hooks 'inferior-lfe-load-hook) +;;; inferior-lfe.el ends here
View file
lfe-1.0.tar.gz/emacs/lfe-indent.el
Added
@@ -0,0 +1,198 @@ +;;; lfe-indent.el --- Lisp Flavoured Erlang indent mode + +;; Copyright (c) 2015 Robert Virding +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. + +;;; Author Robert Virding + +;;; Commentary: +;; Copied from `lisp-mode' and modified for LFE. + +;;; Code: + +(require 'lisp-mode) +(require 'lfe-mode) + +;;; Lisp indent + +(defvar calculate-lisp-indent-last-sexp) + +(defun lfe-indent-function (indent-point state) + "If this function is the value of `lisp-indent-function' then +`calculate-lisp-indent' will call it to determine if the +arguments of a LFE function call should be indented specially. + +INDENT-POINT is the position where the user typed TAB, or equivalent. +Point is located at the point to indent under; +`STATE' is the `parse-partial-sexp' state for that position. + +Copied from function `lisp-indent-function', but with gets of +lfe-indent-{function,hook} and it uses `lfe-body-indent'." + (let ((normal-indent (current-column))) + (goto-char (1+ (elt state 1))) + (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) + (if (and (elt state 2) + (not (looking-at "\\sw\\|\\s_"))) + ;; car of form doesn't seem to be a symbol + (progn + (if (not (> (save-excursion (forward-line 1) (point)) + calculate-lisp-indent-last-sexp)) + (progn (goto-char calculate-lisp-indent-last-sexp) + (beginning-of-line) + (parse-partial-sexp (point) + calculate-lisp-indent-last-sexp 0 t))) + ;; Indent under the list or under the first sexp on the same + ;; line as calculate-lisp-indent-last-sexp. Note that first + ;; thing on that line has to be complete sexp since we are + ;; inside the innermost containing sexp. + (backward-prefix-chars) + (current-column)) + (let ((function (buffer-substring (point) + (progn (forward-sexp 1) (point)))) + method) + ;; Don't use function-get here for backwards compatibility. + (setq method (or (get (intern-soft function) 'lfe-indent-function) + (get (intern-soft function) 'lfe-indent-hook))) + (cond ((or (eq method 'defun) + (and (null method) + (> (length function) 3) + (string-match "\\`def" function))) + (lfe-indent-defform state indent-point)) + ((integerp method) + (lfe-indent-specform method state + indent-point normal-indent)) + (method + (funcall method state indent-point normal-indent))))))) + +(defcustom lfe-body-indent 2 + "Number of columns to indent the second line of a `(def...)' form." + :group 'lfe + :type 'integer) +(put 'lfe-body-indent 'safe-local-variable 'integerp) + +(defun lfe-indent-specform (count state indent-point normal-indent) + (let ((containing-form-start (elt state 1)) + (i count) + body-indent containing-form-column) + ;; Move to the start of containing form, calculate indentation + ;; to use for non-distinguished forms (> count), and move past the + ;; function symbol. lfe-indent-function guarantees that there is at + ;; least one word or symbol character following open paren of containing + ;; form. + (goto-char containing-form-start) + (setq containing-form-column (current-column)) + (setq body-indent (+ lfe-body-indent containing-form-column)) + (forward-char 1) + (forward-sexp 1) + ;; Now find the start of the last form. + (parse-partial-sexp (point) indent-point 1 t) + (while (and (< (point) indent-point) + (condition-case () + (progn + (setq count (1- count)) + (forward-sexp 1) + (parse-partial-sexp (point) indent-point 1 t)) + (error nil)))) + ;; Point is sitting on first character of last (or count) sexp. + (if (> count 0) + ;; A distinguished form. If it is the first or second form use double + ;; lfe-body-indent, else normal indent. With lfe-body-indent bound + ;; to 2 (the default), this just happens to work the same with if as + ;; the older code, but it makes unwind-protect, condition-case, + ;; with-output-to-temp-buffer, et. al. much more tasteful. The older, + ;; less hacked, behavior can be obtained by replacing below with + ;; (list normal-indent containing-form-start). + (if (<= (- i count) 1) + (list (+ containing-form-column (* 2 lfe-body-indent)) + containing-form-start) + (list normal-indent containing-form-start)) + ;; A non-distinguished form. Use body-indent if there are no + ;; distinguished forms and this is the first undistinguished form, + ;; or if this is the first undistinguished form and the preceding + ;; distinguished form has indentation at least as great as body-indent. + (if (or (and (= i 0) (= count 0)) + (and (= count 0) (<= body-indent normal-indent))) + body-indent + normal-indent)))) + +(defun lfe-indent-defform (state indent-point) + (goto-char (car (cdr state))) + (forward-line 1) + (if (> (point) (car (cdr (cdr state)))) + (progn + (goto-char (car (cdr state))) + (+ lfe-body-indent (current-column))))) + +;;; Indentation rule helpers +;; Modified from `clojure-mode'. + +(defun put-lfe-indent (sym indent) + "Instruct `lfe-indent-function' to indent the body of `SYM' by `INDENT'." + (put sym 'lfe-indent-function indent)) + +(defmacro define-lfe-indent (&rest kvs) + "Call `put-lfe-indent' on a series, `KVS'." + `(progn + ,@(mapcar (lambda (x) + `(put-lfe-indent (quote ,(car x)) ,(cadr x))) + kvs))) + +;;; Special indentation rules +;; "def" anything is already fixed! + +;; (define-lfe-indent (begin 0)), say, causes begin to be indented +;; like defun if the first form is placed on the next line, otherwise +;; it is indented like any other form (i.e. forms line up under first). + +(define-lfe-indent + (: 2) + (after 1) + (bc 1) + (binary-comp 1) + (call 2) + (case 1) + (catch 0) + (do 2) + (eval-when-compile 0) + (flet 1) + (flet* 1) + (fletrec 1) + (if 1) + (lambda 1) + (let 1) + (let* 1) + (let-function 1) + (letrec-function 1) + (let-macro 1) + (lc 1) + (list-comp 1) + (macrolet 1) + (match-lambda 0) + (match-spec 0) + (prog1 1) + (prog2 2) + (progn 0) + (receive 0) + (try 1) + (when 0) + (syntaxlet 1) + + (defflavor 3) ;This doesn't behave like other def's + + ;; Old style forms. + (begin 0) + (let-syntax 1) + (syntax-rules 0) + (macro 0) + )
View file
lfe-0.9.2.tar.gz/emacs/lfe-mode.el -> lfe-1.0.tar.gz/emacs/lfe-mode.el
Changed
@@ -1,6 +1,6 @@ ;;; lfe-mode.el --- Lisp Flavoured Erlang mode -;; Copyright (c) 2012-2013 Robert Virding +;; Copyright (c) 2012-2015 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -15,13 +15,24 @@ ;; limitations under the License. ;;; Author Robert Virding -;;; -;;; Copied from lisp-mode and scheme-mode and modified for LFE. + +;;; Commentary: +;; Copied from `lisp-mode' and modified for LFE. ;;; Code: (require 'lisp-mode) +(defgroup lfe nil + "LFE support." + :group 'lisp + :group 'languages) + +(defvar prettify-symbols-alist ()) + +(defconst lfe--prettify-symbols-alist '(("lambda" . ?λ)) + "Prettfy symbols alist user in Lisp Flavoured Erlang mode.") + (defvar lfe-mode-syntax-table (let ((table (copy-syntax-table lisp-mode-syntax-table))) ;; Like scheme we allow [ ... ] as alternate parentheses. @@ -30,10 +41,6 @@ table) "Syntax table in use in Lisp Flavoured Erlang mode buffers.") -;; (setq lfe-mode-syntax-table ()) -;; (unless lfe-mode-syntax-table -;; (setq lfe-mode-syntax-table (copy-syntax-table lisp-mode-syntax-table))) - (defvar lfe-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map lisp-mode-shared-map) @@ -41,25 +48,21 @@ map) "Keymap for Lisp Flavoured Erlang mode.") -;; (unless lfe-mode-map -;; (setq lfe-mode-map (copy-keymap lisp-mode-map)) -;; (define-key lfe-mode-map "\e[" 'lfe-insert-brackets)) - -(defun lfe-insert-brackets (&optional arg) - "Enclose following ARG sexps in brackets. -Leave point after open-bracket." - (interactive "P") - (insert-pair arg ?\[ ?\])) - (defvar lfe-mode-abbrev-table () "Abbrev table used in Lisp Flavoured Erlang mode.") (defvar lfe-mode-hook nil "*Hook for customizing Inferior LFE mode.") +(defun lfe-insert-brackets (&optional arg) + "Enclose following `ARG' sexps in brackets. +Leave point after open-bracket." + (interactive "P") + (insert-pair arg ?\[ ?\])) + ;;;###autoload (defun lfe-mode () - "Major mode for editing Lisp Flavoured Erlang. It's just like lisp mode. + "Major mode for editing Lisp Flavoured Erlang. It's just like `lisp-mode'. Other commands: \\{lfe-mode-map}" @@ -69,13 +72,14 @@ (setq mode-name "LFE") (lfe-mode-variables) (use-local-map lfe-mode-map) -;; ;; For making font-lock case independant, which LFE isn't. -;; (make-local-variable 'font-lock-keywords-case-fold-search) -;; (setq font-lock-keywords-case-fold-search t) + ;; ;; For making font-lock case independent, which LFE isn't. + ;; (make-local-variable 'font-lock-keywords-case-fold-search) + ;; (setq font-lock-keywords-case-fold-search t) (setq imenu-case-fold-search t) (run-mode-hooks 'lfe-mode-hook)) (defun lfe-mode-variables () + "Variables for LFE modes." (set-syntax-table lfe-mode-syntax-table) (setq local-abbrev-table lfe-mode-abbrev-table) (make-local-variable 'paragraph-start) @@ -108,13 +112,14 @@ ;; after either a non-backslash or the line beginning. (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") (make-local-variable 'comment-add) - (setq comment-add 1) ;default to `;;' in comment-region + (setq comment-add 1) ;default to `;;' in comment-region (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'lisp-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) + ;; Make lisp-indent-line call lfe-indent-line. (make-local-variable 'lisp-indent-function) (set lisp-indent-function 'lfe-indent-function) (make-local-variable 'imenu-generic-expression) @@ -123,36 +128,92 @@ (setq multibyte-syntax-as-symbol t) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults - '((lfe-font-lock-keywords - lfe-font-lock-keywords-1 lfe-font-lock-keywords-2) - nil nil (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun - (font-lock-mark-block-function . mark-defun)))) + '((lfe-font-lock-keywords + lfe-font-lock-keywords-1 lfe-font-lock-keywords-2) + nil nil (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun + (font-lock-mark-block-function . mark-defun) + (font-lock-syntactic-face-function + . lisp-font-lock-syntactic-face-function))) + ;; Don't use seq-local here for backwards compatibility. + (make-local-variable 'prettify-symbols-alist) + (setq prettify-symbols-alist lfe--prettify-symbols-alist)) -;; Font locking +;;; Font locking -(defconst lfe-font-lock-keywords-1 +(defconst lfe-font-lock-basic-type-keywords + (eval-when-compile + (list + (concat + "(\\(define-\\(module\\|record\\)\\)\\>" + ;; Any whitespace and declared object. + "[ \t]*(?" + "\\(\\sw+\\)?") + '(1 font-lock-keyword-face) + '(3 font-lock-type-face nil t)) + ) + "LFE basic type definition expressions") + +(defconst lfe-font-lock-basic-function-keywords + (eval-when-compile + (list + (concat + "(\\(define\\(-function\\|-macro\\|-syntax\\)?\\)\\>" + ;; Any whitespace and declared object. + "[ \t]*(?" + "\\(\\sw+\\)?") + '(1 font-lock-keyword-face) + '(3 font-lock-function-name-face nil t)) + ) + "LFE basic function definition expressions") + +(defconst lfe-font-lock-new-type-keywords + (eval-when-compile + (list + (concat + "(\\(def\\(module\\|record\\)\\)\\>" + ;; Any whitespace and declared object. + "[ \t]*(?" + "\\(\\sw+\\)?") + '(1 font-lock-keyword-face) + '(3 font-lock-type-face nil t)) + ) + "LFE new style type expressions") + +(defconst lfe-font-lock-new-function-keywords + (eval-when-compile + (list + (concat + ;; No method here! + "(\\(def\\(un\\|macro\\|syntax\\|test\\)\\)\\>" + ;; Any whitespace and declared object. + "[ \t]*(?" + "\\(\\sw+\\)?") + '(1 font-lock-keyword-face) + '(3 font-lock-function-name-face nil t)) + ) + "LFE new style function expressions") + +(defconst lfe-font-lock-flavor-keywords (eval-when-compile (list - (list (concat "(\\(def\\(" - ;; Base forms and old style names. - "\\(ine\\(-module\\|-function\\|-macro\\|" - "-syntax\\|-record\\)?\\)\\|" - ;; New model function names - "\\(un\\|macro\\|syntax\\)\\|" - ;; New model other names - "\\(module\\)\\|" - "\\(record\\)"
View file
lfe-0.9.2.tar.gz/emacs/lfe-start.el -> lfe-1.0.tar.gz/emacs/lfe-start.el
Changed
@@ -17,6 +17,7 @@ ;; Declare autoload functions in lfe-mode.el and inferior-lfe.el. (autoload 'lfe-mode "lfe-mode" "Major mode for editing LFE code." t) +(autoload 'lfe-indent-function "lfe-indent" "Indent LFE." t) (autoload 'inferior-lfe-mode "inferior-lfe" "Major mode for interacting with an inferior LFE process." t) (autoload 'inferior-lfe "inferior-lfe" "Run an LFE process." t)
View file
lfe-0.9.2.tar.gz/examples/core-macros.lfe -> lfe-1.0.tar.gz/examples/core-macros.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2015 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -68,7 +68,7 @@ (defmacro let* ((cons (cons vb vbs) b) `(let (,vb) (let* ,vbs . ,b))) ((cons () b) `(progn . ,b)) - ((cons vb b) `(let ,vb . b))) ;Pass error to let + ((cons vb b) `(let ,vb . b))) ;Pass error to let (defmacro flet* ((cons (cons fb fbs) b) `(flet (,fb) (flet* ,fbs . ,b))) @@ -107,7 +107,7 @@ ;; Note that we cannot *use* backquote or any macros using ;; backquote in here! It will cause us to loop. (fletrec ((bq-app ;Optimise append - ([(list '++ l) r] (bq-app l r)) ;Catch single unquote-splice + ([(list '++ l) r] (bq-app l r)) ;Catch single comma-at ([() r] r) ([l ()] l) ([(list 'list l) (cons 'list r)] (cons 'list (cons l r))) @@ -122,24 +122,24 @@ ((list 'backquote x) ;; `(list 'backquote ,(bq-expand x (+ n 1))) (list 'list (list 'quote 'backquote) (bq-expand x (+ n 1)))) - ((list 'unquote x) (when (> n 0)) - (bq-cons 'unquote (bq-expand x (- n 1)))) - ((list 'unquote x) (when (=:= n 0)) x) - ((list 'unquote-splicing . x) (when (> n 0)) - (bq-cons (list 'quote 'unquote-splicing) (bq-expand x (- n 1)))) + ((list 'comma x) (when (> n 0)) + (bq-cons (list 'quote 'comma) (bq-expand x (- n 1)))) + ((list 'comma x) (when (=:= n 0)) x) + ((cons 'comma-at x) (when (> n 0)) + (bq-cons (list 'quote 'comma-at) (bq-expand x (- n 1)))) ;; The next two cases handle splicing into a list. - (((list 'unquote . x) . y) (when (=:= n 0)) + ((cons (cons 'comma x) y) (when (=:= n 0)) (bq-app (cons 'list x) (bq-expand y 0))) - (((list 'unquote-splicing . x) . y) (when (=:= n 0)) + ((cons (cons 'comma-at x) y) (when (=:= n 0)) (bq-app (cons '++ x) (bq-expand y 0))) ((cons x y) ;The general list case (bq-cons (bq-expand x n) (bq-expand y n))) - (_ (when (is_tuple exp)) + (x (when (is_tuple x)) ;; Tuples need some smartness for efficient code to handle ;; when no splicing so as to avoid list_to_tuple. - (case (bq-expand (tuple_to_list exp) n) - (('list . es) (cons tuple es)) - ((= ('cons . _) e) (list 'list_to_tuple e)))) - (_ (when (is_atom exp)) (list 'quote exp)) - (_ exp)) ;Self quoting + (case (bq-expand (tuple_to_list x) n) + ((cons 'list es) (cons 'tuple es)) + ((= (cons 'cons _) e) (list 'list_to_tuple e)))) + (x (when (is_atom x)) (list 'quote x)) + (x x)) ;Self quoting )))
View file
lfe-0.9.2.tar.gz/examples/internal-state.lfe -> lfe-1.0.tar.gz/examples/internal-state.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013, 2015 Duncan McGreggor <oubiwann@gmail.com> ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -22,41 +22,40 @@ ;; ;; To use the code below in LFE, do the following: ;; -;; $ cd examples -;; $ ../bin/lfe -pa ../ebin +;; $ ./bin/lfe -pa ./ebin ;; -;; > (slurp '"internal-state.lfe") +;; > (slurp "examples/internal-state.lfe") ;; #(ok internal-state) -;; > (set account (new-account '"Alice" 100.00 0.06)) +;; > (set acct (new-account "Alice" 100.00 0.06)) ;; #Fun<lfe_eval.10.53503600> -;; > (name account) +;; > (send acct 'name) ;; "Alice" -;; > (balance account) +;; > (send acct 'balance) ;; 100.0 -;; > (set account (interest account)) +;; > (set acct (send acct 'apply-interest)) ;; #Fun<lfe_eval.10.53503600> -;; > (balance account) +;; > (send acct 'balance) ;; 106.0 -;; > (set account (withdraw account 54.90)) +;; > (set acct (send acct 'withdraw 54.90)) ;; #Fun<lfe_eval.10.53503600> -;; > (set account (withdraw account 54.90)) +;; > (set acct (send acct 'withdraw 54.90)) ;; exception error: insufficient-funds ;; -;; > (balance account) +;; > (send acct 'balance) ;; 51.1 -;; > (set account (deposit account 1000)) +;; > (set acct (send acct 'deposit 1000)) ;; #Fun<lfe_eval.10.53503600> -;; > (set account (withdraw account 54.90)) +;; > (set acct (send acct 'withdraw 54.90)) ;; #Fun<lfe_eval.10.53503600> -;; > (set account (withdraw account 54.90)) +;; > (set acct (send acct 'withdraw 54.90)) ;; #Fun<lfe_eval.10.53503600> -;; > (set account (withdraw account 54.90)) +;; > (set acct (send acct 'withdraw 54.90)) ;; #Fun<lfe_eval.10.53503600> -;; > (balance account) +;; > (send acct 'balance) ;; 886.4 -;; > (set account (interest account)) +;; > (set acct (send acct 'apply-interest)) ;; #Fun<lfe_eval.10.53503600> -;; > (balance account) +;; > (send acct 'balance) ;; 939.584 (defmodule internal-state @@ -68,38 +67,85 @@ ('withdraw (lambda (amt) (if (=< amt balance) (new-account name (- balance amt) interest-rate) - (: erlang error 'insufficient-funds)))) + (error 'insufficient-funds)))) ('deposit (lambda (amt) (new-account name (+ balance amt) interest-rate))) ('balance (lambda () balance)) ('name (lambda () name)) - ('interest (lambda () + ('apply-interest (lambda () (new-account name (+ balance (* balance interest-rate)) interest-rate)))))) -(defun get-method (object command) - (funcall object command)) +(defun send (object method-name) + "This is a generic function, used to call into the given object (class + instance)." + (funcall (funcall object method-name))) -(defun send (object command arg) - (funcall (get-method object command) arg)) +(defun send (object method-name arg) + "This is a generic function, used to call into the given object (class + instance)." + (funcall (funcall object method-name) arg)) -(defun withdraw (object amt) - "Returns an updated account object." - (funcall (get-method object 'withdraw) amt)) +;; It is also possible to create functionally equivalent code using LFE +;; processes. The code below would then be used in the following manner: +;; +;; > (set acct (init-account "Alice" 1000 0.1)) +;; <0.37.0> +;; > (snd acct 'name) +;; "Alice" +;; > (snd acct 'balance) +;; 1000 +;; > (snd acct 'apply-interest) +;; 1.1e3 +;; > (snd acct 'deposit 1000) +;; 2.1e3 +;; > (snd acct 'balance) +;; 2.1e3 +;; > (snd acct 'withdraw 2000) +;; 100.0 +;; > (snd acct 'withdraw 101) +;; #(error insufficient-funds) -(defun deposit (object amt) - "Returns an updated account object." - (funcall (get-method object 'deposit) amt)) +(defun account-class (name balance interest-rate) + (receive + (`#(,method name ()) + (! method `#(ok ,name)) + (account-class name balance interest-rate)) + (`#(,method balance ()) + (! method `#(ok ,balance)) + (account-class name balance interest-rate)) + (`#(,method deposit (,amt)) + (let ((new-balance (+ balance amt))) + (! method `#(ok ,new-balance)) + (account-class name new-balance interest-rate))) + (`#(,method apply-interest ()) + (let ((new-balance (+ balance (* balance interest-rate)))) + (! method `#(ok ,new-balance)) + (account-class name new-balance interest-rate))) + (`#(,method withdraw (,amt)) + (let ((new-balance (- balance amt))) + (cond ((< new-balance 0) + (! method #(error insufficient-funds)) + (account-class name balance interest-rate)) + ('true + (! method `#(ok ,new-balance)) + (account-class name new-balance interest-rate))))))) -(defun balance (object) - "Returns a float representing the balance." - (funcall (get-method object 'balance))) +(defun init-account (name balance interest-rate) + (spawn (lambda () + (account-class name balance interest-rate)))) -(defun name (object) - "Returns a string represnting the account holder." - (funcall (get-method object 'name))) +(defun snd (object method-name) + (snd object method-name '())) -(defun interest (object) - "Returns an updated account object." - (funcall (get-method object 'interest))) +(defun snd + ((object method-name arg) (when (not (is_list arg))) + (snd object method-name `(,arg))) + ((object method-name args) + (! object `#(,(self) ,method-name ,args)) + (receive + (`#(ok ,result) + result) + (error + error))))
View file
lfe-0.9.2.tar.gz/examples/object-via-closure.lfe -> lfe-1.0.tar.gz/examples/object-via-closure.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013 Duncan McGreggor <oubiwann@gmail.com> ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -26,49 +26,46 @@ ;; ;; To use the code below in LFE, do the following: ;; -;; $ cd examples -;; $ ../bin/lfe -pa ../ebin +;; $ .bin/lfe -pa .ebin ;; ;; Load the file and create a fish-class instance: ;; -;; > (slurp '"object-via-closure.lfe") -;; #(ok object) -;; > (set mommy-fish (fish-class '"Carp")) +;; > (slurp "examples/object-via-closure.lfe") +;; #(ok object-via-closure) +;; > (set mommy-fish (fish-class "Carp")) ;; #Fun<lfe_eval.10.91765564> ;; ;; Execute some of the basic methods: ;; -;; > (get-species mommy-fish) +;; > (send mommy-fish 'species) ;; "Carp" -;; > (move mommy-fish 17) +;; > (send mommy-fish 'move 17) ;; The Carp swam 17 feet! ;; ok -;; > (get-id mommy-fish) +;; > (send mommy-fish 'id) ;; "47eebe91a648f042fc3fb278df663de5" ;; ;; Now let's look at "modifying" state data (e.g., children counts): ;; -;; > (get-children mommy-fish) +;; > (send mommy-fish 'children) ;; () -;; > (get-children-count mommy-fish) +;; > (send mommy-fish 'children-count) ;; 0 -;; > (set (mommy-fish baby-fish-1) (reproduce mommy-fish)) +;; > (set `(,mommy-fish ,baby-fish-1) (send mommy-fish 'reproduce)) ;; (#Fun<lfe_eval.10.91765564> #Fun<lfe_eval.10.91765564>) -;; > (get-id mommy-fish) +;; > (send mommy-fish 'id) ;; "47eebe91a648f042fc3fb278df663de5" -;; > (get-id baby-fish-1) +;; > (send baby-fish-1 'id) ;; "fdcf35983bb496650e558a82e34c9935" -;; > (get-children-count mommy-fish) +;; > (send mommy-fish 'children-count) ;; 1 -;; > (set (mommy-fish baby-fish-2) (reproduce mommy-fish)) +;; > (set `(,mommy-fish ,baby-fish-2) (send mommy-fish 'reproduce)) ;; (#Fun<lfe_eval.10.91765564> #Fun<lfe_eval.10.91765564>) -;; > (get-id mommy-fish) -;; "47eebe91a648f042fc3fb278df663de5" -;; > (get-id baby-fish-2) +;; > (send baby-fish-2 'id) ;; "3e64e5c20fb742dd88dac1032749c2fd" -;; > (get-children-count mommy-fish) +;; > (send mommy-fish 'children-count) ;; 2 -;; > (get-info mommy-fish) +;; > (send mommy-fish 'info) ;; id: "47eebe91a648f042fc3fb278df663de5" ;; species: "Carp" ;; children: ["fdcf35983bb496650e558a82e34c9935", @@ -91,16 +88,15 @@ besides fish-class/1, so it's not strictly necessary. When the id isn't known, generate one." - (let* (((binary (id (size 128))) (: crypto rand_bytes 16)) + (let* (((binary (id (size 128))) (crypto:rand_bytes 16)) (formatted-id (car - (: io_lib format - '"~32.16.0b" (list id))))) + (io_lib:format "~32.16.0b" (list id))))) (fish-class species children formatted-id))) (defun fish-class (species children id) "This is the constructor used internally, once the children and fish id are known." - (let ((move-verb '"swam")) + (let ((move-verb "swam")) (lambda (method-name) (case method-name ('id @@ -111,52 +107,32 @@ (lambda (self) children)) ('info (lambda (self) - (: io format - '"id: ~p~nspecies: ~p~nchildren: ~p~n" - (list (get-id self) - (get-species self) - (get-children self))))) + (io:format "id: ~p~nspecies: ~p~nchildren: ~p~n" + `(,(send self 'id) + ,(send self 'species) + ,(send self 'children))))) ('move (lambda (self distance) - (: io format - '"The ~s ~s ~p feet!~n" - (list species move-verb distance)))) + (io:format "The ~s ~s ~p feet!~n" + `(,species ,move-verb ,distance)))) ('reproduce (lambda (self) (let* ((child (fish-class species)) - (child-id (get-id child)) - (children-ids (: lists append - (list children (list child-id)))) - (parent-id (get-id self)) + (child-id (send child 'id)) + (children-ids (lists:append children `(,child-id))) + (parent-id (send self 'id)) (parent (fish-class species children-ids parent-id))) - (list parent child)))) + `(,parent ,child)))) ('children-count (lambda (self) - (: erlang length children))))))) + (length children))))))) -(defun get-method (object method-name) +(defun send (object method-name) "This is a generic function, used to call into the given object (class instance)." - (funcall object method-name)) - -(defun get-id (object) - "Define object methods." - (funcall (get-method object 'id) object)) - -(defun get-species (object) - (funcall (get-method object 'species) object)) - -(defun get-info (object) - (funcall (get-method object 'info) object)) - -(defun move (object distance) - (funcall (get-method object 'move) object distance)) + (funcall (funcall object method-name) object)) -(defun reproduce (object) - (funcall (get-method object 'reproduce) object)) - -(defun get-children (object) - (funcall (get-method object 'children) object)) - -(defun get-children-count (object) - (funcall (get-method object 'children-count) object)) +(defun send (object method-name arg) + "This is a generic function, used to call into the given object (class + instance)." + (funcall (funcall object method-name) object arg)) \ No newline at end of file
View file
lfe-0.9.2.tar.gz/examples/object-via-process.lfe -> lfe-1.0.tar.gz/examples/object-via-process.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013 Duncan McGreggor <oubiwann@gmail.com> ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -26,143 +26,112 @@ ;; ;; To use the code below in LFE, do the following: ;; -;; $ cd examples -;; $ ../bin/lfe -pa ../ebin +;; $ ./bin/lfe -pa ./ebin ;; ;; Load the file and create a fish-class instance: ;; -;; > (slurp '"object-via-process.lfe") +;; > (slurp "examples/object-via-process.lfe") ;; #(ok object-via-process) -;; > (set mommy-fish (fish-class '"Carp")) +;; > (set mommy-fish (init-fish "Carp")) ;; <0.33.0> ;; ;; Execute some of the basic methods: ;; -;; > (get-species mommy-fish) +;; > (send mommy-fish 'species) ;; "Carp" -;; > (move mommy-fish 17) -;; The Carp swam 17 feet! -;; ok -;; > (get-id mommy-fish) +;; > (send mommy-fish 'move 17) +;; "The Carp swam 17 feet!" +;; > (send mommy-fish 'id) ;; "47eebe91a648f042fc3fb278df663de5" ;; ;; Now let's look at modifying state data (e.g., children counts): ;; -;; > (get-children mommy-fish) +;; > (send mommy-fish 'children) ;; () -;; > (get-children-count mommy-fish) +;; > (send mommy-fish 'children-count) ;; 0 -;; > (set baby-fish-1 (reproduce mommy-fish)) +;; > (set baby-fish-1 (send mommy-fish 'reproduce)) ;; <0.34.0> -;; > (get-id mommy-fish) -;; "47eebe91a648f042fc3fb278df663de5" -;; > (get-id baby-fish-1) +;; > (send baby-fish-1 'id) ;; "fdcf35983bb496650e558a82e34c9935" -;; > (get-children-count mommy-fish) +;; > (send mommy-fish 'children-count) ;; 1 -;; > (set baby-fish-2 (reproduce mommy-fish)) +;; > (set baby-fish-2 (send mommy-fish 'reproduce)) ;; <0.35.0> -;; > (get-id mommy-fish) -;; "47eebe91a648f042fc3fb278df663de5" -;; > (get-id baby-fish-2) +;; > (send baby-fish-2 'id) ;; "3e64e5c20fb742dd88dac1032749c2fd" -;; > (get-children-count mommy-fish) +;; > (send mommy-fish 'children-count) ;; 2 -;; > (get-info mommy-fish) -;; id: 47eebe91a648f042fc3fb278df663de5 -;; species: Carp -;; children: ["fdcf35983bb496650e558a82e34c9935", -;; "3e64e5c20fb742dd88dac1032749c2fd"] -;; ok +;; > (send mommy-fish 'info) +;; (#(id "f05064ffcf92d7b3e72968fd481abbd0") +;; #(species "Carp") +;; #(children +;; ("d53a426c732c938f996a1c2520bb621f" "15fede691ab3f96e9e3df248d37b7b55"))) (defmodule object-via-process (export all)) -(defun fish-class (species) +(defun init-fish (species) "This is the constructor that will be used most often, only requiring that one pass a 'species' string. When the children are not defined, simply use an empty list." - (fish-class species ())) + (init-fish species ())) -(defun fish-class (species children) +(defun init-fish (species children) "This constructor is useful for two reasons: 1) as a way of abstracting out the id generation from the larger constructor, and 2) spawning the 'object loop' code (fish-class/3)." - (let* (((binary (id (size 128))) (: crypto rand_bytes 16)) + (let* (((binary (id (size 128))) (crypto:rand_bytes 16)) (formatted-id (car - (: io_lib format - '"~32.16.0b" (list id))))) - (spawn 'object-via-process - 'fish-class - (list species children formatted-id)))) + (io_lib:format "~32.16.0b" `(,id))))) + (spawn (lambda () + (fish-class species children formatted-id))))) (defun fish-class (species children id) "This function is intended to be spawned as a separate process which is used to track the state of a fish. In particular, fish-class/2 spawns this function (which acts as a loop, pattern matching for messages)." - (let ((move-verb '"swam")) + (let ((move-verb "swam")) (receive - ((tuple caller 'move distance) - (! caller (list species move-verb distance)) + (`#(,caller move ,distance) + (! caller (lists:flatten + (io_lib:format "The ~s ~s ~p feet!" + `(,species ,move-verb ,distance)))) (fish-class species children id)) - ((tuple caller 'species) + (`#(,caller species ()) (! caller species) (fish-class species children id)) - ((tuple caller 'children) + (`#(,caller children ()) (! caller children) (fish-class species children id)) - ((tuple caller 'children-count) + (`#(,caller children-count ()) (! caller (length children)) (fish-class species children id)) - ((tuple caller 'id) - (! caller id) + (`#(,caller id ()) + (! caller (lists:flatten id)) (fish-class species children id)) - ((tuple caller 'info) - (! caller (list id species children)) + (`#(,caller info ()) + (! caller `(#(id ,id) + #(species ,species) + #(children ,children))) (fish-class species children id)) - ((tuple caller 'reproduce) - (let* ((child (fish-class species)) - (child-id (get-id child)) - (children-ids (: lists append - (list children (list child-id))))) - (! caller child) - (fish-class species children-ids id)))))) - -(defun call-method (object method-name) + (`#(,caller reproduce ()) + (let* ((child (init-fish species)) + (child-id (send child 'id)) + (children-ids (lists:append children `(,child-id)))) + (! caller child) + (fish-class species children-ids id)))))) + +(defun send (object method-name) "This is a generic function, used to call into the given object (class instance)." - (! object (tuple (self) method-name)) - (receive - (data data))) + (send object method-name '())) -(defun call-method (object method-name arg) - "Same as above, but with an additional argument." - (! object (tuple (self) method-name arg)) +(defun send (object method-name arg) + "This is a generic function, used to call into the given object (class + instance)." + (! object `#(,(self) ,method-name ,arg)) (receive (data data))) - -(defun get-id (object) - "Define object methods." - (call-method object 'id)) - -(defun get-species (object) - (call-method object 'species)) - -(defun get-info (object) - (let ((data (call-method object 'info))) - (: io format '"id: ~s~nspecies: ~s~nchildren: ~p~n" data))) - -(defun move (object distance) - (let ((data (call-method object 'move distance))) - (: io format '"The ~s ~s ~p feet!~n" data))) - -(defun reproduce (object) - (call-method object 'reproduce)) - -(defun get-children (object)
View file
lfe-1.0.tar.gz/get_maps_opts.escript
Added
@@ -0,0 +1,28 @@ +#! /usr/bin/env escript +%% -*- mode: erlang; indent-tabs-mode: nil -*- +%% Define the makefile variables HAS_MAPS and HAS_FULL_KEYS depending +%% on whether this version of erlang has maps (17) and general map +%% keys (18), or neither. + +-define(MAP_STRING, "#{X => 1}."). +-define(HAS_OPT, "-DHAS_MAPS=true"). +-define(FULL_OPT, "-DHAS_FULL_KEYS=true"). + +main(_) -> + MapsOpts = maps_opts(), + file:write_file("maps_opts.mk", "MAPS_OPTS = " ++ MapsOpts ++ "\n"). + +maps_opts() -> + case erl_scan:string(?MAP_STRING) of + {ok,Ts,_} -> + case erl_parse:parse_exprs(Ts) of + {ok,Es} -> %We have maps! + Binds = [{'X',49}], %We need to bind X + case erl_lint:exprs(Es, Binds) of + {ok,_} -> ?HAS_OPT ++ " " ++ ?FULL_OPT; + {error,_,_} -> ?HAS_OPT + end; + {error,_} -> "" + end; + {error,_,_} -> "" + end.
View file
lfe-1.0.tar.gz/include/cl.lfe
Added
@@ -0,0 +1,99 @@ +;;; Predicates + +(defmacro alivep (x) + `(is_alive)) + +(defmacro atomp (x) + `(is_atom ,x)) + +(defmacro binaryp (x) + `(is_binary ,x)) + +(defmacro bitstringp (x) + `(is_bitstring ,x)) + +(defmacro boolp (x) + `(is_boolean ,x)) + +(defmacro booleanp (x) + `(is_boolean ,x)) + +(defmacro builtinp (mod func arity) + `(erlang:is_builtin ,mod ,func ,arity)) + +(defmacro floatp (x) + `(is_float ,x)) + +(defmacro funcp (x) + `(is_function ,x)) + +(defmacro funcp (x arity) + `(is_function ,x ,arity)) + +(defmacro functionp (x) + `(is_function ,x)) + +(defmacro functionp (x arity) + `(is_function ,x ,arity)) + +(defmacro intp (x) + `(is_integer ,x)) + +(defmacro integerp (x) + `(is_integer ,x)) + +(defmacro listp (x) + `(is_list ,x)) + +(defmacro mapp (x) + `(is_map ,x)) + +(defmacro numberp (x) + `(is_number ,x)) + +(defmacro pidp (x) + `(is_pid ,x)) + +(defmacro portp (x) + `(is_port ,x)) + +(defmacro process-alive-p (pid) + `(is_process_alive ,pid)) + +(defmacro recordp (x rec-tag) + `(is_record ,x ,rec-tag)) + +(defmacro recordp (x rec-tag size) + `(is_record ,x ,rec-tag ,size)) + +(defmacro refp (x) + `(is_reference ,x)) + +(defmacro referencep (x) + `(is_reference ,x)) + +(defmacro tuplep (x) + `(is_tuple ,x)) + +(defmacro vectorp (x) + `(is_tuple ,x)) + +(defun consp + ((`(,a . ,b)) (when (not (is_list b))) + 'true) + ((_) 'false)) + +;;; Constructors + +(defmacro vector args + `(tuple ,@args)) + +;;; List macros + +(defmacro dolist body + (let ((var (caar body)) + (items (cadar body)) + (body (cdr body))) + `(lists:foreach + (lambda (,var) (progn ,@body)) + ,items)))
View file
lfe-0.9.2.tar.gz/rebar.config.script -> lfe-1.0.tar.gz/rebar.config.script
Changed
@@ -1,17 +1,28 @@ %% -*- mode: erlang; indent-tabs-mode: nil -*- Conf0 = CONFIG, -MapOpt = [{d,'HAS_MAPS',true}], +MapString = "#{X => 1}.", +HasOpt = {d,'HAS_MAPS',true}, +FullOpt = {d,'HAS_FULL_KEYS',true}, -case erl_internal:bif(is_map, 1) of - true -> %Maps - case lists:keyfind(erl_opts, 1, Conf0) of - {erl_opts,Opts} -> %Existing erl_opts - NewOpts = {erl_opts,Opts ++ MapOpt}, - lists:keyreplace(erl_opts, 1, Conf0, NewOpts); - false -> %No erl_opts - Conf0 ++ [{erl_opts,MapOpt}] - end; - false -> %No maps - Conf0 +MapsOpts = case erl_scan:string(MapString) of + {ok,Ts,_} -> + case erl_parse:parse_exprs(Ts) of + {ok,Es} -> %We have maps! + Binds = [{'X',49}], %We need to bind X + case erl_lint:exprs(Es, Binds) of + {ok,_} -> [HasOpt,FullOpt]; + {error,_,_} -> [HasOpt] + end; + {error,_} -> [] + end; + {error,_,_} -> [] + end, + +case lists:keyfind(erl_opts, 1, Conf0) of + {erl_opts,Opts} -> %Existing erl_opts + NewOpts = {erl_opts,Opts ++ MapsOpts}, + lists:keyreplace(erl_opts, 1, Conf0, NewOpts); + false -> %No erl_opts + Conf0 ++ [{erl_opts,MapsOpts}] end.
View file
lfe-1.0.tar.gz/src/cl.lfe
Added
@@ -0,0 +1,606 @@ +;; Copyright (c) 2015 Robert Virding +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. + +;; File : cl.lfe +;; Author : Robert Virding, Duncan McGreggor +;; Purpose : LFE Common Lisp interface library. + +(defmodule cl + (export + ;; Boolean conversion functions. + (make-lfe-bool 1) (make-cl-bool 1) + ;; Control structure. + (mapcar 2) (maplist 2) (mapc 2) (mapl 2) + ;; Symbol functions. + (symbol-plist 1) (symbol-name 1) + (get 2) (get 3) (getl 2) (putprop 3) (remprop 2) + ;; Property list functions. + (getf 2) (getf 3) (putf 3) (remf 2) (get-properties 2) + ;; Sequences. + (elt 2) (length 1) (reverse 1) (some 2) (every 2) (notany 2) (notevery 2) + (reduce 2) (reduce 4) (reduce 6) + (remove 2) (remove-if 2) (remove-if-not 2) (remove-duplicates 1) + (find 2) (find-if 2) (find-if-not 2) + (position 2) (position-if 2) (position-if-not 2) + (count 2) (count-if 2) (count-if-not 2) + ;; Lists. + (car 1) (cdr 1) (first 1) (rest 1) (nth 2) + (nthcdr 2) (last 1) (butlast 1) + ;; Substitution of expressions. + (subst 3) (subst-if 3) (subst-if-not 3) (sublis 2) + ;; Lists as sets. + (member 2) (member-if 2) (member-if-not 2) (adjoin 2) (union 2) + (intersection 2) (set-difference 2) (set-exclusive-or 2) (subsetp 2) + ;; Association list functions. + (acons 3) (pairlis 2) (pairlis 3) (assoc 2) (assoc-if 2) (assoc-if-not 2) + (rassoc 2) (rassoc-if 2) (rassoc-if-not 2) + ;; Types. + (type-of 1) (coerce 2) + ) + ;; Export CL-style if and cond, which we don't use internally. + (export-macro if cond) + ) + +;;; Boolean conversion functions. + +(defun make-lfe-bool ;Make an LFE bool from a CL value + ([()] 'false) + ([_] 'true)) ;Everything else is true + +(defun make-cl-bool ;Make a CL bool from an LFE value + (['false] ()) + (['true] 'true)) + +;; Control structure. + +(defun mapcar (func list) + (lists:map func list)) + +(defun maplist + ([func (= (cons _ rest) list)] + (cons (funcall func list) (maplist func rest))) + ([func ()] ())) + +(defun mapc (func list) + (lists:foreach func list) + list) + +(defun mapl (func list) + (fletrec ((mapl-loop + ([(= (cons _ rest) list)] + (funcall func list) + (mapl-loop rest)) + ([()] ()))) + (mapl-loop list) + list)) + +;; Symbol function functions. +;; get, getl, putprop and remprop should really only work on a +;; symbols plist not just a plist. This is coming. Hence including +;; getf, putf and remf. + +(defun ensure-plist-table () + (case (ets:info 'lfe-symbol-plist 'type) + ('undefined + (let ((init-pid (erlang:whereis 'init))) + (ets:new 'lfe-symbol-plist + (list 'set 'public 'named_table (tuple 'heir init-pid ()))))) + (_ 'ok))) + +(defun symbol-plist (symbol) + (ensure-plist-table) + (case (ets:lookup 'lfe-symbol-plist symbol) + (`(#(,_ ,plist)) plist) + (() ()))) + +(defun symbol-name (symb) + (atom_to_list symb)) + +(defun get (symbol pname) + (get symbol pname ())) + +;;(defun get (plist pname def) (getf plist pname def)) + +(defun get (symbol pname def) + (ensure-plist-table) + (let ((plist (symbol-plist symbol))) + (getf plist pname def))) + +(defun getl (symbol pnames) + (ensure-plist-table) + (let ((plist (symbol-plist symbol))) + (fletrec ((getl-loop + ([(= (list* p v plist-rest) plist) pnames] + (if (member p pnames) + plist + (getl-loop plist-rest pnames))) + ([() pnames] ()))) + (getl-loop plist pnames)))) + +;; (defun putprop (plist val pname) (putf plist val pname)) + +(defun putprop (symbol val pname) + (ensure-plist-table) + (let* ((plist (symbol-plist symbol)) + (plist (putf plist val pname))) + (ets:insert 'lfe-symbol-plist (tuple symbol plist)))) + +;; (defun getprop (plist pname) (remf plist pname)) + +(defun remprop (symbol pname) + (ensure-plist-table) + (let* ((plist (symbol-plist symbol)) + (plist (remf plist pname))) + ;; Delete element if plist empty + (if (=:= plist ()) + (ets:delete 'lfe-symbol-plist symbol) + (ets:insert 'lfe-symbol-plist (tuple symbol plist))))) + +;; Property list functions. + +(defun getf (plist pname) + (getf plist pname ())) + +(defun getf + ([(list* p v plist) pname def] (when (=:= p pname)) v) + ([(list* _ _ plist) pname def] (getf plist pname def)) + ([() pname def] def)) + +(defun putf ;This doesn't exist in CL + ([(list* p _ plist) val pname] (when (=:= p pname)) + (list* pname val plist)) + ([(list* p v plist) val pname] + (list* p v (putf plist val pname))) + ([() val pname] (list pname val))) + +(defun remf + ([(list* p _ plist) pname] (when (=:= p pname)) plist) + ([(list* p v plist) pname] + (list* p v (remf plist pname))) + ([() pname] ())) + +(defun get-properties + ([(= (list* p v plist-rest) plist) pnames] + (if (member p pnames) + (tuple p v plist) + (get-properties plist-rest pnames))) + ([() pnames] (tuple () () ()))) + +;; Arrays. + +;; (defun aref (array i j) +;; (elt j (elt i array))) + +;; Sequences. +;; Simple sequence functions. + +(defun elt + ((n seq) (when (is_list seq)) + (nth n seq)) + ((n seq) (when (is_tuple seq)) + (element (+ n 1) seq))) + +(defun length + ([seq] (when (is_list seq)) + (length seq)) + ([seq] (when (is_tuple seq)) + (tuple_size seq))) +
View file
lfe-0.9.2.tar.gz/src/lfe.app.src -> lfe-1.0.tar.gz/src/lfe.app.src
Changed
@@ -15,8 +15,18 @@ {application, lfe, [{description, "Lisp Flavored Erlang (LFE)"}, - {vsn, "0.9.2"}, - {modules, []}, + {vsn, "1.0"}, + {modules,[cl,lfe,lfe_bits,lfe_codegen,lfe_comp,lfe_edlin_expand, + lfe_env,lfe_eval,lfe_gen,lfe_init,lfe_io, + lfe_io_format,lfe_io_pretty,lfe_io_write,lfe_lib, + lfe_lint,lfe_macro,lfe_macro_export,lfe_macro_include, + lfe_macro_record,lfe_ms,lfe_parse,lfe_pmod,lfe_qlc, + lfe_scan,lfe_shell,lfe_trans,lfescript]}, {registered, []}, - {applications, [kernel,stdlib,compiler]} + {applications, [kernel,stdlib,compiler]}, + {maintainers, ["Robert Virding"]}, + {licenses, ["Apache"]}, + {links, [{"Github", "https://github.com/rvirding/lfe"}, + {"Main site", "http://lfe.io/"}, + {"Documentation", "http://docs.lfe.io/"}]} ]}.
View file
lfe-1.0.tar.gz/src/lfe.erl
Added
@@ -0,0 +1,71 @@ +%% Copyright (c) 2016 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : lfe.erl +%% Author : Robert Virding +%% Purpose : Lisp Flavoured Erlang standard library. + +-module(lfe). + +%% Standard lisp library. +-export([eval/1,eval/2, + 'macro-function'/1,'macro-function'/2, + macroexpand/1,macroexpand/2, + 'macroexpand-1'/1,'macroexpand-1'/2, + 'macroexpand-all'/1,'macroexpand-all'/2]). + +-export(['LFE-EXPAND-EXPORTED-MACRO'/3]). + +%% 'LFE-EXPAND-EXPORTED-MACRO'(Name, Args, Env) -> {yes,Expansion} | no. +%% A smart implementation of this where we call the lfe_macro module +%% to expand and check for us. Using an empty environment ensures +%% only predefined macros are used. + +'LFE-EXPAND-EXPORTED-MACRO'(Name, Args, _) -> + lfe_macro:expand_expr([Name|Args], lfe_env:new()). + +%% Standard lisp library functions. +%% eval(Sexpr) -> Value. +%% macro-function(Name [,Environment]) -> Macro | []. +%% macroexpand(Form [,Environment]) -> Expansion | Form. +%% macroexpand-1(Form [,Environment]) -> Expansion | Form. +%% macroexpand-all(Form [,Environment]) -> Expansion | Form. + +eval(Sexpr) -> eval(Sexpr, lfe_env:new()). %Empty environment. +eval(Sexpr, Env) -> lfe_eval:expr(Sexpr, Env). + +'macro-function'(Symb) -> 'macro-function'(Symb, lfe_env:new()). +'macro-function'(Symb, Env) -> + case lfe_env:get_mbinding(Symb, Env) of + {yes,Macro} -> + Macro; + no -> [] + end. + +macroexpand(Form) -> macroexpand(Form, lfe_env:new()). +macroexpand(Form, Env) -> + case lfe_macro:expand_expr(Form, Env) of + {yes,Exp} -> Exp; + no -> Form + end. + +'macroexpand-1'(Form) -> 'macroexpand-1'(Form, lfe_env:new()). +'macroexpand-1'(Form, Env) -> + case lfe_macro:expand_expr_1(Form, Env) of + {yes,Exp} -> Exp; + no -> Form + end. + +'macroexpand-all'(Form) -> 'macroexpand-all'(Form, lfe_env:new()). +'macroexpand-all'(Form, Env) -> lfe_macro:expand_expr_all(Form, Env).
View file
lfe-0.9.2.tar.gz/src/lfe.hrl -> lfe-1.0.tar.gz/src/lfe.hrl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2014 Robert Virding +%% Copyright (c) 2014-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,5 +19,5 @@ %% We do a lot of quoting! -define(Q(E), [quote,E]). -define(BQ(E), [backquote,E]). --define(UQ(E), [unquote,E]). --define(UQ_S(E), ['unquote-splicing',E]). +-define(C(E), [comma,E]). +-define(C_A(E), ['comma-at',E]).
View file
lfe-0.9.2.tar.gz/src/lfe_bits.erl -> lfe-1.0.tar.gz/src/lfe_bits.erl
Changed
@@ -25,37 +25,37 @@ %% Everything default'ed. -record(spec, {type=default,size=default,unit=default, - sign=default,endian=default}). + sign=default,endian=default}). %% get_bitspecs(Specs) -> {ok,Size,{Type,Unit,Sign,End}} | {error,Error}. -%% Parse a bitspec, apply defaults and return data. The size field is -%% unevaluated. We only return the first error found. +%% Parse a bitspec, apply defaults and return data. The size field is +%% unevaluated. We only return the first error found. get_bitspecs(Specs) -> try - #spec{type=Ty0,size=Sz0,unit=Un0,sign=Si0,endian=En0} = - parse_bitspecs(Specs, #spec{}), - {Ty,Sz,Un,Si,En} = apply_defaults(Ty0, Sz0, Un0, Si0, En0), - {ok,Sz,{Ty,Un,Si,En}} + #spec{type=Ty0,size=Sz0,unit=Un0,sign=Si0,endian=En0} = + parse_bitspecs(Specs, #spec{}), + {Ty,Sz,Un,Si,En} = apply_defaults(Ty0, Sz0, Un0, Si0, En0), + {ok,Sz,{Ty,Un,Si,En}} catch - throw:Error -> Error + throw:Error -> Error end. %% parse_bitspecs(Specs) -> {ok,Size,{Type,Unit,Sign,End}} | {error,Error}. -%% Parse a bitspec and return data. Unmentioned fields get the value -%% default. We only return the first error found. +%% Parse a bitspec and return data. Unmentioned fields get the value +%% default. We only return the first error found. parse_bitspecs(Specs) -> case catch parse_bitspecs(Specs, #spec{}) of - #spec{type=Ty,size=Sz,unit=Un,sign=Si,endian=En} -> - {ok,Sz,{Ty,Un,Si,En}}; - Error -> Error + #spec{type=Ty,size=Sz,unit=Un,sign=Si,endian=En} -> + {ok,Sz,{Ty,Un,Si,En}}; + Error -> Error end. %% parse_bitspecs(Specs, #spec{}) -> #spec{}. -%% Parse a bitspec and return a #spec{} record. Unmentioned fields get -%% the value default. Errors throw the tuple {error,Error} and must be -%% caught. +%% Parse a bitspec and return a #spec{} record. Unmentioned fields +%% get the value default. Errors throw the tuple {error,Error} and +%% must be caught. parse_bitspecs(Ss, Sp0) -> foldl(fun (S, Sp) -> parse_bitspec(S, Sp) end, Sp0, Ss).
View file
lfe-0.9.2.tar.gz/src/lfe_codegen.erl -> lfe-1.0.tar.gz/src/lfe_codegen.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,7 +27,7 @@ -export([module/2]). -%% -compile(export_all). +-compile(export_all). -import(lists, [member/2,keysearch/3,reverse/1, all/2,map/2,foldl/3,foldr/3,mapfoldl/3,mapfoldr/3, @@ -40,7 +40,6 @@ add_ibinding/5,get_gbinding/3]). -include("lfe_comp.hrl"). --include_lib("compiler/src/core_parse.hrl"). %% Define IS_MAP/1 macro for is_map/1 bif. -ifdef(HAS_MAPS). @@ -51,7 +50,7 @@ -define(Q(E), [quote,E]). %We do a lot of quoting! --record(cg, {mod=[], %Module name +-record(cg, {module=[], %Module name exps=[], %Exports (ordsets) imps=[], %Imports (orddict) pref=[], %Prefixes @@ -67,101 +66,45 @@ fc=0 %Function counter }). -%% module(Forms, CompInfo) -> {ModuleName,CoreModule} +%% module(ModuleForms, CompInfo) -> {ModuleName,CoreModule} -module(Forms, #cinfo{opts=Opts,file=File}) -> +module(Mfs, #cinfo{opts=Opts,file=File}) -> St0 = #cg{opts=Opts,file=File}, - Core0 = #c_module{name=c_atom(none),exports=[],attrs=[],defs=[]}, - {Core1,St1} = forms(Forms, St0, Core0), - {St1#cg.mod,Core1}. + {Core,St1} = compile_module(Mfs, St0), + {St1#cg.module,Core}. -%% forms(Forms, State, CoreModule) -> {CoreModule,State}. -%% Compile the forms from the file as stored in the state record. +%% compile_module(ModuleForms, State) -> {CoreModule,State}. -forms(Forms, St0, Core0) -> - %% Collect the module definition and functions definitions. - {Fbs0,St1} = lfe_lib:proc_forms(fun collect_form/3, Forms, St0), - %% Add predefined functions and definitions. - Predefs = [{module_info,0},{module_info,1}], - Fbs1 = [{module_info, - [lambda,[], - [call,?Q(erlang),?Q(get_module_info),?Q(St1#cg.mod)]],1}, - {module_info, - [lambda,[x], - [call,?Q(erlang),?Q(get_module_info),?Q(St1#cg.mod),x]],1}| - Fbs0], - %% Make initial environment and set state. - Env = forms_env(Fbs1, St1), - St2 = St1#cg{exps=add_exports(St1#cg.exps, Predefs), - defs=Fbs1,env=Env}, - Exps = make_exports(St2#cg.exps, Fbs1), - Atts = map(fun ({N,V,L}) -> -%% Ann = line_file_anno(L, St2), - Ann = [L], - {c_lit(Ann, N),c_lit(Ann, V)} - end, St2#cg.atts), - %% Compile the functions. - {Cdefs,St3} = mapfoldl(fun (D, St) -> comp_define(D, Env, St) end, - St2, St2#cg.defs), - %% Build the final core module structure. - Core1 = Core0#c_module{name=c_atom(St3#cg.mod),exports=Exps, - attrs=Atts,defs=Cdefs}, - %% Maybe print lots of debug info. - debug_print("#cg: ~p\n", [St3], St3), - when_opt(fun () -> io:fwrite("core_lint: ~p\n", - [(catch core_lint:module(Core1))]) - end, debug_print, St3), - debug_print("#core: ~p\n", [Core1], St3), - %% when_opt(fun () -> - %% Pp = (catch io:put_chars([core_pp:format(Core1),$\n])), - %% io:fwrite("core_pp: ~p\n", [Pp]) - %% end, debug_print, St3), - {Core1,St3}. - -forms_env(Fbs, St) -> - %% Make initial environment with imports and local functions. - Env = foldl(fun ({M,Fs}, Env) -> - foldl(fun ({{F,A},R}, E) -> - add_ibinding(M, F, A, R, E) - end, Env, Fs) - end, lfe_env:new(), St#cg.imps), - foldl(fun ({Name,Def,_}, E) -> - add_fbinding(Name, func_arity(Def), Name, E) - end, Env, Fbs). - -debug_print(Format, Args, St) -> - when_opt(fun () -> io:fwrite(Format, Args) end, debug_print, St). - -when_opt(Fun, Opt, St) -> - case member(Opt, St#cg.opts) of - true -> Fun(); - false -> ok - end. +compile_module(Mfs, St0) -> + {Fbs,St1} = collect_module(Mfs, St0), + Core = c_module(c_atom(none), [], []), + compile_forms(Fbs, St1, Core). -add_exports(all, _) -> all; -add_exports(Old, More) -> union(Old, More). +%% collect_module(ModuleForms, State) -> {Fbs,State}. +%% Collect forms and module data. Returns function bindings and puts +%% module data into state. -make_exports(all, Fbs) -> - map(fun ({F,Def,_}) -> c_fname(F, func_arity(Def)) end, Fbs); -make_exports(Exps, _) -> - map(fun ({F,A}) -> c_fname(F, A) end, Exps). +collect_module(Mfs, St0) -> + {Acc,St1} = lists:foldl(fun collect_form/2, {[],St0}, Mfs), + {lists:reverse(Acc),St1}. %% collect_form(Form, Line, State} -> {[Ret],State}. %% Collect valid forms and module data. Returns forms and put module %% data into state. -collect_form(['define-module',Mod|Mdef], L, St) -> - %% Everything into State - {[],collect_mdef(Mdef, L, St#cg{mod=Mod,anno=[L]})}; -collect_form(['extend-module'|Mdef], L, St) -> - {[],collect_mdef(Mdef, L, St#cg{anno=[L]})}; -collect_form(['define-function',Name,[lambda|_]=Lambda], L, St) -> - {[{Name,Lambda,L}],St}; -collect_form(['define-function',Name,['match-lambda'|_]=Match], L, St) -> - {[{Name,Match,L}],St}. +collect_form({['define-module',Mod|Mdef],L}, {Acc,St}) -> + %% Everything into State. + {Acc,collect_mdef(Mdef, L, St#cg{module=Mod,anno=[L]})}; +collect_form({['extend-module'|Mdef],L}, {Acc,St}) -> + %% Everything into State. + {Acc,collect_mdef(Mdef, L, St#cg{anno=[L]})}; +collect_form({['define-function',Name,[lambda|_]=Lambda],L}, {Acc,St}) -> + {[{Name,Lambda,L}|Acc],St}; +collect_form({['define-function',Name,['match-lambda'|_]=Match],L}, {Acc,St}) -> + {[{Name,Match,L}|Acc],St}. -%% collect_props(ModDef, Line, State) -> State. -%% Collect module definition and fill in the #cg state record. +%% collect_mdef(ModDef, Line, State) -> State. +%% Collect module definition and fill in the #cg state record. collect_mdef([[export,all]|Mdef], L, St) -> collect_mdef(Mdef, L, St#cg{exps=all}); @@ -186,10 +129,10 @@ collect_imp(['from',Mod|Fs], St) -> collect_imp(fun ([F,A], Imps) -> store({F,A}, F, Imps) end, - Mod, St, Fs); + Mod, St, Fs); collect_imp(['rename',Mod|Rs], St) -> collect_imp(fun ([[F,A],R], Imps) -> store({F,A}, R, Imps) end, - Mod, St, Rs); + Mod, St, Rs); collect_imp(['prefix',Mod,Pre], St) -> Pstr = atom_to_list(Pre), %Store prefix as string St#cg{pref=store(Pstr, Mod, St#cg.pref)}. @@ -199,6 +142,74 @@ Imps1 = foldl(Fun, Imps0, Fs), St#cg{imps=store(Mod, Imps1, St#cg.imps)}. +%% compile_forms(Forms, State, CoreModule) -> {CoreModule,State}. +%% Compile the forms from the file as stored in the state record. + +compile_forms(Fbs0, St0, Core0) -> + %% Add predefined functions and definitions, these are in line 0. + Predefs = [{module_info,0},{module_info,1}], + Mibs = [{module_info, + [lambda,[], + [call,?Q(erlang),?Q(get_module_info),?Q(St0#cg.module)]],0}, + {module_info, + [lambda,[x], + [call,?Q(erlang),?Q(get_module_info),?Q(St0#cg.module),x]],0}], + %% The sum of all functions. + Fbs1 = Fbs0 ++ Mibs, + %% Make initial environment and set state. + Env = forms_env(Fbs1, St0), + St1 = St0#cg{exps=add_exports(St0#cg.exps, Predefs), + defs=Fbs1,env=Env}, + Exps = make_exports(St1#cg.exps, Fbs1), + Atts = map(fun ({N,V,L}) -> + Ann = [L], + {ann_c_lit(Ann, N),ann_c_lit(Ann, V)}
View file
lfe-0.9.2.tar.gz/src/lfe_comp.erl -> lfe-1.0.tar.gz/src/lfe_comp.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2016 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -16,51 +16,93 @@ %%% Author : Robert Virding %%% Purpose : Lisp Flavoured Erlang compiler (to core Erlang). +%% All the code in the file is treated as one sequence of forms until +%% after the macroexpansion pass when it is split into separate +%% modules. However up until after the lint pass all errors and +%% warnings are collected together in the errors and warnings +%% fields. After this the errors become more module specific and are +%% kept together with the compiled code, both for core and the +%% following erlang formats. + -module(lfe_comp). --export([file/1,file/2,forms/1,forms/2]). +-export([file/1,file/2,forms/1,forms/2,default_options/0]). %% -compile(export_all). --import(lists, [member/2,keyfind/3,filter/2,foreach/2,all/2, +-import(lists, [member/2,keyfind/3,filter/2,foreach/2,all/2,any/2, map/2,flatmap/2,foldl/3,foldr/3,mapfoldl/3,mapfoldr/3]). -import(ordsets, [add_element/2,is_element/2,from_list/1,union/2]). -import(orddict, [store/3,find/2]). -include("lfe_comp.hrl"). --record(comp, {base="", %Base name - ldir=".", %Lisp file dir - lfile="", %Lisp file - odir=".", %Output directory - bfile="", %Beam file - cfile="", %Core file - opts=[], %User options - ipath=[], %Include path - mod=[], %Module name - ret=file, %What is returned [Val] | [] - code=none, %Code after last pass. - cinfo=none, %Common compiler info +%% The main compiler state. + +-record(comp, {base="", %Base name + ldir=".", %Lisp file dir + lfile="", %Lisp file + odir=".", %Output directory + opts=[], %User options + ipath=[], %Include path + cinfo=none, %Common compiler info + module=[], %Module name + code=[], %Code after last pass. + return=[], %What is returned [Val] | [] errors=[], warnings=[] }). +%% default_options() -> Options. +%% Return the default compiler options. + +-define(DEFAULT_OPTS, [verbose,report]). + +default_options() -> ?DEFAULT_OPTS. + %% file(Name) -> %% {ok,Mod,Warns} | {ok,Mod,Binary,Ws} | {error,Errors,Warns} | error. %% file(Name, Options) -> %% {ok,Mod,Warns} | {ok,Mod,Binary,Ws} | {error,Errors,Warns} | error. %% Compile the LFE file Name. --define(DEFAULT_OPTS, [verbose,report]). +file(Name) -> file(Name, default_options()). + +file(Name, Opts) -> do_compile({file,Name}, Opts). + +%% forms(Forms) -> {ok,Mod,Bin,Warnings} | {error,Errors,Warnings}. +%% forms(Forms, Options) -> {ok,Mod,Bin,Warnings} | {error,Errors,Warnings}. +%% Compile the LFE forms Forms, always return a binary. + +forms(Forms) -> forms(Forms, default_options()). + +forms(Forms, Opts) -> do_compile({forms,Forms}, Opts). + +do_compile(Input, Opts) -> + Ifun = fun () -> + Ret = try + internal(Input, Opts) + catch + error:Reason -> + St = erlang:get_stacktrace(), + {error,{Reason,St}} + end, + exit(Ret) + end, + {Pid,Ref} = spawn_monitor(Ifun), + receive + {'DOWN',Ref,_,Pid,Res} -> Res + end. -file(Name) -> do_file(Name, ?DEFAULT_OPTS). +%% internal(Input, Options) -> Result. -file(Name, Opts) -> do_file(Name, Opts). +internal({file,Name}, Opts) -> do_file(Name, Opts); +internal({forms,Forms}, Opts) -> do_forms(Forms, Opts). do_file(Name, Opts0) -> Opts1 = lfe_comp_opts(Opts0), - St0 = #comp{opts=Opts1}, - St1 = filenames(Name, St0), + St0 = #comp{opts=Opts1,code=[]}, %Code must be list! + St1 = filenames(Name, ".lfe", St0), St2 = include_path(St1), case lfe_io:parse_file(St2#comp.lfile) of {ok,Fs} -> @@ -69,57 +111,47 @@ {error,Error} -> do_error_return(St2#comp{errors=[Error]}) end. -%% forms(Forms) -> {ok,Mod,Bin,Warnings} | {error,Errors,Warnings}. -%% forms(Forms, Options) -> {ok,Mod,Bin,Warnings} | {error,Errors,Warnings}. -%% Compile the LFE forms Forms, always return a binary. - -forms(Forms) -> do_forms(Forms, ?DEFAULT_OPTS). - -forms(Forms, Opts) -> do_forms(Forms, Opts). - do_forms(Fs0, Opts0) -> + Source = proplists:get_value(source, Opts0, "-no-file-"), Opts1 = lfe_comp_opts(Opts0), - St0 = #comp{opts=[binary|Opts1]}, %Implicit binary option - St1 = filenames("-no-file-", St0#comp{opts=Opts1}), + St0 = #comp{opts=[binary|Opts1]}, %Implicit binary option + St1 = filenames(Source, ".lfe", St0), St2 = include_path(St1), %% Tag forms with a "line number", just use their index. {Fs1,_} = mapfoldl(fun (F, N) -> {{F,N},N+1} end, 1, Fs0), do_forms(St2#comp{code=Fs1}). -%% filenames(File, State) -> State. +%% filenames(File, Suffix, State) -> State. %% The default output dir is the current directory unless an %% explicit one has been given in the options. -filenames(File, St) -> +filenames(File, Suffix, St) -> %% Test for explicit outdir. Odir = outdir(St#comp.opts), - Dir = filename:dirname(File), - Base = filename:basename(File, ".lfe"), - Lfile = filename:join(Dir, Base ++ ".lfe"), - Bfile = Base ++ ".beam", - Cfile = Base ++ ".core", + Ldir = filename:dirname(File), + Base = filename:basename(File, Suffix), + Lfile = filename:join(Ldir, Base ++ Suffix), St#comp{base=Base, - ldir=Dir, + ldir=Ldir, lfile=Lfile, - odir=Odir, - bfile=filename:join(Odir, Bfile), - cfile=filename:join(Odir, Cfile)}. + odir=Odir + }. -outdir([{outdir,Dir}|_]) -> Dir; -outdir([[outdir,Dir]|_]) -> Dir; +outdir([{outdir,Dir}|_]) -> Dir; %Erlang way +outdir([[outdir,Dir]|_]) -> Dir; %LFE way outdir([_|Opts]) -> outdir(Opts); outdir([]) -> ".". %% include_path(State) -> State. %% Set the include path, we permit {i,Dir} and [i,Dir]. -include_path(#comp{ldir=Dir,opts=Opts}=St) -> - Ifun = fun ({i,I}, Is) -> [I|Is]; - ([i,I], Is) -> [I|Is]; +include_path(#comp{ldir=Ldir,opts=Opts}=St) -> + Ifun = fun ({i,I}, Is) -> [I|Is]; %Erlang way + ([i,I], Is) -> [I|Is]; %LFE way (_, Is) -> Is end, - %% Same ordering as in the erlang compiler - Is = [".",Dir|foldr(Ifun, [], Opts)], %Default entries + %% Same ordering as in the erlang compiler. + Is = [".",Ldir|foldr(Ifun, [], Opts)], %Default entries St#comp{ipath=Is}. %% compiler_info(State) -> CompInfo. @@ -128,10 +160,25 @@ #cinfo{file=F,opts=Os,ipath=Is}. %% lfe_comp_opts(Opts) -> Opts. -%% Check options for lfe compiler.
View file
lfe-0.9.2.tar.gz/src/lfe_comp.hrl -> lfe-1.0.tar.gz/src/lfe_comp.hrl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2014 Robert Virding +%% Copyright (c) 2014-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,3 +23,8 @@ ipath=[], %Include path mod=none %Module name }). + +-record(module, {name=[], %Module name + code, %Module code + warnings=[] %Module warnings + }).
View file
lfe-1.0.tar.gz/src/lfe_edlin_expand.erl
Added
@@ -0,0 +1,247 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(lfe_edlin_expand). + +%% A default LFE expand function for edlin, expanding modules and +%% functions. It knows about LFE symbol syntax but as yet only works +%% for (mod:fun ...) and not (: mod fun ...) + +-export([expand/1, format_matches/1]). + +-import(lists, [reverse/1, nthtail/2, prefix/2]). + +%% expand(CurrentBefore) -> +%% {yes, Expansion, Matches} | {no, Expansion, Matches} +%% Try to expand the word before as either a module name or a +%% function name. CurrentBefore is reversed and over_word/3 reverses +%% the characters it finds. In certain cases possible expansions are +%% printed. + +expand(Bef0) -> + {Bef1,S1,_} = over_symbol(Bef0, [], 0), + case Bef1 of + [$:|Bef2] -> %After a ':' + {Bef3,S2,_} = over_symbol(Bef2, [], 0), + need_lparen(Bef3, fun () -> expand_function_name(S2, S1) end); + Bef2 -> + need_lparen(Bef2, fun () -> expand_module_name(S1) end) + end. + +need_lparen(Bef, Do) -> + case over_white(Bef, [], 0) of + {[$(|_],_,_} -> Do(); + {_,_,_} -> {no,[],[]} + end. + +%% expand(Bef0) -> +%% {Bef1,Word,_} = edlin:over_word(Bef0, [], 0), +%% case over_white(Bef1, [], 0) of +%% {[$:|Bef2],_White,_Nwh} -> +%% {Bef3,_White1,_Nwh1} = over_white(Bef2, [], 0), +%% {_,Mod,_Nm} = edlin:over_word(Bef3, [], 0), +%% expand_function_name(Mod, Word); +%% {_,_,_} -> +%% expand_module_name(Word) +%% end. + +expand_module_name(Prefix) -> + match(Prefix, code:all_loaded(), ":"). + +expand_function_name(ModStr, FuncPrefix) -> + case to_symbol(ModStr) of + {ok,Mod} -> + case erlang:module_loaded(Mod) of + true -> + L = Mod:module_info(), + case lists:keyfind(exports, 1, L) of + {_, Exports} -> + match(FuncPrefix, Exports, " "); + _ -> + {no,[],[]} + end; + false -> + {no,[],[]} + end; + error -> + {no,[],[]} + end. + +%% If it's a quoted symbol, atom_to_list/1 will do the wrong thing. +to_symbol(Str) -> + case lfe_scan:string(Str) of + {ok,[{symbol,_,A}],_} -> {ok,A}; + _ -> error + end. + +match(Prefix, Alts, Extra0) -> + Len = length(Prefix), + Matches = lists:sort([{S, A} || {H, A} <- Alts, + begin + S = hd(lfe_io:fwrite1("~w", [H])), + prefix(Prefix, S) + end]), + case longest_common_head([N || {N, _} <- Matches]) of + {partial, []} -> + {no, [], Matches}; %format_matches(Matches)}; + {partial, Str} -> + case nthtail(Len, Str) of + [] -> {yes,[],Matches}; %format_matches(Matches)}; + Remain -> {yes,Remain,[]} + end; + {complete, Str} -> + Extra = case {Extra0,Matches} of + {" ",[{Str,0}]} -> ")"; + {_,_} -> Extra0 + end, + {yes, nthtail(Len, Str) ++ Extra, []}; + no -> + {no,[],[]} + end. + +%% Return the list of names L in multiple columns. +format_matches(L) -> + S = format_col(lists:sort(L), []), + ["\n" | S]. + +format_col([], _) -> []; +format_col(L, Acc) -> format_col(L, field_width(L), 0, Acc). + +format_col(X, Width, Len, Acc) when Width + Len > 79 -> + format_col(X, Width, 0, ["\n" | Acc]); +format_col([A|T], Width, Len, Acc0) -> + H = case A of + %% If it's a tuple {string(), integer()}, we assume it's an + %% arity, and meant to be printed. + {H0, I} when is_integer(I) -> + H0 ++ "/" ++ integer_to_list(I); + {H1, _} -> H1; + H2 -> H2 + end, + Acc = [io_lib:format("~-*s", [Width,H]) | Acc0], + format_col(T, Width, Len+Width, Acc); +format_col([], _, _, Acc) -> + lists:reverse(Acc, "\n"). + +field_width(L) -> field_width(L, 0). + +field_width([{H,_}|T], W) -> + case length(H) of + L when L > W -> field_width(T, L); + _ -> field_width(T, W) + end; +field_width([H|T], W) -> + case length(H) of + L when L > W -> field_width(T, L); + _ -> field_width(T, W) + end; +field_width([], W) when W < 40 -> + W + 4; +field_width([], _) -> + 40. + +longest_common_head([]) -> + no; +longest_common_head(LL) -> + longest_common_head(LL, []). + +longest_common_head([[]|_], L) -> + {partial, reverse(L)}; +longest_common_head(LL, L) -> + case same_head(LL) of + true -> + [[H|_]|_] = LL, + LL1 = all_tails(LL), + case all_nil(LL1) of + true -> + {complete, reverse([H|L])}; + false -> + longest_common_head(LL1, [H|L]) + end; + false -> + {partial, reverse(L)} + end. + +same_head([[H|_]|T1]) -> same_head(H, T1). + +same_head(H, [[H|_]|T]) -> same_head(H, T); +same_head(_, []) -> true; +same_head(_, _) -> false. + +all_tails(LL) -> all_tails(LL, []). + +all_tails([[_|T]|T1], L) -> all_tails(T1, [T|L]); +all_tails([], L) -> L. + +all_nil([]) -> true; +all_nil([[] | Rest]) -> all_nil(Rest); +all_nil(_) -> false. + +%% over_symbol(Chars, InitialStack, InitialCount) -> +%% {RemainingChars,CharStack,Count} +%% over_non_symbol(Chars, InitialStack, InitialCount) -> +%% {RemainingChars,CharStack,Count}
View file
lfe-0.9.2.tar.gz/src/lfe_env.erl -> lfe-1.0.tar.gz/src/lfe_env.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2014 Robert Virding +%% Copyright (c) 2008-2016 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,7 +19,8 @@ -module(lfe_env). -export([new/0,add_env/2, - get_vars/1,clr_vars/1,set_vars/2,get_funs/1,clr_funs/1,set_funs/2, + get_vars/1,clr_vars/1,set_vars/2,fold_vars/3, + get_funs/1,clr_funs/1,set_funs/2,fold_funs/3,fold_macros/3, add_vbinding/3,add_vbindings/2,is_vbound/2,get_vbinding/2, fetch_vbinding/2,del_vbinding/2, add_fbinding/4,add_fbindings/2, @@ -31,8 +32,34 @@ -import(lfe_lib, [is_bif/2,is_lfe_bif/2,is_erl_bif/2,is_guard_bif/2]). -import(lists, [reverse/1,reverse/2,map/2,foldl/3,dropwhile/2]). +%% Define access macros depending on whether we have maps. +-ifdef(HAS_MAPS). +-define(NEW(), #{}). +-define(IS_KEY(K, D), maps:is_key(K, D)). +-define(GET(K, D), maps:get(K, D)). +-define(FIND(K, D), maps:find(K, D)). +-define(PUT(K, V, D), maps:put(K, V, D)). +-define(ERASE(K, D), maps:remove(K, D)). +-define(FOLD(F, A, D), maps:fold(F, A, D)). +-define(UPDATE(K, UPD, DEF, D), %This is slightly complex + begin (fun (___K, {ok,___V}) -> + maps:put(___K, UPD(___V), D); + (___K, error) -> + maps:put(___K, DEF, D) + end)(K, maps:find(K, D)) end). +-else. +-define(NEW(), orddict:new()). +-define(IS_KEY(K, D), orddict:is_key(K, D)). +-define(GET(K, D), orddict:fetch(K, D)). +-define(FIND(K, D), orddict:find(K, D)). +-define(PUT(K, V, D), orddict:store(K, V, D)). +-define(ERASE(K, D), orddict:erase(K, D)). +-define(FOLD(F, A, D), orddict:fold(F, A, D)). +-define(UPDATE(K, UPD, DEF, D), orddict:update(K, UPD, DEF, D)). +-endif. + %% The environment structure. --record(env, {vars=[],funs=[]}). +-record(env, {vars=null,funs=null}). %% -compile([export_all]). @@ -41,9 +68,12 @@ %% get_vars(Env) -> Vars. %% clr_vars(Env) -> Env. %% set_vars(Vars, Env) -> Env. +%% fold_vars(Fun, Acc, Env) -> Acc. %% get_funs(Env) -> Funs. %% clr_funs(Env) -> Env. %% set_funs(Funs, Env) -> Env. +%% fold_funs(Fun, Acc, Env) -> Acc. +%% fold_macros(Fun, Acc, Env) -> Acc. %% add_vbinding(Name, Val, Env) -> Env. %% add_vbindings([{Name,Val}], Env) -> Env. %% is_vbound(Symb, Env) -> bool(). @@ -79,44 +109,69 @@ %% is no longer a legal guard bif but must be explicitly called with %% module erlang. -new() -> #env{vars=orddict:new(),funs=orddict:new()}. +new() -> #env{vars=?NEW(),funs=?NEW()}. +-ifdef(HAS_MAPS). +add_env(#env{vars=Vs1,funs=Fs1}, #env{vars=Vs2,funs=Fs2}) -> + #env{vars=maps:merge(Vs2, Vs1), %Always take left env + funs=maps:merge(Fs2, Fs1)}. +-else. add_env(#env{vars=Vs1,funs=Fs1}, #env{vars=Vs2,funs=Fs2}) -> Merge = fun (_, V1, _) -> V1 end, %Always take left env #env{vars=orddict:merge(Merge, Vs1, Vs2), funs=orddict:merge(Merge, Fs1, Fs2)}. +-endif. get_vars(Env) -> Env#env.vars. -clr_vars(Env) -> Env#env{vars=orddict:new()}. +clr_vars(Env) -> Env#env{vars=?NEW()}. set_vars(Vars, Env) -> Env#env{vars=Vars}. +fold_vars(Fun, Acc, Env) -> + ?FOLD(Fun, Acc, Env#env.vars). get_funs(Env) -> Env#env.funs. -clr_funs(Env) -> Env#env{funs=orddict:new()}. +clr_funs(Env) -> Env#env{funs=?NEW()}. set_funs(Funs, Env) -> Env#env{funs=Funs}. +fold_funs(Fun, Acc, Env) -> + Ofun = fun (F, {function,Fs}, Ac) -> %Function + Ffun = fun ({Ar,Def}, A) -> + Fun(F, Ar, Def, A) + end, + lists:foldl(Ffun, Ac, Fs); + (_, _, A) -> A %Macro + end, + ?FOLD(Ofun, Acc, Env#env.funs). + +fold_macros(Fun, Acc, Env) -> + Ofun = fun (F, {macro,Def}, A) -> %Macro + Fun(F, Def, A); + (_, _, A) -> A %Function + end, + ?FOLD(Ofun, Acc, Env#env.funs). + %% Variables. add_vbinding(N, V, #env{vars=Vs}=Env) -> - Env#env{vars=orddict:store(N, V, Vs)}. + Env#env{vars=?PUT(N, V, Vs)}. add_vbindings(Vbs, #env{vars=Vs0}=Env) -> - Vs1 = foldl(fun ({N,V}, Vs) -> orddict:store(N, V, Vs) end, Vs0, Vbs), + Vs1 = foldl(fun ({N,V}, Vs) -> ?PUT(N, V, Vs) end, Vs0, Vbs), Env#env{vars=Vs1}. is_vbound(N, #env{vars=Vs}) -> - orddict:is_key(N, Vs). + ?IS_KEY(N, Vs). get_vbinding(N, #env{vars=Vs}) -> - case orddict:find(N, Vs) of + case ?FIND(N, Vs) of {ok,V} -> {yes,V}; error -> no end. fetch_vbinding(N, #env{vars=Vs}) -> - orddict:fetch(N, Vs). + ?GET(N, Vs). del_vbinding(N, #env{vars=Vs}=Env) -> - Env#env{vars=orddict:erase(N, Vs)}. + Env#env{vars=?ERASE(N, Vs)}. %% Functions. @@ -130,7 +185,7 @@ {function,lists:keystore(A, 1, Fas, T)}; (_) -> Def %Overwrite macros end, - orddict:update(N, Upd, Def, Fs). + ?UPDATE(N, Upd, Def, Fs). add_fbindings(Fbs, #env{funs=Fs0}=Env) -> Fs1 = foldl(fun ({N,A,V}, Fs) -> add_fbinding_1(N, A, {A,V}, Fs) end, @@ -142,18 +197,18 @@ Env#env{funs=Fs1}. is_fbound(N, A, #env{funs=Fs}) -> - case orddict:find(N, Fs) of + case ?FIND(N, Fs) of {ok,{function,Fas}} -> - case lists:keyfind(A, 1, Fas) of - false -> is_bif(N, A); - _ -> true - end; + case lists:keyfind(A, 1, Fas) of + false -> is_bif(N, A); + _ -> true + end; {ok,_} -> false; %A macro error -> is_bif(N, A) end. get_fbinding(N, A, #env{funs=Fs}) -> - case orddict:find(N, Fs) of + case ?FIND(N, Fs) of {ok,{function,Fas}} -> case lists:keyfind(A, 1, Fas) of {A,M,F} -> {yes,M,F}; @@ -177,51 +232,51 @@ end. is_gbound(N, A, #env{funs=Fs}) -> - case orddict:find(N, Fs) of + case ?FIND(N, Fs) of {ok,{function,Fas}} -> - case lists:keyfind(A, 1, Fas) of - false -> is_guard_bif(N, A); - _ -> false - end; + case lists:keyfind(A, 1, Fas) of + false -> is_guard_bif(N, A); + _ -> false + end; {ok,_} -> false; %A macro error -> is_guard_bif(N, A) end. get_gbinding(N, A, #env{funs=Fs}) -> - case orddict:find(N, Fs) of + case ?FIND(N, Fs) of
View file
lfe-0.9.2.tar.gz/src/lfe_eval.erl -> lfe-1.0.tar.gz/src/lfe_eval.erl
Changed
@@ -120,7 +120,7 @@ Pairs = map_pairs(As, Env), maps:from_list(Pairs); eval_expr(['mref',Map,K], Env) -> - Key = map_key(K), + Key = map_key(K, Env), maps:get(Key, eval_expr(Map, Env)); eval_expr(['mset',M|As], Env) -> Map = eval_expr(M, Env), @@ -137,10 +137,10 @@ eval_expr(['map-update',M|As], Env) -> eval_expr([mupd,M|As], Env); %% Handle the Core closure special forms. -eval_expr([lambda|Body], Env) -> - eval_lambda(Body, Env); -eval_expr(['match-lambda'|Cls], Env) -> - eval_match_lambda(Cls, Env); +eval_expr([lambda|_]=Sexpr, Env) -> + eval_lambda_expr(Sexpr, Env); +eval_expr(['match-lambda'|_]=Sexpr, Env) -> + eval_lambda_expr(Sexpr, Env); eval_expr(['let'|Body], Env) -> eval_let(Body, Env); eval_expr(['let-function'|Body], Env) -> @@ -209,7 +209,8 @@ foldr(fun (S, Vs) -> get_bitseg(S, Vs) end, [], Segs). %% get_bitseg(Bitseg, ValSpecs) -> ValSpecs. -%% A bitseg is either an atomic value, a list of value and specs, or a string. +%% A bitseg is either an atomic value, a list of value and specs, or +%% a string. get_bitseg([Val|Specs]=Seg, Vsps) -> case is_posint_list(Seg) of %Is bitseg a string? @@ -259,30 +260,30 @@ eval_exp_bitseg(Val, Size, Eval, Type) -> case Type of - %% Integer types. - {integer,Un,Si,En} -> - Sz = Eval(Size), - eval_int_bitseg(Val, Sz*Un, Si, En); - %% Unicode types, ignore unused fields. - {utf8,_,_,_} -> <<Val/utf8>>; - {utf16,_,_,En} -> eval_utf16_bitseg(Val, En); - {utf32,_,_,En} -> eval_utf32_bitseg(Val, En); - %% Float types. - {float,Un,_,En} -> - Sz = Eval(Size), - eval_float_bitseg(Val, Sz*Un, En); - %% Binary types. - {binary,Unit,_,_} -> - if Size == all -> - case bit_size(Val) of - Sz when Sz rem Unit =:= 0 -> - <<Val:Sz/bitstring>>; - _ -> eval_error(badarg) - end; - true -> + %% Integer types. + {integer,Un,Si,En} -> Sz = Eval(Size), - <<Val:(Sz*Unit)/bitstring>> - end + eval_int_bitseg(Val, Sz*Un, Si, En); + %% Unicode types, ignore unused fields. + {utf8,_,_,_} -> <<Val/utf8>>; + {utf16,_,_,En} -> eval_utf16_bitseg(Val, En); + {utf32,_,_,En} -> eval_utf32_bitseg(Val, En); + %% Float types. + {float,Un,_,En} -> + Sz = Eval(Size), + eval_float_bitseg(Val, Sz*Un, En); + %% Binary types. + {binary,Unit,_,_} -> + if Size == all -> + case bit_size(Val) of + Sz when Sz rem Unit =:= 0 -> + <<Val:Sz/bitstring>>; + _ -> eval_error(badarg) + end; + true -> + Sz = Eval(Size), + <<Val:(Sz*Unit)/bitstring>> + end end. eval_int_bitseg(Val, Sz, signed, big) -> <<Val:Sz/signed>>; @@ -307,101 +308,77 @@ %% map_pairs(Args, Env) -> [{K,V}]. map_pairs([K,V|As], Env) -> - P = {map_key(K),eval_expr(V, Env)}, + P = {map_key(K, Env),eval_expr(V, Env)}, [P|map_pairs(As, Env)]; map_pairs([], _) -> []; map_pairs(_, _) -> eval_error(badarg). -%% map_key(Key) -> Value. -%% Map keys can only be literals. +%% map_key(Key, Env) -> Value. +%% A map key can only be a literal in 17 but can be anything in 18.. -map_key([quote,E]) -> E; -map_key([_|_]=L) -> +-ifdef(HAS_FULL_KEYS). +map_key(Key, Env) -> + eval_expr(Key, Env). +-else. +map_key([quote,E], _) -> E; +map_key([_|_]=L, _) -> case is_posint_list(L) of - true -> L; %Literal strings + true -> L; %Literal strings only false -> eval_error(illegal_mapkey) end; -map_key(E) when not is_atom(E) -> E; %Everything else -map_key(_) -> eval_error(illegal_mapkey). +map_key(E, _) when not is_atom(E) -> E; %Everything else +map_key(_, _) -> eval_error(illegal_mapkey). +-endif. -%% eval_lambda(LambdaBody, Env) -> Val. +%% eval_lambda_expr([lambda|LambdaBody], Env) -> Val. %% Evaluate (lambda args ...). +%% eval_lambda_expr(['match-lambda'|MatchClauses], Env) -> Val. +%% Evaluate (match-lambda cls ...). -eval_lambda([Args|Body], Env) -> +eval_lambda_expr(Sexp, Env) -> + {Arity,Apply} = + case Sexp of + [lambda,Args|Body] -> + { length(Args) + , fun (Vals) -> apply_lambda(Args, Body, Vals, Env) end }; + ['match-lambda'|Cls] -> + { match_lambda_arity(Cls) + , fun(Vals) -> apply_match_lambda(Cls, Vals, Env) end } + end, %% This is a really ugly hack! But it's the same hack as in erl_eval. - case length(Args) of - 0 -> fun () -> apply_lambda([], Body, [], Env) end; - 1 -> fun (A) -> apply_lambda(Args, Body, [A], Env) end; - 2 -> fun (A,B) -> apply_lambda(Args, Body, [A,B], Env) end; - 3 -> fun (A,B,C) -> apply_lambda(Args, Body, [A,B,C], Env) end; - 4 -> fun (A,B,C,D) -> apply_lambda(Args, Body, [A,B,C,D], Env) end; - 5 -> fun (A,B,C,D,E) -> apply_lambda(Args, Body, [A,B,C,D,E], Env) end; - 6 -> fun (A,B,C,D,E,F) -> - apply_lambda(Args, Body, [A,B,C,D,E,F], Env) end; - 7 -> fun (A,B,C,D,E,F,G) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G], Env) end; - 8 -> fun (A,B,C,D,E,F,G,H) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G,H], Env) end; - 9 -> fun (A,B,C,D,E,F,G,H,I) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G,H,I], Env) end; - 10 -> fun (A,B,C,D,E,F,G,H,I,J) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G,H,I,J], Env) end; - 11 -> fun (A,B,C,D,E,F,G,H,I,J,K) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G,H,I,J,K], Env) end; - 12 -> fun (A,B,C,D,E,F,G,H,I,J,K,L) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G,H,I,J,K,L], Env) end; - 13 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G,H,I,J,K,L,M], Env) end; - 14 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G,H,I,J,K,L,M,N], Env) end; - 15 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> - apply_lambda(Args, Body, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], Env) end + case Arity of + 0 -> fun () -> Apply([]) end; + 1 -> fun (A) -> Apply([A]) end; + 2 -> fun (A,B) -> Apply([A,B]) end; + 3 -> fun (A,B,C) -> Apply([A,B,C]) end; + 4 -> fun (A,B,C,D) -> Apply([A,B,C,D]) end; + 5 -> fun (A,B,C,D,E) -> Apply([A,B,C,D,E]) end; + 6 -> fun (A,B,C,D,E,F) -> Apply([A,B,C,D,E,F]) end; + 7 -> fun (A,B,C,D,E,F,G) -> Apply([A,B,C,D,E,F,G]) end; + 8 -> fun (A,B,C,D,E,F,G,H) -> Apply([A,B,C,D,E,F,G,H]) end; + 9 -> fun (A,B,C,D,E,F,G,H,I) -> Apply([A,B,C,D,E,F,G,H,I]) end; + 10 -> fun (A,B,C,D,E,F,G,H,I,J) -> Apply([A,B,C,D,E,F,G,H,I,J]) end; + 11 -> fun (A,B,C,D,E,F,G,H,I,J,K) -> Apply([A,B,C,D,E,F,G,H,I,J,K]) end; + 12 -> fun (A,B,C,D,E,F,G,H,I,J,K,L) -> + Apply([A,B,C,D,E,F,G,H,I,J,K,L]) end; + 13 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M) -> + Apply([A,B,C,D,E,F,G,H,I,J,K,L,M]) end; + 14 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> + Apply([A,B,C,D,E,F,G,H,I,J,K,L,M,N]) end; + 15 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> + Apply([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O]) end end. apply_lambda(Args, Body, Vals, Env0) -> Env1 = bind_args(Args, Vals, Env0), eval_body(Body, Env1). -bind_args(['_'|As], [_|Es], Env) -> %Ignore don't care variables +bind_args(['_'|As], [_|Es], Env) -> %Ignore don't care variables bind_args(As, Es, Env); bind_args([A|As], [E|Es], Env) when is_atom(A) -> bind_args(As, Es, add_vbinding(A, E, Env)); bind_args([], [], Env) -> Env.
View file
lfe-0.9.2.tar.gz/src/lfe_gen.erl -> lfe-1.0.tar.gz/src/lfe_gen.erl
Changed
@@ -20,7 +20,7 @@ -export([compile_forms/1]). -export([new_module/1,add_exports/2,add_imports/2,add_form/2, - print_mod/1,compile_mod/1]). + print_mod/1,compile_mod/1]). -import(lists, [map/2,foldl/3,mapfoldl/3]). -import(ordsets, [add_element/2]). @@ -33,8 +33,8 @@ compile_forms(Fs) -> case lfe_comp:forms(Fs, [return]) of - {ok,Mod,Bin,Ws} -> {ok,Mod,Bin,Ws}; - {error,Es,Ws} -> {error,Es,Ws} + {ok,Mod,Bin,Ws} -> {ok,Mod,Bin,Ws}; + {error,Es,Ws} -> {error,Es,Ws} end. %% new_module(Name) -> Module. @@ -51,19 +51,19 @@ add_exports(Exps, Mod) -> Es0 = Mod#gen.exps, Es1 = foldl(fun ({N,Ar}, Es) when is_atom(N), is_integer(Ar) -> - add_element({N,Ar}, Es) - end, Es0, Exps), + add_element({N,Ar}, Es) + end, Es0, Exps), Mod#gen{exps=Es1}. add_imports({from,M,Is}, Mod) -> Imps0 = Mod#gen.imps, Imps1 = collect_imp(fun ({F,A}, Imps) -> store({F,A}, F, Imps) end, - M, Imps0, Is), + M, Imps0, Is), Mod#gen{imps=Imps1}; add_imports({rename,M,Is}, Mod) -> Imps0 = Mod#gen.imps, Imps1 = collect_imp(fun ({{F,A},R}, Imps) -> store({F,A}, R, Imps) end, - M, Imps0, Is), + M, Imps0, Is), Mod#gen{imps=Imps1}. add_form(Form, Mod) -> @@ -87,9 +87,9 @@ build_def(Mod) -> Exps = map(fun ({N,I}) -> [N,I] end, Mod#gen.exps), Imps = map(fun ({M,Is}) -> - [rename,M|map(fun ({{L,Ar},R}) -> [[L,Ar],R] end, - Is)] - end, Mod#gen.imps), + [rename,M|map(fun ({{L,Ar},R}) -> [[L,Ar],R] end, + Is)] + end, Mod#gen.imps), [defmodule,Mod#gen.name, [export|Exps], [import|Imps]]. @@ -98,6 +98,6 @@ safe_fetch(Key, D, Def) -> case find(Key, D) of - {ok,Val} -> Val; - error -> Def + {ok,Val} -> Val; + error -> Def end.
View file
lfe-0.9.2.tar.gz/src/lfe_init.erl -> lfe-1.0.tar.gz/src/lfe_init.erl
Changed
@@ -41,7 +41,7 @@ run_string(As); [S|As] -> %Run a script user:start(), %Start user for io - run_file([S|As]); + run_file([S|As]); [] -> %Run a shell user_drv:start(['tty_sl -c -e',{lfe_shell,start,[]}]) end. @@ -64,14 +64,14 @@ run_script(Script) -> try - Script(), - init:stop(?OK_STATUS) + Script(), + init:stop(?OK_STATUS) catch - Class:Error -> - St = erlang:get_stacktrace(), %Need to get this first - Sf = fun (_) -> false end, - Ff = fun (T, I) -> lfe_io:prettyprint1(T, 15, I, 80) end, - Cs = lfe_lib:format_exception(Class, Error, St, Sf, Ff, 1), - io:put_chars(Cs), - halt(?ERROR_STATUS) + Class:Error -> + St = erlang:get_stacktrace(), %Need to get this first + Sf = fun (_) -> false end, + Ff = fun (T, I) -> lfe_io:prettyprint1(T, 15, I, 80) end, + Cs = lfe_lib:format_exception(Class, Error, St, Sf, Ff, 1), + io:put_chars(Cs), + halt(?ERROR_STATUS) end.
View file
lfe-0.9.2.tar.gz/src/lfe_io.erl -> lfe-1.0.tar.gz/src/lfe_io.erl
Changed
@@ -18,19 +18,18 @@ %% %% The io functions have been split into the following modules: %% lfe_io - basic read and write functions -%% lfe_io_pretty - sexpr prettyprinter +%% lfe_io_write - basic write functions +%% lfe_io_pretty - basic print functions %% lfe_io_format - formatted output -module(lfe_io). --export([parse_file/1,read_file/1,read/0,read/1,read_string/1, - print/1,print/2,print1/1,print1/2]). +-export([parse_file/1,read_file/1,read/0,read/1,read_string/1]). +-export([print/1,print/2,print1/1,print1/2]). -export([prettyprint/1,prettyprint/2, - prettyprint1/1,prettyprint1/2,prettyprint1/3,prettyprint1/4]). + prettyprint1/1,prettyprint1/2,prettyprint1/3,prettyprint1/4]). -export([format/2,format/3,fwrite/2,fwrite/3, - format1/2,fwrite1/2]). - --export([print1_symb/1,print1_string/2,print1_bits/2]). + format1/2,fwrite1/2]). %% -compile(export_all). @@ -44,39 +43,39 @@ -endif. %% parse_file(FileName) -> {ok,[{Sexpr,Line}]} | {error,Error}. -%% Parse a file returning the raw sexprs (as it should be) and line -%% numbers of start of each sexpr. Handle errors consistently. +%% Parse a file returning the raw sexprs (as it should be) and line +%% numbers of start of each sexpr. Handle errors consistently. parse_file(Name) -> with_token_file(Name, fun (Ts) -> parse_file1(Ts, [], []) end). parse_file1([_|_]=Ts0, Pc0, Ss) -> case lfe_parse:sexpr(Pc0, Ts0) of - {ok,L,S,Ts1} -> parse_file1(Ts1, [], [{S,L}|Ss]); - {more,Pc1} -> - %% Need more tokens but there are none, so call again to - %% generate an error message. - {error,E,_} = lfe_parse:sexpr(Pc1, {eof,99999}), - {error,E}; - {error,E,_} -> {error,E} + {ok,L,S,Ts1} -> parse_file1(Ts1, [], [{S,L}|Ss]); + {more,Pc1} -> + %% Need more tokens but there are none, so call again to + %% generate an error message. + {error,E,_} = lfe_parse:sexpr(Pc1, {eof,99999}), + {error,E}; + {error,E,_} -> {error,E} end; parse_file1([], _, Ss) -> {ok,reverse(Ss)}. %% read_file(FileName) -> {ok,[Sexpr]} | {error,Error}. -%% Read a file returning the raw sexprs (as it should be). +%% Read a file returning the raw sexprs (as it should be). read_file(Name) -> with_token_file(Name, fun (Ts) -> read_file1(Ts, []) end). read_file1([_|_]=Ts0, Ss) -> case lfe_parse:sexpr(Ts0) of - {ok,_,S,Ts1} -> read_file1(Ts1, [S|Ss]); - {more,Pc1} -> - %% Need more tokens but there are none, so call again to - %% generate an error message. - {error,E,_} = lfe_parse:sexpr(Pc1, {eof,99999}), - {error,E}; - {error,E,_} -> {error,E} + {ok,_,S,Ts1} -> read_file1(Ts1, [S|Ss]); + {more,Pc1} -> + %% Need more tokens but there are none, so call again to + %% generate an error message. + {error,E,_} = lfe_parse:sexpr(Pc1, {eof,99999}), + {error,E}; + {error,E,_} -> {error,E} end; read_file1([], Ss) -> {ok,reverse(Ss)}. @@ -95,17 +94,24 @@ {error,Error} -> {error,{none,file,Error}} end. -%% read([IoDevice]) -> {ok,Sexpr} | {error,Error}. +%% read() -> {ok,Sexpr} | {error,Error}. +%% read(Prompt) -> {ok,Sexpr} | {error,Error}. +%% read(IoDevice, Prompt) -> {ok,Sexpr} | {error,Error}. %% A very simple read function. Line oriented and cannot handle %% tokens over line-breaks but can handle multiple lines. Anything %% remaining on last line after a sexpr is lost. Signal errors. +%% read() -> read(standard_io, ''). +%% read(Prompt) -> read(standard_io, Prompt). +%% read(Io, Prompt) -> +%% scan_and_parse(Io, Prompt, [], 1). read() -> read(standard_io). read(Io) -> - scan_and_parse(Io, [], 1). + scan_and_parse(Io, '', [], 1). -scan_and_parse(Io, Pc0, L) -> - case io:get_line(Io, '') of +scan_and_parse(Io, Prompt, Pc0, L) -> + case io:get_line(Io, Prompt) of + {error,E} -> {error,{L,lfe_parse,E}}; eof -> %% No more so must take what we have. case lfe_parse:sexpr(Pc0, {eof,L}) of @@ -116,11 +122,11 @@ case lfe_scan:string(Cs, L) of {ok,[],_} -> %% Empty line (token free) just go on. - scan_and_parse(Io, Pc0, L+1); + scan_and_parse(Io, Prompt, Pc0, L+1); {ok,Ts,_} -> case lfe_parse:sexpr(Pc0, Ts) of {ok,_,S,_} -> {ok,S}; - {more,Pc1} -> scan_and_parse(Io, Pc1, L+1); + {more,Pc1} -> scan_and_parse(Io, Prompt, Pc1, L+1); {error,E,_} -> {error,E} end; {error,E,_} -> {error,E} @@ -149,143 +155,7 @@ print(Io, S) -> io:put_chars(Io, print1(S)). print1(S) -> print1(S, -1). %All the way - -print1(_, 0) -> "..."; -print1(Symb, _) when is_atom(Symb) -> print1_symb(Symb); -print1(Numb,_ ) when is_integer(Numb) -> integer_to_list(Numb); -print1(Numb, _) when is_float(Numb) -> io_lib_format:fwrite_g(Numb); -print1(List, D) when is_list(List) -> - [$(,print1_list(List, D-1),$)]; -print1({}, _) -> "#()"; -print1(Vec, D) when is_tuple(Vec) -> - Es = tuple_to_list(Vec), - ["#(",print1_list(Es, D-1),")"]; -print1(Bit, _) when is_bitstring(Bit) -> - ["#B(",print1_bits(Bit),$)]; -print1(Map, D) when ?IS_MAP(Map) -> print1_map(Map, D); -print1(Other, D) -> %Use standard Erlang for rest - io_lib:write(Other, D). - -%% print1_symb(Symbol) -> [char()]. - -print1_symb(Symb) -> - Cs = atom_to_list(Symb), - case quote_symbol(Symb, Cs) of - true -> print1_string(Cs , $|); - false -> Cs - end. - -%% print1_bits(Bitstring) -> [char()] -%% print1_bits(Bitstring, Depth) -> [char()] -%% Print the bytes in a bitstring. Print bytes except for last which -%% we add size field if not 8 bits big. - -print1_bits(Bits) -> print1_bits(Bits, -1). %Print them all - -print1_bits(_, 0) -> "..."; -print1_bits(<<B:8>>, _) -> integer_to_list(B); %Catch last binary byte -print1_bits(<<B:8,Bits/bitstring>>, N) -> - [integer_to_list(B),$\s|print1_bits(Bits, N-1)]; -print1_bits(<<>>, _) -> []; -print1_bits(Bits, _) -> %0 < Size < 8 - N = bit_size(Bits), - <<B:N>> = Bits, - io_lib:format("(~w (size ~w))", [B,N]). - -%% print1_list(List, Depth) -> Chars. -%% Print the elements in a list. We handle the empty list and depth=0. - -print1_list([], _) -> []; -print1_list(_, 0) -> "..."; -print1_list([Car|Cdr], D) -> - [print1(Car, D)|print1_tail(Cdr, D-1)]. - -%% print1_tail(Tail, Depth) -%% Print the tail of a list decrasing the depth for each element. We -%% know about dotted pairs. - -print1_tail([], _) -> ""; -print1_tail(_, 0) -> [$\s|"..."]; -print1_tail([S|Ss], D) -> - [$\s,print1(S, D)|print1_tail(Ss, D-1)]; -print1_tail(S, D) -> [" . "|print1(S, D)]. - -%% print1_map(Map, Depth) - -print1_map(Map, D) -> - [$#,$M,$(,print1_map_body(maps:to_list(Map), D), $)]. - -print1_map_body([], _) -> []; -print1_map_body(_, D) when D =:= 0; D =:= 1 -> "..."; -print1_map_body([KV], D) -> print1_map_assoc(KV, D); -print1_map_body([KV|KVs], D) ->
View file
lfe-0.9.2.tar.gz/src/lfe_io_format.erl -> lfe-1.0.tar.gz/src/lfe_io_format.erl
Changed
@@ -81,7 +81,7 @@ field_value([C|Fmt], Args, F) when is_integer(C), C >= $0, C =< $9 -> field_value(Fmt, Args, 10*F + (C - $0)); -field_value(Fmt, Args, F) -> %Default case +field_value(Fmt, Args, F) -> %Default case {F,Fmt,Args}. pad_char([$.,$*|Fmt], [Pad|Args]) -> {Pad,Fmt,Args}; @@ -93,9 +93,9 @@ pcount(Cs) -> foldl(fun ({$p,_,_,_,_,_}, Acc) -> Acc+1; - ({$P,_,_,_,_,_}, Acc) -> Acc+1; - (_, Acc) -> Acc - end, 0, Cs). + ({$P,_,_,_,_,_}, Acc) -> Acc+1; + (_, Acc) -> Acc + end, 0, Cs). %% build([Control], Pc, Indentation) -> [Char]. %% Interpret the control structures. Count the number of print @@ -106,8 +106,8 @@ S = control(C, As, F, Ad, P, Pad, I), Pc1 = decr_pc(C, Pc0), if - Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; - true -> [S|build(Cs, Pc1, I)] + Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; + true -> [S|build(Cs, Pc1, I)] end; build([$\n|Cs], Pc, _I) -> [$\n|build(Cs, Pc, 0)]; build([$\t|Cs], Pc, I) -> [$\t|build(Cs, Pc, ((I + 8) div 8) * 8)]; @@ -161,9 +161,9 @@ %% Field widths and precisions have already been calculated. control($w, [A], F, Adj, P, Pad, _) -> - term(lfe_io:print1(A, -1), F, Adj, P, Pad); + write(lfe_io:print1(A, -1), F, Adj, P, Pad); control($W, [A,Depth], F, Adj, P, Pad, _I) when is_integer(Depth) -> - term(lfe_io:print1(A, Depth), F, Adj, P, Pad); + write(lfe_io:print1(A, Depth), F, Adj, P, Pad); control($p, [A], F, Adj, P, Pad, I) -> print(A, -1, F, Adj, P, Pad, I); control($P, [A,Depth], F, Adj, P, Pad, I) when is_integer(Depth) -> @@ -187,13 +187,13 @@ control($B, [A], F, Adj, P, Pad, _) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, false); control($x, [A,Prefix], F, Adj, P, Pad, _) when is_integer(A), - is_atom(Prefix) -> + is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true); control($x, [A,Prefix], F, Adj, P, Pad, _) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true); control($X, [A,Prefix], F, Adj, P, Pad, _) when is_integer(A), - is_atom(Prefix) -> + is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false); control($X, [A,Prefix], F, Adj, P, Pad, _) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list @@ -218,52 +218,52 @@ base(none) -> 10; base(B) when is_integer(B) -> B. -%% term(TermList, Field, Adjust, Precision, PadChar) -%% Output the characters in a term. Use Precision to trim length of +%% write(CharList, Field, Adjust, Precision, PadChar) +%% Write the characters of a term. Use Precision to trim length of %% output. Adjust the characters within the field if length less %% than Max padding with PadChar. -term(T, none, _, none, _) -> T; -term(T, F, Adj, P, Pad) -> +write(T, none, _, none, _) -> T; +write(T, F, Adj, P, Pad) -> N = lists:flatlength(T), - if P =:= none -> term1(T, F, Adj, N, Pad); - P >= N -> term1(T, F, Adj, N, Pad); - true -> term1(flat_trunc(T, P), F, Adj, P, Pad) + if P =:= none -> write1(T, F, Adj, N, Pad); + P >= N -> write1(T, F, Adj, N, Pad); + true -> write1(flat_trunc(T, P), F, Adj, P, Pad) end. -term1(T, none, _, _, _) -> T; -term1(T, F, Adj, N, Pad) -> +write1(T, none, _, _, _) -> T; +write1(T, F, Adj, N, Pad) -> if F < N -> chars($*, F); F == N -> T; true -> adjust(T, chars(Pad, F-N), Adj) end. -%% print(Term, Depth, Field, Adjust, Precision, PadChar, Indentation) -%% Pretty print a term, field width is maximum line length and -%% precision is initial indentation. +%% print(CharList, Depth, Field, Adjust, Precision, PadChar, Indentation) +%% Pretty print the characters of a term, field width is maximum line +%% length and precision is initial indentation. print(T, D, none, Adj, P, Pad, I) -> print(T, D, 80, Adj, P, Pad, I); print(T, D, F, Adj, none, Pad, I) -> print(T, D, F, Adj, I, Pad, I); print(T, D, F, right, P, _, _) -> - lfe_io_pretty:print1(T, D, P, F). + lfe_io_pretty:term(T, D, P, F). %% fwrite_e(Float, Field, Adjust, Precision, PadChar) -fwrite_e(Fl, none, Adj, none, Pad) -> %Default values +fwrite_e(Fl, none, Adj, none, Pad) -> %Default values fwrite_e(Fl, none, Adj, 6, Pad); fwrite_e(Fl, none, _Adj, P, _Pad) when P >= 2 -> float_e(Fl, float_data(Fl), P); fwrite_e(Fl, F, Adj, none, Pad) -> fwrite_e(Fl, F, Adj, 6, Pad); fwrite_e(Fl, F, Adj, P, Pad) when P >= 2 -> - term(float_e(Fl, float_data(Fl), P), F, Adj, F, Pad). + write(float_e(Fl, float_data(Fl), P), F, Adj, F, Pad). -float_e(Fl, Fd, P) when Fl < 0.0 -> %Negative numbers +float_e(Fl, Fd, P) when Fl < 0.0 -> %Negative numbers [$-|float_e(-Fl, Fd, P)]; float_e(_Fl, {Ds,E}, P) -> case float_man(Ds, 1, P-1) of - {[$0|Fs],true} -> [[$1|Fs]|float_exp(E)]; - {Fs,false} -> [Fs|float_exp(E-1)] + {[$0|Fs],true} -> [[$1|Fs]|float_exp(E)]; + {Fs,false} -> [Fs|float_exp(E-1)] end. %% float_man([Digit], Icount, Dcount) -> {[Chars],CarryFlag}. @@ -276,22 +276,22 @@ {[$.|Cs],C}; float_man([D|Ds], I, Dc) -> case float_man(Ds, I-1, Dc) of - {Cs,true} when D =:= $9 -> {[$0|Cs],true}; - {Cs,true} -> {[D+1|Cs],false}; - {Cs,false} -> {[D|Cs],false} + {Cs,true} when D =:= $9 -> {[$0|Cs],true}; + {Cs,true} -> {[D+1|Cs],false}; + {Cs,false} -> {[D|Cs],false} end; -float_man([], I, Dc) -> %Pad with 0's +float_man([], I, Dc) -> %Pad with 0's {string:chars($0, I, [$.|string:chars($0, Dc)]),false}. float_man([D|_], 0) when D >= $5 -> {[],true}; float_man([_|_], 0) -> {[],false}; float_man([D|Ds], Dc) -> case float_man(Ds, Dc-1) of - {Cs,true} when D =:= $9 -> {[$0|Cs],true}; - {Cs,true} -> {[D+1|Cs],false}; - {Cs,false} -> {[D|Cs],false} + {Cs,true} when D =:= $9 -> {[$0|Cs],true}; + {Cs,true} -> {[D+1|Cs],false}; + {Cs,false} -> {[D|Cs],false} end; -float_man([], Dc) -> {string:chars($0, Dc),false}. %Pad with 0's +float_man([], Dc) -> {string:chars($0, Dc),false}. %Pad with 0's %% float_exp(Exponent) -> [Char]. %% Generate the exponent of a floating point number. Always include sign. @@ -303,14 +303,14 @@ %% fwrite_f(FloatData, Field, Adjust, Precision, PadChar) -fwrite_f(Fl, none, Adj, none, Pad) -> %Default values +fwrite_f(Fl, none, Adj, none, Pad) -> %Default values fwrite_f(Fl, none, Adj, 6, Pad); fwrite_f(Fl, none, _Adj, P, _Pad) when P >= 1 -> float_f(Fl, float_data(Fl), P); fwrite_f(Fl, F, Adj, none, Pad) -> fwrite_f(Fl, F, Adj, 6, Pad); fwrite_f(Fl, F, Adj, P, Pad) when P >= 1 -> - term(float_f(Fl, float_data(Fl), P), F, Adj, F, Pad). + write(float_f(Fl, float_data(Fl), P), F, Adj, F, Pad). float_f(Fl, Fd, P) when Fl < 0.0 -> [$-|float_f(-Fl, Fd, P)]; @@ -318,8 +318,8 @@ float_f(Fl, {string:chars($0, -E+1, Ds),1}, P); %Prepend enough 0's float_f(_Fl, {Ds,E}, P) -> case float_man(Ds, E, P) of - {Fs,true} -> "1" ++ Fs; %Handle carry - {Fs,false} -> Fs + {Fs,true} -> "1" ++ Fs; %Handle carry + {Fs,false} -> Fs end. %% float_data([FloatChar]) -> {[Digit],Exponent} @@ -343,20 +343,20 @@ fwrite_g(Fl, F, Adj, P, Pad) when P >= 1 -> A = abs(Fl), E = if A < 1.0e-1 -> -2; - A < 1.0e0 -> -1; - A < 1.0e1 -> 0; - A < 1.0e2 -> 1; - A < 1.0e3 -> 2; - A < 1.0e4 -> 3;
View file
lfe-0.9.2.tar.gz/src/lfe_io_pretty.erl -> lfe-1.0.tar.gz/src/lfe_io_pretty.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2014 Robert Virding +%% Copyright (c) 2008-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,7 +18,7 @@ -module(lfe_io_pretty). --export([print1/1,print1/2,print1/3,print1/4]). +-export([term/1,term/2,term/3,term/4]). -compile(export_all). @@ -31,99 +31,115 @@ -define(IS_MAP(T), false). -endif. -%% print1(Sexpr) -> [char()]. -%% print1(Sexpr, Depth) -> [char()]. -%% print1(Sexpr, Depth, Indentation, LineLength) -> [char()]. +%% term(Sexpr [, Depth [, Indentation [, LineLength]]]) -> [char()]. %% A relatively simple pretty print function, but with some %% customisation. N.B. We know about the standard character macros %% and use them instead of their expanded forms. -print1(S) -> print1(S, -1, 0, 80). +term(S) -> term(S, -1, 0, 80). -print1(S, D) -> print1(S, D, 0, 80). +term(S, D) -> term(S, D, 0, 80). -print1(S, D, I) -> print1(S, D, I, 80). +term(S, D, I) -> term(S, D, I, 80). -print1(_, 0, _, _) -> "..."; -print1(Symb, _, _, _) when is_atom(Symb) -> lfe_io:print1_symb(Symb); -print1(Numb, _, _, _) when is_integer(Numb) -> integer_to_list(Numb); -print1(Numb, _, _, _) when is_float(Numb) -> io_lib_format:fwrite_g(Numb); +term(_, 0, _, _) -> "..."; +term(Symb, _, _, _) when is_atom(Symb) -> lfe_io_write:symbol(Symb); +term(Numb, _, _, _) when is_integer(Numb) -> integer_to_list(Numb); +term(Numb, _, _, _) when is_float(Numb) -> io_lib_format:fwrite_g(Numb); %% Handle some default special cases, standard character macros. These %% don't increase depth as they really should. -print1([quote,E], D, I, L) -> ["'",print1(E, D, I+1, L)]; -print1([backquote,E], D, I, L) -> ["`",print1(E, D, I+1, L)]; -print1([unquote,E], D, I, L) -> [",",print1(E, D, I+1, L)]; -print1(['unquote-splicing',E], D, I, L) -> [",@",print1(E, D, I+2, L)]; -print1([Car|_]=List, D, I, L) -> +term([quote,E], D, I, L) -> ["'",term(E, D, I+1, L)]; +term([backquote,E], D, I, L) -> ["`",term(E, D, I+1, L)]; +term([comma,E], D, I, L) -> [",",term(E, D, I+1, L)]; +term(['comma-at',E], D, I, L) -> [",@",term(E, D, I+2, L)]; +term([map|MapBody], D, I, L) -> + Mcs = map_body(MapBody, D, I+5, L), + ["(map ",Mcs,$)]; +term([Car|_]=List, D, I, L) -> %% Handle printable lists specially. - case io_lib:printable_list(List) of - true -> lfe_io:print1_string(List, $"); %" + case io_lib:printable_unicode_list(List) of + true -> lfe_io_write:string(List, $"); %" false -> - case print1_list_max(List, D-1, I+1, L-1) of + case list_max(List, D-1, I+1, L-1) of {yes,Print} -> ["(",Print,")"]; no -> %% Customise printing of lists. case indent_type(Car) of none -> %Normal lists. - ["(",print1_list(List, D-1, I+1, L-1),")"]; + ["(",list(List, D-1, I+1, L-1),")"]; defun -> %Special case for defuns - print1_defun(List, D, I, L); + defun(List, D, I, L); N when is_integer(N) -> %Special N first elements - print1_type(List, D, I, L, N) + type(List, D, I, L, N) end end end; -print1([], _, _, _) -> "()"; -print1({}, _, _, _) -> "#()"; -print1(Tup, D, I, L) when is_tuple(Tup) -> +term([], _, _, _) -> "()"; +term({}, _, _, _) -> "#()"; +term(Tup, D, I, L) when is_tuple(Tup) -> Es = tuple_to_list(Tup), - case print1_list_max(Es, D-1, I+2, L-1) of + case list_max(Es, D-1, I+2, L-1) of {yes,Print} -> ["#(",Print,")"]; - no -> ["#(",print1_list(Es, D-1, I+2, L),")"] + no -> ["#(",list(Es, D-1, I+2, L),")"] end; -print1(Bit, D, _, _) when is_bitstring(Bit) -> - ["#B(",lfe_io:print1_bits(Bit, D),$)]; %First D bytes -print1(Map, D, I, L) when ?IS_MAP(Map) -> - print1_map(Map, D, I, L); -print1(Other, _, _, _) -> - lfe_io:print1(Other). %Use standard LFE for rest - -%% print1_defun(List, Depth, Indentation, LineLength) -> [char()]. -%% Print a defun depending on whether it is traditional or matching. - -print1_defun([Def,Name,Args|Rest], D, I, L) when - is_atom(Name), (D > 3) or (D < 0) -> +term(Bit, D, _, _) when is_bitstring(Bit) -> + bitstring(Bit, D); %First D bytes +term(Map, D, I, L) when ?IS_MAP(Map) -> + Fun = fun (K, V, Acc) -> [K,V|Acc] end, + Mcs = map_body(maps:fold(Fun, [], Map), D, I+3, L), + ["#M(",Mcs,$)]; +term(Other, _, _, _) -> + lfe_io_write:term(Other). %Use standard LFE for rest + +%% bitstring(Bitstring, Depth) -> [char()] +%% Print the bytes in a bitstring. Print bytes except for last which +%% we add size field if not 8 bits big. + +bitstring(Bit, D) -> + try + Chars = unicode:characters_to_list(Bit, utf8), + true = io_lib:printable_unicode_list(Chars), + [$#|lfe_io_write:string(Chars, $")] + catch + _:_ -> + lfe_io_write:bitstring(Bit, D) + end. + +%% defun(List, Depth, Indentation, LineLength) -> [char()]. +%% Print a defun depending on whether it is traditional or matching. + +defun([Def,Name,Args|Rest], D, I, L) when is_atom(Name), (D > 3) or (D < 0) -> Dcs = atom_to_list(Def), %Might not actually be defun Ncs = atom_to_list(Name), case lfe_lib:is_symb_list(Args) of true -> %Traditional - Acs = print1(Args, D-2, I + length(Dcs) + length(Ncs) + 3, L), - Tcs = print1_tail(Rest, D-3, I+2, L), + Acs = term(Args, D-2, I + length(Dcs) + length(Ncs) + 3, L), + Tcs = list_tail(Rest, D-3, I+2, L), ["(",Dcs," ",Ncs," ",Acs,Tcs,")"]; false -> %Matching - Tcs = print1_tail([Args|Rest], D-2, I+2, L), + Tcs = list_tail([Args|Rest], D-2, I+2, L), ["(",Dcs," ",Ncs,Tcs,")"] end; -print1_defun(List, D, I, L) -> +defun(List, D, I, L) -> %% Too short to get worked up about, or not a "proper" defun or %% not enough depth. - ["(",print1_list(List, D-1, I+1, L),")"]. + ["(",list(List, D-1, I+1, L),")"]. -%% print1_type(List, Depth, Indentation, LineLength, TypeCount) -> [char()]. -%% Print a special type form indenting first TypeCount elements afer -%% type and rest indented 2 steps. +%% type(List, Depth, Indentation, LineLength, TypeCount) -> [char()]. +%% Print a special type form indenting first TypeCount elements afer +%% type and rest indented 2 steps. -print1_type([Car|Cdr], D, I, L, N) when (D > 2) or (D < 0) -> +type([Car|Cdr], D, I, L, N) when (D > 2) or (D < 0) -> %% Handle special lists, we KNOW Car is an atom. Cs = atom_to_list(Car), NewI = I + length(Cs) + 2, {Spec,Rest} = split(N, Cdr), - Tcs = [print1_list(Spec, D-1, NewI, L), - print1_tail(Rest, D-2, I+2, L)], + Tcs = [list(Spec, D-1, NewI, L), + list_tail(Rest, D-2, I+2, L)], ["(" ++ Cs," ",Tcs,")"]; -print1_type(List, D, I, L, _) -> +type(List, D, I, L, _) -> %% Too short to get worked up about or not enough depth. - [$(,print1_list(List, D-1, I+1, L),$)]. + [$(,list(List, D-1, I+1, L),$)]. %% split(N, List) -> {List1,List2}. %% Split a list into two lists, the first containing the first N @@ -135,73 +151,72 @@ {H1,T1} = split(N-1, T), {[H|H1],T1}. -%% print1_list_max(List, Depth, Indentation, LineLength) -> {yes,Chars} | no. +%% list_max(List, Depth, Indentation, LineLength) -> {yes,Chars} | no. %% Maybe print a list on one line, but abort if it goes past %% LineLength. -print1_list_max([], _, _, _) -> {yes,[]}; -print1_list_max(_, 0, _, _) -> {yes,"..."}; -print1_list_max([Car|Cdr], D, I, L) -> - Cs = print1(Car, D, 0, 99999), %Never break the line - print1_tail_max(Cdr, D-1, I + flatlength(Cs), L, [Cs]). +list_max([], _, _, _) -> {yes,[]}; +list_max(_, 0, _, _) -> {yes,"..."}; +list_max([Car|Cdr], D, I, L) -> + Cs = term(Car, D, 0, 99999), %Never break the line
View file
lfe-1.0.tar.gz/src/lfe_io_write.erl
Added
@@ -0,0 +1,155 @@ +%% Copyright (c) 2008-2015 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : lfe_io_write.erl +%% Author : Robert Virding +%% Purpose : Basic write functions for Lisp Flavoured Erlang. + +-module(lfe_io_write). + +-export([term/1,term/2,symbol/1,string/2,bitstring/2]). + +%% -compile(export_all). + +%% Define IS_MAP/1 macro for is_map/1 bif. +-ifdef(HAS_MAPS). +-define(IS_MAP(T), is_map(T)). +-else. +-define(IS_MAP(T), false). +-endif. + +%% print([IoDevice], Sexpr) -> ok. +%% print1(Sexpr) -> [char()]. +%% print1(Sexpr, Depth) -> [char()]. +%% A simple print function. Does not pretty-print but stops at Depth. + +term(S) -> term(S, -1). %All the way + +term(_, 0) -> "..."; +term(Symb, _) when is_atom(Symb) -> symbol(Symb); +term(Numb,_ ) when is_integer(Numb) -> integer_to_list(Numb); +term(Numb, _) when is_float(Numb) -> io_lib_format:fwrite_g(Numb); +term(List, D) when is_list(List) -> + [$(,list(List, D-1),$)]; +term({}, _) -> "#()"; +term(Vec, D) when is_tuple(Vec) -> + Es = tuple_to_list(Vec), + ["#(",list(Es, D-1),")"]; +term(Bit, _) when is_bitstring(Bit) -> + bitstring(Bit); +term(Map, D) when ?IS_MAP(Map) -> map(Map, D); +term(Other, D) -> %Use standard Erlang for rest + io_lib:write(Other, D). + +%% symbol(Symbol) -> [char()]. + +symbol(Symb) -> + Cs = atom_to_list(Symb), + case quote_symbol(Symb, Cs) of + true -> string(Cs , $|); + false -> Cs + end. + +%% bitstring(Bitstring) -> [char()] +%% bitstring(Bitstring, Depth) -> [char()] +%% Print the bytes in a bitstring. Print bytes except for last which +%% we add size field if not 8 bits big. + +bitstring(Bit) -> bitstring(Bit, -1). + +bitstring(Bit, D) -> + ["#B(",bytes(Bit, D),$)]. + +bytes(_, 0) -> "..."; +bytes(<<B:8>>, _) -> integer_to_list(B); %Catch last binary byte +bytes(<<B:8,Bs/bitstring>>, N) -> + [integer_to_list(B),$\s|bytes(Bs, N-1)]; +bytes(<<>>, _) -> []; +bytes(Bits, _) -> %0 < Size < 8 + N = bit_size(Bits), + <<B:N>> = Bits, + io_lib:format("(~w (size ~w))", [B,N]). + +%% list(List, Depth) -> Chars. +%% Print the elements in a list. We handle the empty list and depth=0. + +list([], _) -> []; +list(_, 0) -> "..."; +list([Car|Cdr], D) -> + [term(Car, D)|list_tail(Cdr, D-1)]. + +%% list_tail(Tail, Depth) +%% Print the tail of a list decrasing the depth for each element. We +%% know about dotted pairs. + +list_tail([], _) -> ""; +list_tail(_, 0) -> [$\s|"..."]; +list_tail([S|Ss], D) -> + [$\s,term(S, D)|list_tail(Ss, D-1)]; +list_tail(S, D) -> [" . "|term(S, D)]. + +%% map(Map, Depth) + +map(Map, D) -> + [$#,$M,$(,map_body(maps:to_list(Map), D), $)]. + +map_body([], _) -> []; +map_body(_, D) when D =:= 0; D =:= 1 -> "..."; +map_body([KV], D) -> map_assoc(KV, D); +map_body([KV|KVs], D) -> + Massoc = map_assoc(KV, D), + [Massoc,$\s|map_body(KVs, D-1)]. + +map_assoc({K,V}, D) -> + [term(K, D-1),$\s,term(V, D-1)]. + +%% quote_symbol(Symbol, SymbChars) -> bool(). +%% Check if symbol needs to be quoted when printed. If it can read as +%% a number then it must be quoted. + +quote_symbol('.', _) -> true; %Needs quoting +quote_symbol(_, [C|Cs]=Cs0) -> + case catch {ok,list_to_float(Cs0)} of + {ok,_} -> true; + _ -> case catch {ok,list_to_integer(Cs0)} of + {ok,_} -> true; + _ -> not (lfe_scan:start_symbol_char(C) andalso + symbol_chars(Cs)) + end + end; +quote_symbol(_, []) -> true. + +symbol_chars(Cs) -> lists:all(fun lfe_scan:symbol_char/1, Cs). + +%% string([Char], QuoteChar) -> [Char] +%% Generate the list of characters needed to print a string. + +string(S, Q) -> + [Q,string_chars(S, Q)]. + +string_chars([], Q) -> [Q]; +string_chars([C|Cs], Q) -> + string_char(C, Q, string_chars(Cs, Q)). + +string_char(Q, Q, Tail) -> [$\\,Q|Tail]; %Must check these first! +string_char($\\, _, Tail) -> [$\\,$\\|Tail]; +string_char($\b, _, Tail) -> [$\\,$b|Tail]; %\b = BS +string_char($\t, _, Tail) -> [$\\,$t|Tail]; %\t = TAB +string_char($\n, _, Tail) -> [$\\,$n|Tail]; %\n = LF +string_char($\v, _, Tail) -> [$\\,$v|Tail]; %\v = VT +string_char($\f, _, Tail) -> [$\\,$f|Tail]; %\f = FF +string_char($\r, _, Tail) -> [$\\,$r|Tail]; %\r = CR +string_char($\e, _, Tail) -> [$\\,$e|Tail]; %\e = ESC +string_char($\d, _, Tail) -> [$\\,$d|Tail]; %\d = DEL +string_char(C, _, Tail) -> [C|Tail].
View file
lfe-0.9.2.tar.gz/src/lfe_lib.erl -> lfe-1.0.tar.gz/src/lfe_lib.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2016 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,7 +23,7 @@ -export([is_symb/1,is_symb_list/1,is_proper_list/1,is_core_form/1]). --export([proc_forms/3]). +-export([proc_forms/3,proc_forms/4]). %% Standard lisp library. -export([is_lfe_bif/2, @@ -47,7 +47,7 @@ %% is_bif(Name, Arity) -> bool(). %% is_erl_bif(Name, Arity) -> bool(). %% is_guard_bif(Name, Arity) -> bool(). -%% Collected tests for valid BIFs in guards and expressions. +%% Collected tests for valid BIFs in guards and expressions. is_bif(Name, Ar) -> is_lfe_bif(Name, Ar) orelse is_erl_bif(Name, Ar). @@ -75,7 +75,7 @@ is_symb_list([S|Ss]) when is_atom(S) -> is_symb_list(Ss); is_symb_list([]) -> true; -is_symb_list(_) -> false. %Might not be a proper list +is_symb_list(_) -> false. %Might not be a proper list is_proper_list([_|Ss]) -> is_proper_list(Ss); is_proper_list([]) -> true; @@ -106,9 +106,6 @@ is_core_form('let-function') -> true; is_core_form('letrec-function') -> true; is_core_form('let-macro') -> true; -is_core_form('eval-when-compile') -> true; -is_core_form('define-function') -> true; -is_core_form('define-macro') -> true; %% Core control special forms. is_core_form('progn') -> true; is_core_form('if') -> true; @@ -118,50 +115,61 @@ is_core_form('try') -> true; is_core_form('funcall') -> true; is_core_form(call) -> true; -%% Everything else is not special. +%% Core definition special forms. +is_core_form('eval-when-compile') -> true; +is_core_form('define-function') -> true; +is_core_form('define-macro') -> true; +is_core_form('define-module') -> true; +is_core_form('extend-module') -> true; +%% Everything else is not a core form. is_core_form(_) -> false. %% proc_forms(FormFun, Forms, State) -> {Forms,State}. +%% proc_forms(FormFun, Forms, Line, State) -> {Forms,State}. %% Process a (progn ... ) nested list of forms where top level list %% has elements {Form,LineNumber}. Return a flat list of results and %% passes through State. All the elements are processed left to %% right. The accumulator is in reverse order! -proc_forms(Fun, Fs, St) -> proc_forms(Fun, Fs, [], St). +proc_forms(Fun, Fs, St) -> proc_top_forms(Fun, Fs, [], St). + +proc_forms(Fun, Fs, L, St0) -> + {Rs,St1} = proc_progn_forms(Fun, Fs, L, [], St0), + {reverse(Rs),St1}. -proc_forms(Fun, [{['progn'|Bs],L}|Fs], Rs0, St0) -> - {Rs1,St1} = proc_forms_progn(Fun, Bs, L, Rs0, St0), - proc_forms(Fun, Fs, Rs1, St1); -proc_forms(Fun, [{F,L}|Fs], Rs, St0) -> +proc_top_forms(Fun, [{['progn'|Bs],L}|Fs], Rs0, St0) -> + {Rs1,St1} = proc_progn_forms(Fun, Bs, L, Rs0, St0), + proc_top_forms(Fun, Fs, Rs1, St1); +proc_top_forms(Fun, [{F,L}|Fs], Rs, St0) -> {Frs,St1} = Fun(F, L, St0), - proc_forms(Fun, Fs, reverse(Frs, Rs), St1); -proc_forms(_, [], Rs, St) -> {reverse(Rs),St}. + proc_top_forms(Fun, Fs, reverse(Frs, Rs), St1); +proc_top_forms(_, [], Rs, St) -> {reverse(Rs),St}. -proc_forms_progn(Fun, [['progn'|Bbs]|Bs], L, Rs0, St0) -> - {Rs1,St1} = proc_forms_progn(Fun, Bbs, L, Rs0, St0), - proc_forms_progn(Fun, Bs, L, Rs1, St1); -proc_forms_progn(Fun, [B|Bs], L, Rs, St0) -> +proc_progn_forms(Fun, [['progn'|Bbs]|Bs], L, Rs0, St0) -> + {Rs1,St1} = proc_progn_forms(Fun, Bbs, L, Rs0, St0), + proc_progn_forms(Fun, Bs, L, Rs1, St1); +proc_progn_forms(Fun, [B|Bs], L, Rs, St0) -> {Frs,St1} = Fun(B, L, St0), - proc_forms_progn(Fun, Bs, L, reverse(Frs, Rs), St1); -proc_forms_progn(_, [], _, Rs, St) -> + proc_progn_forms(Fun, Bs, L, reverse(Frs, Rs), St1); +proc_progn_forms(_, [], _, Rs, St) -> {Rs,St}. -%% proc_forms(Fun, [{['progn'|Bs],L}|Fs], Rs, St) -> -%% proc_forms_progn(Fun, Bs, L, [], Fs, Rs, St); -%% proc_forms(Fun, [{F,L}|Fs], Rs, St0) -> +%% proc_top_forms(Fun, [{['progn'|Bs],L}|Fs], Rs, St) -> +%% proc_progn_forms(Fun, Bs, L, [], Fs, Rs, St); +%% proc_top_forms(Fun, [{F,L}|Fs], Rs, St0) -> %% {Frs,St1} = Fun(F, L, St0), -%% proc_forms(Fun, Fs, reverse(Frs, Rs), St1); -%% proc_forms(_, [], Rs, St) -> {reverse(Rs),St}. +%% proc_top_forms(Fun, Fs, reverse(Frs, Rs), St1); +%% proc_top_forms(_, [], Rs, St) -> {reverse(Rs),St}. -%% proc_forms_progn(Fun, [['progn'|Bs1]|Bs], L, Bss, Fs, Rs, St) -> -%% proc_forms_progn(Fun, Bs1, L, [Bs|Bss], Fs, Rs, St); -%% proc_forms_progn(Fun, [B|Bs], L, Bss, Fs, Rs, St0) -> +%% proc_progn_forms(Fun, [['progn'|Bs1]|Bs], L, Bss, Fs, Rs, St) -> +%% proc_progn_forms(Fun, Bs1, L, [Bs|Bss], Fs, Rs, St); +%% proc_progn_forms(Fun, [B|Bs], L, Bss, Fs, Rs, St0) -> %% {Frs,St1} = Fun(B, L, St0), -%% proc_forms_progn(Fun, Bs, L, Bss, Fs, reverse(Frs, Rs), St1); -%% proc_forms_progn(Fun, [], L, [Bs|Bss], Fs, Rs, St) -> -%% proc_forms_progn(Fun, Bs, L, Bss, Fs, Rs, St); -%% proc_forms_progn(Fun, [], _, [], Fs, Rs, St) -> -%% proc_forms(Fun, Fs, Rs, St). +%% proc_progn_forms(Fun, Bs, L, Bss, Fs, reverse(Frs, Rs), St1); +%% proc_progn_forms(Fun, [], L, [Bs|Bss], Fs, Rs, St) -> +%% proc_progn_forms(Fun, Bs, L, Bss, Fs, Rs, St); +%% proc_progn_forms(Fun, [], _, [], Fs, Rs, St) -> +%% proc_top_forms(Fun, Fs, Rs, St). %% Standard lisp library functions. %% is_lfe_bif(Name, Arity) -> bool(). @@ -298,7 +306,7 @@ end end. -eval(Sexpr) -> eval(Sexpr, lfe_env:new()). %Empty environment. +eval(Sexpr) -> eval(Sexpr, lfe_env:new()). %Empty environment. eval(Sexpr, Env) -> lfe_eval:expr(Sexpr, Env). 'macro-function'(Symb) -> 'macro-function'(Symb, lfe_env:new()). @@ -335,7 +343,7 @@ %% used to format terms; and Indentation is the current column. format_exception(Cl, Error0, St0, Sf, Ff, I) -> - Cs = case Cl of %Class type as string + Cs = case Cl of %Class type as string throw -> "throw"; exit -> "exit"; error -> "error" @@ -344,7 +352,7 @@ true -> {Error0,St0}; false -> {{Error0,St0},[]} end, - P = "exception " ++ Cs ++ ": ", %Class description string + P = "exception " ++ Cs ++ ": ", %Class description string [P,lfe_io:prettyprint1(Error1, 10, length(P)+I-1),"\n", format_stacktrace(St1, Sf, Ff)].
View file
lfe-0.9.2.tar.gz/src/lfe_lint.erl -> lfe-1.0.tar.gz/src/lfe_lint.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,8 +18,8 @@ -module(lfe_lint). --export([module/1,module/2,form/1,expr/1,expr/2,pattern/1,pattern/2, - format_error/1]). +-export([module/1,module/2,form/1,expr/1,expr/2, + pattern/1,pattern/2,format_error/1]). -import(lfe_env, [new/0,is_vbound/2,is_fbound/3,is_gbound/3, add_vbinding/3,add_fbinding/4,add_ibinding/5]). @@ -36,20 +36,18 @@ -include("lfe_comp.hrl"). --record(lint, {module=[], %Module name - pars=none, %Module parameters - extd=[], %Extends - exps=[], %Exports - imps=[], %Imports - pref=[], %Prefixes - funcs=[], %Defined functions - env=[], %Top-level environment - line=[], %Current line - func=[], %Current function - file="nofile", %File name - opts=[], %Compiler options - errors=[], %Errors - warnings=[] %Warnings +-record(lint, {module=[], %Module name + exps=[], %Exports + imps=[], %Imports + pref=[], %Prefixes + funcs=[], %Defined functions + env=[], %Top-level environment + line=[], %Current line + func=[], %Current function + file="nofile", %File name + opts=[], %Compiler options + errors=[], %Errors + warnings=[] %Warnings }). %% Errors. @@ -114,25 +112,24 @@ return_status(St1). %% form(Form) -> {ok,[Warning]} | {error,[Error],[Warning]}. +%% Create a dummy module then test the form a function. form(F) -> - module([{['define-module',dummy],1}, - {F,2}]). + module([{['define-module',dummy],1},{F,2}]). -%% module(Forms) -> {ok,[Warning]} | {error,[Error],[Warning]}. -%% module(Forms, CompInfo) -> {ok,[Warning]} | {error,[Error],[Warning]}. -%% Lint the forms in a module. +%% module(ModuleForms) -> +%% {ok,ModuleName,[Warning]} | {error,[Error],[Warning]}. +%% module(ModuleForms, CompInfo) -> +%% {ok,ModuleName,[Warning]} | {error,[Error],[Warning]}. +%% Lint the forms in one module file. -module(Fs) -> module(Fs, #cinfo{file="nofile",opts=[]}). +module(Ms) -> module(Ms, #cinfo{file="nofile",opts=[]}). -module(Fs0, #cinfo{file=F,opts=Os}) -> - %% Predefined functions - St0 = #lint{file=F,opts=Os}, - %% Collect forms and fill in module infor in state. - {Fs1,St1} = lfe_lib:proc_forms(fun collect_form/3, Fs0, St0), - St2 = check_module(Fs1, St1), - debug_print("#lint: ~p\n", [St2], Os), - return_status(St2). +module(Ms, #cinfo{file=F,opts=Os}) -> + St0 = #lint{file=F,opts=Os}, %Initialise the lint record + St1 = check_module(Ms, St0), + debug_print("#lint: ~p\n", [St1], Os), + return_status(St1). debug_print(Format, Args, Opts) -> case member(debug_print, Opts) of @@ -140,43 +137,56 @@ false -> ok end. -return_status(#lint{errors=[]}=St) -> - {ok,St#lint.warnings}; +return_status(#lint{module=M,errors=[]}=St) -> + {ok,M,St#lint.warnings}; return_status(St) -> {error,St#lint.errors,St#lint.warnings}. -%% collect_form(Form, Line, State) -> {[Ret],State}. -%% Collect valid forms and module data. Returns forms and put module -%% data into state. Flag unknown forms and define-module not first. +%% check_module(ModuleForms, State) -> State. +%% Do all the actual work checking a module. -collect_form(['define-module',Mod|Mdef], L, St0) -> - %% Check normal module or parameterised module. - case is_symb_list(Mod) of %Parameterised module - true -> - {Vs,St1} = check_lambda_args(tl(Mod), L, St0), - %% Everything into State. - {[],check_mdef(Mdef, L, St1#lint{module=hd(Mod),pars=Vs})}; - false when is_atom(Mod) -> %Normal module +check_module(Mfs, St0) -> + {Fbs0,St1} = collect_module(Mfs, St0), + %% Make an initial environment and set up state. + {Predefs,Env0,St2} = init_state(St1), + Fbs1 = Predefs ++ Fbs0, + %% Now check definitions. + {Fs,Env1,St3} = check_letrec_bindings(Fbs1, Env0, St2), + %% Save functions and environment and test exports. + St4 = St3#lint{funcs=Fs,env=Env1}, + check_exports(St4#lint.exps, Fs, St4). + +%% collect_module(ModuleForms, State) -> {Fbs,State}. +%% Collect valid forms and module data. Returns function bindings and +%% puts module data into state. Flag unknown forms and define-module +%% not first. + +collect_module(Mfs, St0) -> + {Acc,St1} = lists:foldl(fun collect_form/2, {[],St0}, Mfs), + {lists:reverse(Acc),St1}. + +collect_form({['define-module',Mod|Mdef],L}, {Acc,St0}) -> + if is_atom(Mod) -> %Normal module %% Everything into State. - {[],check_mdef(Mdef, L, St0#lint{module=Mod,pars=none})}; - false -> %Bad module name - {[],bad_mdef_error(L, name, St0)} + {Acc,check_mdef(Mdef, L, St0#lint{module=Mod})}; + true -> %Bad module name + {Acc,bad_mdef_error(L, name, St0)} end; -collect_form(_, L, #lint{module=[]}=St) -> +collect_form({_,L}, {Acc,#lint{module=[]}=St}) -> %% Set module name so this only triggers once. - {[],bad_mdef_error(L, name, St#lint{module='-no-module-'})}; -collect_form(['extend-module'|Mdef], L, St) -> - {[],check_mdef(Mdef, L, St)}; -collect_form(['define-function',Func,Body], L, St) -> + {Acc,bad_mdef_error(L, name, St#lint{module='-no-module-'})}; +collect_form({['extend-module'|Mdef],L}, {Acc,St}) -> + {Acc,check_mdef(Mdef, L, St)}; +collect_form({['define-function',Func,Body],L}, {Acc,St}) -> case Body of [lambda|_] when is_atom(Func) -> - {[{Func,Body,L}],St}; + {[{Func,Body,L}|Acc],St}; ['match-lambda'|_] when is_atom(Func) -> - {[{Func,Body,L}],St}; - _ -> {[],bad_form_error(L, 'define-function', St)} + {[{Func,Body,L}|Acc],St}; + _ -> {Acc,bad_form_error(L, 'define-function', St)} end; -collect_form(_, L, St) -> - {[],add_error(L, unknown_form, St)}. +collect_form({_,L}, {Acc,St}) -> + {Acc,add_error(L, unknown_form, St)}. check_mdef([[export,all]|Mdef], L, St) -> %Pass 'all' along check_mdef(Mdef, L, St#lint{exps=all}); @@ -191,12 +201,6 @@ check_mdef([[import|Is]|Mdef], L, St0) -> St1 = check_imports(Is, L, St0), check_mdef(Mdef, L, St1); -check_mdef([[extends,M]|Mdef], L, St) -> - if is_atom(M) -> - check_mdef(Mdef, L, St#lint{extd=M}); - true -> - check_mdef(Mdef, L, add_error(L, bad_extends, St)) - end; check_mdef([[Name|Vals]|Mdef], L, St) -> %% Other attributes, must be list and have symbol name. case is_atom(Name) and is_proper_list(Vals) of @@ -248,19 +252,6 @@ is_flist([], Funcs) -> {yes,Funcs}; is_flist(_, _) -> no. -%% check_module(FuncBindings, State) -> State. -%% Do all the actual work checking a module. - -check_module(Fbs0, St0) -> - %% Make an initial environment and set up state. - {Predefs,Env0,St1} = init_state(St0), - Fbs1 = Predefs ++ Fbs0, - %% Now check definitions. - {Fs,Env1,St2} = check_letrec_bindings(Fbs1, Env0, St1), - %% Save functions and environment and test exports. - St3 = St2#lint{funcs=Fs,env=Env1},
View file
lfe-0.9.2.tar.gz/src/lfe_macro.erl -> lfe-1.0.tar.gz/src/lfe_macro.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2016 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,37 +21,53 @@ -module(lfe_macro). --compile(export_all). +%% -compile(export_all). %% These work on individual expressions. -export([expand_expr/2,expand_expr_1/2,expand_expr_all/2]). %% These work on list of forms in "file format". --export([expand_forms/2,macro_forms/2]). +-export([expand_forms/2,expand_forms/3,macro_forms/2,macro_forms/3]). +-export([macro_form_init/1,macro_form/4,macro_fileform/3]). +-export([expand_form_init/1,expand_form/4,expand_fileform/3]). -export([format_error/1]). -export([mbe_syntax_rules_proc/4,mbe_syntax_rules_proc/5, - mbe_match_pat/3,mbe_get_bindings/3,mbe_expand_pattern/3]). + mbe_match_pat/3,mbe_get_bindings/3,mbe_expand_pattern/3]). %% -compile([export_all]). --import(lfe_env, [new/0,add_fbinding/4,is_fbound/3, - add_mbinding/3,is_mbound/2,get_mbinding/2]). +-import(lfe_env, [new/0,add_vbinding/3,is_vbound/2, + add_fbinding/4,is_fbound/3, + add_mbinding/3,is_mbound/2,get_mbinding/2]). -import(lfe_lib, [is_symb_list/1,is_proper_list/1]). -import(lists, [any/2,all/2,map/2,foldl/3,foldr/3,mapfoldl/3, - reverse/1,reverse/2,member/2,concat/1]). --import(orddict, [find/2,store/3]). --import(ordsets, [add_element/2,is_element/2]). + reverse/1,reverse/2,member/2,concat/1]). -include("lfe_comp.hrl"). -include("lfe_macro.hrl"). +%% Bloody useful +-define(IF(Test,True,False), case Test of + true -> True; + false -> False + end). + +%% Define IS_MAP/1 macro for is_map/1 bif. +-ifdef(HAS_MAPS). +-define(IS_MAP(T), is_map(T)). +-else. +-define(IS_MAP(T), false). +-endif. + %% Errors format_error({bad_form,Type}) -> lfe_io:format1("bad form: ~w", [Type]); +format_error({bad_env_form,Type}) -> + lfe_io:format1("bad environment form: ~w", [Type]); format_error({expand_macro,Call,_}) -> %% Can be very big so only print limited depth. lfe_io:format1("error expanding ~P", [Call,10]). @@ -62,7 +78,7 @@ %% or as far as it can go. expand_expr_1([Name|_]=Call, Env) when is_atom(Name) -> - St = default_state(false), + St = default_state(false, false), case exp_macro(Call, Env, St) of {yes,Exp,_} -> {yes,Exp}; no -> no @@ -70,7 +86,7 @@ expand_expr_1(_, _) -> no. expand_expr([Name|_]=Call, Env) when is_atom(Name) -> - St0 = default_state(false), + St0 = default_state(false, false), case exp_macro(Call, Env, St0) of {yes,Exp0,St1} -> {Exp1,_} = expand_expr_loop(Exp0, Env, St1), @@ -90,196 +106,258 @@ %% Expand all the macros in an expression. expand_expr_all(F, Env) -> - {Ef,_} = exp_form(F, Env, default_state(true)), + {Ef,_} = exp_form(F, Env, default_state(true, false)), Ef. %% expand_forms(FileForms, Env) -> %% expand_forms(FileForms, Env, CompInfo) -> %% {ok,FileForms,Env,Warnings} | {error,Errors,Warnings}. -%% Expand forms in "file format", {Form,LineNumber}. +%% Collect macro definitions in file forms, completely expand all +%% macros and only keep all functions. expand_forms(Fs, Env) -> - St = default_state(true), + St = default_state(true, false), do_forms(Fs, Env, St). -expand_forms(Fs, Env, #cinfo{file=F,opts=Os,ipath=Is}) -> - St = #mac{expand=true,file=F,opts=Os,ipath=Is}, +expand_forms(Fs, Env, Ci) -> + St = default_state(Ci, true, false), do_forms(Fs, Env, St). %% macro_forms(FileForms, Env) -> %% macro_forms(FileForms, Env, CompInfo) -> %% {ok,FileForms,Env,Warnings} | {error,Errors,Warnings}. -%% Collect, and remove, all macro definitions in a list of forms. All -%% top level macro calls are also expanded and any new macro -%% definitions are collected. +%% Collect macro definitions in file forms, expand top-level macros +%% and keep all forms. macro_forms(Fs, Env) -> - St = default_state(false), + St = default_state(false, true), do_forms(Fs, Env, St). -macro_forms(Fs, Env, #cinfo{file=F,opts=Os,ipath=Is}) -> - St = #mac{expand=false,file=F,opts=Os,ipath=Is}, +macro_forms(Fs, Env, Ci) -> + St = default_state(Ci, false, true), do_forms(Fs, Env, St). do_forms(Fs0, Env0, St0) -> - {Fs1,Env1,St1} = pass(Fs0, Env0, St0), + {Fs1,Env1,St1} = pass_fileforms(Fs0, Env0, St0), case St1#mac.errors of [] -> {ok,Fs1,Env1,St1#mac.warnings}; %No errors Es -> {error,Es,St1#mac.warnings} end. -default_state(Expand) -> - #mac{expand=Expand,line=1,file="-nofile-",opts=[],ipath=["."]}. - -%% pass(FileForms, Env, State) -> {FileForms,Env,State}. -%% Pass over a list of fileforms, {Form,Line}, collecting and -%% removing all macro defintions. All forms must be expanded at -%% top-level to check form, but all can be expanded to full depth. -%% Nesting of forms by progn is preserved. - -pass([{['progn'|Pfs0],L}|Fs0], Env0, St0) -> - {Pfs1,Env1,St1} = pass_progn(Pfs0, Env0, St0#mac{line=L}), - {Fs1,Env2,St2} = pass(Fs0, Env1, St1), - {[{['progn'|Pfs1],L}|Fs1],Env2,St2}; -pass([{['eval-when-compile'|Ewcs0],L}|Fs0], Env0, St0) -> - {Ecws1,Env1,St1} = pass_ewc(Ewcs0, Env0, St0#mac{line=L}), - {Fs1,Env2,St2} = pass(Fs0, Env1, St1), - {[{['progn'|Ecws1],L}|Fs1],Env2,St2}; -pass([{['define-macro'|Def]=F,L}|Fs0], Env0, St0) -> - case pass_define_macro(Def, Env0, St0#mac{line=L}) of - {yes,Env1,St1} -> pass(Fs0, Env1, St1); - {no,St1} -> - %% Ignore it and pass it on to generate error later. - {Fs1,Env1,St2} = pass(Fs0, Env0, St1), - {[{F,L}|Fs1],Env1,St2} - end; -pass([{F,L}|Fs0], Env0, St0) -> - %% First expand enough to test top form, else maybe expand all. - case pass_expand_expr(F, Env0, St0#mac{line=L}, St0#mac.expand) of - {yes,Exp,St1} -> %Top form expanded - pass([{Exp,L}|Fs0], Env0, St1); - {no,F1,St1} -> %Expanded all if flag set - {Fs1,Env1,St2} = pass(Fs0, Env0, St1), - {[{F1,L}|Fs1],Env1,St2} - end; -pass([], Env, St) -> {[],Env,St}. +default_state(Expand, Keep) -> + #mac{expand=Expand,keep=Keep,line=1,file="-nofile-",opts=[],ipath=["."]}. + +default_state(#cinfo{file=File,opts=Os,ipath=Is}, Expand, Keep) -> + #mac{expand=Expand,keep=Keep,line=1,file=File,opts=Os,ipath=Is}. + +%% expand_form_init(CompInfo) -> State. +%% expand_form(Form, Line, Env, State) -> {Form,Env,State}. +%% expand_fileform(Form, Env, State) -> {Form,Env,State}. +%% Collect macro definitions in a (file)form, completely expand all +%% macros and only keep all functions. + +expand_form_init(Ci) -> + default_state(Ci, true, false). + +expand_form(F0, L, E0, St0) -> + {F1,E1,St1} = pass_form(F0, E0, St0#mac{line=L}), + return_status(F1, E1, St1). + +expand_fileform({F0,L}, E0, St0) -> + {F1,E1,St1} = pass_form(F0, E0, St0#mac{line=L}), + return_status({F1,L}, E1, St1). + +%% macro_form_init(CompInfo) -> State. +%% macro_form(Form, Line, Env, State) -> {Form,Env,State}.
View file
lfe-0.9.2.tar.gz/src/lfe_macro.hrl -> lfe-1.0.tar.gz/src/lfe_macro.hrl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2013 Robert Virding +%% Copyright (c) 2013-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,18 +19,20 @@ %% We do a lot of quoting! -define(Q(E), [quote,E]). -define(BQ(E), [backquote,E]). --define(UQ(E), [unquote,E]). --define(UQ_S(E), ['unquote-splicing',E]). +-define(C(E), [comma,E]). +-define(C_A(E), ['comma-at',E]). %% Macro expander state. --record(mac, {expand=true, %Expand everything - module='-no-module', %Current module - line=1, %Line no of current form - vc=0, %Variable counter - fc=0, %Function counter - file=[], %File name - opts=[], %Compiler options - ipath=[], %Include path - errors=[], %Errors - warnings=[] %Warnings - }). +-record(mac, {expand=true, %Expand everything + keep=true, %Keep all forms + module='-no-module', %Current module + line=1, %Line no of current form + vc=0, %Variable counter + fc=0, %Function counter + file=[], %File name + opts=[], %Compiler options + ipath=[], %Include path + errors=[], %Errors + warnings=[], %Warnings + unloadable=[] %Macro modules we can't load + }).
View file
lfe-1.0.tar.gz/src/lfe_macro_export.erl
Added
@@ -0,0 +1,228 @@ +%% Copyright (c) 2016 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% File : lfe_macro_export.erl +%% Author : Robert Virding +%% Purpose : Lisp Flavoured Erlang macro export function builder. + +%% Build the LFE-EXPAND-EXPORTED-MACRO function which exports macros +%% so they can be found by the macro expander without needing to +%% inlcude them. If the module foo exports macro bar then it can be +%% called by doing (foo:bar ...). +%% +%% This version expands the macros when the defining module is +%% compiled so they are expanded in the context when that module is +%% compiled, not when they are called. This is easy and makes it easy +%% to access all macros in the defining module. +%% +%% An alternative would be to expand the macros when they are called +%% but then it becomes difficult to access all the macros within the +%% defining module. This might be easy if we accept exporting all +%% macros not just specific ones. +%% +%% The matching is done in two steps: first we test whether the call +%% name is one of our known macros; if so we test whether the +%% arguments match against the argument patterns in the macro +%% definition. Doing it like this gives us the same failure handling +%% as when expanding local calls to macros. + +%% (defun LFE-EXPAND-EXPORTED-MACRO (name args $ENV) +%% (let ((var-1 val-1) ;Eval-when-compile variables +%% ...) +%% (fletrec ((fun-1 ...) ;Eval-when-compile functions +%% ...) +%% (case name ;Macro name without module +%% ('mac-1 ...) ;Already exported local macros +%% (case args ;Match against args +%% (arg-pat ...) +%% ...)) +%% ('mac-2 ...) +%% ... +%% (_ 'no))))) + +-module(lfe_macro_export). + +%%-compile(export_all). + +-include("lfe_comp.hrl"). + +-export([module/2]). + +-import(lists, [reverse/1,reverse/2,member/2,filter/2]). + +%% We do a lot of quoting! +-define(Q(E), [quote,E]). +-define(BQ(E), [backquote,E]). +-define(C(E), [comma,E]). +-define(C_A(E), ['comma-at',E]). + +-record(umac, {mline=[],expm=[],env=[]}). + +%% We need these variables to have a funny name. +-define(NAMEVAR, '|- MACRO NAME -|'). +-define(ARGSVAR, '|- CALL ARGS -|'). + +%% module(ModuleForms, CompState) -> {ModuleForms,CompState}. +%% module(ModuleDef, ModuleForms, UmacState, CompState) -> +%% {ModuleForms,CompState}. + +module([Mdef|Fs], Cst) -> + Mst = collect_macros(Fs, #umac{env=lfe_env:new()}), + %% io:format("m: ~p\n", [Umac]), + module(Mdef, Fs, Mst, Cst). + +module({['define-module',Name|Mdef],L}, Fs0, Mst0, Cst) -> + Mst1 = collect_mdef(Mdef, Mst0#umac{mline=L}), + Fs1 = add_huf(L, Fs0), + Umac = build_user_macro(Mst1), + %% We need to export the expansion function but leave the rest. + Exp = [export,['LFE-EXPAND-EXPORTED-MACRO',3], + ['$handle_undefined_function',2]], + Md1 = {['define-module',Name,Exp|Mdef],L}, + {[Md1|Fs1 ++ [{Umac,L}]],Cst}. + +collect_macros(Fs, Mst) -> + lists:foldl(fun collect_macro/2, Mst, Fs). + +collect_macro({['define-macro',Name,Def],_}, #umac{env=Env0}=Mst) -> + Env1 = lfe_env:add_mbinding(Name, Def, Env0), + Mst#umac{env=Env1}; +collect_macro({['eval-when-compile'|Fs],_}, Mst) -> + lists:foldl(fun collect_ewc_macro/2, Mst, Fs); +collect_macro({['extend-module'|Mdef],_}, Mst) -> + collect_mdef(Mdef, Mst); +collect_macro(_, Mst) -> Mst. + +collect_ewc_macro([set,Name,Val], #umac{env=Env0}=Mst) -> + Env1 = lfe_env:add_vbinding(Name, Val, Env0), + Mst#umac{env=Env1}; +collect_ewc_macro(['define-function',Name,Def], #umac{env=Env0}=Mst) -> + Ar = function_arity(Def), + Env1 = lfe_env:add_fbinding(Name, Ar, Def, Env0), + Mst#umac{env=Env1}; +collect_ewc_macro([progn|Fs], Mst) -> + lists:foldl(fun collect_ewc_macro/2, Mst, Fs). + +function_arity([lambda,As|_]) -> length(As); +function_arity(['match-lambda',[Pats|_]|_]) -> length(Pats). + +%% collect_mdef(ModuleDef, MacroState) -> MacroState. +%% We are only interested in which macros are exported. + +collect_mdef([['export-macro'|Ms]|Mdef], #umac{expm=Expm0}=Mst) -> + Expm1 = add_exports(Expm0, Ms), + collect_mdef(Mdef, Mst#umac{expm=Expm1}); +collect_mdef([_|Mdef], Mst) -> collect_mdef(Mdef, Mst); +collect_mdef([], Mst) -> Mst. + +%% add_exports(Old, More) -> New. +%% exported_macro(Name, State) -> true | false. + +add_exports(all, _) -> all; +add_exports(_, all) -> all; +add_exports(Old, More) -> + ordsets:union(Old, lists:usort(More)). + +exported_macro(_, #umac{expm=all}) -> true; %All are exported +exported_macro(Name, #umac{expm=Expm}) -> + member(Name, Expm). + +%% build_user_macro(MacroState) -> UserMacFunc. +%% Take the forms in the eval-when-compile and build the +%% LFE-EXPAND-EXPORTED-MACRO function. In this version we expand the +%% macros are compile time. + +build_user_macro(#umac{expm=[]}) -> %No macros to export + empty_leum(); +build_user_macro(#umac{env=Env}=Mst) -> + Vfun = fun (N, V, Acc) -> [[N,V]|Acc] end, + Sets = lfe_env:fold_vars(Vfun, [], Env), + %% Collect the local functions. + Ffun = fun (N, _, Def, Acc) -> + %% [[N,lfe_macro:expand_expr_all(Def, Env)]|Acc] + [[N,Def]|Acc] + end, + Funs = lfe_env:fold_funs(Ffun, [], Env), + %% Collect the local macros. + Mfun = fun (N, Def0, Acc) -> + case exported_macro(N, Mst) of + true -> + %% Def1 = lfe_macro:expand_expr_all(Def0, Env), + [macro_case_clause(N, Def0)|Acc]; + false -> Acc + end + end, + %% Get the macros to export as case clauses. + case lfe_env:fold_macros(Mfun, [], Env) of + [] -> empty_leum(); %No macros to export + Macs -> + %% Build case, flet and let. + Case = ['case',?NAMEVAR|Macs ++ [['_',?Q(no)]]], + Flr = ['letrec-function',Funs,Case], + Fl = ['let',Sets,Flr], + ['define-function','LFE-EXPAND-EXPORTED-MACRO', + [lambda,[?NAMEVAR,?ARGSVAR,'$ENV'],Fl]] + end. + +empty_leum() -> + ['define-function','LFE-EXPAND-EXPORTED-MACRO', + [lambda,['_','_','_'],?Q(no)]]. + +%% add_huf(ModLine, Forms) -> Forms. +%% Add the $handle_undefined_function/2 function to catch run-time +%% macro calls. Scan through forms to check if there is an +%% $handle_undefined_function/2 function already defined. If so use +%% that as default when not a macro, otherwise just generate the +%% standard undef error. + +add_huf(L, [{['define-function','$handle_undefined_function',Def],Lf}=F|Fs]) -> + case function_arity(Def) of + 2 -> [{make_huf(Def),Lf}|Fs]; %Found the right $huf + _ -> [F|add_huf(L, Fs)] + end; +add_huf(L, [F|Fs]) -> + [F|add_huf(L, Fs)]; +add_huf(L, []) -> %No $huf, so make one. + %% Use the default undef exception handler. + Excep = [lambda,[a,b], + [':',error_handler,raise_undef_exception,['MODULE'],a,b]],
View file
lfe-0.9.2.tar.gz/src/lfe_macro_include.erl -> lfe-1.0.tar.gz/src/lfe_macro_include.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2013 Robert Virding +%% Copyright (c) 2013-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,13 +31,13 @@ read_hrl_file_1(Name) -> case epp:open(Name, []) of - {ok,Epp} -> - %% These are two undocumented functions of epp. - Fs = epp:parse_file(Epp), - Ms = epp:macro_defs(Epp), - epp:close(Epp), %Now we close epp - {ok,Fs,Ms}; - {error,E} -> {error,E} + {ok,Epp} -> + %% These are two undocumented functions of epp. + Fs = epp:parse_file(Epp), + Ms = epp:macro_defs(Epp), + epp:close(Epp), %Now we close epp + {ok,Fs,Ms}; + {error,E} -> {error,E} end. %% Errors. @@ -136,15 +136,15 @@ read_file(Name, St) -> case lists:suffix(".hrl", Name) of - true -> read_hrl_file(Name, St); %Read file as .hrl file - false -> read_lfe_file(Name, St) + true -> read_hrl_file(Name, St); %Read file as .hrl file + false -> read_lfe_file(Name, St) end. read_lfe_file(Name, St) -> %% Read the file as an LFE file. case lfe_io:read_file(Name) of - {ok,Fs} -> {ok,Fs,St}; - {error,E} -> {error,E} + {ok,Fs} -> {ok,Fs,St}; + {error,E} -> {error,E} end. %% read_hrl_file(FileName, State) -> {ok,Forms,State} | {error,Error}. @@ -153,13 +153,13 @@ read_hrl_file(Name, St) -> case epp:open(Name, []) of - {ok,Epp} -> - %% These are two undocumented functions of epp. - Fs = epp:parse_file(Epp), %This must be called first - Ms = epp:macro_defs(Epp), % then this! - epp:close(Epp), %Now we close epp - parse_hrl_file(Fs, Ms, St); - {error,E} -> {error,E} + {ok,Epp} -> + %% These are two undocumented functions of epp. + Fs = epp:parse_file(Epp), %This must be called first + Ms = epp:macro_defs(Epp), % then this! + epp:close(Epp), %Now we close epp + parse_hrl_file(Fs, Ms, St); + {error,E} -> {error,E} end. %% parse_hrl_file(Forms, Macros, State) -> {ok,Forms,State} | {error,Error}. @@ -178,9 +178,9 @@ trans_forms([{attribute,_,record,{Name,Fields}}|Fs], St0) -> {As,Lfs,St1} = trans_forms(Fs, St0), case catch {ok,trans_record(Name, Fields)} of - {ok,Lrec} -> {As,[Lrec|Lfs],St1}; - {'EXIT',_} -> %Something went wrong - {As,Lfs,add_warning({notrans_record,Name}, St1)} + {ok,Lrec} -> {As,[Lrec|Lfs],St1}; + {'EXIT',_} -> %Something went wrong + {As,Lfs,add_warning({notrans_record,Name}, St1)} end; trans_forms([{attribute,_,export,Es}|Fs], St0) -> {As,Lfs,St1} = trans_forms(Fs, St0), @@ -196,14 +196,14 @@ trans_forms([{function,_,Name,Arity,Cls}|Fs], St0) -> {As,Lfs,St1} = trans_forms(Fs, St0), case catch {ok,trans_function(Name, Arity, Cls)} of - {ok,Lfunc} -> {As,[Lfunc|Lfs],St1}; - {'EXIT',_} -> %Something went wrong - {As,Lfs,add_warning({notrans_function,Name,Arity}, St1)} + {ok,Lfunc} -> {As,[Lfunc|Lfs],St1}; + {'EXIT',_} -> %Something went wrong + {As,Lfs,add_warning({notrans_function,Name,Arity}, St1)} end; -trans_forms([{error,_}|Fs], St) -> %What should we do with these? +trans_forms([{error,_}|Fs], St) -> %What should we do with these? + trans_forms(Fs, St); +trans_forms([_|Fs], St) -> %Ignore everything else trans_forms(Fs, St); -trans_forms([_|Fs], St) -> %Ignore everything else - trans_forms(Fs, St); trans_forms([], St) -> {[],[],St}. trans_farity(Es) -> @@ -218,9 +218,9 @@ record_fields(Fs) -> [ record_field(F) || F <- Fs ]. -record_field({record_field,_,F}) -> %Just the field name +record_field({record_field,_,F}) -> %Just the field name lfe_trans:from_lit(F); -record_field({record_field,_,F,Def}) -> %Field name and default value +record_field({record_field,_,F,Def}) -> %Field name and default value Fd = lfe_trans:from_lit(F), Ld = lfe_trans:from_expr(Def), [Fd,Ld]. @@ -239,23 +239,23 @@ trans_macros([{{atom,Mac},Defs}|Ms], St0) -> {Lms,St1} = trans_macros(Ms, St0), case catch trans_macro(Mac, Defs, St1) of - {'EXIT',_} -> %It crashed - {Lms,add_warning({notrans_macro,Mac}, St1)}; - {none,St2} -> {Lms,St2}; %No definition, ignore - {Mdef,St2} -> {[Mdef|Lms],St2} + {'EXIT',_} -> %It crashed + {Lms,add_warning({notrans_macro,Mac}, St1)}; + {none,St2} -> {Lms,St2}; %No definition, ignore + {Mdef,St2} -> {[Mdef|Lms],St2} end; trans_macros([], St) -> {[],St}. -trans_macro(_, undefined, St) -> {none,St}; %Undefined macros -trans_macro(_, {none,_}, St) -> {none,St}; %Predefined macros +trans_macro(_, undefined, St) -> {none,St}; %Undefined macros +trans_macro(_, {none,_}, St) -> {none,St}; %Predefined macros trans_macro(Mac, Defs0, St) -> Defs1 = order_macro_defs(Defs0), case trans_macro_defs(Defs1) of - [] -> {none,St}; %No definitions - Lcls -> {[defmacro,Mac|Lcls],St} + [] -> {none,St}; %No definitions + Lcls -> {[defmacro,Mac|Lcls],St} end. -order_macro_defs([{none,Ds}|Defs]) -> %Put the no arg version last +order_macro_defs([{none,Ds}|Defs]) -> %Put the no arg version last Defs ++ [{none,Ds}]; order_macro_defs(Defs) -> Defs. @@ -287,8 +287,8 @@ Ts1 = trans_qm(Ts0), {ok,[E]} = erl_parse:parse_exprs(Ts1 ++ [{dot,0}]), Le0 = lfe_trans:from_expr(E), - %% Wrap variables in arg list with an (unquote ...) call. - Alist = [ [A|[unquote,A]] || A <- As ], + %% Wrap variables in arg list with an (comma ...) call. + Alist = [ [A|[comma,A]] || A <- As ], Le1 = lfe_lib:sublis(Alist, Le0), %% Le1 = unquote_vars(Alist, Le0), [?BQ(Le1)].
View file
lfe-0.9.2.tar.gz/src/lfe_macro_record.erl -> lfe-1.0.tar.gz/src/lfe_macro_record.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -41,27 +41,27 @@ define(Name, Fdefs, Env, St) -> %% Get field names, default values and indices. Fields = map(fun ([F,_]) when is_atom(F) -> F; - (F) when is_atom(F) -> F - end, Fdefs), + (F) when is_atom(F) -> F + end, Fdefs), Defs = map(fun ([F,D])when is_atom(F) -> ?Q(D); - (F) when is_atom(F) -> ?Q(?Q(undefined)) - end, Fdefs), + (F) when is_atom(F) -> ?Q(?Q(undefined)) + end, Fdefs), Findexs = field_indexes(Fields), %% Make names for helper functions. Fi = list_to_atom(concat([Name,'-',field,'-',index])), Fu = list_to_atom(concat([Name,'-',field,'-',update])), %% Build helper functions. Funs = [index_function(Name, Fi, Findexs), - update_function(Name, Fu, Fi)], + update_function(Name, Fu, Fi)], %% Make access macros. - Macs = [make_macro(Name, Defs, Fu), %make-Name - match_macro(Name, Fields, Fu), %match-Name - test_macro(Name, Fields), %is-Name - set_macro(Name, Fi), %set-Name - emp_macro(Name, Fields, Fu), %emp-Name - field_macro(Name, Fields) %fields-Name - | - field_macros(Name, Fields)], %Name-F,set-Name-F + Macs = [make_macro(Name, Defs, Fu), %make-Name + match_macro(Name, Fields, Fu), %match-Name + test_macro(Name, Fields), %is-Name + set_macro(Name, Fi), %set-Name + emp_macro(Name, Fields, Fu), %emp-Name + field_macro(Name, Fields) %fields-Name + | + field_macros(Name, Fields)], %Name-F,set-Name-F Type = type_information(Name, Fdefs, St), %% We can always add type information here as it is stripped later. Forms = [['extend-module',Type]|Macs], @@ -74,21 +74,21 @@ [{F,N}|field_indexes(Fs, N+1)]; field_indexes([], _) -> []. -index_function(Name, Fi, Fxs) -> %Get index of field +index_function(Name, Fi, Fxs) -> %Get index of field [defun,Fi| map(fun ({F,I}) -> [[?Q(F)],I] end, Fxs) ++ - [[[f],[':',erlang,error,[tuple,?Q(undefined_field),?Q(Name),f]]]]]. + [[[f],[':',erlang,error,[tuple,?Q(undefined_field),?Q(Name),f]]]]]. -update_function(Name, Fu, Fi) -> %Update field list +update_function(Name, Fu, Fi) -> %Update field list [defun,Fu,[is,def], %% Convert default list to tuple to make setting easier. [fletrec,[[l, - [[[cons,f,[cons,v,is]],i], - [l,is,[setelement,['-',[Fi,f],1],i,v]]], - [[[list,f],'_'], - [':',erlang,error, - [tuple,?Q(missing_value),?Q(Name),f]]], - [[[],i],i]]], + [[[cons,f,[cons,v,is]],i], + [l,is,[setelement,['-',[Fi,f],1],i,v]]], + [[[list,f],'_'], + [':',erlang,error, + [tuple,?Q(missing_value),?Q(Name),f]]], + [[[],i],i]]], ['let',[[i,[l,is,[list_to_tuple,def]]]], [tuple_to_list,i]]]]. @@ -96,64 +96,64 @@ Make = list_to_atom(concat(['make','-',Name])), ['defmacro',Make,fds, ['let',[[def,[list|Defs]]], - ?BQ([tuple,?Q(Name),?UQ_S([Fu,fds,def])])]]. + ?BQ([tuple,?Q(Name),?C_A([Fu,fds,def])])]]. match_macro(Name, Fs, Fu) -> Match = list_to_atom(concat(['match','-',Name])), ['defmacro',Match,fds, ['let',[[def,[list|lists:duplicate(length(Fs),?Q('_'))]]], - ?BQ([tuple,?Q(Name),?UQ_S([Fu,fds,def])])]]. + ?BQ([tuple,?Q(Name),?C_A([Fu,fds,def])])]]. test_macro(Name, Fs) -> Test = list_to_atom(concat(['is','-',Name])), ['defmacro',Test,[rec], - ?BQ(['is_record',?UQ(rec),?Q(Name),length(Fs)+1])]. + ?BQ(['is_record',?C(rec),?Q(Name),length(Fs)+1])]. set_macro(Name, Fi) -> Set = list_to_atom(concat(['set','-',Name])), ['defmacro',Set, [[cons,rec,fds], [fletrec,[[l, - [[[cons,f,[cons,v,is]],r], - %% Force evaluation left-to-right. - [l,is,[list,[quote,setelement],[Fi,f],r,v]]], - [[[list,f],'_'], - [':',erlang,error, - [tuple,?Q(missing_value),?Q(Name),f]]], - [[[],i],i]]], + [[[cons,f,[cons,v,is]],r], + %% Force evaluation left-to-right. + [l,is,[list,[quote,setelement],[Fi,f],r,v]]], + [[[list,f],'_'], + [':',erlang,error, + [tuple,?Q(missing_value),?Q(Name),f]]], + [[[],i],i]]], [l,fds,rec]]]]. emp_macro(Name, Fs, Fu) -> EMP = list_to_atom(concat(['emp','-',Name])), ['defmacro',EMP,fds, ['let',[[def,[list|lists:duplicate(length(Fs),?Q(?Q('_')))]]], - ?BQ([tuple,?Q(Name),?UQ_S([Fu,fds,def])])]]. + ?BQ([tuple,?Q(Name),?C_A([Fu,fds,def])])]]. field_macro(Name, Fs) -> Recfields = list_to_atom(concat(['fields','-',Name])), ['defmacro',Recfields,[],?BQ(?Q(Fs))]. field_macros(Name, Fs) -> - Fis = field_indexes(Fs), %Calculate indexes + Fis = field_indexes(Fs), %Calculate indexes foldr(fun ({F,N}, Fas) -> - Get = list_to_atom(concat([Name,'-',F])), - Set = list_to_atom(concat(['set-',Name,'-',F])), - [[defmacro,Get, - [[],N], - [[list,rec],?BQ([element,N,?UQ(rec)])]], - [defmacro,Set,[rec,new], - ?BQ([setelement,N,?UQ(rec),?UQ(new)])]| - Fas] - end, [], Fis). + Get = list_to_atom(concat([Name,'-',F])), + Set = list_to_atom(concat(['set-',Name,'-',F])), + [[defmacro,Get, + [[],N], + [[list,rec],?BQ([element,N,?C(rec)])]], + [defmacro,Set,[rec,new], + ?BQ([setelement,N,?C(rec),?C(new)])]| + Fas] + end, [], Fis). type_information(Name, Fdefs, #mac{line=L}) -> %% Only field names which will result in default type any(). %% Adding types greatly complicates things. If we add defaults %% then they would have to be expanded here. Fs = map(fun ([F,_D]) -> - %% De = lfe_trans:to_expr(D, L), - {record_field,L,{atom,L,F}}; - (F) -> - {record_field,L,{atom,L,F}} - end, Fdefs), + %% De = lfe_trans:to_expr(D, L), + {record_field,L,{atom,L,F}}; + (F) -> + {record_field,L,{atom,L,F}} + end, Fdefs), [type,[{record,Name},Fs,[]]].
View file
lfe-0.9.2.tar.gz/src/lfe_ms.erl -> lfe-1.0.tar.gz/src/lfe_ms.erl
Changed
@@ -37,21 +37,21 @@ format_error(match_spec_head) -> "Illegal number of head arguments". --define(Q(E), [quote,E]). %We do a lot of quoting! +-define(Q(E), [quote,E]). %We do a lot of quoting! --record(ms, {dc=1, %Dollar variable count from 1 - bs=[], %Variable/$var bindings - where=guard %Where in spec head/guard/body - }). +-record(ms, {dc=1, %Dollar variable count from 1 + bs=[], %Variable/$var bindings + where=guard %Where in spec head/guard/body + }). %% expand(MSBody) -> Expansion. -%% Expand the match spec body. +%% Expand the match spec body. expand(Cls) -> case catch clauses(Cls, #ms{}) of - {error,E} -> error(E); %Signals errors - {'EXIT',E} -> error(E); %Signals errors - {Exp,_} -> Exp %Hurrah it worked + {error,E} -> error(E); %Signals errors + {'EXIT',E} -> error(E); %Signals errors + {Exp,_} -> Exp %Hurrah it worked end. %% clauses(MSClauses, State) -> {Patterns,State}. @@ -77,24 +77,24 @@ {[tuple,H1,[],B1],St3}. %% head(Patterns, State) -> {Pattern,State}. -%% Expand a head which can only consist of one argument. Only allow -%% aliasing at the top-level and only to a variable. +%% Expand a head which can only consist of one argument. Only allow +%% aliasing at the top-level and only to a variable. head(Pats, St0) -> - St1 = St0#ms{where=head}, %We are now in the head - case Pats of %Test for top-level aliasing - [['=',S,Pat]] when is_atom(S) -> - St2 = new_binding(S, '$_', St1), - pattern(Pat, St2); - [['=',Pat,S]] when is_atom(S) -> - St2 = new_binding(S, '$_', St1), - pattern(Pat, St2); - [Pat] -> pattern(Pat, St1); - _ -> throw({error,match_spec_head}) %Wrong size + St1 = St0#ms{where=head}, %We are now in the head + case Pats of %Test for top-level aliasing + [['=',S,Pat]] when is_atom(S) -> + St2 = new_binding(S, '$_', St1), + pattern(Pat, St2); + [['=',Pat,S]] when is_atom(S) -> + St2 = new_binding(S, '$_', St1), + pattern(Pat, St2); + [Pat] -> pattern(Pat, St1); + _ -> throw({error,match_spec_head}) %Wrong size end. pattern('_', St) -> {?Q('_'),St}; -pattern(Symb, St0) when is_atom(Symb) -> %Variable +pattern(Symb, St0) when is_atom(Symb) -> %Variable {Dv,St1} = pat_binding(Symb, St0), {?Q(Dv),St1}; pattern([quote,_]=E, St) -> {E,St}; @@ -113,26 +113,26 @@ {H1,St1} = pattern(H0, St0), {T1,St2} = pattern(T0, St1), {[H1,T1],St2}; -pattern(E, St) -> {E,St}. %Atomic +pattern(E, St) -> {E,St}. %Atomic pat_list(Ps, St) -> mapfoldl(fun pattern/2, St, Ps). %% pat_binding(Var, Status) -> {DVar,Status}. -%% Get dollar var for variable, creating a new one if neccessary. +%% Get dollar var for variable, creating a new one if neccessary. pat_binding(Var, St0) -> case find_binding(Var, St0) of - {ok,Dv} -> {Dv,St0}; - error -> - {Dv,St1} = new_dollar(St0), - {Dv,new_binding(Var, Dv, St1)} + {ok,Dv} -> {Dv,St0}; + error -> + {Dv,St1} = new_dollar(St0), + {Dv,new_binding(Var, Dv, St1)} end. %% guard(Tests, State) -> {Tests,State}. %% body(Tests, State) -> {Tests,State}. -%% The expression translation in the same except for which -%% expressions/tests are allowed. We use the same functions but carry -%% a 'where' field in the State to separate them. +%% The expression translation in the same except for which +%% expressions/tests are allowed. We use the same functions but carry +%% a 'where' field in the State to separate them. guard(Ts, St0) -> St1 = St0#ms{where=guard}, @@ -153,13 +153,13 @@ expr(S, St) when is_atom(S) -> %Variable case find_binding(S, St) of - {ok,Dv} -> {?Q(Dv),St}; %Head variable - error -> {S,St} %Free variable, need binding + {ok,Dv} -> {?Q(Dv),St}; %Head variable + error -> {S,St} %Free variable, need binding end; expr([quote,A]=E, St) when is_atom(A) -> %Atom case atom_to_list(A) of - [$$|_] -> {[tuple,?Q(const),E],St}; %Catch dollar variables - _ -> {E,St} + [$$|_] -> {[tuple,?Q(const),E],St}; %Catch dollar variables + _ -> {E,St} end; expr([quote,T], St) when is_tuple(T) -> %Must tuple tuples {[tuple,T],St}; @@ -184,18 +184,18 @@ expr([call,?Q(erlang),?Q(Op)|Es0], St0) when is_atom(Op) -> Ar = length(Es0), case is_ms_erlang_func(Op, Ar) of - true -> - {Es1,St1} = expr_list(Es0, St0), - {[tuple,?Q(Op)|Es1],St1}; - false -> throw({error,{illegal_ms_func,{erlang,Op,Ar}}}) + true -> + {Es1,St1} = expr_list(Es0, St0), + {[tuple,?Q(Op)|Es1],St1}; + false -> throw({error,{illegal_ms_func,{erlang,Op,Ar}}}) end; expr([Op|Es0], St0) when is_atom(Op) -> Ar = length(Es0), case is_ms_func(Op, Ar, St0#ms.where) of %Need to know where we are! - true -> - {Es1,St1} = expr_list(Es0, St0), - {[tuple,?Q(Op)|Es1],St1}; - false -> throw({error,{illegal_ms_func,{Op,Ar}}}) + true -> + {Es1,St1} = expr_list(Es0, St0), + {[tuple,?Q(Op)|Es1],St1}; + false -> throw({error,{illegal_ms_func,{Op,Ar}}}) end; expr([_|_], _) -> throw({error,illegal_ms_call}); expr([], St) -> {[],St}; @@ -209,25 +209,25 @@ expr_bitseg([Val0|Specs0]=F, St0) -> case is_integer_list(F) of - true -> {F,St0}; - false -> - {Specs1,St1} = expr_bitspecs(Specs0, St0), - case is_integer_list(Val0) of - true -> {[Val0|Specs1],St1}; + true -> {F,St0}; false -> - {Val1,St2} = expr(Val0, St1), - {[Val1|Specs1],St2} - end + {Specs1,St1} = expr_bitspecs(Specs0, St0), + case is_integer_list(Val0) of + true -> {[Val0|Specs1],St1}; + false -> + {Val1,St2} = expr(Val0, St1), + {[Val1|Specs1],St2} + end end; expr_bitseg(Val, St) -> expr(Val, St). expr_bitspecs(Specs, St) -> mapfoldl(fun ([size,Sz0], S0) -> - {Sz1,S1} = expr(Sz0, S0), - {[size,Sz1],S1}; - (Sp, S) -> {Sp,S} - end, St, Specs). + {Sz1,S1} = expr(Sz0, S0), + {[size,Sz1],S1}; + (Sp, S) -> {Sp,S} + end, St, Specs). is_integer_list([I|Is]) when is_integer(I) -> is_integer_list(Is);
View file
lfe-0.9.2.tar.gz/src/lfe_parse.erl -> lfe-1.0.tar.gz/src/lfe_parse.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2009-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -12,313 +12,272 @@ %% See the License for the specific language governing permissions and %% limitations under the License. -%% File : lfe_parse.erl -%% Author : Robert Virding -%% Purpose : A simple Sexpr parser. -%% A simple sexpr parser. It is both re-entrant and returns excess -%% tokens. The main engine is pretty naively coded at the moment. - -module(lfe_parse). --export([sexpr/1,sexpr/2,format_error/1]). +-export([format_error/1]). --import(lists, [reverse/1,reverse/2]). +%% The root symbol entry points +-export([form/1,form/2]). -%% Define IS_MAP/1 macro for is_map/1 bif. --ifdef(HAS_MAPS). --define(IS_MAP(T), is_map(T)). --else. --define(IS_MAP(T), false). --endif. +%% User code. This is placed here to allow extra attributes. -%% We define the syntax as an LL(1) and write/generate a parser for -%% it. We also define the grammar with the same form as for yecc even -%% though we have no automatic generator. -%% -%% Terminals -%% symbol number string fun '(' ')' '[' ']' '.' '\'' ',' '@' ',@' '`' '#(' -%% '#B(' '#M(' '#\''. -%% -%% Nonterminals form sexpr list list_tail proper_list . -%% -%% 0 form -> sexpr : '$1'. -%% 1 sexpr -> symbol : val('$1'). -%% 2 sexpr -> number : val('$1'). -%% 3 sexpr -> string : val('$1'). -%% 4 sexpr -> '#\'' : make_fun(val('$1')). -%% 5 sexpr -> '\'' sexpr : [quote,'$2']. -%% 6 sexpr -> '`' sexpr : [backquote,'$2']. -%% 7 sexpr -> ',' sexpr : [unquote,'$2']. -%% 8 sexpr -> ',@' sexpr : ['unquote-splicing','$2']. -%% 9 sexpr -> ( list ) : '$2'. -%% 10 sexpr -> [ list ] : '$2'. -%% 11 sexpr -> '#(' proper_list ')' : list_to_tuple('$2'). -%% 12 sexpr -> '#B(' proper_list ')' : -%% case catch lfe_eval:expr([binary|'$2']) of -%% Bin when is_bitstring(Bin) -> Bin; -%% _ -> return_error(line('$1')) -%% end -%% 13 sexpr -> '#M(' proper_list ')' : -%% case catch maps:from_list(pair_list('$2')) of -%% Map when is_map(Map) -> Map; -%% _ -> return_error(line('$1')) -%% end -%% 14 list -> sexpr list_tail : ['$1'|'$2]. -%% 15 list -> empty : []. -%% 16 list_tail -> sexpr list_tail : ['$1'|'$2']. -%% 17 list_tail -> . sexpr : '$2'. -%% 18 list_tail -> empty : []. -%% 19 proper_list -> sexpr proper_list : ['$1'|'$2']. -%% 20 proper_list -> empty : []. - -%% The computed First and Follow sets for the productions. This is the -%% only really tricky bit. -%% -%% First(f) = {symbol number string #' ( [ ' ` , ,@ #( #B( #M(} -%% First(s) = {symbol number string #' ( [ ' ` , ,@ #( #B( #M(} -%% First(l) = {symbol number string #' ( [ ' ` , ,@ #( #B( #M( empty} -%% First(t) = {symbol number string #' ( [ . ' ` , ,@ #( #B( #M( empty} -%% First(p) = {symbol number string #' ( [ ' ` , ,@ #( #B( #M( empty} -%% Follow(f) = empty -%% Follow(s) = {symbol number string #' ( [ ) ] ' ` , ,@ #( #B( #M(} -%% Follow(l) = {symbol number string #' ( [ ) ] ' ` , ,@ #( #B( #M(} -%% Follow(t) = {symbol number string #' ( [ ) ] ' ` , ,@ #( #B( #M(} -%% Follow(p) = {symbol number string #' ( [ ) ] ' ` , ,@ #( #B( #M(} - -%% The table (tedious). -%% Top symbol ( ) [ ] . '`,,@ #(#B(#M( -%% f f->s f->s f->s f->s f->s -%% s s->sym s->( l ) s->[ s ] s->' s s->( p ) -%% l l->s t l->s t l->e l->s t l->e l->s t l->s t -%% t t->s t t->s t t->e t->s t t->e t->. s t->s t t->s t -%% p p->s p p->s p p->e p->s p p->e p->s p p->s p - -%% The non-terminal types. --define(FORM, 0). --define(EXPR, 1). --define(LIST, 2). --define(TAIL, 3). --define(PROP, 4). - -%% Start non-terminal state. -start() -> ?FORM. +-define(CATCH(E, Error), try E catch _:_ -> Error end). -%% The reductions, we are naive and straight forward here. -reduce(0, Vs) -> Vs; %f->s -reduce(1, [T|Vs]) -> [val(T)|Vs]; %s->symbol -reduce(2, [T|Vs]) -> [val(T)|Vs]; %s->number -reduce(3, [T|Vs]) -> [val(T)|Vs]; %s->string -reduce(4, [T|Vs]) -> %s->fun - [make_fun(val(T))|Vs]; -reduce(5, [S,_|Vs]) -> [[quote,S]|Vs]; %s->' s -reduce(6, [S,_|Vs]) -> [[backquote,S]|Vs]; %s->` s -reduce(7, [S,_|Vs]) -> [[unquote,S]|Vs]; %s->, s -reduce(8, [S,_|Vs]) -> %s->,@ s - [['unquote-splicing',S]|Vs]; -reduce(9, [_,L,_|Vs]) -> [L|Vs]; %s->( s ) -reduce(10, [_,L,_|Vs]) -> [L|Vs]; %s->[ s ] -reduce(11, [_,L,_|Vs]) -> %s->#( p ) - [list_to_tuple(L)|Vs]; -reduce(12, [_,L,B|Vs]) -> %s->#B( p ) - case catch lfe_eval:literal([binary|L]) of - Bin when is_bitstring(Bin) -> [Bin|Vs]; - _ -> {error,line(B),{illegal,binary}} - end; -reduce(13, [_,L,B|Vs]) -> %s->#M( p ) - case catch maps:from_list(pair_list(L)) of - Map when ?IS_MAP(Map) -> [Map|Vs]; - _ -> {error,line(B),{illegal,map}} - end; -reduce(14, [T,H|Vs]) -> [[H|T]|Vs]; %l->s t -reduce(15, Vs) -> [[]|Vs]; %l->empty -reduce(16, [T,H|Vs]) -> [[H|T]|Vs]; %t->s t -reduce(17, [T,_|Vs]) -> [T|Vs]; %t->. s -reduce(18, Vs) -> [[]|Vs]; %t->empty -reduce(19, [T,H|Vs]) -> [[H|T]|Vs]; %p->s t -reduce(20, Vs) -> [[]|Vs]. %p->empty - -%% The table, this gets pretty big but is very straight forward. -table(?FORM, symbol) -> [?EXPR]; -table(?FORM, number) -> [?EXPR]; -table(?FORM, string) -> [?EXPR]; -table(?FORM, '#\'') -> [?EXPR]; -table(?FORM, '\'') -> [?EXPR]; -table(?FORM, '`') -> [?EXPR]; -table(?FORM, ',') -> [?EXPR]; -table(?FORM, ',@') -> [?EXPR]; -table(?FORM, '(') -> [?EXPR]; -table(?FORM, '[') -> [?EXPR]; -table(?FORM, '#(') -> [?EXPR]; -table(?FORM, '#B(') -> [?EXPR]; -table(?FORM, '#M(') -> [?EXPR]; - -table(?EXPR, symbol) -> [symbol,{reduce,1}]; -table(?EXPR, number) -> [number,{reduce,2}]; -table(?EXPR, string) -> [string,{reduce,3}]; -table(?EXPR, '#\'') -> ['#\'',{reduce,4}]; -table(?EXPR, '\'') -> ['\'',?EXPR,{reduce,5}]; -table(?EXPR, '`') -> ['`',?EXPR,{reduce,6}]; -table(?EXPR, ',') -> [',',?EXPR,{reduce,7}]; -table(?EXPR, ',@') -> [',@',?EXPR,{reduce,8}]; -table(?EXPR, '(') -> ['(',?LIST,')',{reduce,9}]; -table(?EXPR, '[') -> ['[',?LIST,']',{reduce,10}]; -table(?EXPR, '#(') -> ['#(',?PROP,')',{reduce,11}]; -table(?EXPR, '#B(') -> ['#B(',?PROP,')',{reduce,12}]; -table(?EXPR, '#M(') -> ['#M(',?PROP,')',{reduce,13}]; - -table(?LIST, symbol) -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, number) -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, string) -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, '#\'') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, '\'') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, '`') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, ',') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, ',@') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, '(') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, '[') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, '#(') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, '#B(') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, '#M(') -> [?EXPR,?TAIL,{reduce,14}]; -table(?LIST, ')') -> [{reduce,15}]; -table(?LIST, ']') -> [{reduce,15}]; - -table(?TAIL, symbol) -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, number) -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, string) -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '#\'') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '\'') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '`') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, ',') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, ',@') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '(') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '[') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '#(') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '#B(') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '#M(') -> [?EXPR,?TAIL,{reduce,16}]; -table(?TAIL, '.') -> ['.',?EXPR,{reduce,17}]; -table(?TAIL, ')') -> [{reduce,18}];
View file
lfe-1.0.tar.gz/src/lfe_parse.spell1
Added
@@ -0,0 +1,109 @@ +%% -*- mode: erlang -*- +%% Copyright (c) 2008-2015 Robert Virding +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +%% We define the grammar with the same form as for yecc. + +Terminals + symbol number string binary fun '(' ')' '[' ']' '.' '\'' '`' ',' ',@' + '#(' '#B(' '#M(' '#.' '#\''. + +Nonterminals form sexpr list list_tail proper_list . + +Rootsymbol form. + +form -> sexpr : '$1'. +sexpr -> symbol : value('$1'). +sexpr -> number : value('$1'). +sexpr -> string : value('$1'). +sexpr -> binary : value('$1'). +sexpr -> '#\'' : make_fun(value('$1')). +sexpr -> '#.' sexpr : eval_expr(line('$1'), '$2'). +sexpr -> '\'' sexpr : [quote,'$2']. +sexpr -> '`' sexpr : [backquote,'$2']. +sexpr -> ',' sexpr : [comma,'$2']. +sexpr -> ',@' sexpr : ['comma-at','$2']. +sexpr -> '(' list ')' : '$2'. +sexpr -> '[' list ']' : '$2'. +sexpr -> '#(' proper_list ')' : list_to_tuple('$2'). +sexpr -> '#B(' proper_list ')' : + make_bin(line('$1'), '$2'). +sexpr -> '#M(' proper_list ')' : + make_map(line('$1'), '$2'). +list -> sexpr list_tail : ['$1'|'$2']. +list -> '$empty' : []. +list_tail -> sexpr list_tail : ['$1'|'$2']. +list_tail -> '.' sexpr : '$2'. +list_tail -> '$empty' : []. +proper_list -> sexpr proper_list : ['$1'|'$2']. +proper_list -> '$empty' : []. + +%% Extra Erlang code. +Erlang code. + +-define(CATCH(E, Error), try E catch _:_ -> Error end). + +%% For backwards compatibility +-export([sexpr/1,sexpr/2]). + +sexpr(Ts) -> form(Ts). +sexpr(Cont, Ts) -> form(Cont, Ts). + +%% make_fun(String) -> FunList. +%% Convert a fun string to a fun sexpr. +%% "F/A" -> ['fun', F, A]. +%% "M:F/A" -> ['fun', M, F, A]. + +make_fun("=:=/2") -> + ['fun', '=:=', 2]; +make_fun(FunStr) -> + J = string:rchr(FunStr, $/), + A = list_to_integer(string:substr(FunStr, J + 1)), + case string:chr(FunStr, $:) of + 0 -> + F = list_to_atom(string:substr(FunStr, 1, J - 1)), + ['fun', F, A]; + I -> + F = list_to_atom(string:substr(FunStr, I + 1, J - I - 1)), + M = list_to_atom(string:substr(FunStr, 1, I - 1)), + ['fun', M, F, A] + end. + +%% make_bin(Line, Segments) -> Binary. +%% Make a binary from the segments. + +make_bin(Line, Segs) -> + ?CATCH(lfe_eval:expr([binary|Segs]), + return_error(Line, "bad binary")). + +%% make_map(Line, Elements) -> Map. +%% Make a map from the key/value elements. + +make_map(Line, Es) -> + ?CATCH(maps:from_list(pair_list(Es)), + return_error(Line, "bad map")). + +%% pair_list(List) -> [{A,B}]. +%% Generate a list of tuple pairs from the elements. An error if odd +%% number of elements in list. + +pair_list([A,B|L]) -> [{A,B}|pair_list(L)]; +pair_list([]) -> []. + +%% eval_expr(Line, Expr) -> Val. +%% Evaluate #. expression. + +eval_expr(Line, Expr) -> + ?CATCH(lfe_eval:expr(Expr), + return_error(Line, "bad #. expression")).
View file
lfe-0.9.2.tar.gz/src/lfe_pmod.erl -> lfe-1.0.tar.gz/src/lfe_pmod.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2015 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,109 +23,111 @@ %% -compile(export_all). -import(lists, [member/2,keysearch/3, - all/2,map/2,foldl/3,foldr/3,mapfoldl/3,mapfoldr/3, - concat/1]). + all/2,map/2,foldl/3,foldr/3,mapfoldl/3,mapfoldr/3, concat/1]). -import(ordsets, [add_element/2,is_element/2,from_list/1,union/2]). -import(orddict, [store/3,find/2]). -import(lfe_env, [new/0,add_vbinding/3,add_vbindings/2,get_vbinding/2, - add_fbinding/4,add_fbindings/2,get_fbinding/3, - add_ibinding/5,get_gbinding/3]). + add_fbinding/4,add_fbindings/2,get_fbinding/3, + add_ibinding/5,get_gbinding/3]). -include("lfe_comp.hrl"). --define(Q(E), [quote,E]). %For quoting +-define(Q(E), [quote,E]). %For quoting --record(param, {mod=[], %Module name - pars=[], %Module parameters - extd=[], %Extends - this=[], %This match pattern - env=[]}). %Environment +-record(param, {mod=[], %Module name + pars=[], %Module parameters + extd=[], %Extends + this=[], %This match pattern + env=[]}). %Environment -%% module(Forms, CompInfo) -> Forms. +%% module(ModuleForms, CompInfo) -> {ModuleName,ModuleForms}. %% Expand the forms to handle parameterised modules if necessary, %% otherwise just pass forms straight through. -module([{['define-module',[_|_]|_],_}|_]=Fs, Ci) -> - expand_module(Fs, Ci#cinfo.opts); -module(Fs, _) -> Fs. %Normal module, do nothing +module([{['define-module',[Mod|_]|_],_}|_]=Fs, Ci) -> + {Mod,expand_module(Fs, Ci#cinfo.opts)}; +module([{['define-module',Mod|_],_}|_]=Fs, _) -> + %% Normal module, do nothing. + {Mod,Fs}; +module(Fs, _) -> {[],Fs}. %Not a module, do nothing expand_module(Fs0, Opts) -> St0 = #param{env=lfe_env:new()}, - {Fs1,St1} = lfe_lib:proc_forms(fun exp_form/3, Fs0, St0), + {Acc,St1} = lists:foldl(fun exp_form/2, {[],St0}, Fs0), + Fs1 = lists:reverse(Acc), debug_print("#param: ~p\n", [{Fs1,St1}], Opts), %% {ok,_} = lfe_lint:module(Fs1, Opts), Fs1. -exp_form(['define-module',[Mod|Ps]|Mdef0], L, St0) -> +exp_form({['define-module',[Mod|Ps]|Mdef0],L}, {Acc,St0}) -> %% Save the good bits and define new/N and instance/N. St1 = St0#param{mod=Mod,pars=Ps}, {Mdef1,St2} = exp_mdef(Mdef0, St1), {Nl,Il} = case St2#param.extd of - [] -> - {[lambda,Ps,[instance|Ps]], - [lambda,Ps,[tuple,?Q(Mod)|Ps]]}; - Ex -> - {[lambda,Ps,[instance,[call,?Q(Ex),?Q(new)|Ps]|Ps]], - [lambda,[base|Ps],[tuple,?Q(Mod),base|Ps]]} - end, + [] -> + {[lambda,Ps,[instance|Ps]], + [lambda,Ps,[tuple,?Q(Mod)|Ps]]}; + Ex -> + {[lambda,Ps,[instance,[call,?Q(Ex),?Q(new)|Ps]|Ps]], + [lambda,[base|Ps],[tuple,?Q(Mod),base|Ps]]} + end, New = ['define-function',new,Nl], Inst = ['define-function',instance,Il], %% Fix this match pattern depending on extends. St3 = case St2#param.extd of - [] -> St2#param{this=['=',this,[tuple,'_'|Ps]]}; - _ -> St2#param{this=['=',this,[tuple,'_',base|Ps]]} - end, - {[{['define-module',Mod|Mdef1],L}, - {New,L},{Inst,L}],St3}; -exp_form(['define-function',F,Def0], L, St) -> + [] -> St2#param{this=['=',this,[tuple,'_'|Ps]]}; + _ -> St2#param{this=['=',this,[tuple,'_',base|Ps]]} + end, + {[{{New,L},{Inst,L},['define-module',Mod|Mdef1],L}|Acc],St3}; +exp_form({['define-function',F,Def0],L}, {Acc,St}) -> Def1 = exp_function(Def0, St), - {[{['define-function',F,Def1],L}],St}; -exp_form(F, L, St) -> - {[{F,L}],St}. + {[{['define-function',F,Def1],L}|Acc],St}; +exp_form({F,L}, {Acc,St}) -> + {[{F,L}|Acc],St}. debug_print(Format, Args, Opts) -> case member(debug_print, Opts) of - true -> lfe_io:format(Format, Args); - false -> ok + true -> lfe_io:format(Format, Args); + false -> ok end. exp_mdef(Mdef0, St0) -> %% Pre-scan to pick up 'extends'. St1 = foldl(fun ([extends,M], S) -> S#param{extd=M}; - (_, S) -> S - end, St0, Mdef0), + (_, S) -> S + end, St0, Mdef0), %% Now do "real" processing. {Mdef1,St2} = mapfoldl(fun ([export,all], S) -> {[export,all],S}; - ([export|Es0], S) -> - %% Add 1 for this to each export. - Es1 = map(fun ([F,A]) -> [F,A+1] end, Es0), - {[export|Es1],S}; - ([import|Is], S0) -> - S1 = collect_imps(Is, S0), - {[import|Is],S1}; - (Md, S) -> {Md,S} - end, St1, Mdef0 ++ [[abstract,true]]), + ([export|Es0], S) -> + %% Add 1 for this to each export. + Es1 = map(fun ([F,A]) -> [F,A+1] end, Es0), + {[export|Es1],S}; + ([import|Is], S0) -> + S1 = collect_imps(Is, S0), + {[import|Is],S1}; + (Md, S) -> {Md,S} + end, St1, Mdef0 ++ [[abstract,true]]), %% Add export for new/N and instance/N. Ar = length(St2#param.pars), Iar = case St2#param.extd of - [] -> Ar; - _ -> Ar+1 - end, + [] -> Ar; + _ -> Ar+1 + end, {[[export,[new,Ar],[instance,Iar]]|Mdef1],St2}. collect_imps(Is, St) -> foldl(fun (['from',M|Fs], S) -> - Env = foldl(fun ([F,Ar], E) -> - add_ibinding(M, F, Ar, F, E) end, - S#param.env, Fs), - S#param{env=Env}; - (['rename',M|Fs], S) -> - Env = foldl(fun ([[F,Ar],R], E) -> - add_ibinding(M, F, Ar, R, E) end, - S#param.env, Fs), - S#param{env=Env} - end, St, Is). + Env = foldl(fun ([F,Ar], E) -> + add_ibinding(M, F, Ar, F, E) end, + S#param.env, Fs), + S#param{env=Env}; + (['rename',M|Fs], S) -> + Env = foldl(fun ([[F,Ar],R], E) -> + add_ibinding(M, F, Ar, R, E) end, + S#param.env, Fs), + S#param{env=Env} + end, St, Is). %% exp_function(Lambda, State) -> Lambda. %% The resultant code matches the arguments in two steps: first the @@ -195,12 +197,12 @@ exp_expr([Fun|Es], Env) when is_atom(Fun) -> Ar = length(Es), case get_fbinding(Fun, Ar, Env) of - {yes,_,_} -> [Fun|exp_list(Es, Env)]; %Imported or Bif - {yes,local} -> [Fun|exp_list(Es, Env)]; %Local function - _ -> [Fun|exp_list(Es, Env) ++ [this]] + {yes,_,_} -> [Fun|exp_list(Es, Env)]; %Imported or Bif + {yes,local} -> [Fun|exp_list(Es, Env)]; %Local function + _ -> [Fun|exp_list(Es, Env) ++ [this]] end; exp_expr(E, _) when is_atom(E) -> E; -exp_expr(E, _) -> E. %Atoms expand to themselves. +exp_expr(E, _) -> E. %Atoms expand to themselves. exp_list(Es, Env) -> map(fun (E) -> exp_expr(E, Env) end, Es). @@ -214,8 +216,8 @@ exp_bitseg([N|Specs0], Env) -> %% The only bitspec that needs expanding is size. Specs1 = map(fun ([size,S]) -> [size,exp_expr(S, Env)]; - (S) -> S - end, Specs0), + (S) -> S
View file
lfe-0.9.2.tar.gz/src/lfe_scan.xrl -> lfe-1.0.tar.gz/src/lfe_scan.xrl
Changed
@@ -21,73 +21,87 @@ O = [0-7] D = [0-9] H = [0-9a-fA-F] -B36 = [0-9a-zA-Z] +B36 = [0-9a-zA-Z] U = [A-Z] L = [a-z] A = ({U}|{L}) -DEL = [][()}{";\000-\s] -SYM = [^][()}{";\000-\s] -SSYM = [^][()}{|";#`',\000-\s] -WS = ([\000-\s]|;[^\n]*) +DEL = [][()}{";\000-\s] +SYM = [^][()}{";\000-\s\177-\237] +SSYM = [^][()}{"|;#`',\000-\s\177-\237] +WS = ([\000-\s]|;[^\n]*) Rules. %% Bracketed Comments using #| foo |# -#\|[^\|]*\|+([^#\|][^\|]*\|+)*# : block_comment(string:substr(TokenChars, 3)). +#{D}*\|[^\|]*\|+([^#\|][^\|]*\|+)*# : + block_comment(string:substr(TokenChars, 3)). + %% Separators -#[bB]\( : {token,{'#B(',TokenLine}}. -#[mM]\( : {token,{'#M(',TokenLine}}. -#\( : {token,{'#(',TokenLine}}. -#` : {token,{'#`',TokenLine}}. -#; : {token,{'#;',TokenLine}}. -#, : {token,{'#,',TokenLine}}. -#,@ : {token,{'#,@',TokenLine}}. ' : {token,{'\'',TokenLine}}. ` : {token,{'`',TokenLine}}. , : {token,{',',TokenLine}}. ,@ : {token,{',@',TokenLine}}. \. : {token,{'.',TokenLine}}. [][()}{] : {token,{list_to_atom(TokenChars),TokenLine}}. + +#{D}*[bB]\( : {token,{'#B(',TokenLine}}. +#{D}*[mM]\( : {token,{'#M(',TokenLine}}. +#{D}*\( : {token,{'#(',TokenLine}}. +#{D}*\. : {token,{'#.',TokenLine}}. + +#{D}*` : {token,{'#`',TokenLine}}. +#{D}*; : {token,{'#;',TokenLine}}. +#{D}*, : {token,{'#,',TokenLine}}. +#{D}*,@ : {token,{'#,@',TokenLine}}. + %% Characters -#\\(x{H}+|.) : char_token(string:substr(TokenChars, 3), TokenLine). +#{D}*\\(x{H}+|.) : char_token(skip_past(TokenChars, $\\, $\\), TokenLine). + +%% Based numbers +#{D}*\*{SYM}+ : base_token(skip_past(TokenChars, $*, $*), 2, TokenLine). +#{D}*[bB]{SYM}+ : base_token(skip_past(TokenChars, $b, $B), 2, TokenLine). +#{D}*[oO]{SYM}+ : base_token(skip_past(TokenChars, $o, $O), 8, TokenLine). +#{D}*[dD]{SYM}+ : base_token(skip_past(TokenChars, $d, $D), 10, TokenLine). +#{D}*[xX]{SYM}+ : base_token(skip_past(TokenChars, $x, $X), 16, TokenLine). +#{D}*[rR]{SYM}+ : + %% Scan over digit chars to get base. + {Base,[_|Ds]} = base1(tl(TokenChars), 10, 0), + base_token(Ds, Base, TokenLine). + %% String -"(\\x{H}+;|\\.|[^"])*" : - %% Strip quotes. - S = string:substr(TokenChars, 2, TokenLen - 2), - {token,{string,TokenLine,chars(S)}}. +"(\\x{H}+;|\\.|[^"\\])*" : + %% Strip quotes. + S = string:substr(TokenChars, 2, TokenLen - 2), + {token,{string,TokenLine,chars(S)}}. +%% Binary string +#"(\\x{H}+;|\\.|[^"\\])*" : + %% Strip quotes. + S = string:substr(TokenChars, 3, TokenLen - 3), + Bin = unicode:characters_to_binary(chars(S), utf8, utf8), + {token,{binary,TokenLine,Bin}}. %% Symbols -\|(\\x{H}+;|\\.|[^|])*\| : - %% Strip quotes. - S = string:substr(TokenChars, 2, TokenLen - 2), - symbol_token(chars(S), TokenLine). +\|(\\x{H}+;|\\.|[^|\\])*\| : + %% Strip quotes. + S = string:substr(TokenChars, 2, TokenLen - 2), + symbol_token(chars(S), TokenLine). %% Funs -#'{SSYM}{SYM}*/{D}+ : - %% Strip sharpsign single-quote. - FunStr = string:substr(TokenChars,3), - {token,{'#\'',TokenLine,FunStr}}. -%% Based numbers -#[bB]{B}+ : base_token(string:substr(TokenChars, 3), 2, TokenLine). -#[oO]{O}+ : base_token(string:substr(TokenChars, 3), 8, TokenLine). -#[dD]{D}+ : base_token(string:substr(TokenChars, 3), 10, TokenLine). -#[xX]{H}+ : base_token(string:substr(TokenChars, 3), 16, TokenLine). -#([0]?[2-9]|[12][0-9]|3[0-6])[rR]{B36}+ : - %% Have to scan all possible digit chars and fail if wrong. - {Base,[_|Ds]} = base1(string:substr(TokenChars, 2), 10, 0), - base_token(Ds, Base, TokenLine). - +#'{SSYM}{SYM}*/{D}+ : + %% Strip sharpsign single-quote. + FunStr = string:substr(TokenChars,3), + {token,{'#\'',TokenLine,FunStr}}. %% Atoms -[+-]?{D}+ : - case catch {ok,list_to_integer(TokenChars)} of - {ok,I} -> {token,{number,TokenLine,I}}; - _ -> {error,"illegal integer"} - end. +[+-]?{D}+ : + case catch {ok,list_to_integer(TokenChars)} of + {ok,I} -> {token,{number,TokenLine,I}}; + _ -> {error,"illegal integer"} + end. [+-]?{D}+\.{D}+([eE][+-]?{D}+)? : - case catch {ok,list_to_float(TokenChars)} of - {ok,F} -> {token,{number,TokenLine,F}}; - _ -> {error,"illegal float"} - end. + case catch {ok,list_to_float(TokenChars)} of + {ok,F} -> {token,{number,TokenLine,F}}; + _ -> {error,"illegal float"} + end. {SSYM}{SYM}* : - symbol_token(TokenChars, TokenLine). -{WS}+ : skip_token. + symbol_token(TokenChars, TokenLine). +{WS}+ : skip_token. Erlang code. %% Copyright (c) 2008-2013 Robert Virding @@ -108,25 +122,54 @@ %% Author : Robert Virding %% Purpose : Token definitions for Lisp Flavoured Erlang. +-export([start_symbol_char/1,symbol_char/1]). + -import(string, [substr/2,substr/3]). +%% start_symbol_char(Char) -> true | false. +%% symbol_char(Char) -> true | false. +%% Define start symbol chars and symbol chars. + +start_symbol_char($#) -> false; +start_symbol_char($`) -> false; +start_symbol_char($') -> false; %' +start_symbol_char($,) -> false; +start_symbol_char($|) -> false; %Symbol quote character +start_symbol_char(C) -> symbol_char(C). + +symbol_char($() -> false; +symbol_char($)) -> false; +symbol_char($[) -> false; +symbol_char($]) -> false; +symbol_char(${) -> false; +symbol_char($}) -> false; +symbol_char($") -> false; +symbol_char($;) -> false; +symbol_char(C) -> ((C > $\s) and (C =< $~)) orelse (C > $\240). + %% symbol_token(Chars, Line) -> {token,{symbol,Line,Symbol}} | {error,E}. -%% Build a symbol from list of legal characters, else error. +%% Build a symbol from list of legal characters, else error. symbol_token(Cs, L) -> case catch {ok,list_to_atom(Cs)} of - {ok,S} -> {token,{symbol,L,S}}; - _ -> {error,"illegal symbol"} + {ok,S} -> {token,{symbol,L,S}}; + _ -> {error,"illegal symbol"} end. %% base_token(Chars, Base, Line) -> Integer. -%% Convert a string of Base characters into a number. We know that -%% the strings only contain the correct character. +%% Convert a string of Base characters into a number. We only allow +%% base betqeen 2 and 36, and an optional sign character first. + +base_token(_, B, _) when B < 2; B > 36 -> + {error,"illegal number base"}; +base_token([$+|Cs], B, L) -> base_token(Cs, B, +1, L); +base_token([$-|Cs], B, L) -> base_token(Cs, B, -1, L); +base_token(Cs, B, L) -> base_token(Cs, B, +1, L). -base_token(Cs, B, L) -> +base_token(Cs, B, S, L) -> case base1(Cs, B, 0) of - {N,[]} -> {token,{number,L,N}}; - {_,_} -> {error,"illegal based number"} + {N,[]} -> {token,{number,L,S*N}}; + {_,_} -> {error,"illegal based number"} end. base1([C|Cs], Base, SoFar) when C >= $0, C =< $9, C < Base + $0 -> @@ -135,65 +178,79 @@ base1([C|Cs], Base, SoFar) when C >= $a, C =< $z, C < Base + $a - 10 ->
View file
lfe-0.9.2.tar.gz/src/lfe_shell.erl -> lfe-1.0.tar.gz/src/lfe_shell.erl
Changed
@@ -30,13 +30,13 @@ run_script/2,run_script/3,run_string/2,run_string/3]). %% The shell commands which generally callable. --export([c/1,c/2,cd/1,ec/1,ec/2,help/0,i/0,i/1,l/1,ls/1,m/0,m/1, - pid/3,p/1,pp/1,pwd/0,q/0,regs/0,exit/0]). +-export([c/1,c/2,cd/1,ec/1,ec/2,help/0,i/0,i/1,l/1,ls/1,clear/0,m/0,m/1, + pid/3,p/1,pp/1,pwd/0,q/0,flush/0,regs/0,exit/0]). -import(lfe_env, [new/0,add_env/2, add_vbinding/3,add_vbindings/2,is_vbound/2,get_vbinding/2, fetch_vbinding/2,del_vbinding/2, - add_fbinding/4,add_fbindings/3,get_fbinding/3,add_ibinding/5, + add_fbinding/4,add_fbindings/2,get_fbinding/3,add_ibinding/5, get_gbinding/3,add_mbinding/3]). -import(orddict, [store/3,find/2]). @@ -45,6 +45,12 @@ -include("lfe.hrl"). +%% Colours for the LFE banner +-define(RED(Str), "\e[31m" ++ Str ++ "\e[0m"). +-define(GRN(Str), "\e[1;32m" ++ Str ++ "\e[0m"). +-define(YLW(Str), "\e[1;33m" ++ Str ++ "\e[0m"). +-define(BLU(Str), "\e[1;34m" ++ Str ++ "\e[0m"). + %% -compile([export_all]). %% Implement our own lists functions to get around stacktrace printing @@ -89,11 +95,12 @@ server(lfe_env:new()); server(Env) -> process_flag(trap_exit, true), %Must trap exists - io:fwrite("LFE Shell V~s (abort with ^G)\n", - [erlang:system_info(version)]), + io:fwrite(get_banner()), %% Create a default base env of predefined shell variables with %% default nil bindings and basic shell macros. St = new_state("lfe", [], Env), + %% Set shell io to use LFE expand in edlin, ignore error. + io:setopts([{expand_fun,fun (B) -> lfe_edlin_expand:expand(B) end}]), Eval = start_eval(St), %Start an evaluator server_loop(Eval, St). %Run the loop @@ -186,6 +193,28 @@ read_expression_1(Rdr, start_eval(St), St) end. +get_banner() -> + [io_lib:format( + ?GRN(" ..-~~") ++ ?YLW(".~~_") ++ ?GRN("~~---..") ++ "\n" ++ + ?GRN(" ( ") ++ ?YLW("\\\\") ++ ?GRN(" )") ++ " | A Lisp-2+ on the Erlang VM\n" ++ + ?GRN(" |`-.._") ++ ?YLW("/") ++ ?GRN("_") ++ ?YLW("\\\\") ++ ?GRN("_.-';") ++ " | Type " ++ ?GRN("(help)") ++ " for usage info.\n" ++ + ?GRN(" | ") ++ ?RED("g") ++ ?GRN(" (_ \\") ++ " | \n" ++ + ?GRN(" | ") ++ ?RED("n") ++ ?GRN(" | |") ++ " | Docs: " ++ ?BLU("http://docs.lfe.io/") ++ " \n" ++ + ?GRN(" ( ") ++ ?RED("a") ++ ?GRN(" / /") ++ " | Source: " ++ ?BLU("http://github.com/rvirding/lfe") ++ "\n" ++ + ?GRN(" \\ ") ++ ?RED("l") ++ ?GRN(" (_/") ++ " | \n" ++ + ?GRN(" \\ ") ++ ?RED("r") ++ ?GRN(" /") ++ " | LFE v~s ~s\n" ++ + ?GRN(" `-") ++ ?RED("E") ++ ?GRN("___.-'") ++ "\n\n", [get_lfe_version(), get_abort_message()])]. + +get_abort_message() -> + %% We can update this later to check for env variable settings for + %% shells that require a different control character to abort, such + %% as jlfe. + "(abort with ^G)". + +get_lfe_version() -> + {ok, [App]} = file:consult(code:where_is_file("lfe.app")), + proplists:get_value(vsn, element(3, App)). + %% new_state(ScriptName, Args [,Env]) -> State. %% Generate a new shell state with all the default functions, macros %% and variables. @@ -221,16 +250,17 @@ add_vbinding('$ENV', Env2, Env2). add_shell_functions(Env0) -> - Fs = [{help,0,[lambda,[],[':',lfe_shell,help]]}, + Fs = [{cd,1,[lambda,[d],[':',lfe_shell,cd,d]]}, + {help,0,[lambda,[],[':',lfe_shell,help]]}, {i,0,[lambda,[],[':',lfe_shell,i]]}, {i,1,[lambda,[ps],[':',lfe_shell,i,ps]]}, - %% {m,0,[lambda,[],[':',lfe_shell,m]]}, - %% {m,1,[lambda,[ms],[':',lfe_shell,m,ms]]}, + {clear,0,[lambda,[],[':',lfe_shell,clear]]}, {pid,3,[lambda,[i,j,k],[':',lfe_shell,pid,i,j,k]]}, {p,1,[lambda,[e],[':',lfe_shell,p,e]]}, {pp,1,[lambda,[e],[':',lfe_shell,pp,e]]}, {pwd,0,[lambda,[],[':',lfe_shell,pwd]]}, {q,0,[lambda,[],[':',lfe_shell,exit]]}, + {flush,0,[lambda,[],[':',lfe_shell,flush]]}, {regs,0,[lambda,[],[':',lfe_shell,regs]]}, {exit,0,[lambda,[],[':',lfe_shell,exit]]} ], @@ -242,13 +272,13 @@ add_shell_macros(Env0) -> %% We write macros in LFE and expand them with macro package. - Ms = [{c,[lambda,[args,'$ENV'],?BQ([':',lfe_shell,c,?UQ_S(args)])]}, - {ec,[lambda,[args,'$ENV'],?BQ([':',lfe_shell,ec,?UQ_S(args)])]}, - {l,[lambda,[args,'$ENV'],?BQ([':',lfe_shell,l,[list|?UQ(args)]])]}, - {ls,[lambda,[args,'$ENV'],?BQ([':',lfe_shell,ls,[list|?UQ(args)]])]}, + Ms = [{c,[lambda,[args,'$ENV'],?BQ([':',lfe_shell,c,?C_A(args)])]}, + {ec,[lambda,[args,'$ENV'],?BQ([':',lfe_shell,ec,?C_A(args)])]}, + {l,[lambda,[args,'$ENV'],?BQ([':',lfe_shell,l,[list|?C(args)]])]}, + {ls,[lambda,[args,'$ENV'],?BQ([':',lfe_shell,ls,[list|?C(args)]])]}, {m,['match-lambda', [[[],'$ENV'],?BQ([':',lfe_shell,m])], - [[ms,'$ENV'],?BQ([':',lfe_shell,m,[list|?UQ(ms)]])]]} + [[ms,'$ENV'],?BQ([':',lfe_shell,m,[list|?C(ms)]])]]} ], %% Any errors here will crash shell startup! Env1 = lfe_env:add_mbindings(Ms, Env0), @@ -286,7 +316,7 @@ {Value,St1} = eval_form(Form, St0#state{curr=Ce1}), %% Print the result, but only to depth 30. VS = lfe_io:prettyprint1(Value, 30), - io:requests([{put_chars,VS},nl]), + io:requests([{put_chars,unicode,VS},nl]), %% Update bindings. Ce2 = update_shell_vars(Form, Value, St1#state.curr), St2 = St1#state{curr=Ce2}, @@ -331,6 +361,9 @@ {[],St}, Eforms); eval_form_1(['extend-module'|_], St) -> %Maybe from macro expansion {[],St}; +eval_form_1(['eval-when-compile'|_], St) -> %Maybe from macro expansion + %% We can happily ignore this. + {[],St}; eval_form_1([set|Rest], St0) -> {Value,St1} = set(Rest, St0), {Value,St1}; @@ -378,39 +411,35 @@ Epat = lfe_macro:expand_expr_all(Pat, Ce), %Expand macros in pattern %% Special case to lint pattern. case lfe_lint:pattern(Epat, Ce) of - {ok,Ws} -> list_warnings(Ws); + {ok,_,Ws} -> list_warnings(Ws); {error,Es,Ws} -> list_errors(Es), list_warnings(Ws) end, - set_1([Epat|Rest], St). + set_1(Epat, Rest, St). -set_1([Pat,['when'|_]=G,Exp], #state{curr=Ce0}=St) -> +set_1(Pat, [['when'|_]=G,Exp], St) -> + set_1(Pat, [G], Exp, St); %Just the guard +set_1(Pat, [Exp], St) -> + set_1(Pat, [], Exp, St); %Empty body +set_1(_, _, _) -> erlang:error({bad_form,'set'}). + +set_1(Pat, Guard, Exp, #state{curr=Ce0}=St) -> Val = lfe_eval:expr(Exp, Ce0), %Evaluate expression - case lfe_eval:match_when(Pat, Val, [G], Ce0) of + case lfe_eval:match_when(Pat, Val, Guard, Ce0) of {yes,_,Bs} -> Ce1 = foldl(fun ({N,V}, E) -> add_vbinding(N, V, E) end, Ce0, Bs), {Val,St#state{curr=Ce1}}; no -> erlang:error({badmatch,Val}) - end; -set_1([Pat,Exp], #state{curr=Ce0}=St) -> - Val = lfe_eval:expr(Exp, Ce0), %Evaluate expression - case lfe_eval:match(Pat, Val, Ce0) of - {yes,Bs} -> - Ce1 = foldl(fun ({N,V}, E) -> add_vbinding(N, V, E) end, - Ce0, Bs), - {Val,St#state{curr=Ce1}}; - no -> erlang:error({badmatch,Val}) - end; -set_1(_, _) -> erlang:error({bad_form,'set'}). + end. %% unslurp(State) -> {ok,State}. %% slurp(File, State) -> {{ok,Mod},State}. -%% Load in a file making all functions available. The module is -%% loaded in an empty environment and that environment is finally -%% added to the standard current environment. We could not use the -%% compiler here as we need the macro environment. +%% Load in a file making all functions available. We call the +%% compiler directly and only add defined functions, macros are +%% lost. Any exported macros will be available in the +%% LFE-EXPAND-EXPORTED-MACRO/3 function. -record(slurp, {mod,imps=[]}). %For slurping @@ -426,48 +455,47 @@ slurp([File], St0) -> {ok,#state{curr=Ce0}=St1} = unslurp(St0), %Reset the environment Name = lfe_eval:expr(File, Ce0), %Get file name - case slurp_1(Name, Ce0) of + case slurp_file(Name, Ce0) of {ok,Mod,Ce1} -> %Set the new environment {{ok,Mod},St1#state{save=Ce0,curr=Ce1,slurp=true}}; error -> {error,St1} end.
View file
lfe-0.9.2.tar.gz/src/lfe_trans.erl -> lfe-1.0.tar.gz/src/lfe_trans.erl
Changed
@@ -27,14 +27,14 @@ -module(lfe_trans). -export([from_expr/1,from_expr/2,from_body/1,from_body/2,from_lit/1, - to_expr/2,to_lit/2]). + to_expr/2,to_lit/2]). -import(lists, [map/2,foldl/3,mapfoldl/3,foldr/3,splitwith/2]). -define(Q(E), [quote,E]). %We do a lot of quoting -record(from, {vc=0 %Variable counter - }). + }). %% from_expr(AST) -> Sexpr. %% from_expr(AST, Variables) -> {Sexpr,Variables}. @@ -52,7 +52,7 @@ S. from_expr(E, Vs0) -> - Vt0 = ordsets:from_list(Vs0), %We are clean + Vt0 = ordsets:from_list(Vs0), %We are clean {S,Vt1,_} = from_expr(E, Vt0, #from{}), {S,ordsets:to_list(Vt1)}. @@ -61,18 +61,18 @@ [progn|Les]. from_body(Es, Vs0) -> - Vt0 = ordsets:from_list(Vs0), %We are clean + Vt0 = ordsets:from_list(Vs0), %We are clean {Les,Vt1,_} = from_body(Es, Vt0, #from{}), {[progn|Les],ordsets:to_list(Vt1)}. %% from_expr(AST, VarTable, State) -> {Sexpr,VarTable,State}. -from_expr({var,_,V}, Vt, St) -> {V,Vt,St}; %Unquoted atom +from_expr({var,_,V}, Vt, St) -> {V,Vt,St}; %Unquoted atom from_expr({nil,_}, Vt, St) -> {[],Vt,St}; from_expr({integer,_,I}, Vt, St) -> {I,Vt,St}; from_expr({float,_,F}, Vt, St) -> {F,Vt,St}; -from_expr({atom,_,A}, Vt, St) -> {?Q(A),Vt,St}; %Quoted atom -from_expr({string,_,S}, Vt, St) -> {?Q(S),Vt,St}; %Quoted string +from_expr({atom,_,A}, Vt, St) -> {?Q(A),Vt,St}; %Quoted atom +from_expr({string,_,S}, Vt, St) -> {?Q(S),Vt,St}; %Quoted string from_expr({cons,_,H,T}, Vt0, St0) -> {Car,Vt1,St1} = from_expr(H, Vt0, St0), {Cdr,Vt2,St2} = from_expr(T, Vt1, St1), @@ -120,11 +120,11 @@ {Lqs,Vt1,St1} = from_lc_quals(Qs, Vt0, St0), {Le,Vt2,St2} = from_expr(E, Vt1, St1), {[lc,Lqs,Le],Vt2,St2}; -from_expr({record,_,R,Fs}, Vt0, St0) -> %Create a record +from_expr({record,_,R,Fs}, Vt0, St0) -> %Create a record MR = list_to_atom("make-" ++ atom_to_list(R)), {Lfs,Vt1,St1} = from_rec_fields(Fs, Vt0, St0), {[MR|Lfs],Vt1,St1}; -from_expr({record,_,E,R,Fs}, Vt0, St0) -> %Set fields in record +from_expr({record,_,E,R,Fs}, Vt0, St0) -> %Set fields in record SR = list_to_atom("set-" ++ atom_to_list(R)), {Le,Vt1,St1} = from_expr(E, Vt0, St0), {Lfs,Vt2,St2} = from_rec_fields(Fs, Vt1, St1), @@ -133,18 +133,18 @@ RF = list_to_atom(atom_to_list(R) ++ "-" ++ atom_to_list(F)), {Le,Vt1,St1} = from_expr(E, Vt0, St0), {[RF,Le],Vt1,St1}; -from_expr({record_field,_,_,_}=M, Vt, St) -> %Pre R16 packages +from_expr({record_field,_,_,_}=M, Vt, St) -> %Pre R16 packages from_package_module(M, Vt, St); %% Function calls. -from_expr({call,_,{remote,_,M,F},As}, Vt0, St0) -> %Remote function call +from_expr({call,_,{remote,_,M,F},As}, Vt0, St0) -> %Remote function call {Lm,Vt1,St1} = from_expr(M, Vt0, St0), {Lf,Vt2,St2} = from_expr(F, Vt1, St1), {Las,Vt3,St3} = from_expr_list(As, Vt2, St2), {[call,Lm,Lf|Las],Vt3,St3}; -from_expr({call,_,{atom,_,F},As}, Vt0, St0) -> %Local function call +from_expr({call,_,{atom,_,F},As}, Vt0, St0) -> %Local function call {Las,Vt1,St1} = from_expr_list(As, Vt0, St0), {[F|Las],Vt1,St1}; -from_expr({call,_,F,As}, Vt0, St0) -> %F not an atom or remote +from_expr({call,_,F,As}, Vt0, St0) -> %F not an atom or remote {Lf,Vt1,St1} = from_expr(F, Vt0, St0), {Las,Vt2,St2} = from_expr_list(As, Vt1, St1), {[funcall,Lf|Las],Vt2,St2}; @@ -368,11 +368,11 @@ from_pat({bin,_,Segs}, Vt0, St0) -> {Ss,Eqt,Vt1,St1} = from_pat_bitsegs(Segs, Vt0, St0), {[binary|Ss],Eqt,Vt1,St1}; -from_pat({record,_,R,Fs}, Vt0, St0) -> %Match a record +from_pat({record,_,R,Fs}, Vt0, St0) -> %Match a record MR = list_to_atom("match-" ++ atom_to_list(R)), - {Sfs,Eqt,Vt1,St1} = from_rec_fields(Fs, Vt0, St0), + {Sfs,Eqt,Vt1,St1} = from_pat_rec_fields(Fs, Vt0, St0), {[MR|Sfs],Eqt,Vt1,St1}; -from_pat({match,_,P1,P2}, Vt0, St0) -> %Aliases +from_pat({match,_,P1,P2}, Vt0, St0) -> %Aliases {Lp1,Eqt1,Vt1,St1} = from_pat(P1, Vt0, St0), {Lp2,Eqt2,Vt2,St2} = from_pat(P2, Vt1, St1), {['=',Lp1,Lp2],Eqt1++Eqt2,Vt2,St2}; @@ -388,6 +388,20 @@ {[Lp|Lps],Eqt++Eqts,Vt2,St2}; from_pat_list([], Vt, St) -> {[],[],Vt,St}. +%% from_pat_rec_fields(Recfields, VarTable, State) -> +%% {Recfields,EqTable,VarTable,State}. + +from_pat_rec_fields([{record_field,_,{atom,_,F},P}|Fs], Vt0, St0) -> + {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), + {Lfs,Eqts,Vt2,St2} = from_pat_rec_fields(Fs, Vt1, St1), + {[F,Lp|Lfs],Eqt++Eqts,Vt2,St2}; +from_pat_rec_fields([{record_field,_,{var,_,F},P}|Fs], Vt0, St0) -> + %% Special case!! + {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), + {Lfs,Eqts,Vt2,St2} = from_pat_rec_fields(Fs, Vt1, St1), + {[F,Lp|Lfs],Eqt++Eqts,Vt2,St2}; +from_pat_rec_fields([], Vt, St) -> {[],[],Vt,St}. + %% from_pat_bitsegs(Segs, VarTable, State) -> {Segs,EqTable,VarTable,State}. from_pat_bitsegs([{bin_element,_,Seg,Size,Type}|Segs], Vt0, St0) -> @@ -457,7 +471,7 @@ {{cons,L,Ee,Tail},St1} end, foldr(Fun, {{nil,L},St}, Es); -to_expr(['list*'|Es], L, Vt, St) -> %Macro +to_expr(['list*'|Es], L, Vt, St) -> %Macro to_expr_list_s(fun to_expr/4, L, Vt, St, Es); to_expr([tuple|Es], L, Vt, St0) -> {Ees,St1} = to_expr_list(Es, L, Vt, St0), @@ -605,7 +619,7 @@ {Ep,Vt1,St2} = to_pat(P, L, Vt0, St1), {Eg,St3} = to_body(G, L, Vt1, St2), {{'case',L,Ee,[{clause,L,[Ep],Eg,[Ep]}]},Vt1,St3} - end, + end, mapfoldl2(Fun, Vt, St, Lbs). %% to_icrt_cls(Clauses, LineNumber, VarTable, State) -> {Clauses,State}.
View file
lfe-0.9.2.tar.gz/src/lfescript.erl -> lfe-1.0.tar.gz/src/lfescript.erl
Changed
@@ -42,24 +42,24 @@ start(Lopts) -> try - process_flag(trap_exit, false), - case init:get_plain_arguments() of - [File|Args] -> - parse_check_run(File, Args, Lopts); - [] -> - lfe_io:format("lfescript: Missing filename\n", []), - halt(?ERROR_STATUS) - end + process_flag(trap_exit, false), + case init:get_plain_arguments() of + [File|Args] -> + parse_check_run(File, Args, Lopts); + [] -> + lfe_io:format("lfescript: Missing filename\n", []), + halt(?ERROR_STATUS) + end catch - %% Catch program errors. - throw:Str -> - lfe_io:format("lfescript: ~s\n", [Str]), - halt(?ERROR_STATUS); - _:Reason -> - Stack = erlang:get_stacktrace(), %Need to get this first - lfe_io:format("lfescript: Internal error: ~p\n", [Reason]), - lfe_io:format("~p\n", [Stack]), - halt(?ERROR_STATUS) + %% Catch program errors. + throw:Str -> + lfe_io:format("lfescript: ~s\n", [Str]), + halt(?ERROR_STATUS); + _:Reason -> + Stack = erlang:get_stacktrace(), %Need to get this first + lfe_io:format("lfescript: Internal error: ~p\n", [Reason]), + lfe_io:format("~p\n", [Stack]), + halt(?ERROR_STATUS) end. %% parse_check_run(FileName, Args, Options) -> no_return(). @@ -102,34 +102,34 @@ parse_file(File, _, _) -> case parse_file(File) of - {ok,Fs} -> Fs; - {error,Error} -> - error_exit(File, [Error], []) + {ok,Fs} -> Fs; + {error,Error} -> + error_exit(File, [Error], []) end. parse_file(File) -> case file:open(File, [read]) of - {ok,F} -> - io:get_line(F, ''), %Skip first line - case io:request(F, {get_until,'',lfe_scan,tokens,[2]}) of - {ok,Ts,_} -> - Ret = parse_file1(Ts, [], []), - file:close(F), - Ret; - {error,Error,_} -> {error,Error} - end; - {error,Error} -> {error,{none,file,Error}} + {ok,F} -> + io:get_line(F, ''), %Skip first line + case io:request(F, {get_until,'',lfe_scan,tokens,[2]}) of + {ok,Ts,_} -> + Ret = parse_file1(Ts, [], []), + file:close(F), + Ret; + {error,Error,_} -> {error,Error} + end; + {error,Error} -> {error,{none,file,Error}} end. parse_file1([_|_]=Ts0, Pc0, Ss) -> case lfe_parse:sexpr(Pc0, Ts0) of - {ok,L,S,Ts1} -> parse_file1(Ts1, [], [{S,L}|Ss]); - {more,Pc1} -> - %% Need more tokens but there are none, so call again to - %% generate an error message. - {error,E,_} = lfe_parse:sexpr(Pc1, {eof,99999}), - {error,E}; - {error,E,_} -> {error,E} + {ok,L,S,Ts1} -> parse_file1(Ts1, [], [{S,L}|Ss]); + {more,Pc1} -> + %% Need more tokens but there are none, so call again to + %% generate an error message. + {error,E,_} = lfe_parse:sexpr(Pc1, {eof,99999}), + {error,E}; + {error,E,_} -> {error,E} end; parse_file1([], _, Ss) -> {ok,lists:reverse(Ss)}. @@ -137,10 +137,10 @@ expand_macros(Fs0, File, _, _) -> case lfe_macro:expand_forms(Fs0, lfe_env:new()) of - {ok,Fs1,Fenv,Ws} -> - list_warnings(File, Ws), - {Fs1,Fenv}; - {error,Es,Ws} -> error_exit(File, Es, Ws) + {ok,Fs1,Fenv,Ws} -> + list_warnings(File, Ws), + {Fs1,Fenv}; + {error,Es,Ws} -> error_exit(File, Es, Ws) end. %% check_code(Forms, File, Args, Lopts) -> ok. @@ -150,7 +150,7 @@ check_code(Fs, File, _, _) -> Module = [{['define-module',dummy,[export,[main,1]]],1}|Fs], case lfe_lint:module(Module) of - {ok,Ws} -> + {ok,dummy,Ws} -> list_warnings(File, Ws); {error,Es,Ws} -> error_exit(File, Es, Ws) end. @@ -172,14 +172,14 @@ eval_code(Fenv, _, Args, _) -> try - lfe_eval:expr([main,[quote,Args]], Fenv) + lfe_eval:expr([main,[quote,Args]], Fenv) catch - %% Catch all exceptions in the code. - Class:Error -> - St = erlang:get_stacktrace(), %Need to get this first - Sf = fun (_) -> false end, - Ff = fun (T, I) -> lfe_io:prettyprint1(T, 15, I, 80) end, - Cs = lfe_lib:format_exception(Class, Error, St, Sf, Ff, 1), - io:put_chars(Cs), - halt(?ERROR_STATUS) + %% Catch all exceptions in the code. + Class:Error -> + St = erlang:get_stacktrace(), %Need to get this first + Sf = fun (_) -> false end, + Ff = fun (T, I) -> lfe_io:prettyprint1(T, 15, I, 80) end, + Cs = lfe_lib:format_exception(Class, Error, St, Sf, Ff, 1), + io:put_chars(Cs), + halt(?ERROR_STATUS) end.
View file
lfe-0.9.2.tar.gz/test/eval_SUITE.lfe -> lfe-1.0.tar.gz/test/eval_SUITE.lfe
Changed
@@ -68,32 +68,34 @@ (line (test-pat f14-64 (eval `(binary (,f14-64 binary))))) (line (test-pat f14-64 (eval `(binary (,f14-64 binary (size all)))))) (line (test-pat (tuple 17 47) - (eval `(let (((binary (b1 bits (size 17)) (b2 bits)) ,f14-64)) - (tuple (bit_size b1) (bit_size b2)))))) + (eval `(let (((binary (b1 bits (size 17)) (b2 bits)) + ,f14-64)) + (tuple (bit_size b1) (bit_size b2)))))) ) ;; Matching out values to use as size. (line (test-pat (tuple 2 #b("AB") #b("CD")) - (eval `(let (((binary s (b binary (size s)) (rest binary)) - #b(2 "AB" "CD"))) - (tuple s b rest))))) + (eval `(let (((binary s (b binary (size s)) (rest binary)) + #b(2 "AB" "CD"))) + (tuple s b rest))))) (line (test-pat (tuple 2 #b("AB") #b("CD")) - (eval '(flet ((a ([(binary s - (b binary (size s)) - (rest binary))] - (tuple s b rest)))) - (a #b(2 "AB" "CD")))))) - + (eval '(flet ((a ([(binary s + (b binary (size s)) + (rest binary))] + (tuple s b rest)))) + (a #b(2 "AB" "CD")))))) 'ok)) (defun binding_1 (['suite] ()) (['doc] '"Test function bindings.") ([config] (when (is_list config)) - (let (((1 2) - (funcall (: lfe_eval expr - '(lambda () (foo 1 2)) - ;; We evaluate the above lambda form in a new environment that - ;; contains a binding for the function foo/2. - (: lfe_eval add_expr_func 'foo 2 (lambda (a b) (list a b)) - (: lfe_lib new_env)))))) - 'ok))) + (let (((1 2) + (funcall (: lfe_eval expr + '(lambda () (foo 1 2)) + ;; We evaluate the above lambda form in a new + ;; environment that contains a binding for the + ;; function foo/2. + (: lfe_eval add_lexical_func + 'foo 2 (lambda (a b) (list a b)) + (: lfe_env new)))))) + 'ok)))
View file
lfe-0.9.2.tar.gz/test/test_server.lfe -> lfe-1.0.tar.gz/test/test_server.lfe
Changed
@@ -16,7 +16,7 @@ (defmacro eif (args (fletrec ((r ([(t v . as)] `((_ (when ,t) ,v) . ,(r as))) - ([()] ()))) + ([()] ()))) `(case 1 . ,(r args))))) (defmacro test-pat (pat expr)
View file
lfe-0.9.2.tar.gz/test/visual/test_bin.lfe -> lfe-1.0.tar.gz/test/visual/test_bin.lfe
Changed
@@ -3,13 +3,13 @@ ;;; Purpose : Test binaries. (defmodule test_bin - (export (a 0) (a 1) (af 2) (afp 2) (a 3) ;Constructors - (p1 1) (p2 1) (p2p 1) (p3 1) (p4 0)) ;Patterns - (export (b 1) (b 2) (bb1 2) (bb2 2)) ;Binaries/bitstrings - (export (u 1) (u 2)) ;Unicode types - (export (vs1 2) (vs2 2) (vs3 2)) ;Value and size expressions - (export (d1 0) (d2 0) (d3 0)) ;Binary constants - (export (sl1 0) (sl1 1) (sl2 0) (sl2 1)) ;String literals + (export (a 0) (a 1) (af 2) (afp 2) (a 3) ;Constructors + (p1 1) (p2 1) (p2p 1) (p3 1) (p4 0)) ;Patterns + (export (b 1) (b 2) (bb1 2) (bb2 2)) ;Binaries/bitstrings + (export (u 1) (u 2)) ;Unicode types + (export (vs1 2) (vs2 2) (vs3 2)) ;Value and size expressions + (export (d1 0) (d2 0) (d3 0)) ;Binary constants + (export (sl1 0) (sl1 1) (sl2 0) (sl2 1)) ;String literals ) ;; Binary constructors. @@ -21,7 +21,7 @@ (defun af (x y) (binary (x float (size 32)) (y float (size 64)))) -(defun afp (x y) ;This will cause an error! +(defun afp (x y) ;This will cause an error! (binary (x float (size 32)) (y float (size 40)))) (defun a (x y z) @@ -33,12 +33,12 @@ (case b ((binary (x (size 24)) (zz binary)) (list x zz)))) -(define (p2 b) ;Old style +(define (p2 b) ;Old style (case b ((binary (x float (size 32)) (y float (size 64)) (zz bitstring)) (list x y zz)))) -(defun p2p (b) ;This will cause an error! +(defun p2p (b) ;This will cause an error! (case b ((binary (x float (size 32)) (y float (size 40)) (zz bitstring)) (list x y zz)))) @@ -46,7 +46,7 @@ (defun p3 (b) (case b ((binary (x unsigned) (y (size 16) big-endian) (z (size 3) little-endian) - (zz bitstring)) + (zz bitstring)) (list x y z zz)))) (defun p4 () @@ -64,7 +64,7 @@ (defun b (bin) (binary (bin binary) (bin (size 16) bitstring) (bin binary))) -(define (b b1 b2) ;Old style +(define (b b1 b2) ;Old style (binary (b1 bitstring) (b2 (size 3) bitstring signed) (b2 bitstring))) (defun bb1 (b n) @@ -75,7 +75,7 @@ (defun bb2 (b n) (case b ((binary (b1 bitstring (size n)) (b2 (size 3) bitstring signed) - (b3 bitstring)) + (b3 bitstring)) (list b1 b2 b3)))) ;; Unicode types. @@ -85,24 +85,24 @@ (defun u (x y) (binary (x utf-8 big-endian) (y utf-32 little-endian) - (x utf-16 signed little-endian))) + (x utf-16 signed little-endian))) ;; Value and size expressions (defun vs1 (x y) (tuple (let ((y1 (+ y 1))) - (binary (x (size y)) (y (size y1)))) - (binary (x (size y)) (y (size (+ y 1)))))) + (binary (x (size y)) (y (size y1)))) + (binary (x (size y)) (y (size (+ y 1)))))) (defun vs2 (x y) - (tuple (binary ((* 2 x) (size y))) ;Just value expr - (binary (x (size (+ y 8)))) ;Just size expr - (binary ((* 2 x) (size (+ y 8)))))) ;Both value and size expr + (tuple (binary ((* 2 x) (size y))) ;Just value expr + (binary (x (size (+ y 8)))) ;Just size expr + (binary ((* 2 x) (size (+ y 8)))))) ;Both value and size expr (defun vs3 (x y) - (binary ((* 2 x) (size y)) ;Just value expr - (x (size (+ y 8))) ;Just size expr - ((* 2 x) (size (+ y 8))))) ;Both value and size expr + (binary ((* 2 x) (size y)) ;Just value expr + (x (size (+ y 8))) ;Just size expr + ((* 2 x) (size (+ y 8))))) ;Both value and size expr ;; Binary constants
View file
lfe-0.9.2.tar.gz/test/visual/test_bin_e.erl -> lfe-1.0.tar.gz/test/visual/test_bin_e.erl
Changed
@@ -4,13 +4,13 @@ -module(test_bin_e). --export([a/0,a/1,af/2,afp/2,a/3]). %Constructors --export([p1/1,p2/1,p2p/1,p3/1,p4/0]). %Patterns --export([b/1,b/2,bb1/2,bb2/2]). %Binaries/bitstrings --export([u/1,u/2]). %Unicode types --export([vs1/2,vs2/2,vs3/2]). %Value and size expressions --export([d1/0,d2/0,d3/0]). %Binary constants --export([sl1/0,sl1/1]). %String literals +-export([a/0,a/1,af/2,afp/2,a/3]). %Constructors +-export([p1/1,p2/1,p2p/1,p3/1,p4/0]). %Patterns +-export([b/1,b/2,bb1/2,bb2/2]). %Binaries/bitstrings +-export([u/1,u/2]). %Unicode types +-export([vs1/2,vs2/2,vs3/2]). %Value and size expressions +-export([d1/0,d2/0,d3/0]). %Binary constants +-export([sl1/0,sl1/1]). %String literals %% Binary constructors. @@ -20,7 +20,7 @@ af(X, Y) -> <<X:32/float,Y:64/float>>. -afp(X, Y) -> <<X:32/float,Y:40/float>>. %This will cause an error! +afp(X, Y) -> <<X:32/float,Y:40/float>>. %This will cause an error! a(X, Y, Z) -> <<X/unsigned,Y:16/big,Z:3/little>>. @@ -28,23 +28,23 @@ p1(B) -> case B of - <<X:24,ZZ/binary>> -> [X,ZZ] + <<X:24,ZZ/binary>> -> [X,ZZ] end. p2(B) -> case B of - <<X:32/float,Y:64/float,ZZ/bitstring>> -> [X,Y,ZZ] + <<X:32/float,Y:64/float,ZZ/bitstring>> -> [X,Y,ZZ] end. p2p(B) -> - case B of %This will cause an error! - <<X:32/float,Y:40/float,ZZ/bitstring>> -> [X,Y,ZZ] + case B of %This will cause an error! + <<X:32/float,Y:40/float,ZZ/bitstring>> -> [X,Y,ZZ] end. p3(B) -> case B of - <<X/unsigned,Y:16/big,Z:3/little,ZZ/bitstring>> -> - [X,Y,Z,ZZ] + <<X/unsigned,Y:16/big,Z:3/little,ZZ/bitstring>> -> + [X,Y,Z,ZZ] end. p4() -> @@ -73,8 +73,8 @@ bb2(B, N) -> case B of - <<B1:N/bitstring,B2:3/bitstring-signed,B3/bitstring>> -> - [B1,B2,B3] + <<B1:N/bitstring,B2:3/bitstring-signed,B3/bitstring>> -> + [B1,B2,B3] end. %% Unicode types. @@ -92,15 +92,15 @@ {<<X:Y,Y:Y1>>,<<X:Y,Y:(Y+1)>>}. vs2(X, Y) -> - {<<(2*X):Y>>, %Just value expr - <<X:(Y+8)>>, %Just size expr - <<(2*X):(Y+8)>> %Both value and size expr + {<<(2*X):Y>>, %Just value expr + <<X:(Y+8)>>, %Just size expr + <<(2*X):(Y+8)>> %Both value and size expr }. vs3(X, Y) -> - <<(2*X):Y, %Just value expr - X:(Y+8), %Just size expr - (2*X):(Y+8)>>. %Both value and size expr + <<(2*X):Y, %Just value expr + X:(Y+8), %Just size expr + (2*X):(Y+8)>>. %Both value and size expr %% Binary constants
View file
lfe-0.9.2.tar.gz/test/visual/test_flet.lfe -> lfe-1.0.tar.gz/test/visual/test_flet.lfe
Changed
@@ -6,20 +6,20 @@ (export (a 2) (b-1 1) (b-2 1) (c 1) (d 1) (e 1) (f 1) (f 2) (g 2) (h 1)) ;; (export (t2 2)) (import (from lists (reverse 1) (reverse 2)) - (from ordsets (is_element 2)) - (rename ordsets ((is_element 2) in)))) + (from ordsets (is_element 2)) + (rename ordsets ((is_element 2) in)))) ;; Test multiply defined functions. ;; (defun t1 (x y) ;; (flet ((o (a) (+ x a)) -;; (o (a b) (+ (+ a b) x)) -;; (o (c) (* 100 (* c y)))) +;; (o (a b) (+ (+ a b) x)) +;; (o (c) (* 100 (* c y)))) ;; (list (o x) (o y) (o x y)))) ;; (defun t2 (x y) ;; (fletrec ((o (a) (+ x a)) -;; (o (a b) (+ (+ a b) x)) -;; (o (c) (* 100 (* c y)))) +;; (o (a b) (+ (+ a b) x)) +;; (o (c) (* 100 (* c y)))) ;; (list (o x) (o y) (o x y)))) (defun a (x y) @@ -29,14 +29,14 @@ ;; Which (o 1) do we get in the "recursive" call? (defun b-1 (n) (flet ((o (n) - (if (=< n 1) 1 - (* n (o (- n 1)))))) + (if (=< n 1) 1 + (* n (o (- n 1)))))) (o n))) (defun b-2 (n) (fletrec ((o (n) - (if (=< n 1) 1 - (* n (o (- n 1)))))) + (if (=< n 1) 1 + (* n (o (- n 1)))))) (o n))) (defun o (n) (- 0 n)) @@ -44,11 +44,11 @@ ;; Mutually recursive functions in fletrec. (defun c (n) (fletrec ((o1 (n) - (if (=< n 1) 1 - (* n (o2 (- n 1))))) - (o2 (n) - (if (=< n 1) 1 - (* n (o1 (- n 1)))))) + (if (=< n 1) 1 + (* n (o2 (- n 1))))) + (o2 (n) + (if (=< n 1) 1 + (* n (o1 (- n 1)))))) (o1 n))) ;; Check we get the RIGHT binding for o in fletrec. @@ -56,25 +56,25 @@ (let ((o n)) (list o (fletrec ((o (n) - (if (=< n 1) 1 - (* n (o (- n 1)))))) + (if (=< n 1) 1 + (* n (o (- n 1)))))) (o n))))) ;; These are different f's, f/1 and f/2! (defun e (n) - (fletrec ((f ((x) (+ x n))) ;Generate match-lambda here - (f (x y) (+ x (+ y n)))) + (fletrec ((f ((x) (+ x n))) ;Generate match-lambda here + (f (x y) (+ x (+ y n)))) (list (f n) (f n 10)))) (defun f (n) - (flet ((f ((x) (+ x n))) ;Generate match-lambda here - (f (x y) (+ x (+ y n)))) + (flet ((f ((x) (+ x n))) ;Generate match-lambda here + (f (x y) (+ x (+ y n)))) (list (f n) (f n 10)))) (defun g (x y) (flet* ((f (a) (list a y)) - (f ((a) (list a (f a)))) - (f (a) (list a (f a)))) + (f ((a) (list a (f a)))) + (f (a) (list a (f a)))) (f x))) (defun f
View file
lfe-0.9.2.tar.gz/test/visual/test_guard.lfe -> lfe-1.0.tar.gz/test/visual/test_guard.lfe
Changed
@@ -1,14 +1,14 @@ (defmodule test_guard - (export (b 1) (c 2) (e 2) (f 2) (if-test 2))) + (export all)) (defun b (x) x) -(define (b) '"a string") ;Old style +(define (b) '"a string") ;Old style (defun c (x y) (case (b x) ((tuple 'ok z) (when (> z 5)) (d '|(> z 5)| z)) - ((tuple 'ok z) (when z) (d 'z z)) + ;;((tuple 'ok z) (when z) (d 'z z)) ((tuple 'ok z) (when (+ z z)) (d '|(+ z z)| z)) ((tuple 'ok z) (when (== z 'true)) (d '|(== z true)| z)) ((tuple 'ok z) (when (and z 'true)) (d '|(and z true)| z)) @@ -26,8 +26,8 @@ (case (b x) (#(ok z) (d '|#(ok z)| 'z)) ((tuple 'ok z) (when (andalso (> (+ z 1) 5) - (orelse x (> (+ z 1) 3)) - (/= z 7))) + (orelse x (> (+ z 1) 3)) + (/= z 7))) (d 'andalso z)))) (defun f (x y) @@ -37,5 +37,29 @@ (defun if-test ([x y] (when (if (> (+ x y) 10) 'true - 'false)) 1) + 'false)) 1) ([x y] 2)) + +(defun seq + ([x y z] (when (> x 0) (is_integer z)) 1) + ([x y z] (when (> x 0) (=:= (element y z) 10)) + 2) + ([x y z] (when (> x 0) (=:= (element y z) 10) (=:= (element (+ y 1) z) 10)) + 3) + ([x y z] (when (and (> x 0) + (and (=:= (element y z) 10) + (=:= (element (+ y 1) z) 10)))) + 4) + ([x y z] 999)) + +(defun lit + ([x y z] (when 'true) 1) + ([x y z] (when 'false) 2) + ([x y z] (when 'x 'y) 3) + ([x y z] (when (and x y)) 4) + ([x y z] (when '67 'z) 5) + ([x y z] (when (and '67 'z)) 6) + ([x y z] (when 'x '89 'z) 7) + ([x y z] (when x 89 #(z)) 8) + ([x y z] (when (and x (and 89 z))) 9) + ([x y z] 999))
View file
lfe-1.0.tar.gz/test/visual/test_guard_e.erl
Added
@@ -0,0 +1,23 @@ +-module(test_guard_e). + +-compile([export_all]). + +seq(X, Y, Z) when X > 0, is_integer(Z) -> 1; +seq(X, Y, Z) when X > 0, element(Y, Z) =:= 10 -> + 2; +seq(X, Y, Z) when X > 0, element(Y, Z) =:= 10, element(Y+1, Z) =:= 10 -> + 3; +seq(X, Y, Z) when (X > 0) and ((element(Y, Z) =:= 10) and (element(Y+1, Z) =:= 10)) -> + 4; +seq(X, Y, Z) -> 999. + +lit(X, Y, Z) when true -> 1; +lit(X, Y, Z) when false -> 2; +lit(X, Y, Z) when 'X', 'Y' -> 3; +lit(X, Y, Z) when (X and Y) -> 4; +lit(X, Y, Z) when 67, 'Z' -> 5; +lit(X, Y, Z) when 67 and 'Z' -> 6; +lit(X, Y, Z) when 'X', 89, 'Z' -> 7; +lit(X, Y, Z) when X, 89, {'Z'} -> 8; +lit(X, Y, Z) when X and (89 and Z) -> 9; +lit(X, Y, Z) -> 999.
View file
lfe-0.9.2.tar.gz/test/visual/test_hash_quote.lfe -> lfe-1.0.tar.gz/test/visual/test_hash_quote.lfe
Changed
@@ -1,16 +1,16 @@ (defmodule test_hash_quote - (export (run_all 0)) + (export (run-all 0)) (export (a 0) (b 0) (c 0) (d 0) (e 0) (f 0) (g 0) (h 0) (i 0) (j 0) (k 0)) - (export (foo:bar42 1) (foo/baz42 1))) + (export (foo/bar42 1) (foo/baz42 1))) -(defun run_all () +(defun run-all () (: lists map (lambda (f) (: io format '"~p~n" (list (funcall f)))) (list (fun a 0) (fun b 0) (fun c 0) (fun d 0) (fun e 0) (fun f 0) (fun g 0) - (fun h 0) (fun i 0) (fun j 0) (fun k 0)))) + #'h/0 #'i/0 #'j/0 #'k/0))) (defun a () - (let (((1 2 3) (: lists sort #'</2 '(2 1 3)))) + (let (((list 1 2 3) (: lists sort #'</2 '(2 1 3)))) 'ok)) (defun b () @@ -18,15 +18,15 @@ 'ok)) (defun c () - (let (((-1 2) (: lists map #'-/1 '(1 -2)))) + (let (((list -1 2) (: lists map #'-/1 '(1 -2)))) 'ok)) (defun d () - (let (((1 2) (: lists map #'abs/1 '(-1 2)))) + (let (((list 1 2) (: lists map #'abs/1 '(-1 2)))) 'ok)) (defun e () - (let ((("foobar") (: lists map #'string:to_lower/1 '("fooBar")))) + (let (((list "foobar") (: lists map #'string:to_lower/1 '("fooBar")))) 'ok)) (defun f () @@ -35,28 +35,30 @@ 'ok)) (defun g () - (let (((42 42) (: lists map #'test_hash_quote:foo:bar42/1 '(1 2)))) + (let (((list 42 42) (: lists map #'test_hash_quote:foo/bar42/1 '(1 2)))) 'ok)) (defun h () - (let (((42 42) (: lists map #'foo/baz42/1 '(1 2)))) + (let (((list 42 42) (: lists map #'foo/baz42/1 '(1 2)))) 'ok)) (defun i () - (let (((42 42) (: lists map #'test_hash_quote:foo/baz42/1 '(1 2)))) + (let (((list 42 42) (: lists map #'test_hash_quote:foo/baz42/1 '(1 2)))) 'ok)) (defun j () - (let ((('false 'true 'false) (: lists zipwith #'=:=/2 '(1 2 3) '(3 2 1)))) + (let (((list 'false 'true 'false) + (: lists zipwith #'=:=/2 '(1 2 3) '(3 2 1)))) 'ok)) (defun k () - (let ((('true 'false 'true) (: lists zipwith #'=/=/2 '(1 2 3) '(3 2 1)))) + (let (((list 'true 'false 'true) + (: lists zipwith #'=/=/2 '(1 2 3) '(3 2 1)))) 'ok)) ;;;; -(defun foo:bar42 (_) +(defun foo/bar42 (_) 42) (defun foo/baz42 (_)
View file
lfe-0.9.2.tar.gz/test/visual/test_lc.lfe -> lfe-1.0.tar.gz/test/visual/test_lc.lfe
Changed
@@ -8,18 +8,18 @@ (defun b (x y) (lc ((<- v x) - (?= (y . z) v)) ;Match bind variables + (?= (cons y z) v)) ;Match bind variables (list v y z))) (defun c (x y) - (lc ((<= (b float) y) ;Only bitseg needed, no wrapping + (lc ((<= (b float) y) ;Only bitseg needed, no wrapping (<- (tuple v) x)) (tuple b v))) (defun d (x y) - (bc ((<= b y) ;Only bitseg needed, no wrapping + (bc ((<= b y) ;Only bitseg needed, no wrapping (<- (tuple v) x)) - ((* b v) (size 16)))) ;Only bitseg needed, no wrapping + ((* b v) (size 16)))) ;Only bitseg needed, no wrapping ;; (defun d (x y) ;; (bc ((<= (b float) y)
View file
lfe-0.9.2.tar.gz/test/visual/test_lc_e.erl -> lfe-1.0.tar.gz/test/visual/test_lc_e.erl
Changed
@@ -4,7 +4,7 @@ a(X, Y) -> [ V || V <- X, - V /= Y ]. + V /= Y ]. c(X, Y) -> [ {B,V} || <<B/float>> <= Y, {V} <- X ].
View file
lfe-0.9.2.tar.gz/test/visual/test_let.lfe -> lfe-1.0.tar.gz/test/visual/test_let.lfe
Changed
@@ -3,28 +3,33 @@ ;; Purpose : Test cases for let, let* and funcall. (defmodule test_let - (export (a 1) (b 2) (c 2) (d 2) (e 2) (f 2) (g 2)) + (export (flip 2) (a 1) (b 2) (c 2) (d 2) (e 2) (f 2) (g 2)) (import (from lists (reverse 1) (reverse 2)) - (from ordsets (is_element 2)) - (rename ordsets ((is_element 2) in)))) + (from ordsets (is_element 2)) + (rename ordsets ((is_element 2) in)))) + +(defun flip (x y) + (let ((x y) + (y x)) + (list x y))) (defun a (x) (let* ((a (list x)) - (a (cons x a)) - (a (cons x a))) + (a (cons x a)) + (a (cons x a))) a)) (defun b (x y) (let ((m (+ x y)) - (n (xxx)) - (o (yyy x y))) + (n (xxx)) + (o (yyy x y))) (list m n o))) ;; Test multiply defined variables. -;; (defun (t1 x y) +;; (defun t1 (x y) ;; (let ((m (list x y)) -;; (n (cons x z)) -;; ((n o) (list x y))) +;; (n (cons x z)) +;; ((list n o) (list x y))) ;; (list m n o))) (defun c (x y) @@ -42,15 +47,15 @@ (funcall (lambda (a b) (list a b)) (* x y) (+ x y)) (list x y))) -(defun f (x y) ;Arg mismatch, push error to runtime +(defun f (x y) ;Arg mismatch, push error to runtime (funcall (lambda (a b c) (list a b)) (* x y))) (defun g (x y) (funcall (match-lambda - (('a n) (tuple 'a n)) - (('b n) (tuple 'b n)) - ((m n) (when (> m n)) 'bigger)) - x (* y 2))) + (('a n) (tuple 'a n)) + (('b n) (tuple 'b n)) + ((m n) (when (> m n)) 'bigger)) + x (* y 2))) (defun xxx () '"a string")
View file
lfe-0.9.2.tar.gz/test/visual/test_macro.lfe -> lfe-1.0.tar.gz/test/visual/test_macro.lfe
Changed
@@ -4,8 +4,8 @@ ) (defmacro let@ - (((vb . vbs) . b) `(let (,vb) (let@ ,vbs . ,b))) - ((() . b) `(begin . ,b))) + ((cons (cons vb vbs) b) `(let (,vb) (let@ ,vbs . ,b))) + ((cons () b) `(begin . ,b))) (defsyntax let& ([(vb . vbs) . b] [let (vb) (let& vbs . b)]) @@ -37,8 +37,8 @@ (defun ab (x y) (let@ ((o (e x)) - (p (e-1 y))) - (tuple o p))) + (p (e-1 y))) + (tuple o p))) (defun ac (x y) (and-also (e x) (e-1 y) (aa x y)) @@ -50,17 +50,17 @@ (defun ae (x y) (c-ond ((p-1 x) (e-1 y) (list x y)) - ((?= (p . ps) (e-1 x)) ;Match (p . ps) or fail + ((?= (cons p ps) (e-1 x)) ;Match (p . ps) or fail (list p ps)) ((p-2 x) (e y) (tuple x y)) (else (e y)))) (defun af (x y) (cond ((p-1 x) (e-1 y) (list x y)) - ((?= (p . ps) (e-1 x)) ;Match (p . ps) or fail - (list p ps)) - ((p-2 x) (e y) (tuple x y)) - (else (e y)))) + ((?= (p . ps) (e-1 x)) ;Match (p . ps) or fail + (list p ps)) + ((p-2 x) (e y) (tuple x y)) + (else (e y)))) (defun e (x) (list 'e x)) @@ -85,7 +85,7 @@ (fletrec ((e (a) (aa a a))) (e x)))) -(define-syntax tmac ;Old style still valid +(define-syntax tmac ;Old style still valid (macro ((e) `(tuple 'ok ,e)) ((e . es) `(tuple 'ok (tuple ,e . ,es))))) @@ -93,7 +93,7 @@ (defun t1 (x y) (list (tmac x) (tmac x 1 y 2))) -(define-syntax d-o ;Old style still valid +(define-syntax d-o ;Old style still valid (syntax-rules ([((v i c) ...) (t r) b ...] (fletrec ((f (v ...)
View file
lfe-0.9.2.tar.gz/test/visual/test_map.lfe -> lfe-1.0.tar.gz/test/visual/test_map.lfe
Changed
@@ -6,9 +6,16 @@ (defun make (x y z) (tuple (map 'a x 'b y 'c (tuple 'ok (: test_map foo z))) - (map 'b y 'c (tuple 'ok (: test_map foo z)) 'a x) - (map #b(1 2 3) x) - (map #b((1 (size 16)) ("åäö" utf-8)) y))) + (map 'b y 'c (tuple 'ok (: test_map foo z)) 'a x) + (map #b(1 2 3) x) + (map #b((1 (size 16)) ("åäö" utf-8)) y))) + +(defun lit-make + ([1] (map)) + ([2] (map 'a 1)) + ([3] (map 'a 1 'b 2)) + ([4] (map 'a #(1 2))) + ([5] (map #(1 2) 'a))) ;; (defun get (map) ;; (map-get map 'a)) @@ -33,16 +40,26 @@ (defun update (map v1 v2) (mupd map 'a v1 'b (: test_map foo v2))) +(defun mixed (map v1 v2) + (mupd (mset map 'a v1 'c 3) 'b (: test_map foo v2))) + (defun guard ([map x] (when (== (map 'a x) map)) 1) ([map x] (when (== (mset map 'a 1) x)) 2) ([map x] (when (== (mupd map 'a 1) x)) 3)) (defun match - ([(map 'a x)] x) ([(map 'a 1 'b y)] y) + ([(map 'a x)] x) ([(map 'c (tuple x y))] (tuple x y)) ([(map #(d e) z)] z)) +(defun lit-match + ([(map 'a 1 'b 2)] 1) + ([(map 'a 1)] 2) + ([(map 'a #(1 2))] 3) + ([(map #(1 2) 'z)] 4) + ([(map)] 5)) ;Catch-all + (defun foo (x) (list x x))
View file
lfe-0.9.2.tar.gz/test/visual/test_map_e.erl -> lfe-1.0.tar.gz/test/visual/test_map_e.erl
Changed
@@ -2,29 +2,44 @@ -compile(export_all). +literal() -> + #{a => 1, b => [2,3,4], c => {a,b}}. + make(X,Y,Z) -> {#{a => X, b => Y, c => {ok,test_map_e:foo(Z)}}, #{b => Y, c => {ok,test_map_e:foo(Z)}, a => X}, #{<<1,2,3>> => X}, #{<<1:16,"åäö"/utf8>> => Y}}. +lit_make(1) -> #{}; +lit_make(2) -> #{a => 1}; +lit_make(3) -> #{a => 1, b => 2}; +lit_make(4) -> #{a => {1,2}}; +lit_make(5) -> #{{1,2} => a}. + set(Map, V1, V2) -> - M = Map#{a => V1, b => test_map_e:foo(V2)}. + Map#{a => V1, b => test_map_e:foo(V2)}. update(Map, V1, V2) -> - M = Map#{a := V1, b := test_map_e:foo(V2)}. + Map#{a := V1, b := test_map_e:foo(V2)}. mixed(Map, V1, V2) -> - M = Map#{a => V1, b := test_map_e:foo(V2), c => 3}. + Map#{a => V1, b := test_map_e:foo(V2), c => 3}. guard(Map, X) when #{a=>X} == Map -> 1; guard(Map, X) when Map#{a=>1} == X -> 2; guard(Map, X) when Map#{a:=1} == X -> 3. -match(#{a := X}) -> X; match(#{a := 1, b := Y}) -> Y; +match(#{a := X}) -> X; match(#{c := {X,Y}}) -> {X,Y}; match(#{{d,e} := Z}) -> Z. +lit_match(#{a := 1, b := 2}) -> 1; +lit_match(#{a := 1}) -> 2; +lit_match(#{a := {1,2}}) -> 3; +lit_match(#{{1,2} := z}) -> 4; +lit_match(#{}) -> 5. %Catch-all + foo(X) -> [X,X].
View file
lfe-0.9.2.tar.gz/test/visual/test_pat.lfe -> lfe-1.0.tar.gz/test/visual/test_pat.lfe
Changed
@@ -3,7 +3,7 @@ ;;; Purpose : Test patterns. (defmodule test_pat - (export (a 2) (b 2) (c 2) (d 2) (f 2) (g 2))) + (export (a 2) (b 2) (c 1) (c 2) (d 2) (f 2) (g 2))) (defsyntax make-foo (fs (tuple 'sune . fs))) @@ -35,6 +35,10 @@ (('a _) (tuple 2 'a 'anything)) ((_ _) (tuple 3 'anything))) +(defun c + (("1234") 'string) + ((_) 'other)) + ;; Macro expansion in patterns. (defun c (x y) (let ((foo (make-foo x y))) @@ -58,11 +62,11 @@ ((list 'a m) (tuple 1 'new 'a m)) ((m . n) (tuple 2 'old m n)) ((cons m n) (tuple 2 'new m n)) - ((m n . o) (tuple 3 'old m n o)) - ((cons m (cons n o)) ;(list* m n o) + ;((m n . o) (tuple 3 'old m n o)) + ((cons m (cons n o)) ;(list* m n o) (tuple 3 'new m n o)) ;; cons/list become "reserved words" like tuple/binary. - ((m cons n o) (tuple 4 'old m n o)) ;(cons m (cons n o)) + ((m cons n o) (tuple 4 'old m n o)) ;(cons m (cons n o)) ((m list n o) (tuple 5 'old m n o)) ;(cons m (list n o)) ))
View file
lfe-0.9.2.tar.gz/test/visual/test_pat_e.erl -> lfe-1.0.tar.gz/test/visual/test_pat_e.erl
Changed
@@ -1,35 +1,41 @@ -module(test_pat_e). --export([a/2,b/2,e/2,g/2]). +-export([a/2,b/2,c/1,e/2,g/2]). a(1,_) -> F = fun ([1,_]) -> 1; - ([a,4]) -> {1,a,4} - end, + ([a,4]) -> {1,a,4} + end, {1,F}; a(X, Y) -> case [X,Y] of - [a,4] -> {1,a,4}; - [a,_]=[P1|Ps] -> {2,a,P1,Ps}; - [_,_] -> {3,anything} + [a,4] -> {1,a,4}; + [a,_]=[P1|Ps] -> {2,a,P1,Ps}; + [_,_] -> {3,anything} end. b(a, 4) -> {1,a,4}; b(a, _) -> {2,a,anything}; b(_, _) -> {3,anything}. +c(X) -> + case X of + "1234" -> string; + _ -> other + end. + e(X, Y) -> case [X|Y] of - [a,M] -> {1,old,a,M}; - [M|N] -> {2,old,M,N}; - [M,N|O] -> {3,old,M,N,O}; - [M|[N|O]] -> {4,old,M,N,O}; - [M|[N,O]] -> {5,old,M,N,O} + [a,M] -> {1,old,a,M}; + [M|N] -> {2,old,M,N}; + [M,N|O] -> {3,old,M,N,O}; + [M|[N|O]] -> {4,old,M,N,O}; + [M|[N,O]] -> {5,old,M,N,O} end. g(X, Y) -> case [X|Y] of - [a,M]=[a,M] -> {1,'old/old',M}; - [M|N]=[N|M] -> {2,'old/old',M,N}; - [M1,N1|O1]=[M2,N2|O2] -> {3,'old/old',M1,N1,O1} + [a,M]=[a,M] -> {1,'old/old',M}; + [M|N]=[N|M] -> {2,'old/old',M,N}; + [M1,N1|O1]=[M2,N2|O2] -> {3,'old/old',M1,N1,O1} end.
View file
lfe-0.9.2.tar.gz/test/visual/test_slurp.lfe -> lfe-1.0.tar.gz/test/visual/test_slurp.lfe
Changed
@@ -1,8 +1,8 @@ (defmodule test_slurp (export ) (import (from lists (map 2)) - (rename ordsets ((add_element 2) os-add)))) -;; (rename lists ((map 2) foldl)))) + (rename ordsets ((add_element 2) os-add)))) +;; (rename lists ((map 2) foldl)))) (defun fac (n) (if (> n 0) @@ -10,11 +10,11 @@ 1)) (defun funny (x) - (list 'funny x -)) ;Value of - when function defined + (list 'funny x -)) ;Value of - when function defined (defun fac1 (n) (fletrec ((f (n) - (if (> n 0) - (* (f (- n 1)) n) - 1))) + (if (> n 0) + (* (f (- n 1)) n) + 1))) (f n)))
View file
lfe-0.9.2.tar.gz/test/visual/test_sr.lfe -> lfe-1.0.tar.gz/test/visual/test_sr.lfe
Changed
@@ -14,8 +14,8 @@ (defsyntax dodo ([((a b c) ...) (t v) e ...] [fletrec ((-sune- (a ...) - (if t v - (begin e ... (-sune- c ...))))) + (if t v + (begin e ... (-sune- c ...))))) (-sune- b ...)])) (defmacro aaa @@ -37,14 +37,14 @@ ;; This will not compile, but we are interested in expansion. (defun c (x) - (ccc #((m m1) (n n1) (o o1))) ;Should we take tuple literals? + (ccc #((m m1) (n n1) (o o1))) ;Should we take tuple literals? (ccc (tuple (m m1) (n n1) (o o1)))) (defun e-1 (m) (dodo ((i 1 (+ 1 i)) - (acc 1 (* acc i))) - ((> i m) acc) - '(i))) + (acc 1 (* acc i))) + ((> i m) acc) + '(i))) (defun e-2 (m) (do ((l m (cdr l))
View file
lfe-0.9.2.tar.gz/test/visual/test_try.lfe -> lfe-1.0.tar.gz/test/visual/test_try.lfe
Changed
@@ -5,7 +5,7 @@ (defmodule test_try (export (a 2) (b 1) (b 2) (c 2) (d 2) (e 2) (f 2) (g 2) (h 2)) (import (from lists (reverse 1) (reverse 2)) - (from ordsets (is_element 2)))) + (from ordsets (is_element 2)))) (defun a (x y) (catch (+ x y) (b y))) @@ -14,36 +14,36 @@ ;; Testing just catch. (defun b (x y) (try - (progn - (yyy x y) - (zzz y)) + (progn + (yyy x y) + (zzz y)) (catch - ;; Pattern MUST be tuple of 3 elements here! - ;; (tuple TYPE VALUE IGNORE-THIS) - ((tuple 'error n o) (tuple 'this-is-error n)) - ((tuple 'throw n o) (tuple 'this-is-throw n)) - ((tuple _ n o) (tuple 'this-is-default n))))) + ;; Pattern MUST be tuple of 3 elements here! + ;; (tuple TYPE VALUE IGNORE-THIS) + ((tuple 'error n o) (tuple 'this-is-error n)) + ((tuple 'throw n o) (tuple 'this-is-throw n)) + ((tuple _ n o) (tuple 'this-is-default n))))) ;; Testing using case and catch. (defun c (x y) (try (progn - (yyy x y) - (zzz y)) - (case - ('sune #(value sune)) - ('bert #(value bert))) - (catch - ;; Pattern MUST be tuple of 3 elements here! - ;; (tuple TYPE VALUE IGNORE-THIS) - ((tuple 'error n o) (tuple 'this-is-error n)) - ((tuple 'throw n o) (tuple 'this-is-throw n)) - ((tuple _ n o) (tuple 'this-is-default n))))) + (yyy x y) + (zzz y)) + (case + ('sune #(value sune)) + ('bert #(value bert))) + (catch + ;; Pattern MUST be tuple of 3 elements here! + ;; (tuple TYPE VALUE IGNORE-THIS) + ((tuple 'error n o) (tuple 'this-is-error n)) + ((tuple 'throw n o) (tuple 'this-is-throw n)) + ((tuple _ n o) (tuple 'this-is-default n))))) (defun d (x y) (try (progn - (yyy x y) - (zzz y)) - (after ))) + (yyy x y) + (zzz y)) + (after ))) ;; Testing just after. (defun e (x y) @@ -52,26 +52,26 @@ (yyy x y) (zzz y)) (after (yyy 'this-is-after (list x y)) - 'this-is-after))) + 'this-is-after))) ;; Testing using case and after. (defun f (x y) (try - (progn - (yyy x y) - (zzz y)) + (progn + (yyy x y) + (zzz y)) (case - ('sune #(value sune)) + ('sune #(value sune)) ('bert #(value bert))) (after (yyy 'this-is-after (list x y)) - 'this-is-after))) + 'this-is-after))) ;; Testing using catch and after. (defun g (x y) (try - (progn - (yyy x y) - (zzz y)) + (progn + (yyy x y) + (zzz y)) (catch ;; Pattern MUST be tuple of 3 elements here! ;; (tuple TYPE VALUE IGNORE-THIS) @@ -79,16 +79,16 @@ ((tuple 'throw n o) (tuple 'this-is-throw n)) ((tuple _ n o) (tuple 'this-is-default n))) (after (yyy 'this-is-after (list x y)) - 'this-is-after))) + 'this-is-after))) ;; Testing using all case, catch and after. (defun h (x y) (try - (progn - (yyy x y) - (zzz y)) + (progn + (yyy x y) + (zzz y)) (case - ('sune #(value sune)) + ('sune #(value sune)) ('bert #(value bert))) (catch ;; Pattern MUST be tuple of 3 elements here! @@ -97,7 +97,7 @@ ((tuple 'throw n o) (tuple 'this-is-throw n)) ((tuple _ n o) (tuple 'this-is-default n))) (after (yyy 'this-is-after (list x y)) - 'this-is-after))) + 'this-is-after))) (defun b (x) '"a string")
Locations
Projects
Search
Status Monitor
Help
Open Build Service
OBS Manuals
API Documentation
OBS Portal
Reporting a Bug
Contact
Mailing List
Forums
Chat (IRC)
Twitter
Open Build Service (OBS)
is an
openSUSE project
.