Projects
openEuler:Mainline
erlang-lfe
Sign Up
Log In
Username
Password
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
Expand all
Collapse all
Changes of Revision 2
View file
_service:tar_scm:erlang-lfe.spec
Changed
@@ -6,15 +6,14 @@ %global debug_package %{nil} %endif Name: erlang-%{realname} -Version: 1.3 +Version: 2.1.1 Release: 1 Summary: Lisp Flavoured Erlang License: BSD URL: https://github.com/%{upstream}/%{realname} VCS: scm:git:https://github.com/%{upstream}/%{realname}.git Source0: https://github.com/%{upstream}/%{realname}/archive/%{version}/%{realname}-%{version}.tar.gz -Patch1: erlang-lfe-0001-Remove-support-for-erlang-packages.patch -Patch2: erlang-lfe-0002-Convert-to-proper-UTF-8.patch + %if 0%{?need_bootstrap} BuildRequires: erlang-erts erlang-rpm-macros %else @@ -32,8 +31,6 @@ %prep %setup -q -n %{realname}-%{version} -%patch1 -p1 -b .no_erl_packages -%patch2 -p1 -b .proper_utf8 %build %if 0%{?need_bootstrap} @@ -88,5 +85,8 @@ %{_emacs_sitestartdir}/lfe-start.el %changelog +* Tue Feb 28 2023 lilong <lilong@kylinos.cn> - 2.1.1-1 +- Upgrade to 2.1.1 + * Sat Aug 29 2020 wangyue <wangyue92@huawei.com> - 1.3-1 - package init
View file
_service:tar_scm:erlang-lfe-0001-Remove-support-for-erlang-packages.patch
Deleted
@@ -1,39 +0,0 @@ -From: Peter Lemenkov <lemenkov@gmail.com> -Date: Thu, 31 Mar 2016 08:49:49 +0300 -Subject: PATCH Remove support for erlang packages. - -Erlang "packages" were abandoned long time ago. Remaining support was -dropped in erlang/otp@8e32c07940d9cd1c325d052bded3729333920f81. - -Signed-off-by: Peter Lemenkov <lemenkov@gmail.com> - -diff --git a/src/lfe_trans.erl b/src/lfe_trans.erl -index d2d21b2..628e4eb 100644 ---- a/src/lfe_trans.erl -+++ b/src/lfe_trans.erl -@@ -139,8 +139,6 @@ from_expr({record_field,_,E,R,{atom,_,F}}, Vt0, St0) -> %We KNOW! - 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_package_module(M, Vt, St); - %% Function calls. - from_expr({call,_,{remote,_,M,F},As}, Vt0, St0) -> %Remote function call - {Lm,Vt1,St1} = from_expr(M, Vt0, St0), -@@ -367,16 +365,6 @@ from_rec_fields({record_field,_,{var,_,F},E}|Fs, Vt0, St0) -> %special case!! - {F,Le|Lfs,Vt2,St2}; - from_rec_fields(, Vt, St) -> {,Vt,St}. - --%% from_package_module(Module, VarTable, State) -> {Module,VarTable,State}. --%% We must handle the special case where in pre-R16 you could have --%% packages with a dotted module path. It used a special record_field --%% tuple. This does not work in R16 and later! -- --from_package_module({record_field,_,_,_}=M, Vt, St) -> -- Segs = erl_parse:package_segments(M), -- A = list_to_atom(packages:concat(Segs)), -- {?Q(A),Vt,St}. -- - from_maybe(_, ) -> ; - from_maybe(Tag, Es) -> Tag|Es. -
View file
_service:tar_scm:erlang-lfe-0002-Convert-to-proper-UTF-8.patch
Deleted
@@ -1,19 +0,0 @@ -From: Peter Lemenkov <lemenkov@gmail.com> -Date: Tue, 20 Jun 2017 18:24:11 +0300 -Subject: PATCH Convert to proper UTF-8 - -Signed-off-by: Peter Lemenkov <lemenkov@gmail.com> - -diff --git a/examples/core-macros.lfe b/examples/core-macros.lfe -index e76148a..3cac342 100644 ---- a/examples/core-macros.lfe -+++ b/examples/core-macros.lfe -@@ -96,7 +96,7 @@ - (() `'false))) - - ;; This version of backquote is almost an exact copy of a quasiquote --;; expander for Scheme by André van Tonder. It is very compact and -+;; expander for Scheme by André van Tonder. It is very compact and - ;; with some cons/append optimisations we have added produces quite - ;; reasonable code. -
View file
_service
Changed
@@ -2,7 +2,7 @@ <service name="tar_scm"> <param name="scm">git</param> <param name="url">git@gitee.com:src-openeuler/erlang-lfe.git</param> - <param name="revision">284127a8d941f2673173d41ac8f3ecb4d4b17eca</param> + <param name="revision">master</param> <param name="exclude">*</param> <param name="extract">*</param> </service>
View file
_service:tar_scm:lfe-1.3.tar.gz/.travis.yml
Deleted
@@ -1,18 +0,0 @@ -language: erlang -install: true -before_script: - - wget https://s3.amazonaws.com/rebar3/rebar3 - - chmod +x rebar3 -env: PATH=$PATH:. -script: make travis -notifications: - disabled: true -otp_release: - - 19.0 - - 18.2 - - 18.0 - - 17.5 - - 17.1 - - R16B03-1 - # - R15B03 - # - R14B04
View file
_service:tar_scm:lfe-1.3.tar.gz/dev/record-defs.lfe
Deleted
@@ -1,3 +0,0 @@ -(defrecord point x y) - -(defrecord circle center radius)
View file
_service:tar_scm:lfe-1.3.tar.gz/dev/test_pmod_base.lfe
Deleted
@@ -1,22 +0,0 @@ -(defmodule (test_pmod_base x y) - (export (m1 2) (m2 1) (m3 1) (m4 1)) - (export all) - (import (from lists (reverse 1)))) - -(defun m1 - (('a a) (xxx 1 x)) - (('b a) (xxx 2 x))) - -(defun m2 (z) - (flet ((xxx (z) (tuple x y z))) - (xxx z))) - -(defun m3 (z) (tuple (b1 z) (reverse z) this)) - -(defun m4 (z) (: para_2 a1 z)) - -(defun b1 (z) (length z)) - -(defun b2 (z) (tuple x y (length z))) - -(defun xxx (a b) (cons a b))
View file
_service:tar_scm:lfe-1.3.tar.gz/dev/test_pmod_ext.lfe
Deleted
@@ -1,22 +0,0 @@ -(defmodule (test_pmod_ext x y) - (extends test_pmod_base) - (export (a1 2) (a2 1) (a3 1) (a4 1)) - (import (from lists (reverse 1)))) - -(defun a1 - (('a a) (xxx 1 x)) - (('b a) (xxx 2 x))) - -(defun a2 (z) - (flet ((xxx (z) (tuple x y z))) - (xxx z))) - -(defun a3 (z) (tuple (b1 z) (reverse z) this base)) - -(defun a4 (z) (: para_2 a1 z)) - -(defun b1 (z) (length z)) - -(defun b2 (z) (tuple x y (length z))) - -(defun xxx (a b) (cons a b))
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_doc.txt
Deleted
@@ -1,88 +0,0 @@ -lfe_doc(3) lfe_doc(3) - - - -NAME - lfe_doc - Lisp Flavoured Erlang (LFE) documentation parser. - -SYNOPSIS - This module provides functions to parse docstrings in LFE module - sources. - - There is no guarantee the internal formats will not change but the in‐ - terface functions should stay the same. - -EXPORTS - extract_module_docs(Mod, CompilerInfo) -> {ok,ModDocs} | {error,Er‐ - rors,} - - Parse a module's docstrings and return module documentation structure. - - save_module_docs(Beam, ModDocs, CompilerInfo) -> Beam - - Add the "LDoc" chunk containing ModDocs to a module's .beam binary. - - get_module_docs(Module | Binary) -> {ok,DocChunk} | {error,Error} - - Extract the documentation chunk from a module. The chunk will be con‐ - verted to an internal format. - - format_docs/1 - - Take a list of doc strings and generate a list of indented doc lines. - Each doc string is indented separately. - - format_error(ErrorDecriptor) -> Chars - - Given an ErrorDescriptor, return a deep list of characters which de‐ - scribe the error. This function is usually called implicitly when an - ErrorInfo structure is processed. See lfe_comp(3). - - N.B. Currently, format_error/1 always returns "doc error". - - MODULE DOC ACCESSORS - module_doc(DocChunk) -> DocString - - mf_docs(DocChunk) -> MacFuncDoc - - mf_doc_type(MacFuncDoc) -> function | macro - - function_docs(DocChunk) -> FuncDoc - - macro_docs(DocChunk) -> MacDoc - - Extract fields from the module documentation chunk. - - FUNCTION DOC ACCESSORS - function_name(FuncDoc) -> Name - - function_arity(FuncDoc) -> Arity - - function_line(FuncDoc) -> Line - - function_patterns(FuncDoc) -> Pattern - - function_doc(FuncDoc) -> DocString - - Extract fields from a function documentation structure. - - MACRO DOC ACCESSORS - macro_name(MacDoc) -> Name - - macro_line(MacDoc) -> Line - - macro_patterns(MacDoc) -> Pattern - - macro_doc(MacDoc) -> DocString - - Extract fields from a macro documentation structure. - -SEE ALSO - lfe_comp(3), lfe_macro(3) - -AUTHORS - Eric Bailey. - - - - 2016 lfe_doc(3)
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_doc.3
Deleted
@@ -1,90 +0,0 @@ -.\" Automatically generated by Pandoc 1.19.2.1 -.\" -.TH "lfe_doc" "3" "2016" "" "" -.hy -.SH NAME -.PP -lfe_doc \- Lisp Flavoured Erlang (LFE) documentation parser. -.SH SYNOPSIS -.PP -This module provides functions to parse docstrings in LFE module -sources. -.PP -There is no guarantee the internal formats will not change but the -interface functions should stay the same. -.SH EXPORTS -.PP -\fBextract_module_docs(Mod, CompilerInfo) \-> {ok,ModDocs} | -{error,Errors,}\f -.PP -Parse a module\aqs docstrings and return module documentation -structure. -.PP -\fBsave_module_docs(Beam, ModDocs, CompilerInfo) \-> Beam\f -.PP -Add the \fC"LDoc"\f chunk containing \fCModDocs\f to a -module\aqs .beam binary. -.PP -\fBget_module_docs(Module | Binary) \-> {ok,DocChunk} | -{error,Error}\f -.PP -Extract the documentation chunk from a module. -The chunk will be converted to an internal format. -.PP -\fBformat_docs/1\f -.PP -Take a list of doc strings and generate a list of indented doc lines. -Each doc string is indented separately. -.PP -\fBformat_error(ErrorDecriptor) \-> Chars\f -.PP -Given an \fCErrorDescriptor\f, return a deep list of characters -which describe the error. -This function is usually called implicitly when an \fCErrorInfo\f -structure is processed. -See \fBlfe_comp(3)\f. -.PP -N.B. -Currently, \fCformat_error/1\f always returns \fC"doc\ error"\f. -.SS MODULE DOC ACCESSORS -.PP -\fBmodule_doc(DocChunk) \-> DocString\f -.PP -\fBmf_docs(DocChunk) \-> MacFuncDoc\f -.PP -\fBmf_doc_type(MacFuncDoc) \-> function | macro\f -.PP -\fBfunction_docs(DocChunk) \-> FuncDoc\f -.PP -\fBmacro_docs(DocChunk) \-> MacDoc\f -.PP -Extract fields from the module documentation chunk. -.SS FUNCTION DOC ACCESSORS -.PP -\fBfunction_name(FuncDoc) \-> Name\f -.PP -\fBfunction_arity(FuncDoc) \-> Arity\f -.PP -\fBfunction_line(FuncDoc) \-> Line\f -.PP -\fBfunction_patterns(FuncDoc) \-> Pattern\f -.PP -\fBfunction_doc(FuncDoc) \-> DocString\f -.PP -Extract fields from a function documentation structure. -.SS MACRO DOC ACCESSORS -.PP -\fBmacro_name(MacDoc) \-> Name\f -.PP -\fBmacro_line(MacDoc) \-> Line\f -.PP -\fBmacro_patterns(MacDoc) \-> Pattern\f -.PP -\fBmacro_doc(MacDoc) \-> DocString\f -.PP -Extract fields from a macro documentation structure. -.SH SEE ALSO -.PP -\fBlfe_comp(3)\f, \fBlfe_macro(3)\f -.SH AUTHORS -Eric Bailey.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfe_doc.3.md
Deleted
@@ -1,92 +0,0 @@ -% lfe_doc(3) -% Eric Bailey -% 2016 - - -# NAME - -lfe_doc - Lisp Flavoured Erlang (LFE) documentation parser. - - -# SYNOPSIS - -This module provides functions to parse docstrings in LFE module sources. - -There is no guarantee the internal formats will not change -but the interface functions should stay the same. - - -# EXPORTS - -**extract_module_docs(Mod, CompilerInfo) -> {ok,ModDocs} | {error,Errors,}** - -Parse a module's docstrings and return module documentation structure. - -**save_module_docs(Beam, ModDocs, CompilerInfo) -> Beam** - -Add the ``"LDoc"`` chunk containing ``ModDocs`` to a module's .beam binary. - -**get_module_docs(Module | Binary) -> {ok,DocChunk} | {error,Error}** - -Extract the documentation chunk from a module. The chunk will be -converted to an internal format. - -**format_docs/1** - -Take a list of doc strings and generate a list of indented doc -lines. Each doc string is indented separately. - -**format_error(ErrorDecriptor) -> Chars** - -Given an ``ErrorDescriptor``, return a deep list of characters which describe -the error. This function is usually called implicitly when an ``ErrorInfo`` -structure is processed. See **lfe_comp(3)**. - -N.B. Currently, ``format_error/1`` always returns ``"doc error"``. - - -### MODULE DOC ACCESSORS - -**module_doc(DocChunk) -> DocString** - -**mf_docs(DocChunk) -> MacFuncDoc** - -**mf_doc_type(MacFuncDoc) -> function | macro** - -**function_docs(DocChunk) -> FuncDoc** - -**macro_docs(DocChunk) -> MacDoc** - -Extract fields from the module documentation chunk. - -### FUNCTION DOC ACCESSORS - -**function_name(FuncDoc) -> Name** - -**function_arity(FuncDoc) -> Arity** - -**function_line(FuncDoc) -> Line** - -**function_patterns(FuncDoc) -> Pattern** - -**function_doc(FuncDoc) -> DocString** - -Extract fields from a function documentation structure. - - -### MACRO DOC ACCESSORS - -**macro_name(MacDoc) -> Name** - -**macro_line(MacDoc) -> Line** - -**macro_patterns(MacDoc) -> Pattern** - -**macro_doc(MacDoc) -> DocString** - -Extract fields from a macro documentation structure. - - -# SEE ALSO - -**lfe_comp(3)**, **lfe_macro(3)**
View file
_service:tar_scm:lfe-1.3.tar.gz/rebar.lock
Deleted
@@ -1,1 +0,0 @@ -.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_doc.erl
Deleted
@@ -1,387 +0,0 @@ -%% Copyright (c) 2016 Eric Bailey -%% -%% 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_doc.erl -%% Author : Eric Bailey -%% Purpose : Lisp Flavoured Erlang (LFE) documentation parser. - -%% There is no guarantee the internal formats will not change -%% but the interface functions should stay the same. - --module(lfe_doc). - --export(format_error/1). - --export(extract_module_docs/1,extract_module_docs/2,save_module_docs/3). - -%% Access functions for documentation in modules. --export(get_module_docs/1,module_doc/1,mf_docs/1,mf_doc_type/1, - function_docs/3,macro_docs/2, - function_name/1,function_arity/1,function_line/1, - function_patterns/1, function_doc/1, - macro_name/1,macro_line/1,macro_patterns/1,macro_doc/1). - --export(format_docs/1). - --import(lists, member/2,filter/2,foldl/3,foldr/3,reverse/1). - --include("lfe_comp.hrl"). --include("lfe_doc.hrl"). - --ifdef(EUNIT). --export(collect_docs/2,pprint/2). %Used by prop_lfe_doc - --include_lib("eunit/include/eunit.hrl"). - --define(QC_OPTS, {on_output,fun pprint/2},{numtests,1000},{max_size,10}). --define(QC(T,P), {timeout,30,{T,?_assert(proper:quickcheck(P, ?QC_OPTS))}}). --endif. - -%% Errors -format_error(_) -> "doc error". - -%% extract_module_docs(Defs, CompInfo) -> {ok,Docs} | {error,Errors,}. -%% Parse a module's docstrings and return the docs. - --spec extract_module_docs(Defs, Cinfo) -> {ok,Docs} | {error,Errors,} when - Defs :: {Form,Line}, - Form :: _, - Line :: non_neg_integer(), - Cinfo :: #cinfo{}, - Docs :: doc(), - Errors :: nonempty_list({error,Line,Error}), - Error :: any(). - -extract_module_docs(Defs) -> %Just give a default #cinfo{} - extract_module_docs(Defs, #cinfo{}). - -extract_module_docs(, _Ci) -> {ok,}; -extract_module_docs(Defs, Ci) -> - {Mdoc,Docs} = do_forms(Defs), - Errors = filter(fun (#doc{}) -> false; - (_) -> true - end, Docs), - ?DEBUG("#doc: ~p\n", {Mdoc,Docs}, Ci#cinfo.opts), - ?IF( =:= Errors, - {ok,{Mdoc,Docs}}, - {error,Errors,}). - -do_forms(Fs) -> foldl(fun do_form/2, {,}, Fs). - -do_form({'define-module',_,Meta,Atts,_}, {Mdoc,Docs}) -> - {do_module_def(Meta, Atts, Mdoc),Docs}; -do_form({'extend-module',Meta,Atts,_}, {Mdoc,Docs}) -> - {do_module_def(Meta, Atts, Mdoc),Docs}; -do_form({'define-function',Name,Meta,Def,Line}, {Mdoc,Docs}) -> - {Mdoc,do_function(Name, Def, Meta, Line, Docs)}; -do_form({'define-macro',Name,Meta,Def,Line}, {Mdoc,Docs}) -> - {Mdoc,do_macro(Name, Def, Meta, Line, Docs)}; -do_form(_, Doc) -> Doc. %Ignore eval-when-compile - -do_module_def(Meta, Atts, Mdoc0) -> - Mdoc1 = collect_docs(Meta, Mdoc0), %First take meta docs - collect_docs(Atts, Mdoc1). %then the attribute docs - -collect_docs(As, Mdoc) -> - %% Collect all the docs in all the doc metas/attributes. - Afun = fun (doc|Docs, Md) -> - Dfun = fun (D, M) -> M ++ string_to_binary(D) end, - foldl(Dfun, Md, Docs); - (_, Md) -> Md - end, - foldl(Afun, Mdoc, As). - -do_function(Name, Def, Meta, Line, Docs) -> - %% Must get patterns and arity before we can check if excluded. - {Arity,Pats} = get_function_patterns(Def), - ?IF(exclude(Name, Arity, Meta), - Docs, - begin - Fdoc = make_function_doc(Name, Arity, Pats, Meta, Line), - Fdoc|Docs - end). - -do_macro(Name, Def, Meta, Line, Docs) -> - %% We only need the name to check for exclusion. - ?IF(exclude(Name, Meta), - Docs, - begin - Pats = get_macro_patterns(Def), - Mdoc = make_macro_doc(Name, Pats, Meta, Line), - Mdoc|Docs - end). - -%% exclude(Name, Arity, Meta) -> boolean(). -%% exclude(Name, Meta) -> boolean(). -%% Return true if a function should be excluded from the docs chunk. -%% $handle_undefined_function/2 needs special handling as it is -%% automatically generated but can also be defined by the user. So we -%% only include it is it has user documentation. - --spec exclude(Name, Arity, Meta) -> boolean() when - Name :: atom(), - Arity :: non_neg_integer(), - Meta :: list(). --spec exclude(Name, Meta) -> boolean() when - Name :: atom(), - Meta :: list(). - -exclude('LFE-EXPAND-EXPORTED-MACRO', 3, _) -> true; -exclude('$handle_undefined_function', 2, _) -> %Should check for doc string - true; -exclude(_, _, _) -> false. - -exclude('MODULE', _) -> true; -exclude(_, _) -> false. - -%% get_function_patterns(LambdaForm) -> {Arity,Patterns}. -%% get_macro_patterns(LambdaForm) -> Patterns. -%% Given a {match-,}lambda form, attempt to return its patterns (or -%% arglist). N.B. A guard is appended to its pattern and Patterns is -%% a list of lists. A macro definition must have two args, the pattern -%% and the environment. - --spec get_function_patterns(LambdaForm) -> {Arity,Patterns} when - LambdaForm :: nonempty_list(), - Arity :: non_neg_integer(), - Patterns :: nonempty_list({pattern(),guard()}). --spec get_macro_patterns(LambdaForm) -> Patterns when - LambdaForm :: nonempty_list(), - Patterns :: nonempty_list({pattern(),guard()}). - -get_function_patterns(lambda,Args|_) -> {length(Args),{Args,}}; -get_function_patterns('match-lambda',Pat|_=Cl|Cls) -> - {length(Pat),do_function_patterns(Cl|Cls, )}. - -do_function_patterns(Pat,'when'|Guard|_|Cls, Acc) -> - do_function_patterns(Cls, {Pat,Guard}|Acc); -do_function_patterns(Pat|_|Cls, Acc) -> - do_function_patterns(Cls, {Pat,}|Acc); -do_function_patterns(, Acc) -> reverse(Acc). - -get_macro_patterns(lambda,Args,_Env|_) -> Args; -get_macro_patterns('match-lambda'|Cls) -> do_macro_patterns(Cls, ). - -do_macro_patterns(Pat,_Env,'when'|Guard|_|Cls, Acc) -> - do_macro_patterns(Cls, {Pat,Guard}|Acc); -do_macro_patterns(Pat,_Env|_|Cls, Acc) -> - do_macro_patterns(Cls, {Pat,}|Acc); -do_macro_patterns(, Acc) -> reverse(Acc). - -%% make_function_doc(Name, Arity, Patterns, Doc, Line) -> doc(). -%% make_macro_doc(Name, Patterns, Doc, Line) -> doc(). -%% Convenience constructor for #doc{}, which is defined in src/lfe_doc.hrl. - --spec make_function_doc(Name, Arity, Patterns, Meta, Line) -> doc() when - Name :: atom(), - Arity :: non_neg_integer(), - Patterns :: {,}, - Meta :: any(), - Line :: pos_integer(). - --spec make_macro_doc(Name, Patterns, Meta, Line) -> doc() when - Name :: atom(), - Patterns :: {,}, - Meta :: any(), - Line :: pos_integer(). - -make_function_doc(Name, Arity, Patterns, Meta, Line) -> - Docs = collect_docs(Meta, ), - #doc{type=function,name={Name,Arity},patterns=Patterns,doc=Docs,line=Line}. - -make_macro_doc(Name, Patterns, Meta, Line) -> - Docs = collect_docs(Meta, ), - #doc{type=macro,name=Name,patterns=Patterns,doc=Docs,line=Line}. - -string_to_binary(Str) when is_list(Str) -> - unicode:characters_to_binary(Str, utf8, utf8); -string_to_binary(Bin) -> Bin. - -%% save_module_docs(Beam, ModDocs, CompInfo) -> Mod. -%% Add the "LDoc" chunk to a module's .beam binary. - --spec save_module_docs(Beam, Docs, Cinfo) -> {ok,Beam} | {error,Errors} when - Beam :: binary(), - Docs :: {doc(),doc()}, - Cinfo :: #cinfo{}, - Errors :: {_,_,_}. - -save_module_docs(Beam, {Mdoc,Fdocs0}, _Ci) -> - Fdocs1 = exports_attributes(Beam, Fdocs0), - %% Modified from elixir_module - LDoc = term_to_binary(#lfe_docs_v1{ - docs=Fdocs1, - moduledoc=format_docs(Mdoc) - }), - {ok,add_beam_chunk(Beam, "LDoc", LDoc)}; -save_module_docs(_, _, _) -> {error,{none,lfe_doc,save_chunk}}. - -%% exports_attributes(Beam, MacFuncDocs) -> MacFuncDocs. -%% Return the exported macro and function docs seeting exported=true. - -exports_attributes(Beam, Fdocs) -> - Crefs = exports,attributes, - {ok,{_,{exports,Expf},{attributes,Atts}}} = beam_lib:chunks(Beam, Crefs), - Expm = proplists:get_value('export-macro', Atts, ), - foldl(do_exports(Expf, Expm), , Fdocs). - -%% do_exports(Expf, Expm) -> Fun. -%% Close over Expf and Expm then return the folding function for -%% exports/1. We only included exported functions and macros. The -%% export-macro attribute is not necessarily sorted. - -do_exports(Expf, Expm) -> - fun (#doc{type=function,name=FA,doc=Ds}=Doc, Docs) -> - ?IF(member(FA, Expf), - Doc#doc{exported=true,doc=format_docs(Ds)}|Docs, - Docs); - (#doc{type=macro,name=M,doc=Ds}=Doc, Docs) -> - ?IF(member(M, Expm), - Doc#doc{exported=true,doc=format_docs(Ds)}|Docs, - Docs) - end. - -%% add_beam_chunk(Bin, Id, ChunkData) -> Bin. -%% Add a custom chunk to a .beam binary. Modified from elixir_module. - -add_beam_chunk(Bin, Id, ChunkData) - when is_binary(Bin), is_list(Id), is_binary(ChunkData) -> - {ok,_,Chunks} = beam_lib:all_chunks(Bin), - {ok,NewBin} = beam_lib:build_module({Id,ChunkData}|Chunks), - NewBin. - -%% format_docs(DocString) -> DocLine. -%% Take a list of doc strings and generate a list of indented doc -%% lines. Each doc string is indented separately. Should it be so? - -format_docs(Ds) -> lists:flatmap(fun format_doc/1, Ds). - -format_doc(D) -> - %% Split the string into separate lines, also trims trailing blanks. - Ls = re:split(D, <<" \t*\n">>, trim), - format_doc_lines(Ls). - -format_doc_lines(<<>>|Ls0) -> %First line empty - case skip_empty_lines(Ls0) of %Skip lines until text - {_,L|_=Ls1} -> - C = count_spaces(L), %Use indentation of this line - format_doc_lines(Ls1, C); - {_,} -> - end; -format_doc_lines(L1|Ls0) -> %First line not empty - case skip_empty_lines(Ls0) of - {Els,L|_=Ls1} -> - C = count_spaces(L), %Use indentation of this line - %% Include first line as is. - L1 ++ Els ++ format_doc_lines(Ls1, C); - {Els,} -> L1|Els - end; -format_doc_lines() -> . - -format_doc_lines(Ls, C) -> lists:map(fun (L) -> skip_spaces(L, C) end, Ls). - -count_spaces(L) -> - {match,{_,C}} = re:run(L, <<"^ *">>, ), - C. - -skip_spaces(<<$\s,L/binary>>, C) when C > 0 -> - skip_spaces(L, C-1); -skip_spaces(L, _) -> L. %C =:= 0 or no space - -skip_empty_lines(Ls) -> lists:splitwith(fun (L) -> L =:= <<>> end, Ls). - -%% Access functions for the module doc chunk. - -%% get_module_docs(Module | Binary) -> {ok,Chunk} | {error,What}. - -get_module_docs(Mod) when is_atom(Mod) -> - case code:get_object_code(Mod) of - {Mod,Bin,_} -> - get_module_chunk(Bin); - error -> {error,module} %Could not find the module - end; -get_module_docs(Bin) when is_binary(Bin) -> - get_module_chunk(Bin). - -get_module_chunk(Bin) -> - case beam_lib:chunks(Bin, "LDoc", ) of - {ok,{_,{"LDoc",Chunk}}} -> - {ok,binary_to_term(Chunk)}; - _ -> {error,docs} %Could not find the docs chunk - end. - -%% module_doc(Chunk) -> binary(). -%% mf_docs(Chunk) -> MacFuncDoc. -%% mf_doc_type(MacFuncDoc) -> function | macro. -%% function_docs(Chunk) -> FunctionDoc. -%% macro_docs(Chunk) -> MacroDoc. - -module_doc(#lfe_docs_v1{moduledoc=Moddoc}) -> Moddoc. - -mf_docs(#lfe_docs_v1{docs=Docs}) -> Docs. - -mf_doc_type(#doc{name={_,_}}) -> function; -mf_doc_type(#doc{name=N}) when is_atom(N) -> macro. - -function_docs(Fun, Ar, #lfe_docs_v1{docs=Docs}) -> - case lists:keysearch({Fun,Ar}, #doc.name, Docs) of - {value,Fdoc} -> {ok,Fdoc}; - false -> error - end. - -macro_docs(Mac, #lfe_docs_v1{docs=Docs}) -> - case lists:keysearch(Mac, #doc.name, Docs) of - {value,Mdoc} -> {ok,Mdoc}; - false -> error - end. - -%% function_name(FunctionDoc) -> Name. -%% function_arity(FunctionDoc) -> Arity. -%% function_line(FunctionDoc) -> LineNo. -%% function_patterns(FunctionDoc) -> Pattern. -%% function_doc(FunctionDoc) -> DocString. -%% Extract fields from a function doc structure. - -function_name(#doc{name={Name,_}}) -> Name. -function_arity(#doc{name={_,Ar}}) -> Ar. -function_line(#doc{line=Line}) -> Line. -function_patterns(#doc{name={_,_},patterns=Ps}) -> Ps. -function_doc(#doc{name={_,_},doc=Ds}) -> Ds. - -%% macro_name(MacroDoc) -> Name. -%% macro_line(MacroDoc) -> LineNo. -%% macro_patterns(MacroDoc) -> Pattern. -%% macro_doc(MacroDoc) -> DocString. -%% Extract fields from a macr doc structure. - -macro_name(#doc{name=Name}) -> Name. -macro_line(#doc{line=Line}) -> Line. -macro_patterns(#doc{name=N,patterns=Ps}) when is_atom(N) -> Ps. -macro_doc(#doc{name=N,doc=Ds}) when is_atom(N) -> Ds. - -%%%=================================================================== -%%% EUnit tests -%%%=================================================================== - --ifdef(EUNIT). -parse_test_() -> - ?QC(<<"A lambda definition is parsed correctly.">>, - prop_lfe_doc:prop_define_lambda()) - , ?QC(<<"A match-lambda definition is parsed correctly.">>, - prop_lfe_doc:prop_define_match()) - . - -pprint(_Format, {Def,_Line}) -> lfe_io:format(user, "~p\n", Def); -pprint(Format, Data) -> lfe_io:format(user, Format, Data). --endif.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_doc.hrl
Deleted
@@ -1,42 +0,0 @@ -%% Copyright (c) 2016 Eric Bailey -%% -%% 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_doc.hrl -%% Author : Eric Bailey -%% Purpose : Common documentation-related definitions. - -%% TODO: Actually define these, if possible. --type pattern() :: atom() | term(). - --type guard() :: term(). - --type name() :: atom() | {atom(),non_neg_integer()}. - -%% de{fun,macro} docs. --record(doc, {type = error(missing_type) :: function | macro, - exported = false :: boolean(), - name = error(missing_name) :: name(), - patterns = error(missing_patterns) :: {pattern(),guard()}, - doc = :: binary(), - line = error(missing_line) :: pos_integer() - }). - --type doc() :: #doc{}. - -%% For the BEAM beam chunk, "LDoc". --record(lfe_docs_v1, {docs = :: doc(), %Function/macro docs - moduledoc = :: binary() %Module doc - %% callback_docs=CallbackDocs, %Callback docs - %% type_docs=TypeDocs %Type docs - }).
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_pmod.erl
Deleted
@@ -1,282 +0,0 @@ -%% 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. -%% 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_pmod.erl -%% Author : Robert Virding -%% Purpose : Lisp Flavoured Erlang parameterised module transformer. - --module(lfe_pmod). - --export(module/2). - -%% -compile(export_all). - --import(lists, member/2,keysearch/3, - 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). - --include("lfe_comp.hrl"). - --define(Q(E), quote,E). %For quoting - --record(param, {mod=, %Module name - pars=, %Module parameters - extd=, %Extends - this=, %This match pattern - env=}). %Environment - -%% module(ModuleForms, CompInfo) -> {ModuleName,ModuleForms}. -%% Expand the forms to handle parameterised modules if necessary, -%% otherwise just pass forms straight through. - -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()}, - {Acc,St1} = lists:foldl(fun exp_form/2, {,St0}, Fs0), - Fs1 = lists:reverse(Acc), - ?DEBUG("#param: ~p\n", {Fs1,St1}, Opts), - %% {ok,_} = lfe_lint:module(Fs1, Opts), - Fs1. - -exp_form({'define-module',Mod|Ps,Meta,Atts0,L}, {Acc,St0}) -> - %% Save the good bits and define new/N and instance/N. - St1 = St0#param{mod=Mod,pars=Ps}, - {Atts1,St2} = exp_attrs(Atts0, 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, - 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, - {{{New,L},{Inst,L},'define-module',Mod,Meta,Atts1,L}|Acc,St3}; -exp_form({'define-function',F,Meta,Def0,L}, {Acc,St}) -> - Def1 = exp_function(Def0, St), - {{'define-function',F,Meta,Def1,L}|Acc,St}; -exp_form({F,L}, {Acc,St}) -> - {{F,L}|Acc,St}. - -exp_attrs(Atts0, St0) -> - %% Pre-scan to pick up 'extends'. - St1 = foldl(fun (extends,M, S) -> S#param{extd=M}; - (_, S) -> S - end, St0, Atts0), - %% Now do "real" processing. - {Atts1,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, Atts0 ++ abstract,true), - %% Add export for new/N and instance/N. - Nar = length(St2#param.pars), - Iar = case St2#param.extd of - -> Nar; - _ -> Nar+1 - end, - {export,new,Nar,instance,Iar|Atts1,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). - -%% exp_function(Lambda, State) -> Lambda. -%% The resultant code matches the arguments in two steps: first the -%% THIS arguemnt is matched and then the expanded function body -%% ((match-)lambda) is funcalled. We KNOW that funcall of a -%% (match-)lambda is inline expanded into a let or case so this is -%% efficient. - -exp_function(Lambda, #param{this=Th,env=Env}) -> - As = new_args(lambda_arity(Lambda)), - 'match-lambda',As ++ Th,funcall,exp_expr(Lambda, Env)|As. - -%% exp_function('match-lambda'|Cls0, #param{this=Th,env=Env}) -> -%% Cls1 = map(fun (As|Body) -> -%% exp_clause(As ++ Th|Body, Env) -%% end, Cls0), -%% 'match-lambda'|Cls1; -%% exp_function(lambda,As|Body0, #param{this=Th,env=Env}) -> -%% Body1 = exp_list(Body0, Env), -%% 'match-lambda',As ++ Th|Body1. - -new_args(N) when N > 0 -> - list_to_atom("{{-" ++ $a+N-1 ++ "-}}")|new_args(N-1); -new_args(0) -> . - -%% exp_expr(Sexpr, Environment) -> Expr. -%% Expand Sexpr. - -%% Handle the Core data special forms. -exp_expr(quote|_=E, _) -> E; -exp_expr(cons,H,T, Env) -> - cons,exp_expr(H, Env),exp_expr(T, Env); -exp_expr(car,E, Env) -> car,exp_expr(E, Env); %Provide lisp names -exp_expr(cdr,E, Env) -> cdr,exp_expr(E, Env); -exp_expr(list|Es, Env) -> list|exp_list(Es, Env); -exp_expr(tuple|Es, Env) -> tuple|exp_list(Es, Env); -exp_expr(tref|_,_=Es, Env) -> tref|exp_list(Es, Env); -exp_expr(tset|_,_,_=Es, Env) -> tset|exp_list(Es, Env); -exp_expr(binary|Bs, Env) -> - binary|exp_binary(Bs, Env); -%% Handle the Core closure special forms. -exp_expr(lambda|Body, Env) -> - lambda|exp_lambda(Body, Env); -exp_expr('match-lambda'|Cls, Env) -> - 'match-lambda'|exp_match_lambda(Cls, Env); -exp_expr('let'|Body, Env) -> - 'let'|exp_let(Body, Env); -exp_expr('let-function'|Body, Env) -> - 'let-function'|exp_let_function(Body, Env); -exp_expr('letrec-function'|Body, Env) -> - 'letrec-function'|exp_letrec_function(Body, Env); -%% Handle the control special forms. -exp_expr('progn'|Body, Env) -> - progn|exp_body(Body, Env); -exp_expr('if'|Body, Env) -> - 'if'|exp_if(Body, Env); -exp_expr('case'|Body, Env) -> - 'case'|exp_case(Body, Env); -exp_expr('receive'|Body, Env) -> - 'receive'|exp_receive(Body, Env); -exp_expr('catch'|Body, Env) -> - 'catch'|exp_body(Body, Env); -exp_expr('try'|Body, Env) -> - 'try'|exp_try(Body, Env); -exp_expr(funcall,F|As, Env) -> - funcall,exp_expr(F, Env)|exp_list(As, Env); -exp_expr(call|Body, Env) -> - call|exp_call(Body, Env); -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 - end; -exp_expr(E, _) when is_atom(E) -> E; -exp_expr(E, _) -> E. %Atoms expand to themselves. - -exp_list(Es, Env) -> - map(fun (E) -> exp_expr(E, Env) end, Es). - -exp_body(Es, Env) -> - map(fun (E) -> exp_expr(E, Env) end, Es). - -exp_binary(Segs, Env) -> - map(fun (S) -> exp_bitseg(S, Env) end, Segs). - -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), - exp_expr(N, Env)|Specs1; -exp_bitseg(N, Env) -> exp_expr(N, Env). - -exp_lambda(As|Body, Env) -> - As|exp_list(Body, Env). - -exp_match_lambda(Cls, Env) -> - exp_clauses(Cls, Env). - -exp_clauses(Cls, Env) -> - map(fun (Cl) -> exp_clause(Cl, Env) end, Cls). - -exp_clause(P,'when'|_=G|Body, Env) -> P,G|exp_body(Body, Env); -exp_clause(P|Body, Env) -> P|exp_body(Body, Env). - -exp_let(Vbs|Body, Env) -> - Evbs = map(fun (P,E) -> P,exp_expr(E, Env); - (P,G,E) -> P,G,exp_expr(E, Env) - end, Vbs), - Evbs|exp_body(Body, Env). - -%% exp_let_function(FletBody, Env) -> FletBody. -%% exp_letrec_function(FletrecBody, Env) -> FletrecBody. -%% The only difference is the order in which the environment is updated. - -exp_let_function(Fbs|Body, Env0) -> - Efbs = map(fun (F,Def) -> F,exp_expr(Def, Env0) end, Fbs), - Env1 = foldl(fun (F,Def, E) -> - add_fbinding(F,lambda_arity(Def),local,E) - end, Env0, Fbs), - Efbs|exp_body(Body, Env1). - -exp_letrec_function(Fbs|Body, Env0) -> - Env1 = foldl(fun (F,Def, E) -> - add_fbinding(F,lambda_arity(Def),local,E) - end, Env0, Fbs), - Efbs = map(fun (F,Def) -> F,exp_expr(Def, Env1) end, Fbs), - Efbs|exp_body(Body, Env1). - -exp_if(Test,True, Env) -> - exp_expr(Test, Env),exp_expr(True, Env); -exp_if(Test,True,False, Env) -> - exp_expr(Test, Env),exp_expr(True, Env),exp_expr(False, Env). - -exp_case(E|Cls, Env) -> - exp_expr(E, Env)|exp_clauses(Cls, Env). - -exp_receive(Cls, Env) -> - map(fun (Cl) -> exp_rec_clause(Cl, Env) end, Cls). - -exp_rec_clause('after',T|Body, Env) -> - 'after',exp_expr(T, Env)|exp_body(Body, Env); -exp_rec_clause(Cl, Env) -> exp_clause(Cl, Env). - -exp_try(E|Body, Env) -> - exp_expr(E, Env)| - map(fun ('case'|Cls) -> 'case'|exp_clauses(Cls, Env); - ('catch'|Cls) -> 'catch'|exp_clauses(Cls, Env); - ('after'|B) -> 'after'|exp_body(B, Env) - end, Body). - -exp_call(M,F|As, Env) -> - exp_expr(M, Env),exp_expr(F, Env)|exp_list(As, Env). - -lambda_arity(lambda,As|_) -> length(As); -lambda_arity('match-lambda',As|_|_) -> length(As).
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_trans.erl
Deleted
@@ -1,935 +0,0 @@ -%% Copyright (c) 2008-2013 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_trans.erl -%% Author : Robert Virding -%% Purpose : Lisp Flavoured Erlang translator. - -%%% Translate LFE code to/from vanilla Erlang AST. -%%% -%%% Note that we don't really check code here as such, we assume the -%%% input is correct. If there is an error in the input we just fail. -%%% This allows us to accept forms which are actually illegal but we -%%% may special case, for example functions call in patterns which -%%% will become macro expansions. - --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). - --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}. -%% from_body(AST) -> Sexpr. -%% from_body(AST, Variables) -> {Sexpr,Variables}. -%% Translate a vanilla Erlang expression into LFE. The main -%% difficulty is in the handling of variables. The implicit matching -%% of known variables in vanilla must be translated into explicit -%% equality tests in guards (which is what the compiler does -%% internally). For this we need to keep track of visible variables -%% and detect when they reused in patterns. - -from_expr(E) -> - {S,_,_} = from_expr(E, ordsets:new(), #from{}), - S. - -from_expr(E, Vs0) -> - Vt0 = ordsets:from_list(Vs0), %We are clean - {S,Vt1,_} = from_expr(E, Vt0, #from{}), - {S,ordsets:to_list(Vt1)}. - -from_body(Es) -> - {Les,_,_} = from_body(Es, ordsets:new(), #from{}), - progn|Les. - -from_body(Es, Vs0) -> - 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({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({cons,_,H,T}, Vt0, St0) -> - {Car,Vt1,St1} = from_expr(H, Vt0, St0), - {Cdr,Vt2,St2} = from_expr(T, Vt1, St1), - {from_cons(Car, Cdr),Vt2,St2}; -%% {cons,Car,Cdr,Vt2,St2}; -from_expr({tuple,_,Es}, Vt0, St0) -> - {Ss,Vt1,St1} = from_expr_list(Es, Vt0, St0), - {tuple|Ss,Vt1,St1}; -from_expr({bin,_,Segs}, Vt0, St0) -> - {Ss,Vt1,St1} = from_bitsegs(Segs, Vt0, St0), - {binary|Ss,Vt1,St1}; -from_expr({map,_,Assocs}, Vt0, St0) -> %Build a map - {Ps,Vt1,St1} = from_map_assocs(Assocs, Vt0, St0), - {map|Ps,Vt1,St1}; -from_expr({map,_,Map,Assocs}, Vt0, St0) -> %Update a map - {Lm,Vt1,St1} = from_expr(Map, Vt0, St0), - from_map_update(Assocs, nul, Lm, Vt1, St1); -%% Core closure special forms. -from_expr({'fun',_,{clauses,Cls}}, Vt, St0) -> - {Lcls,St1} = from_fun_cls(Cls, Vt, St0), - {'match-lambda'|Lcls,Vt,St1}; %Don't bother using lambda -from_expr({'fun',_,{function,F,A}}, Vt, St0) -> - %% Build a lambda. - {Vs,St1} = new_from_vars(A, St0), - {lambda,Vs,F|Vs,Vt,St1}; -from_expr({'fun',_,{function,M,F,A}}, Vt0, St0) -> - %% Translate to call to erlang:make_fun/3. - {Las,Vt1,St1} = from_expr_list(M,F,A, Vt0, St0), - {call,?Q(erlang),?Q(make_fun)|Las,Vt1,St1}; -%% Core control special forms. -from_expr({block,_,Es}, Vt0, St0) -> - {Les,Vt1,St1} = from_body(Es, Vt0, St0), - {progn|Les,Vt1,St1}; -from_expr({'case',_,E,Cls}, Vt0, St0) -> - {Le,Vt1,St1} = from_expr(E, Vt0, St0), - {Lcls,Vt2,St2} = from_icrt_cls(Cls, Vt1, St1), - {'case',Le|Lcls,Vt2,St2}; -from_expr({'if',_,Cls}, Vt0, St0) -> - {Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0), - {'case',|Lcls,Vt1,St1}; -from_expr({'receive',_,Cls}, Vt0, St0) -> - {Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0), - {'receive'|Lcls,Vt1,St1}; -from_expr({'receive',_,Cls,Timeout,Body}, Vt0, St0) -> - {Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0), - {Lt,Vt2,St2} = from_expr(Timeout, Vt1, St1), - {Lb,Vt3,St3} = from_body(Body, Vt2, St2), - {'receive'|Lcls ++ 'after',Lt|Lb,Vt3,St3}; -%% More complex special forms. These become LFE macros. -from_expr({lc,_,E,Qs}, Vt0, St0) -> - {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 - 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 - 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), - {SR,Le|Lfs,Vt2,St2}; -from_expr({record_field,_,E,R,{atom,_,F}}, Vt0, St0) -> %We KNOW! - 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_package_module(M, Vt, St); -%% Function calls. -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 - {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 - {Lf,Vt1,St1} = from_expr(F, Vt0, St0), - {Las,Vt2,St2} = from_expr_list(As, Vt1, St1), - {funcall,Lf|Las,Vt2,St2}; -from_expr({'try',_,Es,Scs,Ccs,As}, Vt, St0) -> - %% Currently erl_lint does not allow any exports! - {Les,_,St1} = from_body(Es, Vt, St0), - %% These maybe empty. - {Lscs,_,St2} = if Scs =:= -> {,,St1}; - true -> from_icrt_cls(Scs, Vt, St1) - end, - {Lccs,_,St3} = if Ccs =:= -> {,,St2}; - true -> from_icrt_cls(Ccs, Vt, St2) - end, - {Las,_,St4} = from_body(As, Vt, St3), - {'try',progn|Les| - from_maybe('case', Lscs) ++ - from_maybe('catch', Lccs) ++ - from_maybe('after', Las),Vt,St4}; -from_expr({'catch',_,E}, Vt0, St0) -> - {Le,Vt1,St1} = from_expr(E, Vt0, St0), - {'catch',Le,Vt1,St1}; -from_expr({match,L,P,E}, Vt0, St0) -> - {Alias,St1} = new_from_var(St0), %Alias variable value - MP = {match,L,{var,L,Alias},P}, - {Lp,Eqt,Vt1,St2} = from_pat(MP, Vt0, St1), %The alias pattern - {Le,Vt2,St3} = from_expr(E, Vt1, St2), %The expression - Leg = from_eq_tests(Eqt), %Implicit guard tests - {'let',Lp,'when'|Leg,Le,Alias,Vt2,St3}; -from_expr({op,_,Op,A}, Vt0, St0) -> - {La,Vt1,St1} = from_expr(A, Vt0, St0), - {Op,La,Vt1,St1}; -from_expr({op,_,Op,L,R}, Vt0, St0) -> - {Ll,Vt1,St1} = from_expr(L, Vt0, St0), - {Lr,Vt2,St2} = from_expr(R, Vt1, St1), - {Op,Ll,Lr,Vt2,St2}. - -from_cons(Car, list|Es) -> list,Car|Es; -from_cons(Car, ) -> list,Car; -from_cons(Car, Cdr) -> cons,Car,Cdr. - -%% from_body(Expressions, VarTable, State) -> {Body,VarTable,State}. -%% Handle '=' specially here and translate into let containing rest -%% of body. - -from_body({match,_,_,_}=Match, Vt0,St0) -> %Last match - {Lm,Vt1,St1} = from_expr(Match, Vt0, St0), %Must return pattern as value - {Lm,Vt1,St1}; -from_body({match,_,P,E}|Es, Vt0, St0) -> - {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), - {Le,Vt2,St2} = from_expr(E, Vt1, St1), - {Les,Vt3,St4} = from_body(Es, Vt2, St2), - Leg = from_eq_tests(Eqt), %Implicit guard tests - {'let',Lp,'when'|Leg,Le|Les,Vt3,St4}; -from_body(E|Es, Vt0, St0) -> - {Le,Vt1,St1} = from_expr(E, Vt0, St0), - {Les,Vt2,St2} = from_body(Es, Vt1, St1), - {Le|Les,Vt2,St2}; -from_body(, Vt, St) -> {,Vt,St}. - -from_expr_list(Es, Vt, St) -> mapfoldl2(fun from_expr/3, Vt, St, Es). - -%% from_bitsegs(Segs, VarTable, State) -> {Segs,VarTable,State}. - -from_bitsegs({bin_element,_,Seg,Size,Type}|Segs, Vt0, St0) -> - {S,Vt1,St1} = from_bitseg(Seg, Size, Type, Vt0, St0), - {Ss,Vt2,St2} = from_bitsegs(Segs, Vt1, St1), - {S|Ss,Vt2,St2}; -from_bitsegs(, Vt, St) -> {,Vt,St}. - -%% So it won't get confused with strings. -from_bitseg({integer,_,I}, default, default, Vt, St) -> {I,Vt,St}; -from_bitseg({integer,_,I}, Size, Type, Vt0, St0) -> - {Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0), - {I|from_bitseg_type(Type) ++ Lsize,Vt1,St1}; -from_bitseg({float,_,F}, Size, Type, Vt0, St0) -> - {Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0), - {F|from_bitseg_type(Type) ++ Lsize,Vt1,St1}; -from_bitseg({string,_,S}, Size, Type, Vt0, St0) -> - {Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0), - {S|from_bitseg_type(Type) ++ Lsize,Vt1,St1}; -from_bitseg(E, Size, Type, Vt0, St0) -> - {Le,Vt1,St1} = from_expr(E, Vt0, St0), - {Lsize,Vt2,St2} = from_bitseg_size(Size, Vt1, St1), - {Le|from_bitseg_type(Type) ++ Lsize,Vt2,St2}. - -from_bitseg_size(default, Vt, St) -> {,Vt,St}; -from_bitseg_size(Size, Vt0, St0) -> - {Ssize,Vt1,St1} = from_expr(Size, Vt0, St0), - {size,Ssize,Vt1,St1}. - -from_bitseg_type(default) -> ; -from_bitseg_type(Ts) -> - map(fun ({unit,U}) -> unit,U; (T) -> T end, Ts). - -%% from_map_assocs(MapAssocs, VarTable, State) -> {Pairs,VarTable,State}. - -from_map_assocs({_,_,Key,Val}|As, Vt0, St0) -> - {Lk,Vt1,St1} = from_expr(Key, Vt0, St0), - {Lv,Vt2,St2} = from_expr(Val, Vt1, St1), - {Las,Vt3,St3} = from_map_assocs(As, Vt2, St2), - {Lk,Lv|Las,Vt3,St3}; -from_map_assocs(, Vt, St) -> {,Vt,St}. - -%% from_map_update(MapAssocs, CurrAssoc, CurrMap, VarTable, State) -> -%% {Map,VarTable,State}. -%% We need to be a bit cunning here and do everything left-to-right -%% and minimize nested calls. - -from_map_update({Assoc,_,Key,Val}|As, Curr, Map0, Vt0, St0) -> - {Lk,Vt1,St1} = from_expr(Key, Vt0, St0), - {Lv,Vt2,St2} = from_expr(Val, Vt1, St1), - %% Check if can continue this mapping or need to start a new one. - Map1 = if Assoc =:= Curr -> Map0 ++ Lk,Lv; - Assoc =:= map_field_assoc -> 'map-set',Map0,Lk,Lv; - Assoc =:= map_field_exact -> 'map-update',Map0,Lk,Lv - end, - from_map_update(As, Assoc, Map1, Vt2, St2); -%% from_map_update({Assoc,_,Key,Val}|Fs, Assoc, Map0, Vt0, St0) -> -%% {Lk,Vt1,St1} = from_expr(Key, Vt0, St0), -%% {Lv,Vt2,St2} = from_expr(Val, Vt1, St1), -%% from_map_update(Fs, Assoc, Map0 ++ Lk,Lv, Vt2, St2); -%% from_map_update({Assoc,_,Key,Val}|Fs, _, Map0, Vt0, St0) -> -%% {Lk,Vt1,St1} = from_expr(Key, Vt0, St0), -%% {Lv,Vt2,St2} = from_expr(Val, Vt1, St1), -%% Op = if Assoc =:= map_field_assoc -> 'map-set'; -%% true -> 'map-update' -%% end, -%% from_map_update(Fs, Assoc, Op,Map0,Lk,Lv, Vt2, St2); -from_map_update(, _, Map, Vt, St) -> {Map,Vt,St}. - -%% from_icrt_cls(Clauses, VarTable, State) -> {Clauses,VarTable,State}. -%% from_icrt_cl(Clause, VarTable, State) -> {Clause,VarTable,State}. -%% If/case/receive/try clauses. -%% No ; in guards, so no guard sequence only one list of guard tests. - -from_icrt_cls(Cls, Vt, St) -> from_cls(fun from_icrt_cl/3, Vt, St, Cls). - -from_icrt_cl({clause,_,,G,B}, Vt0, St0) -> %If clause - {Lg,Vt1,St1} = from_body(G, Vt0, St0), - {Lb,Vt2,St2} = from_body(B, Vt1, St1), - {'_','when'|Lg|Lb,Vt2,St2}; -from_icrt_cl({clause,_,H,,B}, Vt0, St0) -> - {Lh,Eqt,Vt1,St1} = from_pat_list(H, Vt0, St0), %List of one - {Lb,Vt2,St2} = from_body(B, Vt1, St1), - Leg = from_eq_tests(Eqt), - {Lh,'when'|Leg|Lb,Vt2,St2}; -from_icrt_cl({clause,_,H,G,B}, Vt0, St0) -> - {Lh,Eqt,Vt1,St1} = from_pat_list(H, Vt0, St0), %List of one - {Lg,Vt2,St2} = from_body(G, Vt1, St1), - {Lb,Vt3,St3} = from_body(B, Vt2, St2), - Leg = from_eq_tests(Eqt), - {Lh,'when'|Leg ++ Lg|Lb,Vt3,St3}. - -%% from_fun_cls(Clauses, VarTable, State) -> {Clauses,State}. -%% from_fun_cl(Clause, VarTable, State) -> {Clause,VarTable,State}. -%% Function clauses, all variables in the patterns are new variables -%% which shadow existing variables without equality tests. - -from_fun_cls(Cls, Vt, St0) -> - {Lcls,_,St1} = from_cls(fun from_fun_cl/3, Vt, St0, Cls), - {Lcls,St1}. - -from_fun_cl({clause,_,H,,B}, Vt0, St0) -> - {Lh,Eqt,Vtp,St1} = from_pat_list(H, , St0), - Vt1 = ordsets:union(Vtp, Vt0), %All variables so far - {Lb,Vt2,St2} = from_body(B, Vt1, St1), - Leg = from_eq_tests(Eqt), - {Lh,'when'|Leg|Lb,Vt2,St2}; -from_fun_cl({clause,_,H,G,B}, Vt0, St0) -> - {Lh,Eqt,Vtp,St1} = from_pat_list(H, , St0), - Vt1 = ordsets:union(Vtp, Vt0), %All variables so far - {Lg,Vt2,St2} = from_body(G, Vt1, St1), - {Lb,Vt3,St3} = from_body(B, Vt2, St2), - Leg = from_eq_tests(Eqt), - {Lh,'when'|Leg ++ Lg|Lb,Vt3,St3}. - -%% from_cls(ClauseFun, VarTable, State, Clauses) -> {Clauses,VarTable,State}. -%% Translate the clauses but only export variables that are defined -%% in all clauses, the intersection of the variables. - -from_cls(Fun, Vt0, St0, C) -> - {Lc,Vt1,St1} = Fun(C, Vt0, St0), - {Lc,Vt1,St1}; -from_cls(Fun, Vt0, St0, C|Cs) -> - {Lc,Vtc,St1} = Fun(C, Vt0, St0), - {Lcs,Vtcs,St2} = from_cls(Fun, Vt0, St1, Cs), - {Lc|Lcs,ordsets:intersection(Vtc, Vtcs),St2}. - -from_eq_tests(Gs) -> '=:=',V,V1 || {V,V1} <- Gs . - -%% from_lc_quals(Qualifiers, VarTable, State) -> {Qualifiers,VarTable,State}. - -from_lc_quals({generate,_,P,E}|Qs, Vt0, St0) -> - {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), - {Le,Vt2,St2} = from_expr(E, Vt1, St1), - {Lqs,Vt3,St3} = from_lc_quals(Qs, Vt2, St2), - Leg = from_eq_tests(Eqt), - {'<-',Lp,'when'|Leg|Le|Lqs,Vt3,St3}; -from_lc_quals(T|Qs, Vt0, St0) -> - {Lt,Vt1,St1} = from_expr(T, Vt0, St0), - {Lqs,Vt2,St2} = from_lc_quals(Qs, Vt1, St1), - {Lt|Lqs,Vt2,St2}; -from_lc_quals(, Vt, St) -> {,Vt,St}. - -%% from_rec_fields(Recfields, VarTable, State) -> {Recfields,VarTable,State}. - -from_rec_fields({record_field,_,{atom,_,F},E}|Fs, Vt0, St0) -> - {Le,Vt1,St1} = from_expr(E, Vt0, St0), - {Lfs,Vt2,St2} = from_rec_fields(Fs, Vt1, St1), - {F,Le|Lfs,Vt2,St2}; -from_rec_fields({record_field,_,{var,_,F},E}|Fs, Vt0, St0) -> %special case!! - {Le,Vt1,St1} = from_expr(E, Vt0, St0), - {Lfs,Vt2,St2} = from_rec_fields(Fs, Vt1, St1), - {F,Le|Lfs,Vt2,St2}; -from_rec_fields(, Vt, St) -> {,Vt,St}. - -%% from_package_module(Module, VarTable, State) -> {Module,VarTable,State}. -%% We must handle the special case where in pre-R16 you could have -%% packages with a dotted module path. It used a special record_field -%% tuple. This does not work in R16 and later! - -from_package_module({record_field,_,_,_}=M, Vt, St) -> - Segs = erl_parse:package_segments(M), - A = list_to_atom(packages:concat(Segs)), - {?Q(A),Vt,St}. - -from_maybe(_, ) -> ; -from_maybe(Tag, Es) -> Tag|Es. - -%% new_from_var(State) -> {VarName,State}. -%% new_from_vars(Count, State) -> {VarNames,State}. - -new_from_var(#from{vc=C}=St) -> - V = list_to_atom(lists:concat('-var-',C,'-')), - {V,St#from{vc=C+1}}. - -new_from_vars(N, St) -> new_from_vars(N, St, ). - -new_from_vars(N, St0, Vs) when N > 0 -> - {V,St1} = new_from_var(St0), - new_from_vars(N-1, St1, V|Vs); -new_from_vars(0, St, Vs) -> {Vs,St}. - -%% from_pat(Pattern, VarTable, State) -> -%% {Pattern,EqualVar,VarTable,State}. - -from_pat({var,_,'_'}, Vt, St) -> {'_',,Vt,St}; %Special case _ -from_pat({var,_,V}, Vt, St0) -> %Unquoted atom - case ordsets:is_element(V, Vt) of %Is variable bound? - true -> - {V1,St1} = new_from_var(St0), %New var for pattern - {V1,{V,V1},Vt,St1}; %Add to guard tests - false -> - {V,,ordsets:add_element(V, Vt),St0} - end; -from_pat({nil,_}, Vt, St) -> {,,Vt,St}; -from_pat({integer,_,I}, Vt, St) -> {I,,Vt,St}; -from_pat({float,_,F}, Vt, St) -> {F,,Vt,St}; -from_pat({atom,_,A}, Vt, St) -> {?Q(A),,Vt,St}; %Quoted atom -from_pat({string,_,S}, Vt, St) -> {?Q(S),,Vt,St}; %Quoted string -from_pat({cons,_,H,T}, Vt0, St0) -> - {Car,Eqt1,Vt1,St1} = from_pat(H, Vt0, St0), - {Cdr,Eqt2,Vt2,St2} = from_pat(T, Vt1, St1), - {from_cons(Car, Cdr),Eqt1++Eqt2,Vt2,St2}; -from_pat({tuple,_,Es}, Vt0, St0) -> - {Ss,Eqt,Vt1,St1} = from_pat_list(Es, Vt0, St0), - {tuple|Ss,Eqt,Vt1,St1}; -from_pat({bin,_,Segs}, Vt0, St0) -> - {Ss,Eqt,Vt1,St1} = from_pat_bitsegs(Segs, Vt0, St0), - {binary|Ss,Eqt,Vt1,St1}; -from_pat({map,_,Assocs}, Vt0, St0) -> - {Ps,Eqt,Vt1,St1} = from_pat_map_assocs(Assocs, Vt0, St0), - {map|Ps,Eqt,Vt1,St1}; -from_pat({record,_,R,Fs}, Vt0, St0) -> %Match a record - MR = list_to_atom("match-" ++ atom_to_list(R)), - {Sfs,Eqt,Vt1,St1} = from_pat_rec_fields(Fs, Vt0, St0), - {MR|Sfs,Eqt,Vt1,St1}; -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}; -%% Basically illegal syntax which maybe generated by internal tools. -from_pat({call,_,{atom,_,F},As}, Vt0, St0) -> - %% This will never occur in real code but for macro expansions. - {Las,Eqt,Vt1,St1} = from_pat_list(As, Vt0, St0), - {F|Las,Eqt,Vt1,St1}. - -from_pat_list(P|Ps, Vt0, St0) -> - {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), - {Lps,Eqts,Vt2,St2} = from_pat_list(Ps, Vt1, St1), - {Lp|Lps,Eqt++Eqts,Vt2,St2}; -from_pat_list(, Vt, St) -> {,,Vt,St}. - -from_pat_map_assocs({map_field_exact,_,Key,Val}|As, Vt0, St0) -> - {Lk,Eqt1,Vt1,St1} = from_pat(Key, Vt0, St0), - {Lv,Eqt2,Vt2,St2} = from_pat(Val, Vt1, St1), - {Lfs,Eqt3,Vt3,St3} = from_pat_map_assocs(As, Vt2, St2), - {Lk,Lv|Lfs,Eqt1 ++ Eqt2 ++ Eqt3,Vt3,St3}; -from_pat_map_assocs(, 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) -> - {S,Eqt,Vt1,St1} = from_pat_bitseg(Seg, Size, Type, Vt0, St0), - {Ss,Eqts,Vt2,St2} = from_pat_bitsegs(Segs, Vt1, St1), - {S|Ss,Eqt++Eqts,Vt2,St2}; -from_pat_bitsegs(, Vt, St) -> {,,Vt,St}. - -from_pat_bitseg({string,_,S}, Size, Type, Vt0, St0) -> - {Lsize,Vt1,St1} = from_pat_bitseg_size(Size, Vt0, St0), - {S|from_bitseg_type(Type) ++ Lsize,,Vt1,St1}; -from_pat_bitseg(P, Size, Type, Vt0, St0) -> - {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), - {Lsize,Vt2,St2} = from_pat_bitseg_size(Size, Vt1, St1), - {Lp|from_bitseg_type(Type) ++ Lsize,Eqt,Vt2,St2}. - -from_pat_bitseg_size(default, Vt, St) -> {,Vt,St}; -from_pat_bitseg_size({var,_,V}, Vt, St) -> %Size vars never match - {size,V,Vt,St}; -from_pat_bitseg_size(Size, Vt0, St0) -> - {Ssize,_,Vt1,St1} = from_pat(Size, Vt0, St0), - {size,Ssize,Vt1,St1}. - -from_lit({nil,_}) -> ; -from_lit({integer,_,I}) -> I; -from_lit({float,_,F}) -> F; -from_lit({atom,_,A}) -> A; %Quoted atom -from_lit({string,_,S}) -> S; -from_lit({cons,_,H,T}) -> - cons,from_lit(H),from_lit(T); -from_lit({tuple,_,Es}) -> - tuple|from_lit_list(Es). - -from_lit_list(Es) -> from_lit(E) || E <- Es . - --record(to, {vc=0 %Variable counter - }). - -to_expr(E, L) -> - {Le,_} = to_expr(E, L, orddict:new(), #to{}), - Le. - -%% to_expr(Expr, LineNumber, VarTable, State) -> {Expr,State}. - -to_expr(, L, _, St) -> {{nil,L},St}; -to_expr(I, L, _, St) when is_integer(I) -> {{integer,L,I},St}; -to_expr(F, L, _, St) when is_float(F) -> {{float,L,F},St}; -to_expr(V, L, Vt, St) when is_atom(V) -> %Unquoted atom - to_expr_var(V, L, Vt, St); -to_expr(T, L, Vt, St0) when is_tuple(T) -> - {Es,St1} = to_expr_list(tuple_to_list(T), L, Vt, St0), - {{tuple,L,Es},St1}; -to_expr(?Q(V), L, _, St) -> {to_lit(V, L),St}; -to_expr(cons,H,T, L, Vt, St0) -> - {Eh,St1} = to_expr(H, L, Vt, St0), - {Et,St2} = to_expr(T, L, Vt, St1), - {{cons,L,Eh,Et},St2}; -to_expr(car,E, L, Vt, St0) -> - {Ee,St1} = to_expr(E, L, Vt, St0), - {{call,L,{atom,L,hd},Ee},St1}; -to_expr(cdr,E, L, Vt, St0) -> - {Ee,St1} = to_expr(E, L, Vt, St0), - {{call,L,{atom,L,tl},Ee},St1}; -to_expr(list|Es, L, Vt, St) -> - Fun = fun (E, {Tail,St0}) -> - {Ee,St1} = to_expr(E, L, Vt, St0), - {{cons,L,Ee,Tail},St1} - end, - foldr(Fun, {{nil,L},St}, Es); -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), - {{tuple,L,Ees},St1}; -to_expr(tref,T,I, L, Vt, St0) -> - {Et,St1} = to_expr(T, L, Vt, St0), - {Ei,St2} = to_expr(I, L, Vt, St1), - %% Get the argument order correct. - {{call,L,{atom,L,element},Ei,Et},St2}; -to_expr(tset,T,I,V, L, Vt, St0) -> - {Et,St1} = to_expr(T, L, Vt, St0), - {Ei,St2} = to_expr(I, L, Vt, St1), - {Ev,St2} = to_expr(V, L, Vt, St2), - %% Get the argument order correct. - {{call,L,{atom,L,setelement},Ei,Et,Ev},St2}; -to_expr(binary|Segs, L, Vt, St0) -> - {Esegs,St1} = to_bitsegs(Segs, L, Vt, St0), - {{bin,L,Esegs},St1}; -to_expr(map|Pairs, L, Vt, St0) -> - {Eps,St1} = to_map_pairs(Pairs, map_field_assoc, L, Vt, St0), - {{map,L,Eps},St1}; -to_expr(mref,Map,K, L, Vt, St) -> - to_expr(call,?Q(maps),?Q(get),K,Map, L, Vt, St); -to_expr(mset,Map|Pairs, L, Vt, St0) -> - {Em,St1} = to_expr(Map, L, Vt, St0), - {Eps,St2} = to_map_pairs(Pairs, map_field_assoc, L, Vt, St1), - {{map,L,Em,Eps},St2}; -to_expr(mupd,Map|Pairs, L, Vt, St0) -> - {Em,St1} = to_expr(Map, L, Vt, St0), - {Eps,St2} = to_map_pairs(Pairs, map_field_exact, L, Vt, St1), - {{map,L,Em,Eps},St2}; -to_expr('map-get',Map,K, L, Vt, St) -> - to_expr(mref,Map,K, L, Vt, St); -to_expr('map-set',Map|Ps, L, Vt, St) -> - to_expr(mset,Map|Ps, L, Vt, St); -to_expr('map-update',Map|Ps, L, Vt, St) -> - to_expr(mupd,Map|Ps, L, Vt, St); -%% Core closure special forms. -to_expr(lambda,As|B, L, Vt, St0) -> - {Ecl,St1} = to_fun_cl(As|B, L, Vt, St0), - {{'fun',L,{clauses,Ecl}},St1}; -to_expr('match-lambda'|Cls, L, Vt, St0) -> - {Ecls,St1} = to_fun_cls(Cls, L, Vt, St0), - {{'fun',L,{clauses,Ecls}},St1}; -to_expr('fun',F,A, L, _, St) -> {{'fun',L,{function,F,A}},St}; -to_expr('fun',M,F,A, L, _, St) -> {{'fun',L,{function,M,F,A}},St}; -to_expr('let',Lbs|B, L, Vt0, St0) -> - {Ebs,Vt1,St1} = to_let_bindings(Lbs, L, Vt0, St0), - {Eb,St2} = to_body(B, L, Vt1, St1), - {{block,L,Ebs ++ Eb},St2}; -%% Core control special forms. -to_expr(progn|B, L, Vt, St) -> to_block(B, L, Vt, St); -to_expr('if',Test,True, L, Vt, St) -> - to_expr('if',Test,True,?Q(false), L, Vt, St); -to_expr('if',Test,True,False, L, Vt, St0) -> - {Etest,St1} = to_expr(Test, L, Vt, St0), - {Ecls,St2} = to_icrt_cls(?Q(true),True,?Q(false),False, L, Vt, St1), - {{'case',L,Etest,Ecls},St2}; -to_expr('case',E|Cls, L, Vt, St0) -> - {Ee,St1} = to_expr(E, L, Vt, St0), - {Ecls,St2} = to_icrt_cls(Cls, L, Vt, St1), - {{'case',L,Ee,Ecls},St2}; -to_expr('receive'|Cls0, L, Vt, St0) -> - %% Get the right receive form depending on whether there is an after. - {Cls1,A} = splitwith(fun ('after'|_) -> false; (_) -> true end, Cls0), - {Ecls,St1} = to_icrt_cls(Cls1, L, Vt, St0), - case A of - 'after',T|B -> - {Et,St2} = to_expr(T, L, Vt, St1), - {Eb,St3} = to_body(B, L, Vt, St2), - {{'receive',L,Ecls,Et,Eb},St3}; - -> - {{'receive',L,Ecls},St1} - end; -%% Special known macros. -%% No record stuff here as they are macros which have been expanded. -to_expr(lc,Qs|Es, L, Vt0, St0) -> - {Eqs,Vt1,St1} = to_lc_quals(Qs, L, Vt0, St0), - {Ees,St2} = to_block(Es, L, Vt1, St1), - {{lc,L,Ees,Eqs},St2}; -%% General function calls. -to_expr(call,?Q(erlang),?Q(F)|As, L, Vt, St0) -> - %% This is semantically the same but some tools behave differently - %% (qlc_pt). - {Eas,St1} = to_expr_list(As, L, Vt, St0), - case is_erl_op(F, length(As)) of - true -> {list_to_tuple(op,L,F|Eas),St1}; - false -> - {{call,L,{remote,{atom,L,erlang},{atom,L,F}},Eas},St1} - end; -to_expr(call,M,F|As, L, Vt, St0) -> - {Em,St1} = to_expr(M, L, Vt, St0), - {Ef,St2} = to_expr(F, L, Vt, St1), - {Eas,St3} = to_expr_list(As, L, Vt, St2), - {{call,L,{remote,L,Em,Ef},Eas},St3}; -to_expr(F|As, L, Vt, St0) when is_atom(F) -> %General function call - {Eas,St1} = to_expr_list(As, L, Vt, St0), - case is_erl_op(F, length(As)) of - true -> {list_to_tuple(op,L,F|Eas),St1}; - false -> {{call,L,{atom,L,F},Eas},St1} - end; -to_expr(List, L, _, St) -> - case is_posint_list(List) of - true -> {{string,L,List},St}; - false -> - error({illegal_code,List}) %Not right! - end. - -to_expr_var(V, L, Vt, St) -> - Var = case orddict:find(V, Vt) of - {ok,V1} -> V1; - error -> V - end, - {{var,L,Var},St}. - -%% is_erl_op(Op, Arity) -> bool(). -%% Is Op/Arity one of the known Erlang operators? - -is_erl_op(Op, Ar) -> - erl_internal:arith_op(Op, Ar) - orelse erl_internal:bool_op(Op, Ar) - orelse erl_internal:comp_op(Op, Ar) - orelse erl_internal:list_op(Op, Ar) - orelse erl_internal:send_op(Op, Ar). - -to_body(Es, L, Vt, St) -> - Fun = fun (E, St0) -> to_expr(E, L, Vt, St0) end, - mapfoldl(Fun, St, Es). - -to_expr_list(Es, L, Vt, St) -> - Fun = fun (E, St0) -> to_expr(E, L, Vt, St0) end, - mapfoldl(Fun, St, Es). - -to_expr_list_s(Fun, L, Vt, St, E) -> Fun(E, L, Vt, St); -to_expr_list_s(Fun, L, Vt, St0, E|Es) -> - {Les,St1} = to_expr_list_s(Fun, L, Vt, St0, Es), - {Le,St2} = Fun(E, L, Vt, St1), - {{cons,L,Le,Les},St2}; -to_expr_list_s(_, L, _, St, ) -> {{nil,L},St}. - -to_pat_list_s(Fun, L, Vt, St, E) -> Fun(E, L, Vt, St); -to_pat_list_s(Fun, L, Vt0, St0, E|Es) -> - {Les,Vt1,St1} = to_pat_list_s(Fun, L, Vt0, St0, Es), - {Le,Vt2,St2} = Fun(E, L, Vt1, St1), - {{cons,L,Le,Les},Vt2,St2}; -to_pat_list_s(_, L, Vt, St, ) -> {{nil,L},Vt,St}. - -%% to_block(Expressions, LineNumber, VarTable, State) -> {Block,State}. -%% Don't generate {block,...} if only one expression, though -%% semantically the same some tools can't handle it (qlc_pt). - -to_block(Es, L, Vt, St0) -> - case to_expr_list(Es, L, Vt, St0) of - {Ee,St1} -> {Ee,St1}; %No need to wrap - {Ees,St1} -> {{block,L,Ees},St1} %Must wrap - end. - -%% to_bitsegs(Segs, LineNumber, VarTable, State) -> {Segs,State}. -%% This gives a verbose value, but it is correct. - -to_bitsegs(Ss, L, Vt, St) -> - Fun = fun (S, St0) -> to_bitseg(S, L, Vt, St0) end, - mapfoldl(Fun, St, Ss). - -to_bitseg(Val|Specs=F, L, Vt, St) -> - case is_posint_list(F) of - true -> - {Size,Type} = to_bitspecs(), - to_bin_element(F, Size, Type, L, Vt, St); - false -> - {Size,Type} = to_bitspecs(Specs), - to_bin_element(Val, Size, Type, L, Vt, St) - end; -to_bitseg(Val, L, Vt, St) -> - {Size,Type} = to_bitspecs(), - to_bin_element(Val, Size, Type, L, Vt, St). - -to_bin_element(Val, Size, {Type,Unit,Sign,End}, L, Vt, St0) -> - {Eval,St1} = to_expr(Val, L, Vt, St0), - {Esiz,St2} = to_bin_size(Size, L, Vt, St1), - {{bin_element,L,Eval,Esiz,Type,to_bin_unit(Unit),Sign,End},St2}. - -to_bin_size(default, _, _, St) -> {default,St}; -to_bin_size(undefined, _, _, St) -> {default,St}; -to_bin_size(Size, L, Vt, St) -> to_expr(Size, L, Vt, St). - -to_bin_unit(default) -> default; -to_bin_unit(Unit) -> {unit,Unit}. - -%% to_bitspec(Specs) -> {Size,Type}. -%% Get the error handling as we want it. - -to_bitspecs(Ss) -> - case lfe_bits:get_bitspecs(Ss) of - {ok,Sz,Ty} -> {Sz,Ty}; - {error,Error} -> erlang:error(Error) - end. - -%% to_map_pairs(Pairs, LineNumber, VarTable, State) -> {Fields,State}. - -to_map_pairs(K,V|Ps, Field, L, Vt, St0) -> - {Ek,St1} = to_expr(K, L, Vt, St0), - {Ev,St2} = to_expr(V, L, Vt, St1), - {Eps,St3} = to_map_pairs(Ps, Field, L, Vt, St2), - {{Field,L,Ek,Ev}|Eps,St3}; -to_map_pairs(, _, _, _, St) -> {,St}. - -%% to_let_bindings(Bindings, LineNumber, VarTable, State) -> -%% {Block,VarTable,State}. -%% When we have a guard translate into a case but special case where -%% we have an empty guard. - -to_let_bindings(Lbs, L, Vt, St) -> - Fun = fun (P,E, Vt0, St0) -> - {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0), - {Ee,St2} = to_expr(E, L, Vt0, St1), - {{match,L,Ep,Ee},Vt1,St2}; - (P,'when',E, Vt0, St0) -> %Just to keep it short - {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0), - {Ee,St2} = to_expr(E, L, Vt0, St1), - {{match,L,Ep,Ee},Vt1,St2}; - (P,'when'|G,E, Vt0, St0) -> - {Ee,St1} = to_expr(E, L, Vt0, St0), - {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, - mapfoldl2(Fun, Vt, St, Lbs). - -%% to_icrt_cls(Clauses, LineNumber, VarTable, State) -> {Clauses,State}. -%% to_icrt_cl(Clause, LineNumber, VarTable, State) -> {Clause,State}. -%% If/case/receive/try clauses. - -to_icrt_cls(Cls, L, Vt, St) -> - Fun = fun (Cl, St0) -> to_icrt_cl(Cl, L, Vt, St0) end, - mapfoldl(Fun, St, Cls). - -to_icrt_cl(P,'when'|G|B, L, Vt0, St0) -> - {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0), - {Eg,St2} = to_body(G, L, Vt1, St1), - {Eb,St3} = to_body(B, L, Vt1, St2), - {{clause,L,Ep,Eg,Eb},St3}; -to_icrt_cl(P|B, L, Vt0, St0) -> - {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0), - {Eb,St2} = to_body(B, L, Vt1, St1), - {{clause,L,Ep,,Eb},St2}. - -%% to_fun_cls(Clauses, LineNumber) -> Clauses. -%% to_fun_cl(Clause, LineNumber) -> Clause. -%% Function clauses. - -to_fun_cls(Cls, L, Vt, St) -> - Fun = fun (Cl, St0) -> to_fun_cl(Cl, L, Vt, St0) end, - mapfoldl(Fun, St, Cls). - -to_fun_cl(As,'when'|G|B, L, Vt0, St0) -> - {Eas,Vt1,St1} = to_pat_list(As, L, Vt0, St0), - {Eg,St2} = to_body(G, L, Vt1, St1), - {Eb,St3} = to_body(B, L, Vt1, St2), - {{clause,L,Eas,Eg,Eb},St3}; -to_fun_cl(As|B, L, Vt0, St0) -> - {Eas,Vt1,St1} = to_pat_list(As, L, Vt0, St0), - {Eb,St2} = to_body(B, L, Vt1, St1), - {{clause,L,Eas,,Eb},St2}. - -%% to_lc_quals(Qualifiers, LineNumber, VarTable, State) -> -%% {Qualifiers,VarTable,State}. -%% Can't use mapfoldl2 as guard habling modifies Qualifiers. - -to_lc_quals('<-',P,E|Qs, L, Vt0, St0) -> - {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0), - {Ee,St2} = to_expr(E, L, Vt1, St1), - {Eqs,Vt2,St3} = to_lc_quals(Qs, L, Vt1, St2), - {{generate,L,Ep,Ee}|Eqs,Vt2,St3}; -to_lc_quals('<-',P,'when'|G,E|Qs, L, Vt, St) -> - to_lc_quals('<-',P,E|G ++ Qs, L, Vt, St); %Move guards to tests -to_lc_quals(T|Qs, L, Vt0, St0) -> - {Et,St1} = to_expr(T, L, Vt0, St0), - {Eqs,Vt1,St2} = to_lc_quals(Qs, L, Vt0, St1), - {Et|Eqs,Vt1,St2}; -to_lc_quals(, _, Vt, St) -> {,Vt,St}. - -%% new_to_var(State) -> {VarName, State}. -new_to_var(#to{vc=C}=St) -> - V = list_to_atom(lists:concat("___",C,"___")), - {V,St#to{vc=C+1}}. - -%% to_pat(Pattern, LineNumber, VarTable, State) -> {Pattern,VarTable,State}. - -to_pat(, L, Vt, St) -> {{nil,L},Vt,St}; -to_pat(I, L, Vt, St) when is_integer(I) -> {{integer,L,I},Vt,St}; -to_pat(F, L, Vt, St) when is_float(F) -> {{float,L,F},Vt,St}; -to_pat(V, L, Vt, St) when is_atom(V) -> %Unquoted atom - to_pat_var(V, L, Vt, St); -to_pat(T, L, Vt, St) when is_tuple(T) -> %Tuple literal - Es = to_lit_list(tuple_to_list(T), L), - {{tuple,L,Es},Vt,St}; -to_pat(?Q(P), L, Vt, St) -> %Everything quoted here - {to_lit(P, L),Vt,St}; -to_pat(cons,H,T, L, Vt0, St0) -> - {Eh,Et,Vt1,St1} = to_pat_list(H,T, L, Vt0, St0), - {{cons,L,Eh,Et},Vt1,St1}; -to_pat(list|Es, L, Vt, St) -> - Fun = fun (E, {Tail,Vt0,St0}) -> - {Ee,Vt1,St1} = to_pat(E, L, Vt0, St0), - {{cons,L,Ee,Tail},Vt1,St1} - end, - foldr(Fun, {{nil,L},Vt,St}, Es); -to_pat('list*'|Es, L, Vt, St) -> - to_pat_list_s(fun to_pat/4, L, Vt, St, Es); -to_pat(tuple|Es, L, Vt0, St0) -> - {Ees,Vt1,St1} = to_pat_list(Es, L, Vt0, St0), - {{tuple,L,Ees},Vt1,St1}; -to_pat(binary|Segs, L, Vt0, St0) -> - {Esegs,Vt1,St1} = to_pat_bitsegs(Segs, L, Vt0, St0), - {{bin,L,Esegs},Vt1,St1}; -to_pat(map|Pairs, L, Vt0, St0) -> - {As,Vt1,St1} = to_pat_map_pairs(Pairs, L, Vt0, St0), - {{map,L,As},Vt1,St1}; -to_pat('=',P1,P2, L, Vt0, St0) -> %Alias - {Ep1,Vt1,St1} = to_pat(P1, L, Vt0, St0), - {Ep2,Vt2,St2} = to_pat(P2, L, Vt1, St1), - {{match,L,Ep1,Ep2},Vt2,St2}. - -to_pat_list(Ps, L, Vt, St) -> - Fun = fun (P, Vt0, St0) -> to_pat(P, L, Vt0, St0) end, - mapfoldl2(Fun, Vt, St, Ps). - -to_pat_var(V, L, Vt, St0) -> - case orddict:is_key(V, Vt) of - true -> - {V1,St1} = new_to_var(St0), - {{var,L,V1},orddict:store(V, V1, Vt),St1}; - false -> - {{var,L,V},orddict:store(V, V, Vt),St0} - end. - -to_pat_map_pairs(K,V|Ps, L, Vt0, St0) -> - {Ek,Vt1,St1} = to_pat(K, L, Vt0, St0), - {Ev,Vt2,St2} = to_pat(V, L, Vt1, St1), - {Eps,Vt3,St3} = to_pat_map_pairs(Ps, L, Vt2, St2), - {{map_field_exact,L,Ek,Ev}|Eps,Vt3,St3}; -to_pat_map_pairs(, _, Vt, St) -> {,Vt,St}. - -%% to_pat_bitsegs(Segs, LineNumber, VarTable, State) -> {Segs,State}. -%% This gives a verbose value, but it is correct. - -to_pat_bitsegs(Ss, L, Vt, St) -> - Fun = fun (S, Vt0, St0) -> to_pat_bitseg(S, L, Vt0, St0) end, - mapfoldl2(Fun, Vt, St, Ss). - -to_pat_bitseg(Val|Specs=F, L, Vt, St) -> - case is_posint_list(F) of - true -> - {Size,Type} = to_bitspecs(), - to_pat_bin_element(F, Size, Type, L, Vt, St); - false -> - {Size,Type} = to_bitspecs(Specs), - to_pat_bin_element(Val, Size, Type, L, Vt, St) - end; -to_pat_bitseg(Val, L, Vt, St) -> - {Size,Type} = to_bitspecs(), - to_pat_bin_element(Val, Size, Type, L, Vt, St). - -to_pat_bin_element(Val, Size, {Type,Unit,Sign,End}, L, Vt0, St0) -> - {Eval,Vt1,St1} = to_pat(Val, L, Vt0, St0), - {Esiz,Vt2,St2} = to_pat_bin_size(Size, L, Vt1, St1), - {{bin_element,L,Eval,Esiz,Type,to_bin_unit(Unit),Sign,End},Vt2,St2}. - -to_pat_bin_size(default, _, Vt, St) -> {default,Vt,St}; -to_pat_bin_size(undefined, _, Vt, St) -> {default,Vt,St}; -to_pat_bin_size(Size, L, Vt, St) -> to_pat(Size, L, Vt, St). - -to_lit(, L) -> {nil,L}; -to_lit(I, L) when is_integer(I) -> {integer,L,I}; -to_lit(F, L) when is_float(F) -> {float,L,F}; -to_lit(V, L) when is_atom(V) -> {atom,L,V}; %Quoted atom here! -to_lit(H|T, L) -> - {cons,L,to_lit(H, L),to_lit(T, L)}; -to_lit(T, L) when is_tuple(T) -> - {tuple,L,to_lit_list(tuple_to_list(T), L)}. - -to_lit_list(Ps, L) -> to_lit(P, L) || P <- Ps . - - -is_posint_list(I|Is) when is_integer(I), I >= 0 -> - is_posint_list(Is); -is_posint_list() -> true; -is_posint_list(_) -> false. - -%% mapfoldl2(Fun, Acc1, Acc2, List) -> {List,Acc1,Acc2}. -%% Like normal mapfoldl but with 2 accumulators. - -mapfoldl2(Fun, A0, B0, E0|Es0) -> - {E1,A1,B1} = Fun(E0, A0, B0), - {Es1,A2,B2} = mapfoldl2(Fun, A1, B1, Es0), - {E1|Es1,A2,B2}; -mapfoldl2(_, A, B, ) -> {,A,B}.
View file
_service:tar_scm:lfe-1.3.tar.gz/test/prop_lfe_doc.erl
Deleted
@@ -1,161 +0,0 @@ -%% Copyright (c) 2016 Eric Bailey -%% -%% 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 : prop_lfe_doc.erl -%% Author : Eric Bailey -%% Purpose : PropEr tests for the lfe_doc module. - --module(prop_lfe_doc). - --export(prop_define_lambda/0,prop_define_match/0). - --include_lib("proper/include/proper.hrl"). - -%%%=================================================================== -%%% Properties -%%%=================================================================== - -prop_define_lambda() -> ?FORALL(Def, define_lambda(), validate(Def)). - -prop_define_match() -> ?FORALL(Def, define_match(), validate(Def)). - -validate({'define-function',Name,_Doc,Def,_}=Func) -> - validate_function(Name, function_arity(Def), Func); -validate({'define-macro',Name,_Doc,_Def,_}=Mac) -> - validate_macro(Name, Mac). - -function_arity(lambda,Args|_) -> length(Args); -function_arity('match-lambda',Pat|_|_) -> length(Pat). - -validate_function(Name, Arity, {_Define,_Name,Meta,_Def,Line}=Func) -> - case lfe_doc:extract_module_docs(Func) of - {ok,{,Fdoc}} -> - (lfe_doc:collect_docs(Meta, ) =:= lfe_doc:function_doc(Fdoc)) - and (Name =:= lfe_doc:function_name(Fdoc)) - and (Arity =:= lfe_doc:function_arity(Fdoc)) - and (Line =:= lfe_doc:function_line(Fdoc)); - _ -> false - end. - -validate_macro(Name, {_Define,_Name,Meta,_Lambda,Line}=Mac) -> - case lfe_doc:extract_module_docs(Mac) of - {ok,{,Mdoc}} -> - (lfe_doc:collect_docs(Meta, ) =:= lfe_doc:macro_doc(Mdoc)) - and (Name =:= lfe_doc:macro_name(Mdoc)) - and (Line =:= lfe_doc:macro_line(Mdoc)); - _ -> false - end. - -%%%=================================================================== -%%% Definition shapes -%%%=================================================================== - -define_lambda() -> - {'define-function',atom1(),meta_with_doc(),lambda(),line()}. - -define_match() -> - ?LET(D, define(), {D,atom1(),meta_with_doc(),'match-lambda'(D),line()}). - - -%%%=================================================================== -%%% Custom types -%%%=================================================================== - -%%% Definitions - -define() -> oneof('define-function','define-macro'). - -lambda() -> lambda,arglist_simple()|body(). - -'match-lambda'('define-function') -> - 'match-lambda'|non_empty(list(function_pattern_clause())); -'match-lambda'('define-macro') -> - 'match-lambda'|non_empty(list(macro_pattern_clause())). - -arglist_simple() -> list(atom1()). - -atom1() -> oneof(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,''). - -body() -> non_empty(list(form())). - -form() -> union(form_elem(),atom1()|list(form_elem())). - -form_elem() -> union(non_string_term(),printable_string(),atom1()). - -meta_with_doc() -> doc,docstring(). - -docstring() -> printable_string(). - -line() -> pos_integer(). - - -%%% Patterns - -pattern() -> union(non_string_term(),printable_string(),pattern_form()). - -pattern_form() -> - oneof('=','++*',, - backquote,quote, - binary,cons,list,map,tuple, - match_fun()) - | body(). - -match_fun() -> 'match-record'. - -macro_pattern_clause() -> pattern_clause(rand_arity(), true). - -function_pattern_clause() -> pattern_clause(rand_arity(), false). - -pattern_clause(Arity, Macro) -> - arglist_patterns(Arity, Macro)|oneof(guard(),form())|body(). - -arglist_patterns(Arity, false) -> vector(Arity, pattern()); -arglist_patterns(Arity, true) -> vector(Arity, pattern()),'$ENV'. - -guard() -> 'when'|non_empty(list(union(logical_clause(),comparison()))). - - -%%% Logical clauses - -logical_clause() -> - X = union(atom1(),comparison()), - logical_operator(),X|non_empty(list(X)). - -logical_operator() -> oneof('and','andalso','or','orelse'). - - -%%% Comparisons - -comparison() -> comparison_operator(),atom1()|list(atom1()). - -comparison_operator() -> oneof('==','=:=','=/=','<','>','=<','>='). - - -%%% Strings and non-strings - -non_string_term() -> - union(atom1(),number(),,bitstring(),binary(),boolean(),tuple()). - -printable_char() -> union(integer(32, 126),integer(160, 255)). - -printable_string() -> list(printable_char()). - - -%%% Rand compat - --ifdef(NEW_RAND). -rand_arity() -> rand:uniform(10). --else. -rand_arity() -> random:uniform(10). --endif.
View file
_service:tar_scm:lfe-2.1.1.tar.gz/.github
Added
+(directory)
View file
_service:tar_scm:lfe-2.1.1.tar.gz/.github/workflows
Added
+(directory)
View file
_service:tar_scm:lfe-2.1.1.tar.gz/.github/workflows/cicd.yml
Added
@@ -0,0 +1,113 @@ +name: ci/cd + +on: + workflow_dispatch: + push: + branches: master, release/*, task/*, feature/*, bugfix/*, develop + pull_request: + branches: master, release/*, task/*, feature/*, bugfix/*, develop + +jobs: + + builds: + name: Newer builds - OTP ${{ matrix.otp-version }} / ${{ matrix.os }} + runs-on: ubuntu-latest + + strategy: + fail-fast: false + matrix: + otp-version: '22', '23', '24', '25' + os: 'ubuntu-latest' + + container: + image: erlang:${{ matrix.otp-version }} + + steps: + - uses: actions/checkout@v2 + - name: Erlang version check + run: erl -noshell -eval 'erlang:display(erlang:system_info(system_version))' -eval 'init:stop()' + - name: Rebar version check + run: rebar3 -v + - name: Compile (with rebar3) + run: rebar3 compile + - name: Run eunit Tests + run: make eunit + - name: Run proper Tests + run: make proper + - name: CT Suite Tests + run: make ct + + installs: + name: Newer installs - OTP ${{ matrix.otp-version }} / ${{ matrix.os }} + needs: builds + runs-on: ubuntu-latest + + strategy: + fail-fast: false + matrix: + otp-version: '22', '23', '24', '25' + os: 'ubuntu-latest' + + container: + image: erlang:${{ matrix.otp-version }} + + steps: + - uses: actions/checkout@v2 + - name: Erlang version check + run: erl -noshell -eval 'erlang:display(erlang:system_info(system_version))' -eval 'init:stop()' + - name: Compile (with make) + run: make compile + - name: Install + run: make install PREFIX=$(mktemp -d) + + + older-builds: + name: Older builds - OTP ${{ matrix.otp-version }} / ${{ matrix.os }} + runs-on: ubuntu-18.04 + + strategy: + fail-fast: false + matrix: + otp-version: '19', '20', '21' + os: 'ubuntu-18.04' + + container: + image: erlang:${{ matrix.otp-version }} + + steps: + - uses: actions/checkout@v2 + - name: Erlang version check + run: erl -noshell -eval 'erlang:display(erlang:system_info(system_version))' -eval 'init:stop()' + - name: Rebar version check + run: rebar3 -v + - name: Compile (with rebar3) + run: rebar3 compile + - name: Run eunit Tests + run: make eunit + - name: Run proper Tests + run: make proper + - name: CT Suite Tests + run: make ct + + older-installs: + name: Older installs - OTP ${{ matrix.otp-version }} / ${{ matrix.os }} + needs: older-builds + runs-on: ubuntu-18.04 + + strategy: + fail-fast: false + matrix: + otp-version: '19', '20', '21' + os: 'ubuntu-18.04' + + container: + image: erlang:${{ matrix.otp-version }} + + steps: + - uses: actions/checkout@v2 + - name: Erlang version check + run: erl -noshell -eval 'erlang:display(erlang:system_info(system_version))' -eval 'init:stop()' + - name: Compile (with make) + run: make compile + - name: Install + run: make install PREFIX=$(mktemp -d)
View file
_service:tar_scm:lfe-1.3.tar.gz/.gitignore -> _service:tar_scm:lfe-2.1.1.tar.gz/.gitignore
Changed
@@ -15,3 +15,8 @@ doc/pdf/* ebin/* erl_crash.dump +*~ +\#*\# +.\#* +.emacs.desktop +.emacs.desktop.lock \ No newline at end of file
View file
_service:tar_scm:lfe-1.3.tar.gz/Dockerfile -> _service:tar_scm:lfe-2.1.1.tar.gz/Dockerfile
Changed
@@ -1,44 +1,13 @@ -# Base image +# LFE Docker images are now based entirely upon the official Erlang Docker +# images which include both Debian and Alpine images. # -# VERSION 0.2 -FROM debian:latest -MAINTAINER LFE Maintainers <maintainers@lfe.io> - -ENV DEBIAN_FRONTEND noninteractive -RUN apt-get update -RUN apt-get install -y --no-install-recommends \ - apt-utils \ - build-essential -RUN apt-get install -y --no-install-recommends \ - ca-certificates \ - libcurl4-openssl-dev \ - curl \ - wget \ - git -RUN apt-get install -y --no-install-recommends \ - libsctp1 libsctp-dev lksctp-tools -RUN apt-get install -y --no-install-recommends \ - pandoc - -ENV ERLANG_DEB1 erlang-solutions_1.0_all.deb -ENV ERLANG_DEB2 esl-erlang_19.1.3-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.6.0 && \ - ./bootstrap && \ - cp rebar /usr/local/bin - -ADD . /opt/erlang/lfe -RUN cd /opt/erlang/lfe && make install - -ENV ERL_LIBS=$ERL_LIBS:/opt/erlang/lfe -ENV DEBIAN_FRONTEND "" -CMD /usr/bin/lfe -eval "(io:format \"~p~n\" (list (* 2 (lists:foldl #'+/2 0 (lists:seq 1 6)))))" +# Resources: +# * Erlang images: https://hub.docker.com/_/erlang +# * LFE images: https://hub.docker.com/r/lfex/lfe/tags +# * LFE Dockerfiles repo: https://github.com/lfex/dockerfiles +# +# Note: The last link has lots of usage examples in the README file. +# Note: The latest version is an image which contains the most recently +# released LFE and Erlang versions. +# +FROM lfex/lfe:latest
View file
_service:tar_scm:lfe-1.3.tar.gz/Makefile -> _service:tar_scm:lfe-2.1.1.tar.gz/Makefile
Changed
@@ -1,4 +1,4 @@ -# Copyright (c) 2016 Robert Virding +# Copyright (c) 2016-2020 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,25 +21,26 @@ LSRCDIR = src INCDIR = include EMACSDIR = emacs +HOSTCC ?= $(CC) PREFIX ?= /usr/local INSTALL = install INSTALL_DIR = $(INSTALL) -m755 -d INSTALL_DATA = $(INSTALL) -m644 INSTALL_BIN = $(INSTALL) -m755 DESTLIBDIR := $(PREFIX)/lib/lfe +DESTINCDIR := $(DESTLIBDIR)/$(INCDIR) DESTEBINDIR := $(DESTLIBDIR)/$(EBINDIR) DESTBINDIR := $(DESTLIBDIR)/$(BINDIR) VPATH = $(SRCDIR) -MKDIR_P = mkdir -p MANDB = $(shell which mandb) -ERLCFLAGS = -W1 -ERLC = erlc +ERLCFLAGS = -W1 +debug_info +ERLC ?= erlc -LFECFLAGS = -pa ../lfe -LFEC = $(BINDIR)/lfe $(BINDIR)/lfec +LFECFLAGS = -pa ../lfe +debug-info +LFEC = $(BINDIR)/lfescript $(BINDIR)/lfec APP_DEF = lfe.app LIB=lfe @@ -72,10 +73,10 @@ .SUFFIXES: .erl .beam $(BINDIR)/%: $(CSRCDIR)/%.c - cc -o $@ $< + $(HOSTCC) -o $@ $< $(EBINDIR)/%.beam: $(SRCDIR)/%.erl - @$(MKDIR_P) $(EBINDIR) + @$(INSTALL_DIR) $(EBINDIR) $(ERLC) -I $(INCDIR) -o $(EBINDIR) $(COMP_OPTS) $(ERLCFLAGS) $< %.erl: %.xrl @@ -89,7 +90,7 @@ all: compile -.PHONY: compile erlc-compile lfec-compile erlc-lfec emacs install docs clean docker-build docker-push docker update-mandb +.PHONY: compile erlc-compile lfec-compile erlc-lfec emacs install install-beam install-bin install-man docs clean docker-build docker-push docker update-mandb compile: comp_opts.mk $(MAKE) $(MFLAGS) erlc-lfec @@ -117,17 +118,30 @@ -include comp_opts.mk -$(BINDIR)/lfe%: - $(INSTALL_BIN) $@ $(DESTBINDIR) +install: compile install-include install-beam install-bin install-man -install: compile install-man +install-include: + $(INSTALL_DIR) $(DESTINCDIR) + $(INSTALL_DATA) $(INCDIR)/* $(DESTINCDIR) + +install-beam: rm -Rf $(DESTEBINDIR) $(INSTALL_DIR) $(DESTEBINDIR) - $(INSTALL_DATA) $(EBINDIR)/$(APP_DEF) $(DESTEBINDIR) - $(INSTALL_DATA) $(addprefix $(EBINDIR)/, $(EBINS)) $(DESTEBINDIR) - $(INSTALL_DATA) $(addprefix $(EBINDIR)/, $(LBINS)) $(DESTEBINDIR) + $(INSTALL_DATA) \ + $(EBINDIR)/$(APP_DEF) \ + $$(printf '%s\n' $(addprefix $(EBINDIR)/, $(EBINS)) | sort -u) \ + $(addprefix $(EBINDIR)/, $(LBINS)) \ + $(DESTEBINDIR) + +install-bin: $(INSTALL_DIR) $(DESTBINDIR) - $(MAKE) $(BINDIR)/lfe $(BINDIR)/lfec $(BINDIR)/lfedoc $(BINDIR)/lfescript + $(INSTALL_BIN) \ + $(BINDIR)/lfe \ + $(BINDIR)/lfec \ + $(BINDIR)/lfedoc \ + $(BINDIR)/lfescript \ + $(DESTBINDIR) + $(INSTALL_DIR) $(PREFIX)/bin ln -sf $(DESTBINDIR)/* $(PREFIX)/bin/ clean: @@ -152,6 +166,33 @@ regenerate-parser: erl -noshell -eval 'spell1:file("src/lfe_parse", report,verbose,{outdir,"./src/"},{includefile,code:lib_dir(spell1,include) ++ "/spell1inc.hrl"}), init:stop().' +############### +### TESTING ### +############### + +# XXX for some reason, the first pass of eunit doesn't run the tests?! +eunit: + @rebar3 as test do compile,eunit,eunit + +# XXX We've had to limit 'n' to 20, since the default count of 100 was +# causing VM crashes due to atom-table filling. Note, however: +# * 'prop_lfe_docs:prop_define_lambda' works just fine with 100 tests +# * 'prop_lfe_docs:prop_define_match' is the one that crashes the VM +proper: + @rebar3 as test do compile,proper -n 20 + +common-test: + @rebar3 as test do compile,ct + +ct: common-test + +tests: + @rebar3 as test do compile,eunit,eunit,proper -n 20,ct + +##################### +### DOCUMENTATION ### +##################### + # Targets for generating docs and man pages DOCDIR = doc DOCSRC = $(DOCDIR)/src @@ -211,16 +252,16 @@ $(DOCDIR)/%.txt: export GROFF_NO_SGR=1 $(DOCDIR)/%.txt: $(MANDIR)/%.1 - groff -t -e -mandoc -Tutf8 -Kutf8 $< | col -bx > $@ + groff -t -e -mandoc -Tutf8 $< | col -bx > $@ $(DOCDIR)/%.txt: $(MANDIR)/%.3 - groff -t -e -mandoc -Tutf8 -Kutf8 $< | col -bx > $@ + groff -t -e -mandoc -Tutf8 $< | col -bx > $@ $(DOCDIR)/%.txt: $(MANDIR)/%.7 - groff -t -e -mandoc -Tutf8 -Kutf8 $< | col -bx > $@ + groff -t -e -mandoc -Tutf8 $< | col -bx > $@ $(PDFDIR): - @$(MKDIR_P) $(PDFDIR) + @$(INSTALL_DIR) $(PDFDIR) docs-pdf: $(PDFDIR) \ $(addprefix $(PDFDIR)/, $(PDF1S)) \ @@ -228,16 +269,16 @@ $(addprefix $(PDFDIR)/, $(PDF7S)) $(PDFDIR)/%.pdf: $(DOCSRC)/%.1.md - pandoc -f markdown --latex-engine=xelatex -o $@ $< + pandoc -f markdown --pdf-engine=xelatex -o $@ $< $(PDFDIR)/%.pdf: $(DOCSRC)/%.3.md - pandoc -f markdown --latex-engine=xelatex -o $@ $< + pandoc -f markdown --pdf-engine=xelatex -o $@ $< $(PDFDIR)/%.pdf: $(DOCSRC)/%.7.md - pandoc -f markdown --latex-engine=xelatex -o $@ $< + pandoc -f markdown --pdf-engine=xelatex -o $@ $< $(EPUBDIR): - @$(MKDIR_P) $(EPUBDIR) + @$(INSTALL_DIR) $(EPUBDIR) docs-epub: $(EPUBDIR) \ $(addprefix $(EPUBDIR)/, $(EPUB1S)) \ @@ -254,7 +295,7 @@ pandoc -f markdown -t epub -o $@ $< $(MANINSTDIR)/man%: - @$(MKDIR_P) -p $@ + @$(INSTALL_DIR) $@ ifeq (,$(findstring mandb,$(MANDB))) install-man: $(MANINSTDIR)/man1 $(MANINSTDIR)/man3 $(MANINSTDIR)/man7 @@ -290,6 +331,3 @@ docker-docs-bash: docker run -i -v `pwd`/doc:/docs -t lfex/lfe-docs:latest bash -travis: - @rebar3 ct - @rebar3 eunit -m clj-tests,prop_lfe_doc
View file
_service:tar_scm:lfe-1.3.tar.gz/README.md -> _service:tar_scm:lfe-2.1.1.tar.gz/README.md
Changed
@@ -1,6 +1,6 @@ # LFE -!Travis(https://img.shields.io/travis/rvirding/lfe.svg)(https://travis-ci.org/rvirding/lfe) +!Build Status(https://github.com/lfe/lfe/workflows/ci%2Fcd/badge.svg)(https://github.com/lfe/lfe/actions) !Hex.pm version(https://img.shields.io/hexpm/v/lfe.svg)(https://hex.pm/packages/lfe) !Hex.pm downloads(https://img.shields.io/hexpm/dt/lfe.svg)(https://hex.pm/packages/lfe) !Hex.pm weekly downloads(https://img.shields.io/hexpm/dw/lfe.svg)(https://hex.pm/packages/lfe) @@ -16,7 +16,7 @@ To compile LFE, simple clone it and compile: ```shell -$ git clone https://github.com/rvirding/lfe.git +$ git clone https://github.com/lfe/lfe.git $ cd lfe $ make compile ``` @@ -163,3 +163,9 @@ the docs, you'll want to read the instructions here: * Updating LFE Documentation(doc/src/updating_docs.md) + +## Join the Community + +LFE on Slack(https://lfe.slack.com), join by requesting an invite here(https://erlef.org/slack-invite/lfe) + +LFE Forum - Erlang Forums(https://erlangforums.com/lfe)
View file
_service:tar_scm:lfe-1.3.tar.gz/VERSION -> _service:tar_scm:lfe-2.1.1.tar.gz/VERSION
Changed
@@ -1,1 +1,1 @@ -1.3 +2.1.1
View file
_service:tar_scm:lfe-1.3.tar.gz/bin/lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/bin/lfe
Changed
@@ -1,5 +1,5 @@ #! /bin/sh -# Copyright (c) 2008-2014 Robert Virding +# Copyright (c) 2008-2020 Robert Virding # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -52,13 +52,13 @@ # First step over the flag section adding them to the end. while "$i" -gt 0 ; do case "$1" in - -e | -eval) # We are going to eval + -e | -eval | -lfe_eval) # We are going to eval e="-lfe_eval" - break ;; # delay removing this + break ;; # delay removing this -h | --help) - $(show_help) # Show help + $(show_help) # Show help exit 1 ;; - -extra | --) # We are explicitly done + -extra | --) # We are explicitly done shift ; i=`expr $i - 1` break ;; -* | +*) # Flags
View file
_service:tar_scm:lfe-1.3.tar.gz/bin/lfe-first-try -> _service:tar_scm:lfe-2.1.1.tar.gz/bin/lfe-first-try
Changed
@@ -1,5 +1,5 @@ #!/bin/sh -# Copyright (c) 2008-2014 Robert Virding +# Copyright (c) 2008-2020 Robert Virding # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/bin/lfe-test -> _service:tar_scm:lfe-2.1.1.tar.gz/bin/lfe-test
Changed
@@ -1,5 +1,5 @@ #!/bin/sh -# Copyright (c) 2008-2014 Robert Virding +# Copyright (c) 2008-2020 Robert Virding # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/bin/lfec -> _service:tar_scm:lfe-2.1.1.tar.gz/bin/lfec
Changed
@@ -1,6 +1,6 @@ -#! /usr/bin/env lfe -;; -*- mode: lfe; -*- -;; Copyright (c) 2008-2014 Robert Virding. +#! /usr/bin/env lfescript +;; -*- mode: lfe -*- +;; Copyright (c) 2008-2020 Robert Virding. ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -39,14 +39,16 @@ (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))) + (parse-opts as (cons 'to-expand opts))) ((cons "-L" as) opts (parse-opts as (cons 'to-lint opts))) + ((cons "-A" as) opts + (parse-opts as (cons 'to-erlang opts))) ((cons "-S" as) opts (parse-opts as (cons 'to-asm opts))) ((cons "-P" as) opts ;Ignore as no LFE counterpart @@ -61,7 +63,7 @@ (defun usage () (let ((usage (++ "Usage: lfec options file ...\n\n" - "Options:\n" + "Options:\n\n" "-h Print usage and exit\n" "-I name Name of include directory\n" "-o name Name of output directory\n" @@ -71,14 +73,17 @@ "-Werror Make all warnings into errors\n" "-Wnumber Set warning level (ignored)\n" "-D Equivalent to +debug-print\n" + "-E Equivalent to +to-expand\n" "-L Equivalent to +to-lint\n" - "-E Equivalent to +to-exp\n" + "-A Equivalent to +to-erlang\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, +no-docs, +to-exp, +to-lint, +to-core0, +to-core, +to-kernel, +to-asm\n" - "+{outdir, Dir}, +report, +return, +debug-print\n"))) + "+binary, +no-docs, +to-exp, +to-lint, +to-core0, +to-core, +to-kernel,\n" + "+to-asm, +{outdir, Dir}, +report, +return, +debug-print\n\n" + "Example:\n\n" + "$ lfec -I include -o ebin examples/ring.lfe\n\n"))) (io:put_chars usage))) (defun compile-file (file opts) @@ -96,11 +101,12 @@ (() _ 'ok)) ;; Parse the arguments and compile the files. -(case script-args - (() (usage)) - (as0 - (fix-code-path) - (let ((`#(,files ,opts1) (parse-opts as0 ()))) - (case (compile-files files (list* 'verbose 'report opts1)) - ('error (halt 1)) - ('ok 'ok))))) +(defun main (script-args) + (case script-args + (() (usage)) + (as0 + (fix-code-path) + (let ((`#(,files ,opts1) (parse-opts as0 ()))) + (case (compile-files files (list* 'verbose 'report opts1)) + ('error (halt 1)) + ('ok 'ok))))))
View file
_service:tar_scm:lfe-1.3.tar.gz/bin/lfedoc -> _service:tar_scm:lfe-2.1.1.tar.gz/bin/lfedoc
Changed
@@ -1,6 +1,6 @@ #!/usr/bin/env lfe ;; -*- mode: lfe; -*- -;; Copyright (c) 2016 Eric Bailey. +;; Copyright (c) 2016-2020 Eric Bailey. ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -41,7 +41,7 @@ (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))) @@ -49,7 +49,7 @@ (parse-opts as opts)) ((cons "--" as) opts (tuple as opts)) - ((cons (++* "+to" _) as) opts ;Ignore this here + ((cons (++ "+to" _) as) opts ;Ignore this here (parse-opts as opts)) ((cons (cons #\+ s) as) opts (let ((`#(ok ,t) (lfe_io:read_string s)))
View file
_service:tar_scm:lfe-1.3.tar.gz/bin/lfescript -> _service:tar_scm:lfe-2.1.1.tar.gz/bin/lfescript
Changed
@@ -1,5 +1,5 @@ #! /bin/sh -# Copyright (c) 2008-2015 Robert Virding +# Copyright (c) 2008-2020 Robert Virding # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -121,7 +121,14 @@ # The following works for rebar and erl.mk PROJ_LIBS=$(find_libs "./deps") # The following works for rebar3 -R3_PROJ_LIBS=$(find_libs "./_build/${REBAR_PROFILE:-default}/deps"):$(find_libs "./_build/${REBAR_PROFILE:-default}/lib") +if -d "$REBAR_DEPS_DIR" ; then + # Use $REBAR_DEPS_DIR if set... + R3_PROJ_LIBS=$(find_libs "$REBAR_DEPS_DIR") +else + # ... otherwise provide a sensible default + R3_PROJ_LIBS=$(find_libs "./_build/${REBAR_PROFILE:-default}/deps"):$(find_libs "./_build/${REBAR_PROFILE:-default}/lib") +fi 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
_service:tar_scm:lfe-1.3.tar.gz/c_src/lfeexec.c -> _service:tar_scm:lfe-2.1.1.tar.gz/c_src/lfeexec.c
Changed
@@ -1,5 +1,5 @@ /* - * Copyright (c) 2008-2014 Robert Virding + * Copyright (c) 2008-2020 Robert Virding * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/dev/record-test.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/dev/record-test.lfe
Changed
@@ -21,6 +21,9 @@ (defun d (p c) (tuple (point-x p) (circle-radius c))) +(defun d2 + (p (when (=:= (point-y p) 99)) 'ok)) + (defun e (p c) (tuple (case p ((match-point x x) x)
View file
_service:tar_scm:lfe-1.3.tar.gz/dev/record_test.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/dev/record_test.erl
Changed
@@ -21,6 +21,9 @@ d(P, C) -> {P#point.x,C#circle.radius}. +d2(PP) when (element(2, PP))#point.y =:= 99 -> + (element(2, PP))#point.x. + e(P, C) -> {case P of #point{x=X} -> X;
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe.txt
Changed
@@ -37,14 +37,6 @@ Clear the REPL output. - (doc | describe Mod) - - (doc | describe Mod:Mac) - - (doc | describe Mod:Fun/Arity) - - Print out documentation of a module/macro/function. - (ec File Options) Compile and load an Erlang file. @@ -66,11 +58,23 @@ Print usage info. + (h Mod) + + (h Mod Mac) + + (h Mod Fun Arity) + + Print out help information of a module/macro/function. + (i (list Pid ...)) Print information about a list of pids. If no list is given then print information about currently running processes in the system. + (i x y z) + + Print information about the about #Pid<x.y.z> + (l Module ...) Load modules. @@ -117,7 +121,7 @@ (reset-environment) Resets the environment to its initial state. This will clear all vari‐ - ables, functions an macros that have been set. + ables, functions and macros that have been set. (run File) @@ -165,7 +169,7 @@ *, **, *** - The values of the previous 3 expressions. + The values of the previous three expressions. - @@ -199,9 +203,11 @@ Flags that LFE recognizes include the following: + · -nobanner - starts LFE without showing the banner + · -h or --help - provides command line usage help - · -e or -eval - evaluates a given sexpr + · -e or -eval - evaluates a given sexpr in a string · -prompt - users may supply a value here to override the default lfe> prompt; note that -prompt classic will set the prompt to the original @@ -212,14 +218,24 @@ taining the string ~node (which will be substituted with the actual name of the node). + There can be multiple string expressions to be evaluated; each one must + be prefixed with an -e or -eval. String expressions are run in the LFE + repl so shell commands and functions are allowed. They are all run in + the same invocation of the repl so: + + $ lfe -e "(set aaa 42)" -e "(set bbb 84)" -e "(pp (tuple aaa bbb))" + #(42 84) + + If there are string expressions then the LFE repl will not be run. + RUNNING LFE SHELL SCRIPTS - The LFE shell can also be directly called to run LFE shell scripts + The LFE shell can also be directly called to run LFE shell scripts with: lfe flags file args - This will start the shell, run a script with LFE shell commands and - then terminate the shell. The following built-in variables are also + This will start the shell, run a script with LFE shell commands and + then terminate the shell. The following built-in variables are also bound: script-name @@ -231,6 +247,14 @@ A list of the arguments to the script as strings. If no arguments have been given then this will be an empty list. + Note that if there are any string expressions to be evaluated then + these must come before the name of the script file and its arguments. + These expressions will be evaluated before the script and the script + will use the environment from the string expressions. + + It is possible to run both string expressions and an LFE shell script + and they are then run in the same LFE repl. + SEE ALSO lfescript(1), lfe_guide(7) lfe_doc(3) @@ -239,4 +263,4 @@ - 2008-2016 lfe(1) + 2008-2020 lfe(1)
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_bits.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_bits.txt
Changed
@@ -16,7 +16,7 @@ {error,Error}. Parse a bitspec and return the data. Unmentioned fields get the value - 'default'. + `default'. get_bitspecs(Specs) -> @@ -24,7 +24,7 @@ {error,Error}. Parse a bitspec, apply defaults and return the data. Unmentioned - fields get the value 'default'. + fields get the value `default'. ERROR INFORMATION The following error values are returned:
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_cl.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_cl.txt
Changed
@@ -7,7 +7,7 @@ SYNOPSIS This module provides a set of Common Lisp functions and macros for use - in LFE. The definitions closely follow the CL definitions and won't be + in LFE. The definitions closely follow the CL definitions and won’t be documented here. DATA TYPES @@ -50,10 +50,10 @@ remprop symbol pname - Atoms (symbols) in LFE don't have property lists associated with them. - However, here we have experimented with having a global ETS table - lfe-symbol-plist which associates an atom with a property list. This - is very unLFEy, but quite fun. + Atoms (symbols) in LFE don’t have property lists associated with them. + However, here we have experimented with having a global ETS table lfe- + symbol-plist which associates an atom with a property list. This is + very unLFEy, but quite fun. Property list functions getf plist pname @@ -87,11 +87,11 @@ reduce function sequence - reduce function sequence 'initial-value x + reduce function sequence ’initial-value x - reduce function sequence 'from-end 'true + reduce function sequence ’from-end ’true - reduce function sequence 'initial-value x 'from-end 'true + reduce function sequence ’initial-value x ’from-end ’true Modifying sequences remove item sequence
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_clj.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_clj.txt
Changed
@@ -6,7 +6,7 @@ clj - LFE Clojure interface library. SYNOPSIS - This module provides Clojure-inpired functions and macros for use in + This module provides Clojure-inspired functions and macros for use in LFE. EXPORTS @@ -36,7 +36,7 @@ Equivalent to lambda. Threading Macros - Note: The original versions were copied from Tim Dysinger's lfesl repo + Note: The original versions were copied from Tim Dysinger’s lfesl repo here: https://github.com/lfex/lfesl/blob/master/include/thread.lfe @@ -132,7 +132,7 @@ Given an expression and a set of test/sexp pairs, thread x (via ->) through each sexp for which the corresponding test expression is - truthy, i.e. neither 'false nor 'undefined. Note that, unlike cond + truthy, i.e. neither 'false nor 'undefined. Note that, unlike cond branching, cond-> threading does not short circuit after the first truthy test expression. @@ -140,7 +140,7 @@ Given an expression and a set of test/sexp pairs, thread x (via ->>) through each sexp for which the corresponding test expression is - truthy, i.e. neither 'false nor 'undefined. Note that, unlike cond + truthy, i.e. neither 'false nor 'undefined. Note that, unlike cond branching, cond->> threading does not short circuit after the first truthy test expression. @@ -176,7 +176,7 @@ test-expr >> result-fn - where result-fn is a unary function, if (pred test-expr expr) returns + where result-fn is a unary function, if (pred test-expr expr) returns anything other than 'undefined or 'false, the clause is a match. If a binary clause matches, return result-expr. If a ternary clause @@ -196,7 +196,7 @@ (iff test . body) - Like Clojure's when. If test evaluates to anything other than 'false + Like Clojure’s when. If test evaluates to anything other than 'false or 'undefined, evaluate body in an implicit progn. (when-not test . body) @@ -336,8 +336,8 @@ of their string representations. N.B. Because Erlang characters are represented as integers, this will - not work for chars, e.g. #\a, which will be presented in the return - value as its integer value, i.e. "97". + not work for chars, e.g. #\a, which will be presented in the return + value as its integer value, i.e. "97". > (clj:str #\a "bc") "97bc" @@ -539,7 +539,7 @@ Return a nullary function that returns a cons cell with start as the head and a nullary function, (next func (funcall func start step) step) as the tail. The result can be treated as a (possibly infinite) lazy - list, which only computes subseqeuent values as needed. + list, which only computes subsequent values as needed. (lazy-seq seq) @@ -570,18 +570,18 @@ (drop n lst) - (drop 'all lst) + (drop ’all lst) Return a list of all but the first n elements in lst. If n is the atom all, return the empty list. (take n lst) - (take 'all lst) + (take ’all lst) Given a (possibly lazy) list lst, return a list of the first n elements of lst, or all elements if there are fewer than n. If n is the atom - all and lst is a "normal" list, return lst. + all and lst is a “normal” list, return lst. (split-at n lst) @@ -599,7 +599,7 @@ Return a list of lists of n items each, at offsets step apart. Use the elements of pad as necessary to complete the last partition up to n el‐ - ements. In case there are not enough padding elements, return a pari‐ + ements. In case there are not enough padding elements, return a parti‐ tion with less than n items. (partition-all n lst) @@ -654,8 +654,8 @@ (constantly x) - Return a unary function that returns x. N.B. This is like Haskell's - const rather than Clojure's constantly. + Return a unary function that returns x. N.B. This is like Haskell’s + const rather than Clojure’s constantly. (inc x)
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_comp.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_comp.txt
Changed
@@ -48,6 +48,10 @@ LFE code in the files .lint. No object files are produced. Mainly useful for debugging and interest. + · to_erlang, to-erlang - Print a listing of the Erlang AST in the file + .erl. 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 .core. No ob‐ ject files are produced. Mainly useful for debugging and interest. @@ -111,8 +115,8 @@ Compile the forms as an LFE module returning a binary. This function takes the same options as lfe_comp:file/1/2. When generating Errors - and Warnings the "line number" is the index of the form in which the - error occured. + and Warnings the “line number” is the index of the form in which the + error occurred. format_error(Error) -> Chars
View file
_service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_docs.txt
Added
@@ -0,0 +1,34 @@ +lfe_docs(3) lfe_docs(3) + + + +NAME + lfe_docs - Lisp Flavoured Erlang (LFE) documentation handling. + +SYNOPSIS + This module provides functions to parse docstrings in LFE module + sources in EEP48 format. + +EXPORTS + make_chunk(Mod, CompilerInfo) -> {ok,DocsChunk} + + Parse a module’s docstrings and return a documentation chunk. + + make_docs_info(Mod, CompilerInfo) -> {ok,DocsInfo} + + Parse a module’s docstrings and return the documentation info. + + get_module_docs(Module | Binary) -> {ok,DocsInfo} | {error,Error} + + Extract the documentation from a module documentation chunk and return + it in the documentation format of the current Erlang version. + +SEE ALSO + lfe_comp(3), lfe_macro(3) + +AUTHORS + Robert Virding. + + + + 2016 lfe_docs(3)
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_guide.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_guide.txt
Changed
@@ -3,10 +3,10 @@ NAME - lfe_guide - Lisp Flavoured Erlang User Guide + lfe_guide ‐ Lisp Flavoured Erlang User Guide -SYNPOSIS - Note: {{ ... }} is use to denote optional syntax. +SYNOPSIS + Note: {{ ... }} is used to denote optional syntax. LITERALS AND SPECIAL SYNTACTIC RULES Integers @@ -14,27 +14,27 @@ · Regular decimal notation: - 1234 -123 0 + 1234 ‐123 0 · Binary notation: - #b0 #b10101 #b-1100 + #b0 #b10101 #b‐1100 · Binary notation (alternative form): - #*0 #b*10101 #*-1100 + #*0 #*10101 #*‐1100 · Octal notation: - #o377 #o-111 + #o377 #o‐111 · Explicitly decimal notation: - #d1234 #d-123 #d0 + #d1234 #d‐123 #d0 · Hexadecimal notation: - #xc0ffe 0x-01 + #xc0ffe #x‐01 · Notation with explicit base (up to 36): @@ -50,58 +50,58 @@ #\x1f42d; In all these forms, the case of the indicating letter is not signifi‐ - cant, i.e. #b1010 and #B1010 are identical as are #16rf00 and #16Rf00. + cant, 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. #36rHel‐ - loWorld is valid and the same number as #36Rhelloworld and #36rHEL‐ + 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. #36rHel‐ + loWorld is valid and the same number as #36Rhelloworld and #36rHEL‐ LOWORLD. 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 + 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 num‐ + 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 num‐ bers: - 1.0 +1.0 -1.0 1.0e10 1.111e-10 + 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 be‐ - fore or after the decimal point if it is zero. E.g. the following are - not valid forms: 100. or .125. + The one thing to watch out for is that you cannot omit 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 + 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) then typing the ac‐ - tual unicode letter. + 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 view‐ + able with regular fonts. E.g. "Cat: \\x1f639;" might be easier to + type (and view on output devices without a Unicode font) then typing + the actual Unicode letter. Binary Strings Binary strings are just like list strings but they are represented dif‐ - ferently in the virtual machine. The simple syntax is #"...", e.g. - #"This is a binary string \n with some \"escaped\" and quot‐ - ed (\\x1f639;) characters" + ferently 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(...), de‐ - scribed below), e.g. #B("a"), #"a", and #B(97) are all the same binary + scribed below), e.g. #B("a"), #"a", and #B(97) are all the same binary string. Character Escaping @@ -109,7 +109,7 @@ escaped name: | Escaped name | Character | - |--------------+-----------------| + |‐‐‐‐‐‐‐‐‐‐‐‐‐‐+‐‐‐‐‐‐‐‐‐‐‐‐‐‐‐‐‐| | \b | Backspace | | \t | Tab | | \n | Newline | @@ -120,21 +120,21 @@ | \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. + 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 + 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(‐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 @@ -142,13 +142,13 @@ > #B((#"a" binary) (#"b" binary)) #"ab" - Learn more about "segments" of binary data e.g. in "Learn You Some Er‐ - lang (http://learnyousomeerlang.com/starting-out-for-real#bit-syntax)" - <http://learnyousomeerlang.com/starting-out-for-real#bit-syntax>. + Learn more about “segments” of binary data e.g. in “Learn You Some Er‐ + lang (http://learnyousomeerlang.com/starting‐out‐for‐real#bit‐syntax)” + <http://learnyousomeerlang.com/starting‐out‐for‐real#bit‐syntax>. Lists - Lists are formed either as ( ... ) or ... where the optional ele‐ - ments of the list are separated by some form or whitespace. For exam‐ + Lists are formed either as ( ... ) or ... where the optional ele‐ + ments of the list are separated by some form or whitespace. For exam‐ ple: () @@ -163,33 +163,33 @@ so valid. Maps - Maps are written as #M(key1 value1 key2 value2 ...) The empty map is + Maps are written as #M(key1 value1 key2 value2 ...) 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 sur‐ - prisingly 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). + Simple examples are foo, Foo, foo‐bar, :foo. But also somewhat sur‐ + prisingly 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, basically - all of the latin-1 character set without control character, whitespace, + Symbol names can contain a surprising breadth or characters, 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). + symbol’s name (but they are allowed as subsequent letters). I.e. these are all legal symbols: foo, foo, µ#, ±1, 451°F. - Symbols can be explicitly constructed by wrapping their name in verti‐ - cal bars, e.g. |foo|, |symbol name with spaces|. In this case the - name can contain any character of in the range from 0 to 255 (or even - none, i.e. || is a valid symbol). The vertical bar in the symbol name - needs to be escaped: |symbol with a vertical bar \| in its name| (simi‐ - larly you will obviously have to escape the escape character as well). + Symbols can be explicitly constructed by wrapping their name in verti‐ + cal bars, e.g. |foo|, |symbol name with spaces|. In this case the name + can contain any character of in the range from 0 to 255 (or even none, + i.e. || is a valid symbol). The vertical bar in the symbol name needs + to be escaped: |symbol with a vertical bar \| in its name| (similarly + you will obviously have to escape the escape character as well). Comments Comments come in two forms: line comments and block comments. @@ -198,8 +198,8 @@ line. Block comments are written as #| comment text |# where the comment text - may span multiple lines but my not contain another block comment, i.e. - it may not contain the character sequence #|. + may span multiple lines but my not contain another block comment, + i.e. it may not contain the character sequence #|. Evaluation While Reading #.(... some expression ...). E.g. #.(+ 1 1) will evaluate the (+ 1 1) @@ -217,27 +217,31 @@ (tset tuple index val) (binary seg ... ) (map key val ...) - (map-get m k) (map-set m k v ...) (map-update m k v ...) + (map‐size map) (msiz m) + (map‐get map key) (mref m k) + (map‐set map key val ...) (mset m k v ...) + (map‐update map key val ...) (mupd m k v ...) + (map‐remove map key ...) (mrem m k k ...) (lambda (arg ...) ...) - (match-lambda - ((arg ... ) {{(when e ...)}} ...) - Matches clauses + (match‐lambda + ((arg ... ) {{(when e ...)}} ...) ‐ Matches clauses ... ) - (function func-name arity) - Function references - (function mod-name func-name arity) + (function func‐name arity) ‐ Function reference + (function mod‐name func‐name arity) (let ((pat {{(when e ...)}} e) ...) ... ) - (let-function ((name lambda|match-lambda) - Local functions + (let‐function ((name lambda|match‐lambda) ‐ Local functions ... ) ... ) - (letrec-function ((name lambda|match-lambda) - Local functions + (letrec‐function ((name lambda|match‐lambda) ‐ Local functions ... ) ... ) - (let-macro ((name lambda-match-lambda) - Local macros + (let‐macro ((name lambda‐match‐lambda) ‐ Local macros ...) ...) (progn ... ) - (if test true-expr {{false-expr}}) + (if test true‐expr {{false‐expr}}) (case e (pat {{(when e ...)}} ...) ... )) @@ -251,19 +255,37 @@ {{(case ((pat {{(when e ...)}} ... ) ... ))}} {{(catch - (((tuple type value ignore) {{(when e ...)}} - - Must be tuple of length 3! + ((tuple type value stacktrace)|_ {{(when e ...)}} + ‐ Must be tuple of length 3 or just _! ... ) ... )}} {{(after ... )}}) (funcall func arg ... ) - (call mod func arg ... ) - Call to Mod:Func(Arg, ... ) + (call mod func arg ... ) ‐ Call to Mod:Func(Arg, ... ) - (define-module name meta-data attributes) - (extend-module meta-data attributes) + (define‐record name fields) + (record name field val ...) + (is‐record record name) + (record‐index name field) + (record‐field record name field) + (record‐update record name field val ...) - (define-function name meta-data lambda|match-lambda) - (define-macro name meta-data lambda|match-lambda) + (define‐struct fields) + (struct field val ...) + (is‐struct struct) + (is‐struct struct name) + (struct‐field struct name field) + (struct‐update struct name field val ...) + + (define‐module name meta‐data attributes) + (extend‐module meta‐data attributes) + + (define‐function name meta‐data lambda|match‐lambda) + (define‐macro name meta‐data lambda|match‐lambda) + + (define‐type type definition) + (define‐opaque‐type type definition) + (define‐function‐spec func spec) Basic macro forms (: mod func arg ... ) => @@ -272,44 +294,48 @@ (call 'mod 'func arg ... ) (? {{timeout {{default}} }}) (++ ... ) - (list* ...) - (let* (...) ... ) - (flet ((name (arg ...) {{doc-string}} ...) + (‐‐ ... ) + (list* ... ) + (let* (... ) ... ) + (flet ((name (arg ...) {{doc‐string}} ...) ...) ...) (flet* (...) ... ) - (fletrec ((name (arg ...) {{doc-string}} ...) + (fletrec ((name (arg ...) {{doc‐string}} ...) ...) ...) - (cond ... - {{(?= pat expr)}} - ... ) + (cond (test body ...) + ... + ((?= pat expr) ...) + ... + (else ...)) (andalso ... ) (orelse ... ) (fun func arity) (fun mod func arity) - (lc (qual ...) ...) - (list-comp (qual ...) ...) - (bc (qual ...) ...) - (binary-comp (qual ...) ...) - (match-spec ...) + (lc (qual ...) expr) + (list‐comp (qual ...) expr) + (bc (qual ...) bitstringexpr) + (binary‐comp (qual ...) bitstringexpr) + (ets‐ms ...) + (trace‐ms ...) Common Lisp inspired macros - (defun name (arg ...) {{doc-string}} ...) + (defun name (arg ...) {{doc‐string}} ...) (defun name - {{doc-string}} + {{doc‐string}} ((argpat ...) ...) ...) - (defmacro name (arg ...) {{doc-string}} ...) - (defmacro name arg {{doc-string}} ...) + (defmacro name (arg ...) {{doc‐string}} ...) + (defmacro name arg {{doc‐string}} ...) (defmacro name - {{doc-string}} + {{doc‐string}} ((argpat ...) ...) ...) (defsyntax name (pat exp) ...) - (macrolet ((name (arg ...) {{doc-string}} ...) + (macrolet ((name (arg ...) {{doc‐string}} ...) ...) ...) (syntaxlet ((name (pat exp) ...) @@ -319,48 +345,38 @@ (prog2 ...) (defmodule name ...) (defrecord name ...) - - Older Scheme inspired macros - (define (name arg ...) ...) - (define name lambda|match-lambda) - (define-syntax name - (syntax-rules (pat exp) ...)|(macro (pat body) ...)) - (let-syntax ((name ...) - ...) - ...) - (begin ...) - (define-record name ...) + (defstruct ...) Patterns - Written as normal data expressions where symbols are variables and use - quote to match explicit values. Binaries and tuples have special syn‐ + Written as normal data expressions where symbols are variables and use + quote to match explicit values. Binaries and tuples have special syn‐ tax. - {ok,X} -> (tuple 'ok x) - error -> 'error - {yes,X|Xs} -> (tuple 'yes (cons x xs)) - <<34,U:16,F/float>> -> (binary 34 (u (size 16)) (f float)) - P|Ps=All -> (= (cons p ps) all) + {ok,X} ‐> (tuple 'ok x) + error ‐> 'error + {yes,X|Xs} ‐> (tuple 'yes (cons x xs)) + <<34,U:16,F/float>> ‐> (binary 34 (u (size 16)) (f float)) + P|Ps=All ‐> (= (cons p ps) all) - Repeated variables are supported in patterns and there is an automatic + Repeated variables are supported in patterns and there is an automatic comparison of values. - _ as the "don't care" variable is supported. This means that the sym‐ - bol _, which is a perfectly valid symbol, can never be bound through + _ as the “don’t care” variable is supported. This means that the sym‐ + bol _, which is a perfectly valid symbol, can never be bound through pattern matching. - Aliases are defined with the (= pattern1 pattern2) pattern. As in Er‐ + Aliases are defined with the (= pattern1 pattern2) pattern. As in Er‐ lang patterns they can be used anywhere in a pattern. CAVEAT The lint pass of the compiler checks for aliases and if they are - possible to match. If not an error is flagged. This is not the best - way. Instead there should be a warning and the offending clause re‐ - moved, but later passes of the compiler can't handle this yet. + possible to match. If not an error is flagged. This is not the best + way. Instead there should be a warning and the offending clause re‐ + moved, but later passes of the compiler can’t handle this yet. Guards - Wherever a pattern occurs (in let, case, receive, lc, etc.) it can be - followed by an optional guard which has the form (when test ...). - Guard tests are the same as in vanilla Erlang and can contain the fol‐ + Wherever a pattern occurs (in let, case, receive, lc, etc.) it can be + followed by an optional guard which has the form (when test ...). + Guard tests are the same as in vanilla Erlang and can contain the fol‐ lowing guard expressions: (quote e) @@ -371,25 +387,32 @@ (tuple gexpr ...) (tref gexpr gexpr) (binary ...) - (progn gtest ...) - Sequence of guard tests - (if gexpr gexpr gexpr) - (type-test e) - (guard-bif ...) - Guard BIFs, arithmetic, + (record ...) ‐ Also the macro versions + (is‐record ...) + (record‐field ...) + (record‐index ...) + (map ...) + (msiz ...) (map‐size ...) + (mref ...) (map‐get ...) + (mset ...) (map‐set ...) + (mupd ...) (map‐update ...) + (type‐test e) ‐ Type tests + (guard‐bif ...) ‐ Guard BIFs, arithmetic, boolean and comparison operators - An empty guard, (when), always succeeds as there is no test which + An empty guard, (when), always succeeds as there is no test which fails. This simplifies writing macros which handle guards. Comments in Function Definitions - Inside functions defined with defun LFE permits optional comment - strings in the Common Lisp style after the argument list. So we can + Inside functions defined with defun LFE permits optional comment + strings in the Common Lisp style after the argument list. So we can have: (defun max (x y) "The max function." (if (>= x y) x y)) - Optional comments are also allowed in match style functions after the + Optional comments are also allowed in match style functions after the function name and before the clauses: (defun max @@ -397,7 +420,7 @@ ((x y) (when (>= x y)) x) ((x y) y)) - This is also possible in a similar style in local functions defined by + This is also possible in a similar style in local functions defined by flet and fletrec: (defun foo (x y) @@ -408,9 +431,9 @@ (m x y))) Variable Binding and Scoping - Variables are lexically scoped and bound by lambda, match-lambda and - let forms. All variables which are bound within these forms shadow - variables bound outside but other variables occurring in the bodies of + Variables are lexically scoped and bound by lambda, match‐lambda and + let forms. All variables which are bound within these forms shadow + variables bound outside but other variables occurring in the bodies of these forms will be imported from the surrounding environments.No vari‐ ables are exported out of the form. So for example the following func‐ tion: @@ -420,22 +443,22 @@ (zap x z)) (zop x y)) - The variable y in the call (zip y) comes from the function arguments. + The variable y in the call (zip y) comes from the function arguments. However, the x bound in the let will shadow the x from the arguments so - in the call (zap x z) the x is bound in the let while the z comes from - the function arguments. In the final (zop x y) both x and y come from + in the call (zap x z) the x is bound in the let while the z comes from + the function arguments. In the final (zop x y) both x and y come from the function arguments as the let does not export x. Function Binding and Scoping - Functions are lexically scoped and bound by the top-level defun and by - the macros flet and fletrec. LFE is a Lisp-2 so functions and vari‐ - ables have separate namespaces and when searching for function both + Functions are lexically scoped and bound by the top‐level defun and by + the macros flet and fletrec. LFE is a Lisp‐2 so functions and vari‐ + ables have separate namespaces and when searching for function both name and arity are used. This means that when calling a function which - has been bound to a variable using (funcall func-var arg ...) is re‐ - quired to call lambda/match-lambda bound to a variable or used as a + has been bound to a variable using (funcall func‐var arg ...) is re‐ + quired to call lambda/match‐lambda bound to a variable or used as a value. - Unqualified functions shadow as stated above which results in the fol‐ + Unqualified functions shadow as stated above which results in the fol‐ lowing order within a module, outermost to innermost: · Predefined Erlang BIFs @@ -444,62 +467,101 @@ · Imports - · Top-level defines + · Top‐level defines · Flet/fletrec · Core forms, these can never be shadowed - This means that it is perfectly legal to shadow BIFs by imports, - BIFs/imports by top-level functions and BIFs/imports/top-level by fle‐ - trecs. In this respect there is nothing special about BIfs, they just - behave as prefined imported functions, a whopping big (import (from er‐ - lang ...)). EXCEPT that we know about guard BIFs and expression BIFs. - If you want a private version of spawn then define it, there will be no - warnings. + This means that it is perfectly legal to shadow BIFs by imports, + BIFs/imports by top‐level functions and BIFs/imports/top‐level by fle‐ + trecs. In this respect there is nothing special about BIFs, they just + behave as predefined imported functions, a whopping big (import (from + erlang ...)). EXCEPT that we know about guard BIFs and expression + BIFs. If you want a private version of spawn then define it, there + will be no warnings. - CAVEAT This does not hold for the supported core forms. These can be - shadowed by imports or redefined but the compiler will always use the + CAVEAT This does not hold for the supported core forms. These can be + shadowed by imports or redefined but the compiler will always use the core meaning and never an alternative. Silently! Module definition + The basic forms for defining a module and extending its metadata and + attributes are: + + (define‐module name meta‐data attributes) + (extend‐module meta‐data attributes) + + The valid meta data is (type typedef ...), (opaque typedef ...), (spec + function‐spec ...) and (record record‐def ...). Each can take multiple + definitions in one meta form. + + Attributes declarations have the syntax (attribute value‐1 ...) where + the attribute value is a list off the values in the declaration + + To simplify defining modules there is a predefined macro: + (defmodule name "This is the module documentation." (export (f 2) (g 1) ... ) (export all) ;Export all functions (import (from mod (f1 2) (f2 1) ... ) - (rename mod ((f1 2) sune) ((f2 1) kurt) ... )) - (import (prefix mod mod-prefix)) - NYI - (attr-1 value-1 value-2) + (rename mod ((g1 2) m‐g1) ((g2 1) m‐g2) ... )) + (module‐alias (really‐long‐module‐name rlmn) ...) + (attr‐1 value‐1 value‐2) + {meta meta‐data ...) ... ) - Can have multiple export and import declarations within module declara‐ - tion. The (export all) declaration is allowed together with other ex‐ - port declarations and overrides them. Other attributes which are not - recognised by the compiler are allowed and are simply passed on to the - module and can be accessed through module_info/0-1. + We can have multiple export and import attributes within module decla‐ + ration. The (export all) attribute is allowed together with other ex‐ + port attributes and overrides them. Other attributes which are not + recognized by the compiler are allowed and are simply passed on to the + module and can be accessed with the module_info/0‐1 functions. -Parameterized modules - (defmodule (name par1 par2 ... ) - ... ) + In the import attribute the (from mod (f1 2) ...) means that the call + (f1 'everything 42) will be converted by the compiler to (mod:f1 'ev‐ + erything 42)) while the (rename mod ((g2 2) m‐g1) ...) means that the + call (m‐g1 'everything 42) will be converted to (mod:g1 'everything + 42). The rename form can be used as compact way of indicating the im‐ + ported function’s module. Note that when importing a module + + · the compiler does no checking on that module at all - Define a parameterized module which behaves the same way as in vanilla - Erlang. For now avoid defining functions 'new' and 'instance'. + · in the rename above the functions g1/2 and g2/1 aren’t automatically + imported, only the “renamed” functions. + + · we do not really see in the code that we are calling a function in + another module + + In the module‐alias attribute the (really‐long‐module‐name rlmn) decla‐ + ration means that the call (lrmn:foo 'everything 42) will be converted + by the compiler to (really‐long‐module‐name:foo 'everything 42). This + is often used to write short module names in the code when calling + functions in modules with long names. It is in many ways better than + using import as it does not hide that we are calling a function in an‐ + other module. Macros - Macro calls are expanded in both body and patterns. This can be very + Macro calls are expanded in both body and patterns. This can be very useful to have both make and match macros, but be careful with names. - A macro is function of two argument which is a called with a list of - the arguments to the macro call and the current macro environment. It - can be either a lambda or a match-lambda. The basic forms for defining + A macro is function of two arguments which is a called with a list of + the arguments to the macro call and the current macro environment. It + can be either a lambda or a match‐lambda. The basic forms for defining macros are: - (define-macro name meta-data lambda|match-lambda) - (let-macro ((name lambda|match-lambda) + (define‐macro name meta‐data lambda|match‐lambda) + (let‐macro ((name lambda|match‐lambda) ...) - Macros are definitely NOT hygienic in any form. + Macros are definitely NOT hygienic in any form. However, variable + scoping and variable immutability remove most of the things that can + cause unhygienic macros. It can be done but you are not going to do it + by mistake. The only real issue is if you happen to be using a vari‐ + able which has the same name as one which the macro generates, that can + cause problems. The work around for this is to give variables created + in the macro expansion really weird names like | ‐ foo ‐ | which no one + in their right mind would use. To simplify writing macros there are a number of predefined macros: @@ -514,7 +576,7 @@ ment list. For example: (defmacro double (a) `(+ ,a ,a)) - (defmacro my-list args `(list ,@args)) + (defmacro my‐list args `(list ,@args)) (defmacro andalso ((list e) `,e) ((cons e es) `(if ,e (andalso ,@es) 'false)) @@ -529,61 +591,64 @@ ment are exported outside the macro. User defined macros shadow the predefined macros so it is possible to - redefine the built-in macro definitions. However, see the caveat be‐ + redefine the built‐in macro definitions. However, see the caveat be‐ low! Yes, we have the backquote. It is implemented as a macro so it is ex‐ panded at macro expansion time. Local functions that are only available at compile time and can be - called by macros are defined using eval-when-compile: + called by macros are defined using eval‐when‐compile: (defmacro foo (x) ... - (foo-helper m n) + (foo‐helper m n) ...) - (eval-when-compile - (defun foo-helper (a b) + (eval‐when‐compile + (defun foo‐helper (a b) ...) ) - There can be many eval-when-compile forms. Functions defined within an - eval-when-compile are mutually recursive but they can only call other - local functions defined in an earlier eval-when-compile and macros de‐ - fined earlier in the file. Functions defined in eval-when-compile + There can be many eval‐when‐compile forms. Functions defined within an + eval‐when‐compile are mutually recursive but they can only call other + local functions defined in an earlier eval‐when‐compile and macros de‐ + fined earlier in the file. Functions defined in eval‐when‐compile which are called by macros can defined after the macro but must be de‐ fined before the macro is used. - Scheme's syntax rules are an easy way to define macros where the body - is just a simple expansion. These are supported with defsyntax and - syntaxlet. Note that the patterns are only the arguments to the macro - call and do not contain the macro name. So using them we would get: + Scheme’s syntax rules are an easy way to define macros where the body + is just a simple expansion. The are implemented the the module scm and + are supported with scm:define‐syntax and scm:let‐syntax and the equiva‐ + lent scm:defsyntax and scm:syntaxlet. Note that the patterns are only + the arguments to the macro call and do not contain the macro name. So + using them we would get: - (defsyntax andalso + (scm:defsyntax andalso (() 'true) ((e) e) ((e . es) (case e ('true (andalso . es)) ('false 'false)))) - N.B. These are definitely NOT hygienic. + There is an include file “include/scm.lfe” which defines macros so the + names don’t have to be prefixed with scm:. - CAVEAT While it is perfectly legal to define a Core form as a macro + CAVEAT While it is perfectly legal to define a Core form as a macro these will silently be ignored by the compiler. Comments in Macro Definitions - Inside macros defined with defmacro LFE permits optional comment - strings in the Common Lisp style after the argument list. So we can + Inside macros defined with defmacro LFE permits optional comment + strings in the Common Lisp style after the argument list. So we can have: (defmacro double (a) "Double macro." `(+ ,a ,a)) - Optional comments are also allowed in match style macros after the + Optional comments are also allowed in match style macros after the macro name and before the clauses: - (defmacro my-list args + (defmacro my‐list args "List of arguments." `(list ,@args)) @@ -593,7 +658,7 @@ ((cons e es) `(if ,e (andalso ,@es) 'false)) (() `'true)) - This is also possible in a similar style in local functions defined by + This is also possible in a similar style in local functions defined by macrolet: (defun foo (x y) @@ -604,85 +669,182 @@ (m x y))) Extended cond + The tests in cond are Erlang tests in that they should return either + true or false. If no test succeeds then the cond does not generate an + exception but just returns false. There is a simple catch‐all “test” + else which must last and can be used to handle when all tests fail. + Cond has been extended with the extra test (?= pat expr) which tests if - the result of expr matches pat. If so it binds the variables in pat - which can be used in the cond. A optional guard is allowed here. An - example: + the result of expr matches the pattern pat. If so it binds the vari‐ + ables in pat which can be used in the cond. A optional guard is al‐ + lowed here. An example: (cond ((foo x) ...) ((?= (cons x xs) (when (is_atom x)) (bar y)) (fubar xs (baz x))) ((?= (tuple 'ok x) (baz y)) (zipit x)) - ... ) + ... + (else 'yay)) Records Records are tuples with the record name as first element and the rest - of the fields in order exactly like "normal" Erlang records. As with - Erlang records the default default value is 'undefined'. + of the fields in order exactly like “normal” Erlang records. As with + Erlang records the default default value is the atom ‘undefined’. + + The basic forms for defining a record, creating, accessing and updating + it are: + + (define‐record name (field | (field) | + (field default‐value) | + (field default‐value type) ...)) + (record name field value field value ...) + (is‐record record name) + (record‐index name field) + (record‐field record name field) + (record‐update record name field value field value ...) + + Note that the list of field/value pairs when making or updating a + record is a flat list. + + Note that the old make‐record form has been deprecated and is replaced + by record which better matches other constructors like tuple and map. + It still exists but should not be used. + + We will explain these forms with a simple example. To define a record + we do: + + (define‐record person + ((name "") + (address "" (string)) + (age))) + + which defines a record person with the fields name (default value ""), + address (default value "" and type (string)) and age. To make an in‐ + stance of a person record we do: + + (record person name "Robert" age 54) + + The record form is also used to define a pattern. + + We can get the value of the address field in a person record and set it + by doing (the variable robert references a person record): + + (record‐field robert person address) + (record‐update robert person address "my home" age 55) + + Note that we must include the name of the record when accessing it and + there is no need to quote the record and field names as these are al‐ + ways literal atoms. + + To simplify defining and using records there is a predefined macro: (defrecord name - field - (field default-value) + (field) | field + (field default‐value) + (field default‐value type) ... ) - Will create access functions/macros for creation and accessing fields. - The make-, match- and set- forms takes optional argument pairs - field-name value to get non-default values. E.g. for + This will create access macros for record creation and accessing and + updating fields. The make‐, match‐ and update‐ forms takes optional + argument pairs field‐name value to get non‐default values. E.g. for (defrecord person (name "") - (address "") - age) + (address "" (string)) + (age)) the following will be generated: - (make-person {{field value}} ... ) - (match-person {{field value}} ... ) - (is-person r) - (fields-person) - (emp-person {{field value}} ... ) - (set-person r {{field value}} ... ) - (person-name r) - (person-name) - (set-person-name r name) - (person-age r) - (person-age) - (set-person-age r age) - (person-address r) - (set-person-address r address) - - · (make-person name "Robert" age 54) - Will create a new person record - with the name field set to "Robert", the age field set to 54 and the - address field set to the default "". - - · (match-person name name age 55) - Will match a person with age 55 and + (make‐person {{field value}} ... ) + (match‐person {{field value}} ... ) + (is‐person r) + (fields‐person) + (update‐person r {{field value}} ... ) + (person‐name r) + (person‐name) + (update‐person‐name r name) + (person‐age r) + (person‐age) + (update‐person‐age r age) + (person‐address r) + (person‐address) + (update‐person‐address r address) + + · (make‐person name "Robert" age 54) ‐ Will create a new person record + with the name field set to “Robert”, the age field set to 54 and the + address field set to the default ““. + + · (match‐person name name age 55) ‐ Will match a person with age 55 and bind the variable name to the name field of the record. Can use any variable name here. - · (is-person john) - Test if john is a person record. - - · (emp-person age '$1) - Create an Ets Match Pattern for record person - where the age field is set to $1 and all other fields are set to '_. + · (is‐person john) ‐ Test if john is a person record. - · (person-address john) - Return the address field of the person record + · (person‐address john) ‐ Return the address field of the person record john. - · (person-address) - Return the index of the address field of a person + · (person‐address) ‐ Return the index of the address field of a person record. - · (set-person-address john "back street") - Sets the address field of - the person record john to "back street". + · (update‐person‐address john "back street") ‐ Updates the address + field of the person record john to “back street”. + + · (update‐person john age 35 address "front street") ‐ In the person + record john update the age field to 35 and the address field to + “front street”. + + · (fields‐person) ‐ Returns a list of fields for the record. This is + useful for when using LFE with Mnesia, as the record field names + don’t have to be provided manually in the create_table call. + + · (size‐person) ‐ Returns the size of the record tuple. + + Note that the older now deprecated set‐ forms are still generated. + +Structs + Structs in LFE are the same as Elixir structs and have been defined in + the same way so to be truly compatible. This means that you can use + structs defined in Elixr from LFE and structs defined in LFE from + Elixir. + + (define‐struct (field | (field) | + (field default‐value) | + (field default‐value type) ...)) + (struct name field value field value ...) + (is‐struct struct) + (is‐struct struct name) + (struct‐field struct name field) + (struct‐update struct name field value field value ...) - · (set-person john age 35 address "front street") - In the person - record john set the age field to 35 and the address field to "front - street". + We will explain these forms with a simple example. To define a struct + we do: - · (fields-person) - Returns a list of fields for the record. This is - useful for when using LFE with Mnesia, as the record field names - don't have to be provided manually in the create_table call. + (define‐struct ((name "") + (address "" (string)) + (age))) - · (size-person) - Returns the size of the record tuple. + which defines a struct with the name of the current module with the + fields name (default value ""), address (default value "" and type + (string)) and age. To make an instance of struct we do: + + (struct mod‐name name "Robert" age 54) + + The struct form is also used to define a pattern. + + We can get the value of the address field in the struct and set it by + doing (the variable robert references a struct): + + (struct‐field robert mod‐name address) + (struct‐update robert mod‐name address "my home" age 55) + + Note that a struct automatically gets the name of the module in which + it is defined so that there can only be one struct defined in a module. + This mirrors how structs are implemented in Elixir. + + Note that we must include the name of the struct when accessing it and + there is no need to quote the struct and field names as these are al‐ + ways literal atoms. Binaries/bitstrings A binary is @@ -691,13 +853,14 @@ where seg is - byte - string - (val integer|float|binary|bitstring|bytes|bits - (size n) (unit n) - big-endian|little-endian|native-endian - big|little|native - signed|unsigned) + byte + string + (val integer | float | binary | bitstring | bytes | bits | + utf8 | utf‐8 | utf16 | utf‐16 | utf32 | utf‐32 + (size n) (unit n) + big‐endian | little‐endian | native‐endian + big | little | native + signed | unsigned) val can also be a string in which case the specifiers will be applied to every character in the string. As strings are just lists of inte‐ @@ -705,97 +868,101 @@ are allowed on input but they will always be written as bytes. Maps - A map is: + A map is created with: (map key value ... ) To access maps there are the following forms: - · (map-get map key) - Return the value associated with key in map. + · (map‐size map) ‐ Return the size of a map. - · (map-set map key val ... ) - Set keys in map to values. + · (map‐get map key) ‐ Return the value associated with the key in the + map. - · (map-update map key val ... ) - Update keys in map to values. Note - that this form requires all the keys to exist. + · (map‐set map key val ... ) ‐ Set the keys in the map to values. This + form can be used to update the values of existing keys and to add new + keys. - N.B. This syntax for processing maps has stablized but may change in - the future! + · (map‐update map key val ... ) ‐ Update the keys in the map to values. + Note that this form requires all the keys to already exist in the + map. - There is also an alternate short form map, mref, mset, mupd based on - the Maclisp array reference forms. They take the same arguments as - their longer alternatives. + · (map‐remove map key ... ) ‐ Remove the keys in the map. + + There are also alternate short forms msiz, mref, mset, mupd and mrem + based on the Maclisp array reference forms. They take the same argu‐ + ments as their longer alternatives. List/binary comprehensions - List/binary comprehensions are supported as macros. The syntax for + List/binary comprehensions are supported as macros. The syntax for list comprehensions is: - (lc (qual ...) expr ... ) - (list-comp (qual ...) expr ... ) + (lc (qual ...) expr) + (list‐comp (qual ...) expr) - where the final expr is used to generate the elements of the list. + where the last expr is used to generate the elements of the list. The syntax for binary comprehensions is: - (bc (qual ...) expr ... ) - (binary-comp (qual ...) expr ... ) + (bc (qual ...) bitstringexpr ) + (binary‐comp (qual ...) bitstringexpr) - where the final expr is a bitseg expr and is used to generate the ele‐ - ments of the binary. + where the final expr is a bitstring expression and is used to generate + the elements of the binary. The supported qualifiers, in both list/binary comprehensions are: - (<- pat {{guard}} list-expr) - Extract elements from list - (<= bin-pat {{guard}} binary-expr) - Extract elements from binary - (?= pat {{guard}} expr) - Match test and bind variables in pat - expr - Normal boolean test + (<‐ pat {{guard}} list‐expr) ‐ Extract elements from list + (<= bin‐pat {{guard}} binary‐expr) ‐ Extract elements from binary + expr ‐ Normal boolean test Some examples: - (lc ((<- v (when (> v 5)) l1) + (lc ((<‐ v (when (> v 5)) l1) (== (rem v 2) 0)) v) - returns a list of all the even elements of the list l1 which are + returns a list of all the even elements of the list l1 which are greater than 5. - (bc ((<= (f float (size 32)) b1) ;Only bitseg needed + (bc ((<= (binary (f float (size 32))) b1) (> f 10.0)) - (: io fwrite "~p\n" (list f)) - (f float (size 64))) ;Only bitseg needed + (progn + (: io fwrite "~p\n" (list f)) + (binary (f float (size 64))))) - returns a binary of floats of size 64 of floats which are larger than - 10.0 from the binary b1 and of size 32. The returned numbers are first - printed. + returns a binary of floats of size 64 bits which are from the binary b1 + where they are of size 32 bits and larger than 10.0. The returned num‐ + bers are first printed. N.B. A word of warning when using guards when extracting elements from - a binary. When a match/guard fails for a binary no more attempts will - be made to extract data from the binary. This means that even if a - value could be extracted from the binary if the guard fails this value + a binary. When a match/guard fails for a binary no more attempts will + be made to extract data from the binary. This means that even if a + value could be extracted from the binary if the guard fails this value will be lost and extraction will cease. This is NOT the same as having - following boolean test which may remove an element but will not stop + following boolean test which may remove an element but will not stop extraction. Using a guard is probably not what you want! Normal vanilla Erlang does the same thing but does not allow guards. ETS and Mnesia - Apart from (emp-record ...) macros for ETS Match Patterns, which are - also valid in Mnesia, LFE also supports match specifications and Query - List Comprehensions. The syntax for a match specification is the same - as for match-lambdas: + LFE also supports match specifications and Query List Comprehensions. + The syntax for a match specification is the same as for match‐lambdas: - (match-spec - ((arg ... ) {{(when e ...)}} ...) - Matches clauses + (ets‐ms + ((arg ... ) {{(when e ...)}} ...) ‐ Matches clauses ... ) For example: - (ets:select db (match-spec + (ets:select db (ets‐ms ((tuple _ a b) (when (> a 3)) (tuple 'ok b)))) - It is a macro which creates the match specification structure which is - used in ets:select and mnesia:select. The same match-spec macro can - also be used with the dbg module. The same restrictions as to what can - be done apply as for vanilla match specifications: + It is a macro which creates the match specification structure which is + used in ets:select and mnesia:select. For tracing instead of the ets‐ + ms macro there is the trace‐ms macro which is also used in conjunction + with the dbg module. The same restrictions as to what can be done ap‐ + ply as for vanilla match specifications: · There is only a limited number of BIFs which are allowed @@ -807,29 +974,29 @@ · For dbg it takes a single parameter which must a list or a variable N.B. the current macro neither knows nor cares whether it is being - used in ets/mnesia or in dbg. It is up to the user to get this right. + used in ets/mnesia or in dbg. It is up to the user to get this right. - Macros, especially record macros, can freely be used inside match + Macros, especially record macros, can freely be used inside match specs. - CAVEAT Some things which are known not to work in the current version + CAVEAT Some things which are known not to work in the current version are andalso, orelse and record updates. Query List Comprehensions - LFE supports QLCs for mnesia through the qlc macro. It has the same - structure as a list comprehension and generates a Query Handle in the - same way as with qlc:q(...). The handle can be used together with + LFE supports QLCs for mnesia through the qlc macro. It has the same + structure as a list comprehension and generates a Query Handle in the + same way as with qlc:q(...). The handle can be used together with all the combination functions in the module qlc. For example: - (qlc (lc ((<- (tuple k v) (: ets table e2)) (== k i)) v) + (qlc (lc ((<‐ (tuple k v) (: ets table e2)) (== k i)) v) {{Option}}) - Macros, especially record macros, can freely be used inside query list + Macros, especially record macros, can freely be used inside query list comprehensions. - CAVEAT Some things which are known not to work in the current version + CAVEAT Some things which are known not to work in the current version are nested QLCs and let/case/recieve which shadow variables. Predefined LFE functions @@ -838,8 +1005,8 @@ (<arith_op> expr ...) (<comp_op> expr ...) - The standard arithmentic operators, + - * /, and comparison operators, - > >= < =< == /= =:= =/= , can take multiple arguments the same as their + The standard arithmetic operators, + ‐ * /, and comparison operators, > + >= < =< == /= =:= =/= , can take multiple arguments the same as their standard lisp counterparts. This is still experimental and implemented using macros. They do, however, behave like normal functions and eval‐ uate ALL their arguments before doing the arithmetic/comparisons opera‐ @@ -848,58 +1015,267 @@ (acons key value list) (pairlis keys values {{list}}) (assoc key list) - (assoc-if test list) - (assoc-if-not test list) + (assoc‐if test list) + (assoc‐if‐not test list) (rassoc value list) - (rassoc-if test list) - (rassoc-if-not test list) + (rassoc‐if test list) + (rassoc‐if‐not test list) The standard association list functions. (subst new old tree) - (subst-if new test tree) - (subst-if-not new test tree) + (subst‐if new test tree) + (subst‐if‐not new test tree) (sublis alist tree) - The standard substituition functions. + The standard substitution functions. - (macroexpand-1 expr {{environment}}) + (macroexpand‐1 expr {{environment}}) If Expr is a macro call, does one round of expansion, otherwise returns Expr. (macroexpand expr {{environment}}) - Returns the expansion returned by calling macroexpand-1 repeatedly, + Returns the expansion returned by calling macroexpand‐1 repeatedly, starting with Expr, until the result is no longer a macro call. - (macroexpand-all expr {{environment}}) + (macroexpand‐all expr {{environment}}) - Returns the expansion from the expression where all macro calls have + Returns the expansion from the expression where all macro calls have been expanded with macroexpand. - NOTE that when no explicit environment is given the macroexpand func‐ - tions then only the default built-in macros will be expanded. Inside + NOTE that when no explicit environment is given the macroexpand func‐ + tions then only the default built‐in macros will be expanded. Inside macros and in the shell the variable $ENV is bound to the current macro environment. (eval expr {{environment}}) - Evaluate the expression expr. Note that only the pre-defined lisp - functions, erlang BIFs and exported functions can be called. Also no + Evaluate the expression expr. Note that only the pre‐defined lisp + functions, erlang BIFs and exported functions can be called. Also no local variables can be accessed. To access local variables the expr to be evaluated can be wrapped in a let defining these. For example if the data we wish to evaluate is in the variable expr and - it assumes there is a local variable "foo" which it needs to access + it assumes there is a local variable “foo” which it needs to access then we could evaluate it by calling: (eval `(let ((foo ,foo)) ,expr)) + Supplemental Common Lisp Functions + LFE provides the module cl which contains the following functions which + closely mirror functions defined in the Common Lisp Hyperspec. Note + that the following functions use zero‐based indices, like Common Lisp + (unlike Erlang, which start at index ‘1’). A major difference between + the LFE versions and the Common Lisp versions of these functions is + that the boolean values are the LFE 'true and 'false. Otherwise the + definitions closely follow the CL definitions and won’t be documented + here. + + cl:make‐lfe‐bool cl‐value + cl:make‐cl‐bool lfe‐bool + + cl:mapcar function list + cl:maplist function list + cl:mapc function list + cl:mapl function list + + cl:symbol‐plist symbol + cl:symbol‐name symbol + cl:get symbol pname + cl:get symbol pname default + cl:getl symbol pname‐list + cl:putprop symbol value pname + cl:remprop symbol pname + + cl:getf plist pname + cl:getf plist pname default + cl:putf plist value pname ; This does not exist in CL + cl:remf plist pname + cl:get‐properties plist pname‐list + + cl:elt index sequence + cl:length sequence + cl:reverse sequence + cl:some predicate sequence + cl:every predicate sequence + cl:notany predicate sequence + cl:notevery predicate sequence + cl:reduce function sequence + cl:reduce function sequence 'initial‐value x + cl:reduce function sequence 'from‐end 'true + cl:reduce function sequence 'initial‐value x 'from‐end 'true + + cl:remove item sequence + cl:remove‐if predicate sequence + cl:remove‐if‐not predicate sequence + cl:remove‐duplicates sequence + + cl:find item sequence + cl:find‐if predicate sequence + cl:find‐if‐not predicate sequence + cl:find‐duplicates sequence + cl:position item sequence + cl:position‐if predicate sequence + cl:position‐if‐not predicate sequence + cl:position‐duplicates sequence + cl:count item sequence + cl:count‐if predicate sequence + cl:count‐if‐not predicate sequence + cl:count‐duplicates sequence + + cl:car list + cl:first list + cl:cdr list + cl:rest list + cl:nth index list + cl:nthcdr index list + cl:last list + cl:butlast list + + cl:subst new old tree + cl:subst‐if new test tree + cl:subst‐if‐not new test tree + cl:sublis alist tree + + cl:member item list + cl:member‐if predicate list + cl:member‐if‐not predicate list + cl:adjoin item list + cl:union list list + cl:intersection list list + cl:set‐difference list list + cl:set‐exclusive‐or list list + cl:subsetp list list + + cl:acons key data alist + cl:pairlis list list + cl:pairlis list list alist + cl:assoc key alist + cl:assoc‐if predicate alost + cl:assoc‐if‐not predicate alost + cl:rassoc key alist + cl:rassoc‐if predicate alost + cl:rassoc‐if‐not predicate alost + + cl:type‐of object + cl:coerce object type + + Furthermore, there is an include file which developers may which to + utilize in their LFE programs: (include‐lib "lfe/include/cl.lfe"). + Currently this offers Common Lisp predicates, but may include other + useful macros and functions in the future. The provided predicate + macros wrap the various is_* Erlang functions; since these are expanded + at compile time, they are usable in guards. The include the following: + + (alivep x) + (atomp x) + (binaryp x) + (bitstringp x) + (boolp x) and (booleanp x) + (builtinp x) + (consp x) + (floatp x) + (funcp x) and (functionp x) + (intp x) and (integerp x) + (listp x) + (mapp x) + (numberp x) + (pidp x) + (process‐alive‐p x) + (recordp x tag) + (recordp x tag size) + (refp x) and (referencep x) + (tuplep x) + (vectorp x) + + Non‐predicate macros in lfe/include/cl.lfe include: + + (dolist ...) + (vector ...) + + Supplemental Clojure Functions + From LFE’s earliest days, it’s Lisp‐cousin Clojure (created around the + same time) has inspired LFE developers to create similar, BEAM‐versions + of those functions. These were collected in a separate library and + then expanded upon, until eventually becoming part of the LFE standard + library. + + Function definition macros: + + (clj:defn ...) + (clj:defn‐ ...) + (clj:fn ...) + + Threading macros: + + (clj:‐> ...) + (clj:‐>> ...) + (clj:as‐> ...) + (clj:cond‐> ...) + (clj:cond‐>> ...) + (clj:some‐> ...) + (clj:some‐>> ...) + (clj:doto ...) + + Conditional macros: + + (clj:if‐let ...) + (clj:iff‐let ...) + (clj:condp ...) + (clj:if‐not ...) + (clj:iff‐not ...) + (clj:when‐not ...) + (clj:not= ...) + + Predicate macros: + + (clj:atom? x) + (clj:binary? x) + (clj:bitstring? x) + (clj:bool? x) + (clj:boolean? x) + (clj:even? x) + (clj:false? x) + (clj:falsy? x) + (clj:float? x) + (clj:func? x) + (clj:function? x) + (clj:identical? x) + (clj:int? x) + (clj:integer? x) + (clj:map? x) + (clj:neg? x) + (clj:nil? x) + (clj:number? x) + (clj:odd? x) + (clj:pos? x) + (clj:record? x) + (clj:reference? x) + (clj:true? x) + (clj:tuple? x) + (clj:undef? x) + (clj:undefined? x) + (clj:zero? x) + + Other: + + (clj:str x) + (clj:lazy‐seq x) + (clj:conj ...) + (clj:if ...) + + Most of the above mentioned macros are available in the clj include + file, the use of which allows developers to forego the clj: prefix in + calls: + + (include‐lib "lfe/include/clj.lfe") + Notes - · NYI - Not Yet Implemented + · NYI ‐ Not Yet Implemented - · N.B. - Nota bene (note well) + · N.B. ‐ Nota bene (note well) SEE ALSO lfe(1), lfescript(1), lfe_cl(3) @@ -909,4 +1285,4 @@ - 2008-2016 lfe_guide(7) + 2008‐2020 lfe_guide(7)
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_io.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_io.txt
Changed
@@ -25,13 +25,13 @@ compiler to give better error information. EXPORTS - read(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo} + read(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo} | eof Read an s-expr from the standard input (IoDevice) with a prompt (Prompt). Note that this is not line-oriented in that it stops as soon as it has consumed enough characters. - read_line(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo} + read_line(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo} | eof Read an s-expr from the standard input (IoDevice) with a prompt (Prompt). Note that this is line-oriented in that it reads whole lines @@ -39,7 +39,8 @@ read_string(String) -> {ok,Sexpr} | {error,ErrorInfo} - Read an s-expr from String. + Read an s-expr from String. Note that this only reads from String dis‐ + carding left-over characters at the end of the string. print(IoDevice, Sexpr) -> ok @@ -49,6 +50,10 @@ Return the list of characters which represent the s-expr Sexpr. + prettyprint(IoDevice, Sexpr) -> ok + + Pretty print the s-expr Sexpr to the standard output (IoDevice). + prettyprint1(Sexpr) -> DeepCharList prettyprint1(Sexpr, Depth) -> DeepCharList @@ -57,8 +62,9 @@ prettyprint1(Sexpr, Depth, Indentation, LineLength) -> DeepCharList - Return the lost of characters which represents the prettyprinted s-expr - Sexpr. Assume we start at indentation Indentation or 0. + Return the list of characters which represents the prettyprinted s-expr + Sexpr. Default values for Depth is 30, Indentation is 0 and LineLength + is 80. format(IoDevice, Format, Args) -> ok @@ -133,4 +139,4 @@ - 2008-2016 lfe_io(3) + 2008-2019 lfe_io(3)
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_macro.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_macro.txt
Changed
@@ -25,22 +25,26 @@ This is an macro and evaluation environment as created by lfe_lib:new_env(). -EXPORTS - expand_forms(FileSexpr, Env) -> ExpRet + mac_state() - where + This is the internal state used by the macro expander. - FileSexpr = filesexpr() - Env = env() - ExpRet = {yes,FileSexpr,Env,Warnings} | {error,Errors,Warnings} +EXPORTS + expand_expr(Sexpr, Env) -> {yes,Exp} | no. - macro_forms(FileSexpr, Env) -> {FileSexpr,Env}. + expand_expr_1(Sexpr, Env) -> {yes,Exp} | no. where - FileSexpr = filesexpr() + 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 ex‐ + pand 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. + expand_expr_all(Sexpr, Env) -> Sexpr. where @@ -52,20 +56,49 @@ the default macros. Note that any eventual new macro definitions will be lost. - expand_expr(Sexpr, Env) -> {yes,Exp} | no. + expand_form_init(Deep, Keep) -> MacState - expand_expr_1(Sexpr, Env) -> {yes,Exp} | no. + where + + Deep = boolean() + Keep = boolean() + MacState = mac_state() + + Create an internal macro state. Deep determines whether the form is to + be expanded internally at depth and Keep whether macro definition forms + are to be kept. + + expand_fileforms(FileForm, Env, Deep, Keep) -> ExpRet + + expand_fileforms(FileForm, Env, MacState) -> ExpRet where - Sexpr = Exp = sexpr() - Env = env() + FileForm = filesexpr() + Env = env() + Deep = boolean() + Keep = boolean() + MacState = mac_state() + ExpRet = {yes,FileSexpr,Env,Warnings} | + {error,Errors,Warnings} - 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 ex‐ - pand 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. + expand a sequence of file forms. + + expand_form(Form, Line, Env, MacState) -> RetState + + expand_fileform(FileForm, Env, MacState) -> RetState + + where + + Form = sexpr() + FileForm = filesexpr() + Line = integer() + Env = env() + MacState = mac_state() + RetState = {ok,Form,Env,Macstate} | + {error,Errors,Warnings,MacState} + + Expand a file form using the environment and macro state. SEE ALSO lfe_comp(3), lfe_gen(3) @@ -75,4 +108,4 @@ - 2008-2016 lfe_macro(3) + 2008-2020 lfe_macro(3)
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfe_types.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfe_types.txt
Changed
@@ -24,9 +24,11 @@ (lambda () <type>) fun(() -> <type>) (lambda (<tlist>) <type>) fun((<tlist>) -> <type>) (map) map() - (map <pairlist>) #{<pairlist>} + #M() #{} + #M(<key> <value> ...) #{<pairlist>} (tuple) tuple() - (tuple <tlist>) {<tlist>} + #() {} + #(<tlist>) {<tlist>} (UNION <tlist>) <type> | <type> Apart from the predefined types in the Erlang type system we also have @@ -34,6 +36,10 @@ lambda and range. The usage of bitstring, tuple and map have also been extended. + Note that the type #M() is the empty map and the type #() is the empty + tuple. We can still use the older (map <key valuelist>) and (tuple + <tlist>) formats when declaring types for maps and tuples. + The general form of bitstrings is (bitstring m n) which denotes a bit‐ string which starts with m bits and continues with segments of n bits. (binary) is a short form for a sequence of bytes while (bitstring) is a @@ -57,7 +63,7 @@ (deftype bar (tuple 'bar (integer) (list))) Type Information in Record Declarations - (defrecord rec (field1 default1 type1) (field2 default2) field3) + (defrecord rec (field1 default1 type1) (field2 default2) (field3)) Fields with type annotations MUST give a default value and fields with‐ out type annotations get the default type (any). @@ -97,16 +103,27 @@ (defspec (remove-if 2) (pred (list) (list) (pred (lambda ((any)) (boolean))))) - Note that a constraint variable doesn't need to start with an up‐ - per-case like an Erlang variable, though in some case it may be easier - to read. + Note that a constraint variable doesn’t need to start with an upper- + case like an Erlang variable, though in some case it may be easier to + read. Note we are using the alternate list form with instead of parenthe‐ ses to make it easier to see the function arguments. +Types and function specifications in the module definition + Types can also be defined in the module declaration, for example: + + (defmodule this-module + ... + (type ((foo-type) (tuple 'foo (integer) (list))) + ((bar-type) (tuple 'bar (integer) (list)))) + (spec ((foo 1) ((integer) (foo-type))) + ((id 1) (x x ((x (tuple)))))) + ...) + AUTHORS Robert Virding. - 2016 lfe_types(7) + 2021 lfe_types(7)
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/lfescript.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/lfescript.txt
Changed
@@ -64,11 +64,11 @@ In the example the second line is an optional directive to Emacs which causes it to enter LFE mode when editing the script file. - The rest of the file contains LFE source code. It must always the - function main/1. When the script is run this function will be called - with a list of strings representing the arguments with which the script - was called. It is possible to define, include and use macros in the - source code. + The rest of the file contains LFE source code. It must always contain + the function main/1. When the script is run this function will be + called with a list of strings representing the arguments with which the + script was called. It is possible to define, include and use macros in + the source code. The source code is checked and warnings and errors will be printed. If there are errors the script will not run and it will terminate with ex‐ @@ -89,7 +89,7 @@ ENVIRONMENT VARIABLES LFESCRIPT_EMULATOR - The command used to start the emulator. Default is 'erl'. This can be + The command used to start the emulator. Default is `erl'. This can be useful for passing arguments into the emulator, for example LFESCRIPT_EMULATOR="erl -pa sune"
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe.1 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe.1
Changed
@@ -1,151 +1,155 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe" "1" "2008\-2016" "" "" +.TH "lfe" "1" "2008-2020" "" "" .hy .SH NAME .PP -lfe \- Lisp Flavoured Erlang (LFE) shell +lfe - Lisp Flavoured Erlang (LFE) shell .SH SYNOPSIS .PP -\fClfe\f is a simple LFE repl (read\-eval\-print loop) in which you +\fClfe\fR is a simple LFE repl (read-eval-print loop) in which you can enter sexprs which then are evaluated and the value printed. You can also define local functions and macros as well as set variables. It can read commands either from the standard input or from a file. .PP -The LFE repl is implemented in the module \fClfe_shell\f. -.SH BUILT\-IN SHELL FUNCTIONS +The LFE repl is implemented in the module \fClfe_shell\fR. +.SH BUILT-IN SHELL FUNCTIONS .PP These are defined as normal functions and macros and can be called from anywhere in the shell. They can even be redefined. -They can also be explicitly called (: lfe_shell ...). +They can also be explicitly called (: lfe_shell \&...). .PP -\fB(c File Options)\f +\fB(c File Options)\fR .PP Compile and load an LFE file. -Assumes default extension \fC\&.lfe\f. +Assumes default extension \fC.lfe\fR. .PP -\fB(: c Command Arg ...)\f +\fB(: c Command Arg \&...)\fR .PP -\fB(c:Command Arg ...)\f +\fB(c:Command Arg \&...)\fR .PP All the commands in the standard Erlang shell can be reached in this way. .PP -\fB(cd Dir)\f +\fB(cd Dir)\fR .PP Change the working directory. .PP -\fB(clear)\f +\fB(clear)\fR .PP Clear the REPL output. .PP -\fB(doc | describe Mod)\f -.PP -\fB(doc | describe Mod:Mac)\f -.PP -\fB(doc | describe Mod:Fun/Arity)\f -.PP -Print out documentation of a module/macro/function. -.PP -\fB(ec File Options)\f +\fB(ec File Options)\fR .PP Compile and load an Erlang file. .PP -\fB(ep Expr Depth)\f +\fB(ep Expr Depth)\fR .PP -\fB(epp Expr Depth)\f +\fB(epp Expr Depth)\fR .PP Print/prettyprint a value in Erlang form to either the specified depth or if no value is given the full depth. .PP -\fB(flush)\f +\fB(flush)\fR .PP Flush any messages sent to the shell. .PP -\fB(h)\f +\fB(h)\fR .PP -\fB(help)\f +\fB(help)\fR .PP Print usage info. .PP -\fB(i (list Pid ...))\f +\fB(h Mod)\fR +.PP +\fB(h Mod Mac)\fR +.PP +\fB(h Mod Fun Arity)\fR +.PP +Print out help information of a module/macro/function. +.PP +\fB(i (list Pid \&...))\fR .PP Print information about a list of pids. If no list is given then print information about currently running processes in the system. .PP -\fB(l Module ...)\f +\fB(i x y z)\fR +.PP +Print information about the about #Pid<x.y.z> +.PP +\fB(l Module \&...)\fR .PP Load modules. .PP -\fB(ls)\f +\fB(ls)\fR .PP -\fB(ls dir)\f +\fB(ls dir)\fR .PP List files in a directory. If no directory is given then list files in the current directory. .PP -\fB(m Module ...)\f +\fB(m Module \&...)\fR .PP Print out module information. If no modules are given then print information about all modules. .PP -\fB(p Expr Depth)\f +\fB(p Expr Depth)\fR .PP -\fB(pp Expr Depth)\f +\fB(pp Expr Depth)\fR .PP Print/prettyprint a value to either the specified depth or if no value is given the full depth. .PP -\fB(pid x y z)\f +\fB(pid x y z)\fR .PP Create a pid from x, y, z. .PP -\fB(pwd)\f +\fB(pwd)\fR .PP Print the current working directory. .PP -\fB(q)\f +\fB(q)\fR .PP -Quit \- shorthand for \fCinit:stop/0\f. +Quit - shorthand for \fCinit:stop/0\fR. .PP -\fB(regs)\f +\fB(regs)\fR .PP Print information about the registered processes in the system. -.SH BUILT\-IN SHELL COMMANDS +.SH BUILT-IN SHELL COMMANDS .PP -These are special forms which are only recognised at the top\-level in +These are special forms which are only recognised at the top-level in shell input. The cannot be redefined. .PP -\fB(reset\-environment)\f +\fB(reset-environment)\fR .PP Resets the environment to its initial state. -This will clear all variables, functions an macros that have been set. +This will clear all variables, functions and macros that have been set. .PP -\fB(run File)\f +\fB(run File)\fR .PP Execute all the shell commands in File. All defined variables, functions and macros will be saved in the environment if there are no errors. .PP -\fB(set Pattern Expr)\f +\fB(set Pattern Expr)\fR .PP -\fB(set Pattern (when Guard) Expr)\f +\fB(set Pattern (when Guard) Expr)\fR .PP Evaluate Expr and match the result with Pattern binding variables in it. These variables can then be used in the shell and also rebound in another set. .PP -\fB(slurp File)\f +\fB(slurp File)\fR .PP Slurp in a source LFE file and makes all functions and macros defined in the file available in the shell. Only one file can be slurped at a time and slurping a new file basically does an unslurp first. .PP -\fB(unslurp)\f +\fB(unslurp)\fR .PP Revert back to the state before the last slurp removing all function and macro definitions both in the slurped file and defined in the shell @@ -156,33 +160,33 @@ These will only be local to the shell and cannot be called from modules. The forms are the standard forms for defining functions and macros. .PP -\fB(defun Fun ...)\f +\fB(defun Fun \&...)\fR .PP Define a function in the shell. .PP -\fB(defmacro Macro ...)\f +\fB(defmacro Macro \&...)\fR .PP Define a macro in the shell. -.SH BUILT\-IN SHELL VARIABLES +.SH BUILT-IN SHELL VARIABLES .PP -\fB\fC+\f, \fC++\f, \fC+++\f\f +\fB\fCB+\fB, \fCB++\fB, \fCB+++\fB\fR .PP The three previous expressions input. .PP -\fB\fC*\f, \fC**\f, \fC***\f\f +\fB\fCB*\fB, \fCB**\fB, \fCB***\fB\fR .PP -The values of the previous 3 expressions. +The values of the previous three expressions. .PP -\fB\fC\-\f\f +\fB\fCB-\fB\fR .PP The current expression input. .SH SHELL ENVIRONMENT .PP The shell maintains an environment of local function and macro definitions, and variable bindings. -The environment can be accessed using the built\-in shell variable $ENV. +The environment can be accessed using the built-in shell variable $ENV. This can be useful when calling functions like macroexpand and -macro\-function which unless an explicit environment is given will only +macro-function which unless an explicit environment is given will only search the default environment. .SH STARTING THE LFE SHELL .PP @@ -191,8 +195,8 @@ .IP .nf \fC -lfe\ flags -\f +lfe flags +\fR .fi .PP From a normal Erlang shell the best way to start the shell is by @@ -200,17 +204,17 @@ .IP .nf \fC -17>\ lfe_shell:server(). -\f +17> lfe_shell:server(). +\fR .fi .PP Giving the user switch commands: .IP .nf \fC -\-\->\ s\ lfe_shell -\-\->\ c -\f +--> s lfe_shell +--> c +\fR .fi .PP will create a job running the LFE shell and connect to it. @@ -218,43 +222,70 @@ .PP Flags that LFE recognizes include the following: .IP \bu 2 -\fC\-h\f or \fC\-\-help\f \- provides command line usage help +\fC-nobanner\fR - starts LFE without showing the banner +.IP \bu 2 +\fC-h\fR or \fC--help\fR - provides command line usage help .IP \bu 2 -\fC\-e\f or \fC\-eval\f \- evaluates a given sexpr +\fC-e\fR or \fC-eval\fR - evaluates a given sexpr in a string .IP \bu 2 -\fC\-prompt\f \- users may supply a value here to override the -default \fClfe>\f prompt; note that \fC\-prompt\ classic\f will -set the prompt to the original \fC>\f and \fC\-prompt\f with no +\fC-prompt\fR - users may supply a value here to override the +default \fClfe>\fR prompt; note that \fC-prompt classic\fR will +set the prompt to the original \fC>\fR and \fC-prompt\fR with no associated value will cause no prompt to be displayed at all. These also work when node names are provided (with either -\fC\-sname\f or \fC\-name\f). +\fC-sname\fR or \fC-name\fR). Furthermore, users may override the default formatting of node names in -prompts by providing a prompt value containing the string \fC~node\f -(which will be substituted with the actual name of the node). +prompts by providing a prompt value containing the string +\fC\tinode\fR (which will be substituted with the actual name of +the node). +.PP +There can be multiple string expressions to be evaluated; each one must +be prefixed with an \fC-e\fR or \fC-eval\fR. +String expressions are run in the LFE repl so shell commands and +functions are allowed. +They are all run in the same invocation of the repl so: +.IP +.nf +\fC +$ lfe -e \dq(set aaa 42)\dq -e \dq(set bbb 84)\dq -e \dq(pp (tuple aaa bbb))\dq +#(42 84) +\fR +.fi +.PP +If there are string expressions then the LFE repl will \fCnot\fR be +run. .SH RUNNING LFE SHELL SCRIPTS .PP The LFE shell can also be directly called to run LFE shell scripts with: .IP .nf \fC -lfe\ flags\ file\ args -\f +lfe flags file args +\fR .fi .PP This will start the shell, run a script with LFE shell commands and then terminate the shell. -The following built\-in variables are also bound: +The following built-in variables are also bound: .PP -\fBscript\-name\f +\fBscript-name\fR .PP The name of the script file as a string. .PP -\fBscript\-args\f +\fBscript-args\fR .PP A list of the arguments to the script as strings. If no arguments have been given then this will be an empty list. +.PP +Note that if there are any string expressions to be evaluated then these +must come before the name of the script file and its arguments. +These expressions will be evaluated before the script and the script +will use the environment from the string expressions. +.PP +It is possible to run both string expressions and an LFE shell script +and they are then run in the same LFE repl. .SH SEE ALSO .PP -\fBlfescript(1)\f, \fBlfe_guide(7)\f \fBlfe_doc(3)\f +\fBlfescript(1)\fR, \fBlfe_guide(7)\fR \fBlfe_doc(3)\fR .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_bits.3 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_bits.3
Changed
@@ -1,10 +1,10 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe_bits" "3" "2011\-2016" "" "" +.TH "lfe_bits" "3" "2011-2016" "" "" .hy .SH NAME .PP -lfe_bits \- Lisp Flavoured Erlang (LFE) common binary functions +lfe_bits - Lisp Flavoured Erlang (LFE) common binary functions .SH SYNOPSIS .PP This module contains a collection of library functions for for handling @@ -12,35 +12,35 @@ They are generally not called by the user. .SH EXPORTS .PP -\fBparse_bitspecs(Specs) \->\f +\fBparse_bitspecs(Specs) ->\fR .IP .nf \fC -\ \ {ok,Size,{Type,Unit,Sign,Endian}}\ | -\ \ {error,Error}. -\f + {ok,Size,{Type,Unit,Sign,Endian}} | + {error,Error}. +\fR .fi .PP Parse a bitspec and return the data. -Unmentioned fields get the value \aqdefault\aq. +Unmentioned fields get the value `default'. .PP -\fBget_bitspecs(Specs) \->\f +\fBget_bitspecs(Specs) ->\fR .IP .nf \fC -\ \ {ok,Size,{Type,Unit,Sign,Endian}}\ | -\ \ {error,Error}. -\f + {ok,Size,{Type,Unit,Sign,Endian}} | + {error,Error}. +\fR .fi .PP Parse a bitspec, apply defaults and return the data. -Unmentioned fields get the value \aqdefault\aq. +Unmentioned fields get the value `default'. .SH ERROR INFORMATION .PP The following error values are returned: .PP -\fB{undefined_bittype,Type}\f +\fB{undefined_bittype,Type}\fR .PP -\fBbittype_unit\f +\fBbittype_unit\fR .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_cl.3 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_cl.3
Changed
@@ -1,260 +1,260 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" .TH "lfe_cl" "3" "2017" "" "" .hy .SH NAME .PP -lfe_cl \- LFE Common Lisp interface library +lfe_cl - LFE Common Lisp interface library .SH SYNOPSIS .PP This module provides a set of Common Lisp functions and macros for use in LFE. -The definitions closely follow the CL definitions and won\aqt be +The definitions closely follow the CL definitions and won\cqt be documented here. .SH DATA TYPES .PP -The boolean values used here are the standard LFE \fCtrue\f and -\fCfalse\f and \fBNOT\f the Common Lisp values. +The boolean values used here are the standard LFE \fCtrue\fR and +\fCfalse\fR and \fBNOT\fR the Common Lisp values. .SH EXPORTS .SS Boolean conversion functions .PP -\fBmake\-lfe\-bool cl\-value\f +\fBmake-lfe-bool cl-value\fR .PP -\fBmake\-cl\-bool lfe\-bool\f +\fBmake-cl-bool lfe-bool\fR .SS Control structures .PP -\fB\fCdo\ vars\ (end\-test\ result)\ body\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ macro\f\f +\fB\fCBdo vars (end-test result) body macro\fB\fR .PP -The value of \fCbody\f is bound the variable \fCdo\-state\f -which can be used when updating vars and in the \fCend\-test\f. +The value of \fCbody\fR is bound the variable \fCdo-state\fR +which can be used when updating vars and in the \fCend-test\fR. This is the only way to get a value out of the body. .PP -\fBmapcar function list\f +\fBmapcar function list\fR .PP -\fBmaplist function list\f +\fBmaplist function list\fR .PP -\fBmapc function list\f +\fBmapc function list\fR .PP -\fBmapl function list\f +\fBmapl function list\fR .SS Symbol functions .PP -\fBsymbol\-plist symbol\f +\fBsymbol-plist symbol\fR .PP -\fBsymbol\-name symbol\f +\fBsymbol-name symbol\fR .PP -\fBget symbol pname\f +\fBget symbol pname\fR .PP -\fBget symbol pname default\f +\fBget symbol pname default\fR .PP -\fBgetl symbol pname\-list\f +\fBgetl symbol pname-list\fR .PP -\fBputprop symbol value pname\f +\fBputprop symbol value pname\fR .PP -\fBremprop symbol pname\f +\fBremprop symbol pname\fR .PP -Atoms (symbols) in LFE don\aqt have property lists associated with +Atoms (symbols) in LFE don\cqt have property lists associated with them. However, here we have experimented with having a global ETS table -\fClfe\-symbol\-plist\f which associates an atom with a property +\fClfe-symbol-plist\fR which associates an atom with a property list. This is very unLFEy, but quite fun. .SS Property list functions .PP -\fBgetf plist pname\f +\fBgetf plist pname\fR .PP -\fBgetf plist pname default\f +\fBgetf plist pname default\fR .PP -\fBputf plist value pname\f +\fBputf plist value pname\fR .PP -\fBremf plist pname\f +\fBremf plist pname\fR .PP -\fBget\-properties plist pname\-list\f +\fBget-properties plist pname-list\fR .PP -The function \fCputf/3\f does not exist in Common Lisp but is +The function \fCputf/3\fR does not exist in Common Lisp but is included to complete the operations on property lists. .SS Simple sequence functions .PP -\fBelt index sequence\f +\fBelt index sequence\fR .PP -\fBlength sequence\f +\fBlength sequence\fR .PP -\fBreverse sequence\f +\fBreverse sequence\fR .SS Concatenation, mapping and reducing functions .PP -\fBsome predicate sequence\f +\fBsome predicate sequence\fR .PP -\fBevery predicate sequence\f +\fBevery predicate sequence\fR .PP -\fBnotany predicate sequence\f +\fBnotany predicate sequence\fR .PP -\fBnotevery predicate sequence\f +\fBnotevery predicate sequence\fR .PP -\fBreduce function sequence\f +\fBreduce function sequence\fR .PP -\fBreduce function sequence \aqinitial\-value x\f +\fBreduce function sequence \cqinitial-value x\fR .PP -\fBreduce function sequence \aqfrom\-end \aqtrue\f +\fBreduce function sequence \cqfrom-end \cqtrue\fR .PP -\fBreduce function sequence \aqinitial\-value x \aqfrom\-end -\aqtrue\f +\fBreduce function sequence \cqinitial-value x \cqfrom-end +\cqtrue\fR .SS Modifying sequences .PP -\fBremove item sequence\f +\fBremove item sequence\fR .PP -\fBremove\-if predicate sequence\f +\fBremove-if predicate sequence\fR .PP -\fBremove\-if\-not predicate sequence\f +\fBremove-if-not predicate sequence\fR .PP -\fBremove\-duplicates sequence\f +\fBremove-duplicates sequence\fR .PP -\fBsubstitute new old sequence\f +\fBsubstitute new old sequence\fR .PP -\fBsubstitute\-if predicate sequence\f +\fBsubstitute-if predicate sequence\fR .PP -\fBsubstitute\-if\-not predicate sequence\f +\fBsubstitute-if-not predicate sequence\fR .SS Searching sequences .PP -\fBfind item sequence\f +\fBfind item sequence\fR .PP -\fBfind\-if predicate sequence\f +\fBfind-if predicate sequence\fR .PP -\fBfind\-if\-not predicate sequence\f +\fBfind-if-not predicate sequence\fR .PP -\fBfind\-duplicates sequence\f +\fBfind-duplicates sequence\fR .PP -\fBposition item sequence\f +\fBposition item sequence\fR .PP -\fBposition\-if predicate sequence\f +\fBposition-if predicate sequence\fR .PP -\fBposition\-if\-not predicate sequence\f +\fBposition-if-not predicate sequence\fR .PP -\fBposition\-duplicates sequence\f +\fBposition-duplicates sequence\fR .PP -\fBcount item sequence\f +\fBcount item sequence\fR .PP -\fBcount\-if predicate sequence\f +\fBcount-if predicate sequence\fR .PP -\fBcount\-if\-not predicate sequence\f +\fBcount-if-not predicate sequence\fR .SS Lists .PP -\fBcar list\f +\fBcar list\fR .PP -\fBfirst list\f +\fBfirst list\fR .PP -\fBcdr list\f +\fBcdr list\fR .PP -\fBrest list\f +\fBrest list\fR .PP -\fBnth index list\f +\fBnth index list\fR .PP -\fBnthcdr index list\f +\fBnthcdr index list\fR .PP -\fBlast list\f +\fBlast list\fR .PP -\fBbutlast list\f +\fBbutlast list\fR .SS Substitution of expressions .PP -\fBsubst new old tree\f +\fBsubst new old tree\fR .PP -\fBsubst\-if new test tree\f +\fBsubst-if new test tree\fR .PP -\fBsubst\-if\-not new test tree\f +\fBsubst-if-not new test tree\fR .PP -\fBsublis alist tree\f +\fBsublis alist tree\fR .SS Lists as sets .PP -\fBmember item list\f +\fBmember item list\fR .PP -\fBmember\-if predicate list\f +\fBmember-if predicate list\fR .PP -\fBmember\-if\-not predicate list\f +\fBmember-if-not predicate list\fR .PP -\fBadjoin item list\f +\fBadjoin item list\fR .PP -\fBunion list list\f +\fBunion list list\fR .PP -\fBintersection list list\f +\fBintersection list list\fR .PP -\fBset\-difference list list\f +\fBset-difference list list\fR .PP -\fBset\-exclusive\-or list list\f +\fBset-exclusive-or list list\fR .PP -\fBsubsetp list list\f +\fBsubsetp list list\fR .SS Association list functions .PP -\fBacons key data alist\f +\fBacons key data alist\fR .PP -\fBpairlis list list\f +\fBpairlis list list\fR .PP -\fBpairlis list list alist\f +\fBpairlis list list alist\fR .PP -\fBassoc key alist\f +\fBassoc key alist\fR .PP -\fBassoc\-if predicate alost\f +\fBassoc-if predicate alost\fR .PP -\fBassoc\-if\-not predicate alost\f +\fBassoc-if-not predicate alost\fR .PP -\fBrassoc key alist\f +\fBrassoc key alist\fR .PP -\fBrassoc\-if predicate alost\f +\fBrassoc-if predicate alost\fR .PP -\fBrassoc\-if\-not predicate alost\f +\fBrassoc-if-not predicate alost\fR .SS Types .PP -\fBtype\-of object\f +\fBtype-of object\fR .PP -\fBcoerce object type\f +\fBcoerce object type\fR .SS Type testing macros .PP There is an include file which developers may which to utilize in their -LFE programs: \fC(include\-lib\ "lfe/include/cl.lfe")\f. +LFE programs: \fC(include-lib \dqlfe/include/cl.lfe\dq)\fR. Currently this offers Common Lisp predicates, but may include other useful macros and functions in the future. -The provided predicate macros wrap the various \fCis_*\f Erlang +The provided predicate macros wrap the various \fCis_*\fR Erlang functions; since these are expanded at compile time, they are usable in guards. It includes the following: .PP -\fBalivep x\f +\fBalivep x\fR .PP -\fBatomp x\f +\fBatomp x\fR .PP -\fBbinaryp x\f +\fBbinaryp x\fR .PP -\fBbitstringp x\f +\fBbitstringp x\fR .PP -\fBboolp x\f +\fBboolp x\fR .PP -\fBbooleanp x\f +\fBbooleanp x\fR .PP -\fBbuiltinp x\f +\fBbuiltinp x\fR .PP -\fBfloatp x\f +\fBfloatp x\fR .PP -\fBfuncp x\f +\fBfuncp x\fR .PP -\fBfunctionp x\f +\fBfunctionp x\fR .PP -\fBintp x\f and \fBintegerp x\f +\fBintp x\fR and \fBintegerp x\fR .PP -\fBlistp x\f +\fBlistp x\fR .PP -\fBmapp x\f +\fBmapp x\fR .PP -\fBnumberp x\f +\fBnumberp x\fR .PP -\fBpidp x\f +\fBpidp x\fR .PP -\fBprocess\-alive\-p x\f +\fBprocess-alive-p x\fR .PP -\fBrecordp x tag\f +\fBrecordp x tag\fR .PP -\fBrecordp x tag size\f +\fBrecordp x tag size\fR .PP -\fBrefp x\f +\fBrefp x\fR .PP -\fBreferencep x\f +\fBreferencep x\fR .PP -\fBtuplep x\f +\fBtuplep x\fR .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_clj.3 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_clj.3
Changed
@@ -1,59 +1,60 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe_clj" "3" "2015\-2016" "" "" +.TH "lfe_clj" "3" "2015-2016" "" "" .hy .SH NAME .PP -clj \- LFE Clojure interface library. +clj - LFE Clojure interface library. .SH SYNOPSIS .PP -This module provides Clojure\-inpired functions and macros for use in +This module provides Clojure-inspired functions and macros for use in LFE. .SH EXPORTS .PP N.B. -Instead of making fully\-qualified calls to the macros exported from -\fIclj\f, you may \fC(include\-lib\ "lfe/include/clj.lfe")\f and -then call them directly, e.g. +Instead of making fully-qualified calls to the macros exported from +\fIclj\fR, you may +\fC(include-lib \dqlfe/include/clj.lfe\dq)\fR and then call them +directly, e.g. .IP .nf \fC -(include\-lib\ "lfe/include/clj.lfe") +(include-lib \dqlfe/include/clj.lfe\dq) -(\->\ 2\ (+\ 2)\ (=:=\ 4))\ ;\ \aqtrue -\f +(-> 2 (+ 2) (=:= 4)) ; \aqtrue +\fR .fi .SS Function Macros .PP -\fB(defn name arg ... {{doc\-string}} ...)\f +\fB(defn name arg \&... {{doc-string}} \&...)\fR .PP -\fB(defn {{doc\-string}} (argpat ... ...))\f +\fB(defn {{doc-string}} (argpat \&... \&...))\fR .PP Define and automatically export a function. .PP -\fB(defn\- name arg ... {{doc\-string}} ...)\f +\fB(defn- name arg \&... {{doc-string}} \&...)\fR .PP -\fB(defn\- {{doc\-string}} (argpat ... ...))\f +\fB(defn- {{doc-string}} (argpat \&... \&...))\fR .PP -Equivalent to \fBdefun\f. +Equivalent to \fBdefun\fR. .PP -\fB(fn (arg ...) ...)\f +\fB(fn (arg \&...) \&...)\fR .PP -Equivalent to \fClambda\f. +Equivalent to \fClambda\fR. .SS Threading Macros .PP -Note: The original versions were copied from Tim Dysinger\aqs lfesl +Note: The original versions were copied from Tim Dysinger\cqs lfesl repo here: .IP .nf \fC https://github.com/lfex/lfesl/blob/master/include/thread.lfe -\f +\fR .fi .PP They have since been modified to be safely exportable. .PP -\fB(\-> ...)\f +\fB(-> \&...)\fR .PP Thread first. .PP @@ -61,52 +62,52 @@ .IP .nf \fC ->\ (set\ o\ \aq(#(a\ 1)\ #(b\ 2)\ #(c\ 3))) -(#(a\ 1)\ #(b\ 2)\ #(c\ 3)) ->\ (clj:\->\ o ->\ \ \ \ \ \ \ \ \ (++\ \aq(#(d\ 4))) ->\ \ \ \ \ \ \ \ \ (++\ \aq(#(e\ 5))) ->\ \ \ \ \ \ \ \ \ (++\ \aq(#(f\ 6)))) -(#(a\ 1)\ #(b\ 2)\ #(c\ 3)\ #(d\ 4)\ #(e\ 5)\ #(f\ 6)) -\f +> (set o \aq(#(a 1) #(b 2) #(c 3))) +(#(a 1) #(b 2) #(c 3)) +> (clj:-> o +> (++ \aq(#(d 4))) +> (++ \aq(#(e 5))) +> (++ \aq(#(f 6)))) +(#(a 1) #(b 2) #(c 3) #(d 4) #(e 5) #(f 6)) +\fR .fi .PP -Note that the use of \fB\->\f in this example results in each -successive value being \fIappended\f to the input list. +Note that the use of \fB->\fR in this example results in each +successive value being \fIappended\fR to the input list. .PP Another example showing how this works: .IP .nf \fC ->\ (lists:sublist ->\ \ \ (lists:reverse ->\ \ \ \ \ (lists:sort ->\ \ \ \ \ \ \ (lists:merge ->\ \ \ \ \ \ \ \ \ (string:tokens ->\ \ \ \ \ \ \ \ \ \ \ (string:to_upper\ "a\ b\ c\ d\ e") ->\ \ \ \ \ \ \ \ \ \ \ "\ ") ->\ \ \ \ \ \ \ \ \ \aq("X"\ "F"\ "L")))) ->\ \ \ 2\ 3) -("L"\ "F"\ "E") -\f +> (lists:sublist +> (lists:reverse +> (lists:sort +> (lists:merge +> (string:tokens +> (string:to_upper \dqa b c d e\dq) +> \dq \dq) +> \aq(\dqX\dq \dqF\dq \dqL\dq)))) +> 2 3) +(\dqL\dq \dqF\dq \dqE\dq) +\fR .fi .PP Can be rewritten as this: .IP .nf \fC ->\ (clj:\->\ "a\ b\ c\ d\ e" ->\ \ \ \ \ \ \ \ \ (string:to_upper) ->\ \ \ \ \ \ \ \ \ (string:tokens\ "\ ") ->\ \ \ \ \ \ \ \ \ (lists:merge\ \aq("X"\ "F"\ "L")) ->\ \ \ \ \ \ \ \ \ (lists:sort) ->\ \ \ \ \ \ \ \ \ (lists:reverse) ->\ \ \ \ \ \ \ \ \ (lists:sublist\ 2\ 3)) -("L"\ "F"\ "E") -\f +> (clj:-> \dqa b c d e\dq +> (string:to_upper) +> (string:tokens \dq \dq) +> (lists:merge \aq(\dqX\dq \dqF\dq \dqL\dq)) +> (lists:sort) +> (lists:reverse) +> (lists:sublist 2 3)) +(\dqL\dq \dqF\dq \dqE\dq) +\fR .fi .PP -\fB(\->> ...)\f +\fB(->> \&...)\fR .PP Thread last. .PP @@ -114,419 +115,421 @@ .IP .nf \fC ->\ (set\ o\ \aq(#(a\ 1)\ #(b\ 2)\ #(c\ 3))) -(#(a\ 1)\ #(b\ 2)\ #(c\ 3)) ->\ (clj:\->>\ o ->\ \ \ \ \ \ \ \ \ \ (++\ \aq(#(d\ 4))) ->\ \ \ \ \ \ \ \ \ \ (++\ \aq(#(e\ 5))) ->\ \ \ \ \ \ \ \ \ \ (++\ \aq(#(f\ 6)))) -(#(f\ 6)\ #(e\ 5)\ #(d\ 4)\ #(a\ 1)\ #(b\ 2)\ #(c\ 3)) -\f +> (set o \aq(#(a 1) #(b 2) #(c 3))) +(#(a 1) #(b 2) #(c 3)) +> (clj:->> o +> (++ \aq(#(d 4))) +> (++ \aq(#(e 5))) +> (++ \aq(#(f 6)))) +(#(f 6) #(e 5) #(d 4) #(a 1) #(b 2) #(c 3)) +\fR .fi .PP -Note that the use of \fB\->>\f in this example results in each -successive value being \fIprepended\f to the input list. +Note that the use of \fB->>\fR in this example results in each +successive value being \fIprepended\fR to the input list. .PP Another example showing how this: .IP .nf \fC ->\ (lists:foldl\ #\aq+/2\ 0 ->\ \ \ (clj:take\ 10 ->\ \ \ \ \ (lists:filter ->\ \ \ \ \ \ \ (clj:comp\ #\aqclj:even?/1\ #\aqclj:round/1) ->\ \ \ \ \ \ \ (lists:map ->\ \ \ \ \ \ \ \ \ (lambda\ (x) ->\ \ \ \ \ \ \ \ \ \ \ (math:pow\ x\ 2)) ->\ \ \ \ \ \ \ \ \ (clj:seq\ 42))))) +> (lists:foldl #\aq+/2 0 +> (clj:take 10 +> (lists:filter +> (clj:comp #\aqclj:even?/1 #\aqclj:round/1) +> (lists:map +> (lambda (x) +> (math:pow x 2)) +> (clj:seq 42))))) 1540.0 -\f +\fR .fi .PP Can be rewritten as this: .IP .nf \fC ->\ (clj:\->>\ (clj:seq\ 42) ->\ \ \ \ \ \ \ \ \ \ (lists:map\ (lambda\ (x)\ (math:pow\ x\ 2))) ->\ \ \ \ \ \ \ \ \ \ (lists:filter\ (clj:comp\ #\aqclj:even?/1\ #\aqclj:round/1)) ->\ \ \ \ \ \ \ \ \ \ (clj:take\ 10) ->\ \ \ \ \ \ \ \ \ \ (lists:foldl\ #\aq+/2\ 0)) +> (clj:->> (clj:seq 42) +> (lists:map (lambda (x) (math:pow x 2))) +> (lists:filter (clj:comp #\aqclj:even?/1 #\aqclj:round/1)) +> (clj:take 10) +> (lists:foldl #\aq+/2 0)) 1540.0 -\f +\fR .fi .PP -\fB(as\-> expr name . sexps)\f +\fB(as-> expr name . sexps)\fR .PP -Bind \fCname\f to \fCexpr\f, evaluate the first \fCsexp\f in -the lexical context of that binding, then bind \fCname\f to that -result, repeating for each successive \fCsexp\f in \fCsexps\f, -returning the result of the last \fCsexp\f. +Bind \fCname\fR to \fCexpr\fR, evaluate the first \fCsexp\fR +in the lexical context of that binding, then bind \fCname\fR to that +result, repeating for each successive \fCsexp\fR in \fCsexps\fR, +returning the result of the last \fCsexp\fR. .PP -\fB(cond\-> expr . clauses)\f +\fB(cond-> expr . clauses)\fR .PP -Given an \fCexpr\fession and a set of \fCtest\f/\fCsexp\f -pairs, thread \fCx\f (via \fB\->\f) through each \fCsexp\f -for which the corresponding \fCtest\f expression is truthy, i.e. -neither \fC\aqfalse\f nor \fC\aqundefined\f. -Note that, unlike \fBcond\f branching, \fBcond\->\f threading +Given an \fCexpr\fRession and a set of \fCtest\fR/\fCsexp\fR +pairs, thread \fCx\fR (via \fB->\fR) through each \fCsexp\fR +for which the corresponding \fCtest\fR expression is truthy, +i.e.\ neither \fC\aqfalse\fR nor \fC\aqundefined\fR. +Note that, unlike \fBcond\fR branching, \fBcond->\fR threading does not short circuit after the first truthy test expression. .PP -\fB(cond\->> expr . clauses)\f +\fB(cond->> expr . clauses)\fR .PP -Given an \fCexpr\fession and a set of \fCtest\f/\fCsexp\f -pairs, thread \fCx\f (via \fB\->>\f) through each \fCsexp\f -for which the corresponding \fCtest\f expression is truthy, i.e. -neither \fC\aqfalse\f nor \fC\aqundefined\f. -Note that, unlike \fBcond\f branching, \fBcond\->>\f threading -does not short circuit after the first truthy \fCtest\f expression. +Given an \fCexpr\fRession and a set of \fCtest\fR/\fCsexp\fR +pairs, thread \fCx\fR (via \fB->>\fR) through each +\fCsexp\fR for which the corresponding \fCtest\fR expression is +truthy, i.e.\ neither \fC\aqfalse\fR nor \fC\aqundefined\fR. +Note that, unlike \fBcond\fR branching, \fBcond->>\fR threading +does not short circuit after the first truthy \fCtest\fR expression. .PP -\fB(some\-> x . sexps)\f +\fB(some-> x . sexps)\fR .PP -When \fCx\f is not \fC\aqundefined\f, thread it into the first -\fCsexp\f (via \fB\->\f), and when that result is not -\fC\aqundefined\f, through the next, etc. +When \fCx\fR is not \fC\aqundefined\fR, thread it into the +first \fCsexp\fR (via \fB->\fR), and when that result is not +\fC\aqundefined\fR, through the next, etc. .PP -\fB(some\->> x . sexps)\f +\fB(some->> x . sexps)\fR .PP -When \fCx\f is not \fC\aqundefined\f, thread it into the first -\fCsexp\f (via \fB\->>\f), and when that result is not -\fC\aqundefined\f, through the next, etc. +When \fCx\fR is not \fC\aqundefined\fR, thread it into the +first \fCsexp\fR (via \fB->>\fR), and when that result is not +\fC\aqundefined\fR, through the next, etc. .SS Conditional Macros .PP -\fB(if\-let ((patt test)) then {{else}})\f +\fB(if-let ((patt test)) then {{else}})\fR .PP -If \fCtest\f evaluates to anything other than \fC\aqfalse\f or -\fC\aqundefined\f, evaluate \fCthen\f with \fCpatt\f bound -to the value of \fCtest\f, otherwise \fCelse\f, if supplied, -else \fC\aqundefined\f. +If \fCtest\fR evaluates to anything other than \fC\aqfalse\fR +or \fC\aqundefined\fR, evaluate \fCthen\fR with \fCpatt\fR +bound to the value of \fCtest\fR, otherwise \fCelse\fR, if +supplied, else \fC\aqundefined\fR. .PP -\fB(iff\-let ((patt test)) . body)\f +\fB(iff-let ((patt test)) . body)\fR .PP -When \fCtest\f evaluates to anything other than \fC\aqfalse\f -or \fC\aqundefined\f, evaluate \fCbody\f with \fCpatt\f -bound to the value of \fCtest\f, otherwise return -\fC\aqundefined\f. +When \fCtest\fR evaluates to anything other than +\fC\aqfalse\fR or \fC\aqundefined\fR, evaluate +\fCbody\fR with \fCpatt\fR bound to the value of \fCtest\fR, +otherwise return \fC\aqundefined\fR. .PP -\fB(condp pred expr . clauses)\f +\fB(condp pred expr . clauses)\fR .PP Given a binary predicate, an expression and a set of clauses of the form: .IP .nf \fC -test\-expr\ result\-expr +test-expr result-expr -test\-expr\ >>\ result\-fn -\f +test-expr >> result-fn +\fR .fi .PP -where \fCresult\-fn\f is a unary function, if -\fC(pred\ test\-expr\ expr)\f returns anything other than -\fC\aqundefined\f or \fC\aqfalse\f, the clause is a match. +where \fCresult-fn\fR is a unary function, if +\fC(pred test-expr expr)\fR returns anything other than +\fC\aqundefined\fR or \fC\aqfalse\fR, the clause is a match. .PP -If a binary clause matches, return \fCresult\-expr\f. -If a ternary clause matches, call \fCresult\-fn\f with the result of +If a binary clause matches, return \fCresult-expr\fR. +If a ternary clause matches, call \fCresult-fn\fR with the result of the predicate and return the result. .PP If no clause matches and a single default expression is given after the clauses, return it. If no default expression is given and no clause matches, throw a -\fCno\-matching\-clause\f error. +\fCno-matching-clause\fR error. .PP -\fB(if\-not test then)\f +\fB(if-not test then)\fR .PP -\fB(if\-not test then else)\f +\fB(if-not test then else)\fR .PP -If \fCtest\f evaluates to \fC\aqfalse\f or -\fC\aqundefined\f, evaluate and return \fCthen\f, otherwise -\fCelse\f, if supplied, else \fC\aqundefined\f. +If \fCtest\fR evaluates to \fC\aqfalse\fR or +\fC\aqundefined\fR, evaluate and return \fCthen\fR, otherwise +\fCelse\fR, if supplied, else \fC\aqundefined\fR. .PP -\fB(iff test . body)\f +\fB(iff test . body)\fR .PP -Like Clojure\aqs \fCwhen\f. -If \fCtest\f evaluates to anything other than \fC\aqfalse\f or -\fC\aqundefined\f, evaluate \fCbody\f in an implicit -\fCprogn\f. +Like Clojure\cqs \fCwhen\fR. +If \fCtest\fR evaluates to anything other than \fC\aqfalse\fR +or \fC\aqundefined\fR, evaluate \fCbody\fR in an implicit +\fCprogn\fR. .PP -\fB(when\-not test . body)\f +\fB(when-not test . body)\fR .PP -If \fCtest\f evaluates to \fC\aqfalse\f or -\fC\aqundefined\f, evaluate \fCbody\f in an implicit -\fCprogn\f. -Otherwise return \fC\aqundefined\f. +If \fCtest\fR evaluates to \fC\aqfalse\fR or +\fC\aqundefined\fR, evaluate \fCbody\fR in an implicit +\fCprogn\fR. +Otherwise return \fC\aqundefined\fR. .PP -\fB(not= x)\f +\fB(not= x)\fR .PP -\fB(not= x y)\f +\fB(not= x y)\fR .PP -\fB(not= x y . more)\f +\fB(not= x y . more)\fR .PP -Same as \fC(not\ (==\ ...))\f. +Same as \fC(not (== ...))\fR. .SS Predicate Macros .PP Allowed in guards, unless otherwise stated. .PP -\fB(tuple? x)\f +\fB(tuple? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a tuple. +Return \fC\aqtrue\fR if \fCx\fR is a tuple. .PP -\fB(atom? x)\f +\fB(atom? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is an atom. +Return \fC\aqtrue\fR if \fCx\fR is an atom. .PP -\fB(binary? x)\f +\fB(binary? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a binary. +Return \fC\aqtrue\fR if \fCx\fR is a binary. .PP -\fB(bitstring? x)\f +\fB(bitstring? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a bitstring. +Return \fC\aqtrue\fR if \fCx\fR is a bitstring. .PP -\fB(boolean? x)\f +\fB(boolean? x)\fR .PP -\fB(bool? x)\f +\fB(bool? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a boolean. +Return \fC\aqtrue\fR if \fCx\fR is a boolean. .PP -\fB(float? x)\f +\fB(float? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a float. +Return \fC\aqtrue\fR if \fCx\fR is a float. .PP -\fB(function? f)\f +\fB(function? f)\fR .PP -\fB(func? f)\f +\fB(func? f)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a function. +Return \fC\aqtrue\fR if \fCx\fR is a function. .PP -\fB(function? f n)\f +\fB(function? f n)\fR .PP -\fB(func? f n)\f +\fB(func? f n)\fR .PP -Return \fC\aqtrue\f if \fCf\f is an \fCn\f\-ary function. +Return \fC\aqtrue\fR if \fCf\fR is an \fCn\fR-ary +function. .PP -\fB(integer? x)\f +\fB(integer? x)\fR .PP -\fB(int? x)\f +\fB(int? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is an integer. +Return \fC\aqtrue\fR if \fCx\fR is an integer. .PP -\fB(number? x)\f +\fB(number? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a number. +Return \fC\aqtrue\fR if \fCx\fR is a number. .PP -\fB(record? x record\-tag)\f +\fB(record? x record-tag)\fR .PP -\fB(record? x record\-tag size)\f +\fB(record? x record-tag size)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a tuple and its first element -is \fCrecord\-tag\f. -If \fCsize\f is given, check that \fCx\f is a -\fCrecord\-tag\f record of size \fCsize\f. +Return \fC\aqtrue\fR if \fCx\fR is a tuple and its first +element is \fCrecord-tag\fR. +If \fCsize\fR is given, check that \fCx\fR is a +\fCrecord-tag\fR record of size \fCsize\fR. .PP N.B. -\fBrecord?/2\f may yield unexpected results, due to difference +\fBrecord?/2\fR may yield unexpected results, due to difference between the Erlang and LFE compilers. -As such, whenever possible, prefer \fBrecord?/3\f." +As such, whenever possible, prefer \fBrecord?/3\fR.\dq .PP -\fB(reference? x)\f +\fB(reference? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a reference. +Return \fC\aqtrue\fR if \fCx\fR is a reference. .PP -\fB(map? x)\f +\fB(map? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a map. -Return \fC\aqfalse\f on versions of Erlang without maps. +Return \fC\aqtrue\fR if \fCx\fR is a map. +Return \fC\aqfalse\fR on versions of Erlang without maps. .PP -\fB(undefined? x)\f +\fB(undefined? x)\fR .PP -\fB(undef? x)\f +\fB(undef? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is the atom -\fC\aqundefined\f. +Return \fC\aqtrue\fR if \fCx\fR is the atom +\fC\aqundefined\fR. .PP -\fB(nil? x)\f +\fB(nil? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is the atom \fC\aqnil\f or -the empty list. +Return \fC\aqtrue\fR if \fCx\fR is the atom \fC\aqnil\fR +or the empty list. .PP -\fB(true? x)\f +\fB(true? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is the atom \fC\aqtrue\f. +Return \fC\aqtrue\fR if \fCx\fR is the atom +\fC\aqtrue\fR. .PP -\fB(false? x)\f +\fB(false? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is the atom \fC\aqfalse\f. +Return \fC\aqtrue\fR if \fCx\fR is the atom +\fC\aqfalse\fR. .PP -\fB(falsy? x)\f +\fB(falsy? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is one of the atoms -\fC\aqfalse\f and \fC\aqundefined\f. +Return \fC\aqtrue\fR if \fCx\fR is one of the atoms +\fC\aqfalse\fR and \fC\aqundefined\fR. .PP -\fB(odd? x)\f +\fB(odd? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is odd. +Return \fC\aqtrue\fR if \fCx\fR is odd. .PP -\fB(even? x)\f +\fB(even? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is even. +Return \fC\aqtrue\fR if \fCx\fR is even. .PP -\fB(zero? x)\f +\fB(zero? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is zero. +Return \fC\aqtrue\fR if \fCx\fR is zero. .PP -\fB(pos? x)\f +\fB(pos? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is greater than zero. +Return \fC\aqtrue\fR if \fCx\fR is greater than zero. .PP -\fB(neg? x)\f +\fB(neg? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is less than zero. +Return \fC\aqtrue\fR if \fCx\fR is less than zero. .PP -\fB(identical? x)\f +\fB(identical? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is exactly equal to \fCy\f. +Return \fC\aqtrue\fR if \fCx\fR is exactly equal to +\fCy\fR. .SS Other Macros .PP -\fB(str x1, x2 ... xn)\f +\fB(str x1, x2 \&... xn)\fR .PP Given arbitrary number of arguments, return a string consisting of each of their string representations. .PP N.B. Because Erlang characters are represented as integers, this will not -work for chars, e.g. -\fC#\\a\f, which will be presented in the return value as its -integer value, i.e. -\fC"97"\f. +work for chars, e.g.\ \fC#\rsa\fR, which will be presented in the +return value as its integer value, i.e.\ \fC\dq97\dq\fR. .IP .nf \fC ->\ (clj:str\ #\\a\ "bc") -"97bc" ->\ (clj:str\ "a"\ "bc") -"abc" -\f +> (clj:str #\rsa \dqbc\dq) +\dq97bc\dq +> (clj:str \dqa\dq \dqbc\dq) +\dqabc\dq +\fR .fi .PP -\fB(lazy\-seq)\f +\fB(lazy-seq)\fR .PP -\fB(lazy\-seq seq)\f +\fB(lazy-seq seq)\fR .PP Return a (possibly infinite) lazy sequence from a given lazy sequence -\fCseq\f or a finite lazy sequence from given list \fCseq\f. +\fCseq\fR or a finite lazy sequence from given list \fCseq\fR. A lazy sequence is treated as finite if at any iteration it produces the empty list, instead of a cons cell with data as the head and a nullary function for the next iteration as the tail. .PP -\fB(conj coll . xs)\f +\fB(conj coll . xs)\fR .PP conjoin a value onto an existing collection. Prepend to a list, append to a tuple, and merge maps. -.SS Clojure\-inspired \fIif\f Macro +.SS Clojure-inspired \fIif\fR Macro .PP -\fB(if test then)\f +\fB(if test then)\fR .PP -\fB(if test then else)\f +\fB(if test then else)\fR .PP -If \fCtest\f evaluates to anything other than \fC\aqfalse\f or -\fC\aqundefined\f, return \fCthen\f, otherwise \fCelse\f, -if given, else \fC\aqundefined\f. +If \fCtest\fR evaluates to anything other than \fC\aqfalse\fR +or \fC\aqundefined\fR, return \fCthen\fR, otherwise +\fCelse\fR, if given, else \fC\aqundefined\fR. .SS Function Composition .PP -\fB(comp f g)\f +\fB(comp f g)\fR .PP Right to left function composition. .PP -\fB(comp fs x)\f +\fB(comp fs x)\fR .PP -Compose a list of functions \fCfs\f, right to left, and apply the -resulting function to \fCx\f. +Compose a list of functions \fCfs\fR, right to left, and apply the +resulting function to \fCx\fR. .PP -\fB(comp f g x)\f +\fB(comp f g x)\fR .PP -Equivalent to \fC(funcall\ (comp\ f\ g)\ x)\f. +Equivalent to \fC(funcall (comp f g) x)\fR. .PP -\fB(comp fs)\f +\fB(comp fs)\fR .PP -Compose a list of functions \fCfs\f from right to left. +Compose a list of functions \fCfs\fR from right to left. .PP -\fB(comp)\f +\fB(comp)\fR .PP -Equivalent to \fC#\aqidentity/1\f. +Equivalent to \fC#\aqidentity/1\fR. .SS Usage .PP -The following examples assume \fC#\aq1+/1\f is defined: +The following examples assume \fC#\aq1+/1\fR is defined: .IP .nf \fC ->\ (defun\ 1+\ (x)\ (+\ x\ 1)) +> (defun 1+ (x) (+ x 1)) 1+ -\f +\fR .fi .IP .nf \fC ->\ (funcall\ (clj:comp\ #\aqmath:sin/1\ #\aqmath:asin/1)\ 0.5) +> (funcall (clj:comp #\aqmath:sin/1 #\aqmath:asin/1) 0.5) 0.49999999999999994 ->\ (funcall\ (clj:comp\ (list\ #\aq1+/1\ #\aqmath:sin/1\ #\aqmath:asin/1)\ 0.5)) +> (funcall (clj:comp (list #\aq1+/1 #\aqmath:sin/1 #\aqmath:asin/1) 0.5)) 1.5 -\f +\fR .fi .PP Or used in another function call: .IP .nf \fC ->\ (lists:filter\ (clj:comp\ #\aqnot/1\ #\aqzero?/1) -\ \ \ \ \aq(0\ 1\ 0\ 2\ 0\ 3\ 0\ 4)) -(1\ 2\ 3\ 4) -\f +> (lists:filter (clj:comp #\aqnot/1 #\aqzero?/1) + \aq(0 1 0 2 0 3 0 4)) +(1 2 3 4) +\fR .fi .PP -The usage above is best when \fBcomp\f will be called by -higher\-order functions like \fBlists:foldl/3\f or -\fBlists:filter/2\f, etc. -However, one may also call \fBcomp\f in the following manner, best +The usage above is best when \fBcomp\fR will be called by +higher-order functions like \fBlists:foldl/3\fR or +\fBlists:filter/2\fR, etc. +However, one may also call \fBcomp\fR in the following manner, best suited for direct usage: .IP .nf \fC ->\ (clj:comp\ #\aqmath:sin/1\ #\aqmath:asin/1\ 0.5) +> (clj:comp #\aqmath:sin/1 #\aqmath:asin/1 0.5) 0.49999999999999994 ->\ (clj:comp\ (list\ #\aq1+/1\ #\aqmath:sin/1\ #\aqmath:asin/1)\ 0.5) +> (clj:comp (list #\aq1+/1 #\aqmath:sin/1 #\aqmath:asin/1) 0.5) 1.5 -\f +\fR .fi .SS Partial Application .PP -\fB(partial f args)\f +\fB(partial f args)\fR .PP -\fB(partial f arg\-1)\f +\fB(partial f arg-1)\fR .PP -Partially apply \fCf\f to a given argument \fCarg\-1\f or list -of \fCargs\f. +Partially apply \fCf\fR to a given argument \fCarg-1\fR or list +of \fCargs\fR. .SS Usage .IP .nf \fC ->\ (set\ f\ (clj:partial\ #\aq+/2\ 1)) +> (set f (clj:partial #\aq+/2 1)) #Fun<clj.3.121115395> ->\ (funcall\ f\ 2) +> (funcall f 2) 3 ->\ (set\ f\ (clj:partial\ #\aq+/3\ 1)) +> (set f (clj:partial #\aq+/3 1)) #Fun<clj.3.121115395> ->\ (funcall\ f\ \aq(2\ 3)) +> (funcall f \aq(2 3)) 6 ->\ (set\ f\ (clj:partial\ #\aq+/3\ \aq(2\ 3))) +> (set f (clj:partial #\aq+/3 \aq(2 3))) #Fun<clj.3.121115395> ->\ (funcall\ f\ 4) +> (funcall f 4) 9 ->\ (set\ f\ (clj:partial\ #\aq+/4\ \aq(2\ 3))) +> (set f (clj:partial #\aq+/4 \aq(2 3))) #Fun<clj.3.121115395> ->\ (funcall\ f\ \aq(4\ 5)) +> (funcall f \aq(4 5)) 14 -\f +\fR .fi .PP Note that to partially apply a function that expects a list, you must @@ -534,250 +537,251 @@ .IP .nf \fC ->\ (set\ double\ (clj:partial\ #\aq*/2\ 2)) +> (set double (clj:partial #\aq*/2 2)) #Fun<clj.5.16146786> ->\ (set\ f\ (clj:partial\ #\aqlists:map/2\ double)) +> (set f (clj:partial #\aqlists:map/2 double)) #Fun<clj.5.16146786> ->\ (funcall\ f\ \aq((1\ 2\ 3))) -(2\ 4\ 6) -\f +> (funcall f \aq((1 2 3))) +(2 4 6) +\fR .fi .SS Predicate Functions .PP N.B. -These functions may \fInot\f be used in guards. +These functions may \fInot\fR be used in guards. .PP -\fB(string? data)\f +\fB(string? data)\fR .PP -Return \fC\aqtrue\f if \fCdata\f is a flat list of printable +Return \fC\aqtrue\fR if \fCdata\fR is a flat list of printable characters. .PP -\fB(unicode? data)\f +\fB(unicode? data)\fR .PP -Return \fC\aqtrue\f if \fCdata\f is a flat list of printable +Return \fC\aqtrue\fR if \fCdata\fR is a flat list of printable Unicode characters. .PP -\fB(list? data)\f +\fB(list? data)\fR .PP -Return \fC\aqtrue\f if \fCdata\f is a list and not a string. +Return \fC\aqtrue\fR if \fCdata\fR is a list and not a string. .PP -\fB(set? data)\f +\fB(set? data)\fR .PP -Return \fC\aqtrue\f if \fCdata\f is appears to be a (possibly -ordered) set. +Return \fC\aqtrue\fR if \fCdata\fR is appears to be a +(possibly ordered) set. .PP -\fB(dict? data)\f +\fB(dict? data)\fR .PP -Return \fC\aqtrue\f if \fCdata\f is a dictionary. +Return \fC\aqtrue\fR if \fCdata\fR is a dictionary. .PP -\fB(proplist? lst)\f +\fB(proplist? lst)\fR .PP -Return \fC\aqtrue\f if \fClst\f is a list where -\fBproplist\-kv?/1\f returns \fC\aqtrue\f for all elements in -\fClst\f. +Return \fC\aqtrue\fR if \fClst\fR is a list where +\fBproplist-kv?/1\fR returns \fC\aqtrue\fR for all elements in +\fClst\fR. .PP -\fB(proplist\-kv? data)\f +\fB(proplist-kv? data)\fR .PP -Return \fC\aqtrue\f if a \fCdata\f is a key/value tuple or an -atom. +Return \fC\aqtrue\fR if a \fCdata\fR is a key/value tuple or +an atom. .PP -\fB(queue? x)\f +\fB(queue? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is a queue. +Return \fC\aqtrue\fR if \fCx\fR is a queue. .PP -\fB(empty? x)\f +\fB(empty? x)\fR .PP -Return \fC\aqtrue\f if \fCx\f is the empty list, tuple, map, +Return \fC\aqtrue\fR if \fCx\fR is the empty list, tuple, map, dictionary, queue, or general balanced tree. .PP -\fB(every? pred lst)\f +\fB(every? pred lst)\fR .PP -\fB(all? pred lst)\f +\fB(all? pred lst)\fR .PP -Return \fC\aqtrue\f if \fC(pred\ x)\f returns -\fC\aqtrue\f for every \fCx\f in \fClst\f. +Return \fC\aqtrue\fR if \fC(pred x)\fR returns +\fC\aqtrue\fR for every \fCx\fR in \fClst\fR. .PP -\fB(any? pred lst)\f +\fB(any? pred lst)\fR .PP -Return \fC\aqtrue\f if \fC(pred\ x)\f returns -\fC\aqtrue\f for any \fCx\f in \fClst\f. +Return \fC\aqtrue\fR if \fC(pred x)\fR returns +\fC\aqtrue\fR for any \fCx\fR in \fClst\fR. .PP -\fB(not\-any? pred lst)\f +\fB(not-any? pred lst)\fR .PP -Return \fC\aqfalse\f if \fC(pred\ x)\f returns -\fC\aqtrue\f for any \fCx\f in \fClst\f. +Return \fC\aqfalse\fR if \fC(pred x)\fR returns +\fC\aqtrue\fR for any \fCx\fR in \fClst\fR. .PP -\fB(element? elem data)\f +\fB(element? elem data)\fR .PP -Return \fC\aqtrue\f if \fCelem\f is an element of -\fCdata\f, where \fCdata\f is a list, set or ordset. +Return \fC\aqtrue\fR if \fCelem\fR is an element of +\fCdata\fR, where \fCdata\fR is a list, set or ordset. .SS Sequence Functions .PP -\fB(seq end)\f +\fB(seq end)\fR .PP -Equivalent to \fC(seq\ 1\ end)\f. +Equivalent to \fC(seq 1 end)\fR. .PP -\fB(seq start end)\f +\fB(seq start end)\fR .PP -Equivalent to \fC(seq\ start\ end\ 1)\f. +Equivalent to \fC(seq start end 1)\fR. .PP -\fB(seq start end step)\f +\fB(seq start end step)\fR .PP -Return a sequence of integers, starting with \fCstart\f, containing -the successive results of adding \fCstep\f to the previous element, -until \fCend\f has been reached or password. -In the latter case, \fCend\f is not an element of the sequence. +Return a sequence of integers, starting with \fCstart\fR, containing +the successive results of adding \fCstep\fR to the previous element, +until \fCend\fR has been reached or password. +In the latter case, \fCend\fR is not an element of the sequence. .PP -\fB(next func)\f +\fB(next func)\fR .PP -Equivalent to \fC(next\ func\ 1\ 1)\f. +Equivalent to \fC(next func 1 1)\fR. .PP -\fB(next func start)\f +\fB(next func start)\fR .PP -Equivalent to \fC(next\ func\ start\ 1)\f. +Equivalent to \fC(next func start 1)\fR. .PP -\fB(next func start step)\f +\fB(next func start step)\fR .PP -Return a nullary function that returns a cons cell with \fCstart\f +Return a nullary function that returns a cons cell with \fCstart\fR as the head and a nullary function, -\fC(next\ func\ (funcall\ func\ start\ step)\ step)\f as the tail. +\fC(next func (funcall func start step) step)\fR as the tail. The result can be treated as a (possibly infinite) lazy list, which only -computes subseqeuent values as needed. +computes subsequent values as needed. .PP -\fB(lazy\-seq seq)\f +\fB(lazy-seq seq)\fR .PP Return a lazy sequence (possibly infinite) from given lazy sequence -\fCseq\f or finite lazy sequence from given list \fCseq\f. +\fCseq\fR or finite lazy sequence from given list \fCseq\fR. Lazy sequence is treated as finite if at any iteration it produces empty list instead of data as its head and nullary function for next iteration as its tail. .PP -\fB(cycle lst)\f +\fB(cycle lst)\fR .PP Return a lazy infinite sequence with all elements from a given list -\fClst\f or another lazy sequence cycled. +\fClst\fR or another lazy sequence cycled. .PP -See \fBnext/3\f for details on the structure. +See \fBnext/3\fR for details on the structure. .PP -\fB(range)\f +\fB(range)\fR .PP -Equivalent to \fC(range\ 1\ 1)\f. +Equivalent to \fC(range 1 1)\fR. .PP -\fB(range start)\f +\fB(range start)\fR .PP -Equivalent to \fC(range\ start\ 1)\f. +Equivalent to \fC(range start 1)\fR. .PP -\fB(range start step)\f +\fB(range start step)\fR .PP -Return a lazy list of integers, starting with \fCstart\f and -increasing by \fCstep\f. -Equivalent to \fC(next\ #\aq+/2\ start\ step)\f. -See also: \fBnext/3\f. +Return a lazy list of integers, starting with \fCstart\fR and +increasing by \fCstep\fR. +Equivalent to \fC(next #\aq+/2 start step)\fR. +See also: \fBnext/3\fR. .PP -\fB(drop n lst)\f +\fB(drop n lst)\fR .PP -\fB(drop \aqall lst)\f +\fB(drop \cqall lst)\fR .PP -Return a list of all but the first \fCn\f elements in \fClst\f. -If \fCn\f is the atom \fCall\f, return the empty list. +Return a list of all but the first \fCn\fR elements in +\fClst\fR. +If \fCn\fR is the atom \fCall\fR, return the empty list. .PP -\fB(take n lst)\f +\fB(take n lst)\fR .PP -\fB(take \aqall lst)\f +\fB(take \cqall lst)\fR .PP -Given a (possibly lazy) list \fClst\f, return a list of the first -\fCn\f elements of \fClst\f, or all elements if there are fewer -than \fCn\f. -If \fCn\f is the atom \fCall\f and \fClst\f is a "normal" -list, return \fClst\f. +Given a (possibly lazy) list \fClst\fR, return a list of the first +\fCn\fR elements of \fClst\fR, or all elements if there are +fewer than \fCn\fR. +If \fCn\fR is the atom \fCall\fR and \fClst\fR is a +\lqnormal\rq list, return \fClst\fR. .PP -\fB(split\-at n lst)\f +\fB(split-at n lst)\fR .PP -Return a tuple of \fC`#(,(take\ n\ lst)\ ,(drop\ n\ lst))\f. +Return a tuple of \fC\ga#(,(take n lst) ,(drop n lst))\fR. .PP -\fB(partition n lst)\f +\fB(partition n lst)\fR .PP -Equivalent to \fC(partition\ n\ n\ lst)\f. +Equivalent to \fC(partition n n lst)\fR. .PP -\fB(partition n step lst)\f +\fB(partition n step lst)\fR .PP -Equivalent to \fC(partition\ n\ step\ ()\ lst)\f. +Equivalent to \fC(partition n step () lst)\fR. .PP -\fB(partition n step pad lst)\f +\fB(partition n step pad lst)\fR .PP -Return a list of lists of \fCn\f items each, at offsets -\fCstep\f apart. -Use the elements of \fCpad\f as necessary to complete the last -partition up to \fCn\f elements. -In case there are not enough padding elements, return a parition with -less than \fCn\f items. +Return a list of lists of \fCn\fR items each, at offsets +\fCstep\fR apart. +Use the elements of \fCpad\fR as necessary to complete the last +partition up to \fCn\fR elements. +In case there are not enough padding elements, return a partition with +less than \fCn\fR items. .PP -\fB(partition\-all n lst)\f +\fB(partition-all n lst)\fR .PP -Equivalent to \fC(partition\-all\ n\ n\ lst)\f. +Equivalent to \fC(partition-all n n lst)\fR. .PP -\fB(partition\-all n step lst)\f +\fB(partition-all n step lst)\fR .PP -Return a list of lists like \fBpartition/3\f, possibly including -partitions with fewer than \fCn\f elements at the end. +Return a list of lists like \fBpartition/3\fR, possibly including +partitions with fewer than \fCn\fR elements at the end. .PP -\fB(interleave list\-1 list\-2)\f +\fB(interleave list-1 list-2)\fR .PP Return a list of the first element of each list, then the second, etc. .PP -\fB(get\-in data keys)\f +\fB(get-in data keys)\fR .PP -Equivalent to \fC(get\-in\ data\ keys\ \aqundefined)\f. +Equivalent to \fC(get-in data keys \aqundefined)\fR. .PP -\fB(get\-in data keys not\-found)\f +\fB(get-in data keys not-found)\fR .PP -Return the value in a nested associative structure, where \fCkeys\f +Return the value in a nested associative structure, where \fCkeys\fR is a list of keys or list indices. -Return the atom \fCnot\-found\f if the key is not present or index -is out of bounds, or the \fCnot\-found\f value. +Return the atom \fCnot-found\fR if the key is not present or index +is out of bounds, or the \fCnot-found\fR value. .PP -\fB(reduce func (cons head tail))\f +\fB(reduce func (cons head tail))\fR .PP -Equivalent to \fC(reduce\ func\ head\ tail)\f. +Equivalent to \fC(reduce func head tail)\fR. .PP -\fB(reduce func acc lst)\f +\fB(reduce func acc lst)\fR .PP -Equivalent to \fC(lists:foldl\ func\ acc\ lst)\f. +Equivalent to \fC(lists:foldl func acc lst)\fR. .PP -\fB(repeat x)\f +\fB(repeat x)\fR .PP -Return a lazy infinite sequence of \fCx\fs. +Return a lazy infinite sequence of \fCx\fRs. .PP -See \fBnext/3\f for details on the structure. +See \fBnext/3\fR for details on the structure. .PP -\fB(repeat n f)\f +\fB(repeat n f)\fR .PP -Given a nullary function \fCf\f, return a list of \fCn\f -applications of \fCf\f. +Given a nullary function \fCf\fR, return a list of \fCn\fR +applications of \fCf\fR. .PP -\fB(repeat n x)\f +\fB(repeat n x)\fR .PP -Given a term \fCx\f, return a list of \fCn\f copies of -\fCx\f. +Given a term \fCx\fR, return a list of \fCn\fR copies of +\fCx\fR. .SS Other Functions .PP -\fB(identity x)\f +\fB(identity x)\fR .PP Identity function. .PP -\fB(constantly x)\f +\fB(constantly x)\fR .PP -Return a unary function that returns \fCx\f. +Return a unary function that returns \fCx\fR. N.B. -This is like Haskell\aqs \fCconst\f rather than Clojure\aqs -\fCconstantly\f. +This is like Haskell\cqs \fCconst\fR rather than Clojure\cqs +\fCconstantly\fR. .PP -\fB(inc x)\f +\fB(inc x)\fR .PP -Increment \fCx\f by 1. +Increment \fCx\fR by 1. .PP -\fB(dec x)\f +\fB(dec x)\fR .PP -Decrement \fCx\f by 1. +Decrement \fCx\fR by 1. .SH AUTHORS Tim Dysinger, Duncan McGreggor, Eric Bailey.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_comp.3 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_comp.3
Changed
@@ -1,10 +1,10 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe_comp" "3" "2008\-2016" "" "" +.TH "lfe_comp" "3" "2008-2016" "" "" .hy .SH NAME .PP -lfe_comp \- Lisp Flavoured Erlang (LFE) compiler +lfe_comp - Lisp Flavoured Erlang (LFE) compiler .SH SYNOPSIS .PP This module provides an interface to the standard LFE compiler. @@ -13,24 +13,24 @@ return binaries which can be loaded directly. .SH EXPORTS .PP -\fBfile(FileName) \-> CompRet\f +\fBfile(FileName) -> CompRet\fR .PP -Is the same as \fCfile(FileName,\ report).\f +Is the same as \fCfile(FileName, report).\fR .PP -\fBfile(FileName, Options) \-> CompRet\f +\fBfile(FileName, Options) -> CompRet\fR .PP where .IP .nf \fC -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} -\f +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} +\fR .fi .PP Compile an LFE file, either writing the generated modules to files or @@ -39,102 +39,107 @@ .PP The currently recognised options are: .IP \bu 2 -\fCbinary\f \- Return the binary of the module and do not save it in +\fCbinary\fR - Return the binary of the module and do not save it in a file. .IP \bu 2 -\fCno_docs\f, \fCno\-docs\f \- Do not parse docstrings and write -the \fC"LDoc"\f chunk in the binary of the module. +\fCno_docs\fR, \fCno-docs\fR - Do not parse docstrings and write +the \fC\dqLDoc\dq\fR chunk in the binary of the module. .IP \bu 2 -\fCto_expand\f, \fCto\-expand\f \- Print a listing of the macro +\fCto_expand\fR, \fCto-expand\fR - Print a listing of the macro expanded LFE code in the file .expand. No object file is produced. Mainly useful for debugging and interest. .IP \bu 2 -\fCto_lint\f, \fCto\-lint\f \- Print a listing of the macro +\fCto_lint\fR, \fCto-lint\fR - Print a listing of the macro expanded and linted LFE code in the files .lint. No object files are produced. Mainly useful for debugging and interest. .IP \bu 2 -\fCto_core0\f, \fCto\-core0\f, \fCto_core\f, -\fCto\-core\f \- Print a listing of the Core Erlang code -before/after being optimised in the files .core. +\fCto_erlang\fR, \fCto-erlang\fR - Print a listing of the Erlang +AST in the file .erl. No object files are produced. Mainly useful for debugging and interest. .IP \bu 2 -\fCto_kernel\f, \fCto\-kernel\f \- Print a listing of the Kernel +\fCto_core0\fR, \fCto-core0\fR, \fCto_core\fR, +\fCto-core\fR - Print a listing of the Core Erlang code before/after +being optimised in the files .core. +No object files are produced. +Mainly useful for debugging and interest. +.IP \bu 2 +\fCto_kernel\fR, \fCto-kernel\fR - Print a listing of the Kernel Erlang code in the files .kernel. No object files are produced. Mainly useful for debugging and interest. .IP \bu 2 -\fCto_asm\f, \fCto\-asm\f \- Print a listing of the Beam code in +\fCto_asm\fR, \fCto-asm\fR - Print a listing of the Beam code in the files .S. No object files are produced. Mainly useful for debugging and interest. .IP \bu 2 -\fC{outdir,Dir}\f, \fCoutdir,Dir\f \- Save the generated files -in director Dir instead of the current directory. +\fC{outdir,Dir}\fR, \fCoutdir,Dir\fR - Save the generated +files in director Dir instead of the current directory. .IP \bu 2 -\fC{i,Dir}\f, \fCi,Dir\f \- Add dir to the list of directories -to be searched when including a file. +\fC{i,Dir}\fR, \fCi,Dir\fR - Add dir to the list of +directories to be searched when including a file. .IP \bu 2 -\fCreport\f \- Print the errors and warnings as they occur. +\fCreport\fR - Print the errors and warnings as they occur. .IP \bu 2 -\fCreturn\f \- Return an extra return field containing Warnings on -success or the errors and warnings in \fC{error,Errors,Warnings}\f +\fCreturn\fR - Return an extra return field containing Warnings on +success or the errors and warnings in \fC{error,Errors,Warnings}\fR when there are errors. .IP \bu 2 -\fCdebug_print\f, \fCdebug\-print\f \- Causes the compiler to +\fCdebug_print\fR, \fCdebug-print\fR - Causes the compiler to print a lot of debug information. .IP \bu 2 -\fCwarnings_as_errors\f, \fCwarnings\-as\-errors\f \- Causes +\fCwarnings_as_errors\fR, \fCwarnings-as-errors\fR - Causes warnings to be treated as errors. .IP \bu 2 -\fCno_export_macros\f, \fCno\-export\-macros\f \- Do not export +\fCno_export_macros\fR, \fCno-export-macros\fR - Do not export macros from modules. .PP If the binary option is given then options that produce listing files will cause the internal formats for that compiler pass to be returned. .PP -Both \fCWarnings\f and \fCErrors\f have the following format: +Both \fCWarnings\fR and \fCErrors\fR have the following format: .IP .nf \fC {FileName,ErrorInfo} -\f +\fR .fi .PP -\fCErrorInfo\f is described below. +\fCErrorInfo\fR 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. .PP -\fBforms(Forms) \-> CompRet\f +\fBforms(Forms) -> CompRet\fR .PP Is the same as forms(Forms, report). .PP -\fBforms(Forms, Options) \-> CompRet\f +\fBforms(Forms, Options) -> CompRet\fR .PP where .IP .nf \fC -Forms\ =\ sexpr() -CompRet\ =\ BinRet\ |\ ErrRet -BinRet\ =\ {ok,ModBin}\ |\ {ok,ModBin,Warnings} -ModBin\ =\ {ok,ModuleName,Binary}\ |\ {ok,ModuleName,Binary,Warnings} -ErrRet\ =\ error\ |\ {error,ModErr,Errors,Warnings} -ModErr\ =\ {error,Errors,Warnings} -\f +Forms = sexpr() +CompRet = BinRet | ErrRet +BinRet = {ok,ModBin} | {ok,ModBin,Warnings} +ModBin = {ok,ModuleName,Binary} | {ok,ModuleName,Binary,Warnings} +ErrRet = error | {error,ModErr,Errors,Warnings} +ModErr = {error,Errors,Warnings} +\fR .fi .PP Compile the forms as an LFE module returning a binary. -This function takes the same options as \fClfe_comp:file/1/2\f. -When generating Errors and Warnings the "line number" is the index of -the form in which the error occured. +This function takes the same options as \fClfe_comp:file/1/2\fR. +When generating Errors and Warnings the \lqline number\rq is the +index of the form in which the error occurred. .PP -\fBformat_error(Error) \-> Chars\f +\fBformat_error(Error) -> Chars\fR .PP Uses an ErrorDescriptor and returns a deep list of characters which describes the error. @@ -143,21 +148,21 @@ See below. .SH ERROR INFORMATION .PP -The \fCErrorInfo\f mentioned above is the standard -\fCErrorInfo\f structure which is returned from all IO modules. +The \fCErrorInfo\fR mentioned above is the standard +\fCErrorInfo\fR structure which is returned from all IO modules. It has the following format: .PP -\fB{ErrorLine,Module,ErrorDescriptor}\f +\fB{ErrorLine,Module,ErrorDescriptor}\fR .PP A string describing the error is obtained with the following call: .IP .nf \fC Module:format_error(ErrorDescriptor) -\f +\fR .fi .SH SEE ALSO .PP -\fBlfe_gen(3)\f, \fBlfe_macro(3)\f +\fBlfe_gen(3)\fR, \fBlfe_macro(3)\fR .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_docs.3
Added
@@ -0,0 +1,31 @@ +.\" Automatically generated by Pandoc 2.11.2 +.\" +.TH "lfe_docs" "3" "2016" "" "" +.hy +.SH NAME +.PP +lfe_docs - Lisp Flavoured Erlang (LFE) documentation handling. +.SH SYNOPSIS +.PP +This module provides functions to parse docstrings in LFE module sources +in EEP48 format. +.SH EXPORTS +.PP +\fBmake_chunk(Mod, CompilerInfo) -> {ok,DocsChunk}\fR +.PP +Parse a module\cqs docstrings and return a documentation chunk. +.PP +\fBmake_docs_info(Mod, CompilerInfo) -> {ok,DocsInfo}\fR +.PP +Parse a module\cqs docstrings and return the documentation info. +.PP +\fBget_module_docs(Module | Binary) -> {ok,DocsInfo} | +{error,Error}\fR +.PP +Extract the documentation from a module documentation chunk and return +it in the documentation format of the current Erlang version. +.SH SEE ALSO +.PP +\fBlfe_comp(3)\fR, \fBlfe_macro(3)\fR +.SH AUTHORS +Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_gen.3 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_gen.3
Changed
@@ -1,61 +1,61 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe_gen" "3" "2008\-2016" "" "" +.TH "lfe_gen" "3" "2008-2016" "" "" .hy .SH NAME .PP -lfe_gen \- Lisp Flavoured Erlang (LFE) dynamic code generator +lfe_gen - Lisp Flavoured Erlang (LFE) dynamic code generator .SH SYNOPSIS .PP This module provides an experimental interface for dynamically generating modules. .SH DATA TYPES .PP -\fBsexpr()\f +\fBsexpr()\fR .PP -An LFE s\-expression, a list structure. +An LFE s-expression, a list structure. .SH EXPORTS .PP -\fBnew_module(Name) \-> ModDef.\f +\fBnew_module(Name) -> ModDef.\fR .PP -\fBadd_exports(Name,Arity, ModDef) \-> ModDef.\f +\fBadd_exports(Name,Arity, ModDef) -> ModDef.\fR .PP -\fBadd_imports(from,Module|Functions, ModDef) \-> ModDef.\f +\fBadd_imports(from,Module|Functions, ModDef) -> ModDef.\fR .PP -\fBadd_imports(rename,Module|Renames, ModDef) \-> ModDef.\f +\fBadd_imports(rename,Module|Renames, ModDef) -> ModDef.\fR .PP -\fBadd_attribute(Attribute, ModDef) \-> ModDef.\f +\fBadd_attribute(Attribute, ModDef) -> ModDef.\fR .PP -\fBadd_form(Form, ModDef) \-> ModDef.\f +\fBadd_form(Form, ModDef) -> ModDef.\fR .PP -\fBbuild_mod(ModDef) \-> Forms.\f +\fBbuild_mod(ModDef) -> Forms.\fR .PP -\fBcompile_mod(Mod) \-> CompRet\f +\fBcompile_mod(Mod) -> CompRet\fR .PP where .IP .nf \fC -CompRet\ =\ BinRet\ |\ ErrRet -BinRet\ =\ {ok,ModuleName,Binary,Warnings} -ErrRet\ =\ {error,Errors,Warnings} -\f +CompRet = BinRet | ErrRet +BinRet = {ok,ModuleName,Binary,Warnings} +ErrRet = {error,Errors,Warnings} +\fR .fi .PP These functions are used to incrementally create a module which can at -the end be compiled by \fCcompile_mod/1\f. +the end be compiled by \fCcompile_mod/1\fR. The various components have the same formats as they do when defining a module in a file. -A simple module which defines one function \fCa/0\f could be defined -with: +A simple module which defines one function \fCa/0\fR could be +defined with: .IP .nf \fC -M0\ =\ lfe_gen:new_module(foo), -M1\ =\ lfe_gen:add_exports(a,0,\ M0), -M2\ =\ lfe_gen:add_form(defun,a,,quote,yes,\ M1), +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) -\f +\fR .fi .SH EXAMPLE .PP @@ -69,17 +69,17 @@ .IP .nf \fC -\-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. \&... -\f +\fR .fi .PP but generating it and compiling it directly in memory without generating @@ -88,51 +88,51 @@ .IP .nf \fC -Params\ =\ {Parameter,{Feature,Value}} -\f +Params = {Parameter,{Feature,Value}} +\fR .fi .PP The equivalent LFE code which we will be generating is: .IP .nf \fC -(defmodule\ Name -\ \ (export\ (<param1>\ 1)\ (<param2>\ 1)\ ...\ )) +(defmodule Name + (export (<param1> 1) (<param2> 1) ... )) -(defun\ <param1>\ (f) -\ \ (case\ f -\ \ \ \ (\aq<feature1>\ \aq<value1>) -\ \ \ \ ... -\ \ \ \ (f\ (:\ erlang\ error\ (tuple\ \aqunknown_feature\ \aq<param1>\ f))))) +(defun <param1> (f) + (case f + (\aq<feature1> \aq<value1>) + ... + (f (: erlang error (tuple \aqunknown_feature \aq<param1> f))))) \&... -\f +\fR .fi .PP The following code builds and compiles a module from the parameter data: .IP .nf \fC -make_module(Name,\ Params)\ \-> -\ \ \ \ Mod0\ =\ lfe_gen:new_module(Name), -\ \ \ \ Exps\ =\ lists:map(fun\ ({Param,_})\ \->\ Param,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 = lists:map(fun ({Param,_}) -> Param,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,\aq:\aq,erlang,error, -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ tuple,unknown_feature,quote,Param,f, -\ \ \ \ %%\ Build\ case\ clauses -\ \ \ \ Fold\ =\ fun\ ({Feature,Value},\ Cls)\ \-> -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ quote,Feature,quote,Value|Cls -\ \ \ \ \ \ \ \ \ \ \ end -\ \ \ \ Cls\ =\ lists:foldr(Fold,\ CatchAll,\ Params), -\ \ \ \ %%\ Build\ function. -\ \ \ \ Func\ =\ defun,Param,f,\aqcase\aq,f,Cls, -\ \ \ \ make_funcs(Ps,\ lfe_gen:add_form(Func,\ Mod)); -make_funcs(,\ Mod)\ \->\ Mod.\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ %All\ done -\f +make_funcs({Param,Fs}|Ps, Mod) -> + %% Define catch-all which generates more explicit exit value. + CatchAll = f,\aq:\aq,erlang,error, + tuple,unknown_feature,quote,Param,f, + %% Build case clauses + Fold = fun ({Feature,Value}, Cls) -> + quote,Feature,quote,Value|Cls + end + Cls = lists:foldr(Fold, CatchAll, Params), + %% Build function. + Func = defun,Param,f,\aqcase\aq,f,Cls, + make_funcs(Ps, lfe_gen:add_form(Func, Mod)); +make_funcs(, Mod) -> Mod. %All done +\fR .fi .PP This module could be generated and then be loaded into the system by @@ -140,30 +140,30 @@ .IP .nf \fC -{ok,ModuleName,Binary,Warnings}\ =\ make_module(Name,\ Params), -code:load_binary(ModuleName,\ "nofile",\ Binary) -\f +{ok,ModuleName,Binary,Warnings} = make_module(Name, Params), +code:load_binary(ModuleName, \dqnofile\dq, Binary) +\fR .fi .PP -The second argument to \fCcode:load_binary/3\f, here -\fC"nofile"\f, is irrelevant in this case. +The second argument to \fCcode:load_binary/3\fR, here +\fC\dqnofile\dq\fR, is irrelevant in this case. .SH ERROR INFORMATION .PP The ErrorInfo mentioned above is the standard ErrorInfo structure which is returned from all IO modules. It has the following format: .PP -\fB{ErrorLine,Module,ErrorDescriptor}\f +\fB{ErrorLine,Module,ErrorDescriptor}\fR .PP A string describing the error is obtained with the following call: .IP .nf \fC -apply(Module,\ format_error,\ ErrorDescriptor) -\f +apply(Module, format_error, ErrorDescriptor) +\fR .fi .SH SEE ALSO .PP -\fBlfe_comp(3)\f, \fBlfe_macro(3)\f +\fBlfe_comp(3)\fR, \fBlfe_macro(3)\fR .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_guide.7 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_guide.7
Changed
@@ -1,14 +1,28 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.19.1 .\" -.TH "lfe_guide" "7" "2008\-2016" "" "" +.\" Define V font for inline verbatim, using C font in formats +.\" that render this, and otherwise B font. +.ie "\fCBx\f"x" \{\ +. ftr V B +. ftr VI BI +. ftr VB B +. ftr VBI BI +.\} +.el \{\ +. ftr V CR +. ftr VI CI +. ftr VB CB +. ftr VBI CBI +.\} +.TH "lfe_guide" "7" "2008-2020" "" "" .hy .SH NAME .PP -lfe_guide \- Lisp Flavoured Erlang User Guide -.SH SYNPOSIS +lfe_guide - Lisp Flavoured Erlang User Guide +.SH SYNOPSIS .PP -Note: {{ ... -}} is use to denote optional syntax. +Note: {{ \&... +}} is used to denote optional syntax. .SH LITERALS AND SPECIAL SYNTACTIC RULES .SS Integers .PP @@ -18,56 +32,56 @@ .IP .nf \fC -\ \ 1234\ \-123\ 0 -\f + 1234 -123 0 +\fR .fi .IP \bu 2 Binary notation: .IP .nf \fC -\ \ #b0\ #b10101\ #b\-1100 -\f + #b0 #b10101 #b-1100 +\fR .fi .IP \bu 2 Binary notation (alternative form): .IP .nf \fC -\ \ #*0\ #b*10101\ #*\-1100 -\f + #*0 #*10101 #*-1100 +\fR .fi .IP \bu 2 Octal notation: .IP .nf \fC -\ \ #o377\ #o\-111 -\f + #o377 #o-111 +\fR .fi .IP \bu 2 Explicitly decimal notation: .IP .nf \fC -\ \ #d1234\ #d\-123\ #d0 -\f + #d1234 #d-123 #d0 +\fR .fi .IP \bu 2 Hexadecimal notation: .IP .nf \fC -\ \ #xc0ffe\ 0x\-01 -\f + #xc0ffe #x-01 +\fR .fi .IP \bu 2 Notation with explicit base (up to 36): .IP .nf \fC -\ \ #2r1010\ #8r377\ #36rhelloworld -\f + #2r1010 #8r377 #36rhelloworld +\fR .fi .IP \bu 2 Character notation (the value is the Unicode code point of the @@ -75,53 +89,51 @@ .IP .nf \fC -\ \ #\\a\ #\\$\ #\\ä -\f + #\rsa #\rs$ #\rs\:a +\fR .fi .IP \bu 2 Character notation with the value in hexadecimal: .IP .nf \fC -\ \ #\\x1f42d; -\f + #\rsx1f42d; +\fR .fi .PP In all these forms, the case of the indicating letter is not -significant, i.e. -\fC#b1010\f and \fC#B1010\f are identical as are -\fC#16rf00\f and \fC#16Rf00\f. -.PP -Similarly, the case is not significant for digits beyond 9 (i.e. -\aqa\aq, \aqb\aq, \aqc\aq, \&... for number bases larger -than 10), e.g. -\fC#xabcd\f is the same as \fC#xABCD\f and can even be mixed in -the same number, e.g. -\fC#36rHelloWorld\f is valid and the same number as -\fC#36Rhelloworld\f and \fC#36rHELLOWORLD\f. +significant, i.e.\ \fV#b1010\fR and \fV#B1010\fR are identical +as are \fV#16rf00\fR and \fV#16Rf00\fR. +.PP +Similarly, the case is not significant for digits beyond 9 (i.e.\ `a', +`b', `c', \&... +for number bases larger than 10), e.g.\ \fV#xabcd\fR is the same as +\fV#xABCD\fR and can even be mixed in the same number, +e.g.\ \fV#36rHelloWorld\fR is valid and the same number as +\fV#36Rhelloworld\fR and \fV#36rHELLOWORLD\fR. .PP The character notation using hexadecimal code representation -(\fC#\\x....;\f) is basically the same thing as the regular -hexadecimal notation \fC#x...\f 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). +(\fV#\rsx....;\fR) is basically the same thing as the regular +hexadecimal notation \fV#x...\fR 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). .SS Floating point numbers .PP 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: +written in the usual way, e.g.\ these are all valid floating point +numbers: .IP .nf \fC -1.0\ +1.0\ \-1.0\ 1.0e10\ 1.111e\-10 -\f +1.0 +1.0 -1.0 1.0e10 1.111e-10 +\fR .fi .PP -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. +The one thing to watch out for is that you cannot omit the part before +or after the decimal point if it is zero. E.g. -the following are not valid forms: \fC100.\f or \fC\&.125\f. +the following are not valid forms: \fV100.\fR or \fV.125\fR. .SS Strings .PP There are two forms of strings: list strings and binary strings. @@ -131,30 +143,32 @@ 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 \fC\\n\f can be escaped". +like it is meant to be a string): \lqany text between double quotes +where \dq and other special characters like \fV\rsn\fR can be +escaped\rq. .PP As a special case you can also write out the character number in the -form \fC\\xHHH;\f (where "HHH" is an integer in hexadecimal -notation), e.g. -\fC"\\x61;\\x62;\\x63;"\f is a complicated way of writing -\fC"abc"\f. +form \fV\rsxHHH;\fR (where \lqHHH\rq is an integer in +hexadecimal notation), +e.g.\ \fV\dq\rsx61;\rsx62;\rsx63;\dq\fR is a complicated +way of writing \fV\dqabc\dq\fR. This can be convenient when writing Unicode letters not easily typeable or viewable with regular fonts. E.g. -\fC"Cat:\ \\\\x1f639;"\f might be easier to type (and view on output -devices without a Unicode font) then typing the actual unicode letter. +\fV\dqCat: \rs\rsx1f639;\dq\fR might be easier to type (and +view on output devices without a Unicode font) then typing the actual +Unicode letter. .SS Binary Strings .PP Binary strings are just like list strings but they are represented differently in the virtual machine. -The simple syntax is \fC#"..."\f, e.g. -\fC#"This\ is\ a\ binary\ string\ \\n\ with\ some\ \\"escaped\\"\ and\ quoted\ (\\\\x1f639;)\ characters"\f +The simple syntax is \fV#\dq...\dq\fR, e.g. +\fV#\dqThis is a binary string \rsn with some \rs\dqescaped\rs\dq and quoted (\rs\rsx1f639;) characters\dq\fR .PP You can also use the general format for creating binaries -(\fC#B(...)\f, described below), e.g. -\fC#B("a")\f, \fC#"a"\f, and \fC#B(97)\f are all the same -binary string. +(\fV#B(...)\fR, described below), e.g.\ \fV#B(\dqa\dq)\fR, +\fV#\dqa\dq\fR, and \fV#B(97)\fR are all the same binary +string. .SS Character Escaping .PP Certain control characters can be more readably included by using their @@ -162,26 +176,27 @@ .IP .nf \fC -\ \ |\ Escaped\ name\ |\ Character\ \ \ \ \ \ \ | -\ \ |\-\-\-\-\-\-\-\-\-\-\-\-\-\-+\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-| -\ \ |\ \\b\ \ \ \ \ \ \ \ \ \ \ |\ Backspace\ \ \ \ \ \ \ | -\ \ |\ \\t\ \ \ \ \ \ \ \ \ \ \ |\ Tab\ \ \ \ \ \ \ \ \ \ \ \ \ | -\ \ |\ \\n\ \ \ \ \ \ \ \ \ \ \ |\ Newline\ \ \ \ \ \ \ \ \ | -\ \ |\ \\v\ \ \ \ \ \ \ \ \ \ \ |\ Vertical\ tab\ \ \ \ | -\ \ |\ \\f\ \ \ \ \ \ \ \ \ \ \ |\ Form\ Feed\ \ \ \ \ \ \ | -\ \ |\ \\r\ \ \ \ \ \ \ \ \ \ \ |\ Carriage\ Return\ | -\ \ |\ \\e\ \ \ \ \ \ \ \ \ \ \ |\ Escape\ \ \ \ \ \ \ \ \ \ | -\ \ |\ \\s\ \ \ \ \ \ \ \ \ \ \ |\ Space\ \ \ \ \ \ \ \ \ \ \ | -\ \ |\ \\d\ \ \ \ \ \ \ \ \ \ \ |\ Delete\ \ \ \ \ \ \ \ \ \ | -\f + | Escaped name | Character | + |--------------+-----------------| + | \rsb | Backspace | + | \rst | Tab | + | \rsn | Newline | + | \rsv | Vertical tab | + | \rsf | Form Feed | + | \rsr | Carriage Return | + | \rse | Escape | + | \rss | Space | + | \rsd | Delete | +\fR .fi .PP -Alternatively you can also use the hexadecimal character encoding, e.g. -\fC"a\\nb"\f and \fC"a\\x0a;b"\f are the same string. +Alternatively you can also use the hexadecimal character encoding, +e.g.\ \fV\dqa\rsnb\dq\fR and \fV\dqa\rsx0a;b\dq\fR +are the same string. .SS Binaries .PP -We have already seen binary strings, but the \fC#B(...)\f syntax can -be used to create binaries with any contents. +We have already seen binary strings, but the \fV#B(...)\fR 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. .PP @@ -189,240 +204,250 @@ .IP .nf \fC ->\ #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" -\f +> #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((#\dqa\dq binary) (#\dqb\dq binary)) +#\dqab\dq +\fR .fi .PP -Learn more about "segments" of binary data e.g. -in "Learn You Some -Erlang (http://learnyousomeerlang.com/starting-out-for-real#bit-syntax)" +Learn more about \lqsegments\rq of binary data e.g.\ in \lqLearn +You Some +Erlang (http://learnyousomeerlang.com/starting-out-for-real#bit-syntax)\rq <http://learnyousomeerlang.com/starting-out-for-real#bit-syntax>. .SS Lists .PP -Lists are formed either as \fC(\ ...\ )\f or \fC\ ...\ \f -where the optional elements of the list are separated by some form or +Lists are formed either as \fV( ... )\fR or \fV ... \fR where +the optional elements of the list are separated by some form or whitespace. For example: .IP .nf \fC () -(the\ empty\ list) -(foo\ bar\ baz) +(the empty list) +(foo bar baz) (foo -\ bar -\ baz) -\f + bar + baz) +\fR .fi .SS Tuples .PP -Tuples are written as \fC#(value1\ value2\ ...)\f. -The empty tuple \fC#()\f is also valid. +Tuples are written as \fV#(value1 value2 ...)\fR. +The empty tuple \fV#()\fR is also valid. .SS Maps .PP -Maps are written as \fC#M(key1\ value1\ key2\ value2\ ...)\f The -empty map is also valid and written as \fC#M()\f. +Maps are written as \fV#M(key1 value1 key2 value2 ...)\fR The empty +map is also valid and written as \fV#M()\fR. .SS Symbols .PP Things that cannot be parsed as any of the above are usually considered as a symbol. .PP -Simple examples are \fCfoo\f, \fCFoo\f, \fCfoo\-bar\f, -\fC:foo\f. -But also somewhat surprisingly \fC123foo\f and \fC1.23e4extra\f -(but note that illegal digits don\aqt make a number a symbol when -using the explicit number base notation, e.g. -\fC#b10foo\f gives an error). +Simple examples are \fVfoo\fR, \fVFoo\fR, \fVfoo-bar\fR, +\fV:foo\fR. +But also somewhat surprisingly \fV123foo\fR and +\fV1.23e4extra\fR (but note that illegal digits don\cqt make a +number a symbol when using the explicit number base notation, +e.g.\ \fV#b10foo\fR gives an error). .PP Symbol names can contain a surprising breadth or characters, basically -all of the latin\-1 character set without control character, whitespace, +all of the latin-1 character set without control character, whitespace, the various brackets, double quotes and semicolon. .PP -Of these, only \fC|\f, \fC\\\aq\f, \fC\aq\f, \fC,\f, -and \fC#\f may not be the first character of the symbol\aqs name -(but they \fIare\f allowed as subsequent letters). +Of these, only \fV|\fR, \fV\rs\aq\fR, \fV\aq\fR, +\fV,\fR, and \fV#\fR may not be the first character of the +symbol\cqs name (but they \fIare\fR allowed as subsequent +letters). .PP I.e. -these are all legal symbols: \fCfoo\f, \fCfoo\f, \fCµ#\f, -\fC±1\f, \fC451°F\f. +these are all legal symbols: \fVfoo\fR, \fVfoo\fR, +\fV\mc#\fR, \fV\t+-1\fR, \fV451\deF\fR. .PP Symbols can be explicitly constructed by wrapping their name in vertical -bars, e.g. -\fC|foo|\f, \fC|symbol\ name\ with\ spaces|\f. +bars, e.g.\ \fV|foo|\fR, \fV|symbol name with spaces|\fR. In this case the name can contain any character of in the range from 0 -to 255 (or even none, i.e. -\fC||\f is a valid symbol). +to 255 (or even none, i.e.\ \fV||\fR is a valid symbol). The vertical bar in the symbol name needs to be escaped: -\fC|symbol\ with\ a\ vertical\ bar\ \\|\ in\ its\ name|\f (similarly -you will obviously have to escape the escape character as well). +\fV|symbol with a vertical bar \rs| in its name|\fR (similarly you +will obviously have to escape the escape character as well). .SS Comments .PP Comments come in two forms: line comments and block comments. .PP -Line comments start with a semicolon (\fC;\f) and finish with the +Line comments start with a semicolon (\fV;\fR) and finish with the end of the line. .PP -Block comments are written as \fC#|\ comment\ text\ |#\f where the +Block comments are written as \fV#| comment text |#\fR where the comment text may span multiple lines but my not contain another block -comment, i.e. -it may not contain the character sequence \fC#|\f. +comment, i.e.\ it may not contain the character sequence \fV#|\fR. .SS Evaluation While Reading .PP -\fC#.(...\ some\ expression\ ...)\f. +\fV#.(... some expression ...)\fR. E.g. -\fC#.(+\ 1\ 1)\f will evaluate the \fC(+\ 1\ 1)\f while it reads -the expression and then be effectively \fC2\f. +\fV#.(+ 1 1)\fR will evaluate the \fV(+ 1 1)\fR while it reads +the expression and then be effectively \fV2\fR. .SH Supported forms .SS Core forms .IP .nf \fC -(quote\ e) -(cons\ head\ tail) -(car\ e) -(cdr\ e) -(list\ e\ ...\ ) -(tuple\ e\ ...\ ) -(tref\ tuple\ index) -(tset\ tuple\ index\ val) -(binary\ seg\ ...\ ) -(map\ key\ val\ ...) -(map\-get\ m\ k)\ (map\-set\ m\ k\ v\ ...)\ (map\-update\ m\ k\ v\ ...) -(lambda\ (arg\ ...)\ ...) -(match\-lambda -\ \ ((arg\ ...\ )\ {{(when\ e\ ...)}}\ ...)\ \ \ \ \ \ \ \ \ \ \ \-\ Matches\ clauses -\ \ ...\ ) -(function\ func\-name\ arity)\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \-\ Function\ references -(function\ mod\-name\ func\-name\ arity) -(let\ ((pat\ {{(when\ e\ ...)}}\ e) -\ \ \ \ \ \ ...) -\ \ ...\ ) -(let\-function\ ((name\ lambda|match\-lambda)\ \ \ \ \ \-\ Local\ functions -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ...\ ) -\ \ ...\ ) -(letrec\-function\ ((name\ lambda|match\-lambda)\ \ \-\ Local\ functions -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ...\ ) -\ \ ...\ ) -(let\-macro\ ((name\ lambda\-match\-lambda)\ \ \ \ \ \ \ \ \-\ Local\ macros -\ \ \ \ \ \ \ \ \ \ \ \ ...) -\ \ ...) -(progn\ ...\ ) -(if\ test\ true\-expr\ {{false\-expr}}) -(case\ e -\ \ (pat\ {{(when\ e\ ...)}}\ ...) -\ \ ...\ )) +(quote e) +(cons head tail) +(car e) +(cdr e) +(list e ... ) +(tuple e ... ) +(tref tuple index) +(tset tuple index val) +(binary seg ... ) +(map key val ...) +(map-size map) (msiz m) +(map-get map key) (mref m k) +(map-set map key val ...) (mset m k v ...) +(map-update map key val ...) (mupd m k v ...) +(map-remove map key ...) (mrem m k k ...) +(lambda (arg ...) ...) +(match-lambda + ((arg ... ) {{(when e ...)}} ...) - Matches clauses + ... ) +(function func-name arity) - Function reference +(function mod-name func-name arity) +(let ((pat {{(when e ...)}} e) + ...) + ... ) +(let-function ((name lambda|match-lambda) - Local functions + ... ) + ... ) +(letrec-function ((name lambda|match-lambda) - Local functions + ... ) + ... ) +(let-macro ((name lambda-match-lambda) - Local macros + ...) + ...) +(progn ... ) +(if test true-expr {{false-expr}}) +(case e + (pat {{(when e ...)}} ...) + ... )) (receive -\ \ (pat\ {{(when\ e\ ...)}}\ ...\ ) -\ \ ... -\ \ (after\ timeout\ ...\ )) -(catch\ ...\ ) + (pat {{(when e ...)}} ... ) + ... + (after timeout ... )) +(catch ... ) (try -\ \ e -\ \ {{(case\ ((pat\ {{(when\ e\ ...)}}\ ...\ ) -\ \ \ \ \ \ \ \ \ \ ...\ ))}} -\ \ {{(catch -\ \ \ \ \ (((tuple\ type\ value\ ignore)\ {{(when\ e\ ...)}} -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \-\ Must\ be\ tuple\ of\ length\ 3! -\ \ \ \ \ \ ...\ ) -\ \ \ \ \ ...\ )}} -\ \ {{(after\ ...\ )}}) -(funcall\ func\ arg\ ...\ ) -(call\ mod\ func\ arg\ ...\ )\ \ \ \ \ \ \ \ \-\ Call\ to\ Mod:Func(Arg,\ ...\ ) + e + {{(case ((pat {{(when e ...)}} ... ) + ... ))}} + {{(catch + ((tuple type value stacktrace)|_ {{(when e ...)}} + - Must be tuple of length 3 or just _! + ... ) + ... )}} + {{(after ... )}}) +(funcall func arg ... ) +(call mod func arg ... ) - Call to Mod:Func(Arg, ... ) + +(define-record name fields) +(record name field val ...) +(is-record record name) +(record-index name field) +(record-field record name field) +(record-update record name field val ...) + +(define-struct fields) +(struct field val ...) +(is-struct struct) +(is-struct struct name) +(struct-field struct name field) +(struct-update struct name field val ...) + +(define-module name meta-data attributes) +(extend-module meta-data attributes) -(define\-module\ name\ meta\-data\ attributes) -(extend\-module\ meta\-data\ attributes) +(define-function name meta-data lambda|match-lambda) +(define-macro name meta-data lambda|match-lambda) -(define\-function\ name\ meta\-data\ lambda|match\-lambda) -(define\-macro\ name\ meta\-data\ lambda|match\-lambda) -\f +(define-type type definition) +(define-opaque-type type definition) +(define-function-spec func spec) +\fR .fi .SS Basic macro forms .IP .nf \fC -(:\ mod\ func\ arg\ ...\ )\ => -\ \ \ \ \ \ \ \ (call\ \aqmod\ \aqfunc\ arg\ ...\ ) -(mod:func\ arg\ ...\ )\ => -\ \ \ \ \ \ \ \ (call\ \aqmod\ \aqfunc\ arg\ ...\ ) -(?\ {{timeout\ {{default}}\ }}) -(++\ ...\ ) -(list*\ ...) -(let*\ (...)\ ...\ ) -(flet\ ((name\ (arg\ ...)\ {{doc\-string}}\ ...) -\ \ \ \ \ \ \ ...) -\ \ ...) -(flet*\ (...)\ ...\ ) -(fletrec\ ((name\ (arg\ ...)\ {{doc\-string}}\ ...) -\ \ \ \ \ \ \ \ \ \ ...) -\ \ ...) -(cond\ ... -\ \ \ \ \ \ {{(?=\ pat\ expr)}} -\ \ \ \ \ \ ...\ ) -(andalso\ ...\ ) -(orelse\ ...\ ) -(fun\ func\ arity) -(fun\ mod\ func\ arity) -(lc\ (qual\ ...)\ ...) -(list\-comp\ (qual\ ...)\ ...) -(bc\ (qual\ ...)\ ...) -(binary\-comp\ (qual\ ...)\ ...) -(match\-spec\ ...) -\f +(: mod func arg ... ) => + (call \aqmod \aqfunc arg ... ) +(mod:func arg ... ) => + (call \aqmod \aqfunc arg ... ) +(? {{timeout {{default}} }}) +(++ ... ) +(-- ... ) +(list* ... ) +(let* (... ) ... ) +(flet ((name (arg ...) {{doc-string}} ...) + ...) + ...) +(flet* (...) ... ) +(fletrec ((name (arg ...) {{doc-string}} ...) + ...) + ...) +(cond (test body ...) + ... + ((?= pat expr) ...) + ... + (else ...)) +(andalso ... ) +(orelse ... ) +(fun func arity) +(fun mod func arity) +(lc (qual ...) expr) +(list-comp (qual ...) expr) +(bc (qual ...) bitstringexpr) +(binary-comp (qual ...) bitstringexpr) +(ets-ms ...) +(trace-ms ...) +\fR .fi .SS Common Lisp inspired macros .IP .nf \fC -(defun\ name\ (arg\ ...)\ {{doc\-string}}\ ...) -(defun\ name -\ \ {{doc\-string}} -\ \ ((argpat\ ...)\ ...) -\ \ ...) -(defmacro\ name\ (arg\ ...)\ {{doc\-string}}\ ...) -(defmacro\ name\ arg\ {{doc\-string}}\ ...) -(defmacro\ name -\ \ {{doc\-string}} -\ \ ((argpat\ ...)\ ...) -\ \ ...) -(defsyntax\ name -\ \ (pat\ exp) -\ \ ...) -(macrolet\ ((name\ (arg\ ...)\ {{doc\-string}}\ ...) -\ \ \ \ \ \ \ \ \ \ \ ...) -\ \ ...) -(syntaxlet\ ((name\ (pat\ exp)\ ...) -\ \ \ \ \ \ \ \ \ \ \ \ ...) -\ \ ...) -(prog1\ ...) -(prog2\ ...) -(defmodule\ name\ ...) -(defrecord\ name\ ...) -\f -.fi -.SS Older Scheme inspired macros -.IP -.nf -\fC -(define\ (name\ arg\ ...)\ ...) -(define\ name\ lambda|match\-lambda) -(define\-syntax\ name -\ \ (syntax\-rules\ (pat\ exp)\ ...)|(macro\ (pat\ body)\ ...)) -(let\-syntax\ ((name\ ...) -\ \ \ \ \ \ \ \ \ \ \ \ \ ...) -\ \ ...) -(begin\ ...) -(define\-record\ name\ ...) -\f +(defun name (arg ...) {{doc-string}} ...) +(defun name + {{doc-string}} + ((argpat ...) ...) + ...) +(defmacro name (arg ...) {{doc-string}} ...) +(defmacro name arg {{doc-string}} ...) +(defmacro name + {{doc-string}} + ((argpat ...) ...) + ...) +(defsyntax name + (pat exp) + ...) +(macrolet ((name (arg ...) {{doc-string}} ...) + ...) + ...) +(syntaxlet ((name (pat exp) ...) + ...) + ...) +(prog1 ...) +(prog2 ...) +(defmodule name ...) +(defrecord name ...) +(defstruct ...) +\fR .fi .SH Patterns .PP @@ -432,56 +457,64 @@ .IP .nf \fC -{ok,X}\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \->\ (tuple\ \aqok\ x) -error\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \->\ \aqerror -{yes,X|Xs}\ \ \ \ \ \ \ \ \ \ \ \ \->\ (tuple\ \aqyes\ (cons\ x\ xs)) -<<34,U:16,F/float>>\ \ \ \ \ \->\ (binary\ 34\ (u\ (size\ 16))\ (f\ float)) -P|Ps=All\ \ \ \ \ \ \ \ \ \ \ \ \ \ \->\ (=\ (cons\ p\ ps)\ all) -\f +{ok,X} -> (tuple \aqok x) +error -> \aqerror +{yes,X|Xs} -> (tuple \aqyes (cons x xs)) +<<34,U:16,F/float>> -> (binary 34 (u (size 16)) (f float)) +P|Ps=All -> (= (cons p ps) all) +\fR .fi .PP Repeated variables are supported in patterns and there is an automatic comparison of values. .PP -\fC_\f as the "don\aqt care" variable is supported. -This means that the symbol \fC_\f, which is a perfectly valid +\fV_\fR as the \lqdon\cqt care\rq variable is supported. +This means that the symbol \fV_\fR, which is a perfectly valid symbol, can never be bound through pattern matching. .PP -Aliases are defined with the \fC(=\ pattern1\ pattern2)\f pattern. +Aliases are defined with the \fV(= pattern1 pattern2)\fR pattern. As in Erlang patterns they can be used anywhere in a pattern. .PP -\fICAVEAT\f The lint pass of the compiler checks for aliases and if +\fICAVEAT\fR The lint pass of the compiler checks for aliases and if they are possible to match. If not an error is flagged. This is not the best way. Instead there should be a warning and the offending clause removed, but -later passes of the compiler can\aqt handle this yet. +later passes of the compiler can\cqt handle this yet. .SH Guards .PP -Wherever a pattern occurs (in let, case, receive, lc, etc.) it can be -followed by an optional guard which has the form (when test ...). +Wherever a pattern occurs (in let, case, receive, lc, etc.) +it can be followed by an optional guard which has the form +\fV(when test ...)\fR. Guard tests are the same as in vanilla Erlang and can contain the following guard expressions: .IP .nf \fC -(quote\ e) -(cons\ gexpr\ gexpr) -(car\ gexpr) -(cdr\ gexpr) -(list\ gexpr\ ...) -(tuple\ gexpr\ ...) -(tref\ gexpr\ gexpr) -(binary\ ...) -(progn\ gtest\ ...)\ \ \ \ \ \ \ \ \ \ \ \-\ Sequence\ of\ guard\ tests -(if\ gexpr\ gexpr\ gexpr) -(type\-test\ e) -(guard\-bif\ ...)\ \ \ \ \ \ \ \ \ \ \ \ \ \-\ Guard\ BIFs,\ arithmetic, -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ boolean\ and\ comparison\ operators -\f +(quote e) +(cons gexpr gexpr) +(car gexpr) +(cdr gexpr) +(list gexpr ...) +(tuple gexpr ...) +(tref gexpr gexpr) +(binary ...) +(record ...) - Also the macro versions +(is-record ...) +(record-field ...) +(record-index ...) +(map ...) +(msiz ...) (map-size ...) +(mref ...) (map-get ...) +(mset ...) (map-set ...) +(mupd ...) (map-update ...) +(type-test e) - Type tests +(guard-bif ...) - Guard BIFs, arithmetic, + boolean and comparison operators +\fR .fi .PP -An empty guard, \fC(when)\f, always succeeds as there is no test +An empty guard, \fV(when)\fR, always succeeds as there is no test which fails. This simplifies writing macros which handle guards. .SH Comments in Function Definitions @@ -492,10 +525,10 @@ .IP .nf \fC -(defun\ max\ (x\ y) -\ \ "The\ max\ function." -\ \ (if\ (>=\ x\ y)\ x\ y)) -\f +(defun max (x y) + \dqThe max function.\dq + (if (>= x y) x y)) +\fR .fi .PP Optional comments are also allowed in match style functions after the @@ -503,11 +536,11 @@ .IP .nf \fC -(defun\ max -\ \ "The\ max\ function." -\ \ ((x\ y)\ (when\ (>=\ x\ y))\ x) -\ \ ((x\ y)\ y)) -\f +(defun max + \dqThe max function.\dq + ((x y) (when (>= x y)) x) + ((x y) y)) +\fR .fi .PP This is also possible in a similar style in local functions defined by @@ -515,18 +548,18 @@ .IP .nf \fC -(defun\ foo\ (x\ y) -\ \ "The\ max\ function." -\ \ (flet\ ((m\ (a\ b) -\ \ \ \ \ \ \ \ \ \ \ "Local\ comment." -\ \ \ \ \ \ \ \ \ \ \ (if\ (>=\ a\ b)\ a\ b))) -\ \ \ \ (m\ x\ y))) -\f +(defun foo (x y) + \dqThe max function.\dq + (flet ((m (a b) + \dqLocal comment.\dq + (if (>= a b) a b))) + (m x y))) +\fR .fi .SH Variable Binding and Scoping .PP -Variables are lexically scoped and bound by \fClambda\f, -\fCmatch\-lambda\f and \fClet\f forms. +Variables are lexically scoped and bound by \fVlambda\fR, +\fVmatch-lambda\fR and \fVlet\fR forms. All variables which are bound within these forms shadow variables bound outside but other variables occurring in the bodies of these forms will be imported from the surrounding environments.No variables are exported @@ -535,32 +568,32 @@ .IP .nf \fC -(defun\ foo\ (x\ y\ z) -\ \ (let\ ((x\ (zip\ y))) -\ \ \ \ (zap\ x\ z)) -\ \ (zop\ x\ y)) -\f +(defun foo (x y z) + (let ((x (zip y))) + (zap x z)) + (zop x y)) +\fR .fi .PP -The variable \fCy\f in the call \fC(zip\ y)\f comes from the +The variable \fVy\fR in the call \fV(zip y)\fR comes from the function arguments. -However, the \fCx\f bound in the \fClet\f will shadow the -\fCx\f from the arguments so in the call \fC(zap\ x\ z)\f the -\fCx\f is bound in the \fClet\f while the \fCz\f comes from -the function arguments. -In the final \fC(zop\ x\ y)\f both \fCx\f and \fCy\f come -from the function arguments as the \fClet\f does not export -\fCx\f. +However, the \fVx\fR bound in the \fVlet\fR will shadow the +\fVx\fR from the arguments so in the call \fV(zap x z)\fR the +\fVx\fR is bound in the \fVlet\fR while the \fVz\fR comes +from the function arguments. +In the final \fV(zop x y)\fR both \fVx\fR and \fVy\fR come +from the function arguments as the \fVlet\fR does not export +\fVx\fR. .SH Function Binding and Scoping .PP -Functions are lexically scoped and bound by the top\-level -\fCdefun\f and by the macros \fCflet\f and \fCfletrec\f. -LFE is a Lisp\-2 so functions and variables have separate namespaces and +Functions are lexically scoped and bound by the top-level +\fVdefun\fR and by the macros \fVflet\fR and \fVfletrec\fR. +LFE is a Lisp-2 so functions and variables have separate namespaces and when searching for function both name and arity are used. This means that when calling a function which has been bound to a -variable using \fC(funcall\ func\-var\ arg\ ...)\f is required to -call \fClambda\f/\fCmatch\-lambda\f bound to a variable or used -as a value. +variable using \fV(funcall func-var arg ...)\fR is required to call +\fVlambda\fR/\fVmatch-lambda\fR bound to a variable or used as a +value. .PP Unqualified functions shadow as stated above which results in the following order within a module, outermost to innermost: @@ -571,90 +604,136 @@ .IP \bu 2 Imports .IP \bu 2 -Top\-level defines +Top-level defines .IP \bu 2 Flet/fletrec .IP \bu 2 Core forms, these can never be shadowed .PP This means that it is perfectly legal to shadow BIFs by imports, -BIFs/imports by top\-level functions and BIFs/imports/top\-level by -\fCfletrec\fs. -In this respect there is nothing special about BIfs, they just behave as -prefined imported functions, a whopping big -\fC(import\ (from\ erlang\ ...))\f. +BIFs/imports by top-level functions and BIFs/imports/top-level by +\fVfletrec\fRs. +In this respect there is nothing special about BIFs, they just behave as +predefined imported functions, a whopping big +\fV(import (from erlang ...))\fR. EXCEPT that we know about guard BIFs and expression BIFs. -If you want a private version of \fCspawn\f then define it, there +If you want a private version of \fVspawn\fR then define it, there will be no warnings. .PP -\fICAVEAT\f This does not hold for the supported core forms. +\fICAVEAT\fR This does not hold for the supported core forms. These can be shadowed by imports or redefined but the compiler will -\fIalways\f use the core meaning and never an alternative. +\fIalways\fR use the core meaning and never an alternative. Silently! .SH Module definition +.PP +The basic forms for defining a module and extending its metadata and +attributes are: .IP .nf \fC -(defmodule\ name -\ \ "This\ is\ the\ module\ documentation." -\ \ (export\ (f\ 2)\ (g\ 1)\ ...\ ) -\ \ (export\ all)\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ;Export\ all\ functions -\ \ (import\ (from\ mod\ (f1\ 2)\ (f2\ 1)\ ...\ ) -\ \ \ \ \ \ \ \ \ \ (rename\ mod\ ((f1\ 2)\ sune)\ ((f2\ 1)\ kurt)\ ...\ )) -\ \ (import\ (prefix\ mod\ mod\-prefix))\ \ \ \ \ \ \-\ NYI -\ \ (attr\-1\ value\-1\ value\-2) -\ \ ...\ ) -\f +(define-module name meta-data attributes) +(extend-module meta-data attributes) +\fR .fi .PP -Can have multiple export and import declarations within module -declaration. -The \fC(export\ all)\f declaration is allowed together with other -export declarations and overrides them. -Other attributes which are not recognised by the compiler are allowed -and are simply passed on to the module and can be accessed through -\fCmodule_info/0\-1\f. -.SH Parameterized modules +The valid meta data is \fV(type typedef ...)\fR, +\fV(opaque typedef ...)\fR, \fV(spec function-spec ...)\fR and +\fV(record record-def ...)\fR. +Each can take multiple definitions in one meta form. +.PP +Attributes declarations have the syntax +\fV(attribute value-1 ...)\fR where the attribute value is a list +off the values in the declaration +.PP +To simplify defining modules there is a predefined macro: .IP .nf \fC -(defmodule\ (name\ par1\ par2\ ...\ ) -\ \ ...\ ) -\f +(defmodule name + \dqThis is the module documentation.\dq + (export (f 2) (g 1) ... ) + (export all) ;Export all functions + (import (from mod (f1 2) (f2 1) ... ) + (rename mod ((g1 2) m-g1) ((g2 1) m-g2) ... )) + (module-alias (really-long-module-name rlmn) ...) + (attr-1 value-1 value-2) + {meta meta-data ...) + ... ) +\fR .fi .PP -Define a parameterized module which behaves the same way as in vanilla -Erlang. -For now avoid defining functions \aqnew\aq and \aqinstance\aq. +We can have multiple export and import attributes within module +declaration. +The \fV(export all)\fR attribute is allowed together with other +export attributes and overrides them. +Other attributes which are not recognized by the compiler are allowed +and are simply passed on to the module and can be accessed with the +\fVmodule_info/0-1\fR functions. +.PP +In the \fVimport\fR attribute the \fV(from mod (f1 2) ...)\fR +means that the call \fV(f1 \aqeverything 42)\fR will be converted +by the compiler to \fV(mod:f1 \aqeverything 42))\fR while the +\fV(rename mod ((g2 2) m-g1) ...)\fR means that the call +\fV(m-g1 \aqeverything 42)\fR will be converted to +\fV(mod:g1 \aqeverything 42)\fR. +The \fVrename\fR form can be used as compact way of indicating the +imported function\cqs module. +Note that when importing a module +.IP \bu 2 +the compiler does no checking on that module at all +.IP \bu 2 +in the \fVrename\fR above the functions \fVg1/2\fR and +\fVg2/1\fR aren\cqt automatically imported, only the +\lqrenamed\rq functions. +.IP \bu 2 +we do not really see in the code that we are calling a function in +another module +.PP +In the \fVmodule-alias\fR attribute the +\fV(really-long-module-name rlmn)\fR declaration means that the call +\fV(lrmn:foo \aqeverything 42)\fR will be converted by the +compiler to \fV(really-long-module-name:foo \aqeverything 42)\fR. +This is often used to write short module names in the code when calling +functions in modules with long names. +It is in many ways better than using \fVimport\fR as it does not +hide that we are calling a function in another module. .SH Macros .PP Macro calls are expanded in both body and patterns. This can be very useful to have both make and match macros, but be careful with names. .PP -A macro is function of two argument which is a called with a list of the -arguments to the macro call and the current macro environment. -It can be either a lambda or a match\-lambda. +A macro is function of two arguments which is a called with a list of +the arguments to the macro call and the current macro environment. +It can be either a lambda or a match-lambda. The basic forms for defining macros are: .IP .nf \fC -(define\-macro\ name\ meta\-data\ lambda|match\-lambda) -(let\-macro\ ((name\ lambda|match\-lambda) -\ \ ...) -\f +(define-macro name meta-data lambda|match-lambda) +(let-macro ((name lambda|match-lambda) + ...) +\fR .fi .PP Macros are definitely NOT hygienic in any form. +However, variable scoping and variable immutability remove most of the +things that can cause unhygienic macros. +It can be done but you are not going to do it by mistake. +The only real issue is if you happen to be using a variable which has +the same name as one which the macro generates, that can cause problems. +The work around for this is to give variables created in the macro +expansion really weird names like \fV| - foo - |\fR which no one in +their right mind would use. .PP To simplify writing macros there are a number of predefined macros: .IP .nf \fC -(defmacro\ name\ (arg\ ...)\ ...) -(defmacro\ name\ arg\ ...) -(defmacro\ name\ ((argpat\ ...)\ body)\ ...) -\f +(defmacro name (arg ...) ...) +(defmacro name arg ...) +(defmacro name ((argpat ...) body) ...) +\fR .fi .PP Defmacro can be used for defining simple macros or sequences of matches @@ -666,78 +745,80 @@ .IP .nf \fC -(defmacro\ double\ (a)\ `(+\ ,a\ ,a)) -(defmacro\ my\-list\ args\ `(list\ ,\@args)) -(defmacro\ andalso -\ \ ((list\ e)\ `,e) -\ \ ((cons\ e\ es)\ `(if\ ,e\ (andalso\ ,\@es)\ \aqfalse)) -\ \ (()\ `\aqtrue)) -\f +(defmacro double (a) \ga(+ ,a ,a)) +(defmacro my-list args \ga(list ,\atargs)) +(defmacro andalso + ((list e) \ga,e) + ((cons e es) \ga(if ,e (andalso ,\ates) \aqfalse)) + (() \ga\aqtrue)) +\fR .fi .PP The macro definitions in a macrolet obey the same rules as defmacro. .PP The macro functions created by defmacro and macrolet automatically add the second argument with the current macro environment with the name -$ENV. +\fV$ENV\fR. This allows explicit expansion of macros inside the macro and also manipulation of the macro environment. No changes to the environment are exported outside the macro. .PP User defined macros shadow the predefined macros so it is possible to -redefine the built\-in macro definitions. +redefine the built-in macro definitions. However, see the caveat below! .PP Yes, we have the backquote. It is implemented as a macro so it is expanded at macro expansion time. .PP Local functions that are only available at compile time and can be -called by macros are defined using eval\-when\-compile: +called by macros are defined using eval-when-compile: .IP .nf \fC -(defmacro\ foo\ (x) -\ \ ... -\ \ (foo\-helper\ m\ n) -\ \ ...) +(defmacro foo (x) + ... + (foo-helper m n) + ...) -(eval\-when\-compile -\ \ (defun\ foo\-helper\ (a\ b) -\ \ \ \ ...) +(eval-when-compile + (defun foo-helper (a b) + ...) -\ \ ) -\f + ) +\fR .fi .PP -There can be many eval\-when\-compile forms. -Functions defined within an \fCeval\-when\-compile\f are mutually +There can be many eval-when-compile forms. +Functions defined within an \fVeval-when-compile\fR are mutually recursive but they can only call other local functions defined in an -earlier \fCeval\-when\-compile\f and macros defined earlier in the +earlier \fVeval-when-compile\fR and macros defined earlier in the file. -Functions defined in \fCeval\-when\-compile\f which are called by +Functions defined in \fVeval-when-compile\fR which are called by macros can defined after the macro but must be defined before the macro is used. .PP -Scheme\aqs syntax rules are an easy way to define macros where the +Scheme\cqs syntax rules are an easy way to define macros where the body is just a simple expansion. -These are supported with \fCdefsyntax\f and \fCsyntaxlet\f. +The are implemented the the module \fVscm\fR and are supported with +\fVscm:define-syntax\fR and \fVscm:let-syntax\fR and the +equivalent \fVscm:defsyntax\fR and \fVscm:syntaxlet\fR. Note that the patterns are only the arguments to the macro call and do not contain the macro name. So using them we would get: .IP .nf \fC -(defsyntax\ andalso -\ \ (()\ \aqtrue) -\ \ ((e)\ e) -\ \ ((e\ .\ es)\ (case\ e\ (\aqtrue\ (andalso\ .\ es))\ (\aqfalse\ \aqfalse)))) -\f +(scm:defsyntax andalso + (() \aqtrue) + ((e) e) + ((e . es) (case e (\aqtrue (andalso . es)) (\aqfalse \aqfalse)))) +\fR .fi .PP -N.B. -These are definitely NOT hygienic. +There is an include file \lqinclude/scm.lfe\rq which defines macros +so the names don\cqt have to be prefixed with \fVscm:\fR. .PP -\fICAVEAT\f While it is perfectly legal to define a Core form as a +\fICAVEAT\fR While it is perfectly legal to define a Core form as a macro these will silently be ignored by the compiler. .SH Comments in Macro Definitions .PP @@ -747,10 +828,10 @@ .IP .nf \fC -(defmacro\ double\ (a) -\ \ "Double\ macro." -\ \ `(+\ ,a\ ,a)) -\f +(defmacro double (a) + \dqDouble macro.\dq + \ga(+ ,a ,a)) +\fR .fi .PP Optional comments are also allowed in match style macros after the macro @@ -758,16 +839,16 @@ .IP .nf \fC -(defmacro\ my\-list\ args -\ \ "List\ of\ arguments." -\ \ `(list\ ,\@args)) +(defmacro my-list args + \dqList of arguments.\dq + \ga(list ,\atargs)) -(defmacro\ andalso -\ \ "The\ andalso\ form." -\ \ ((list\ e)\ `,e) -\ \ ((cons\ e\ es)\ `(if\ ,e\ (andalso\ ,\@es)\ \aqfalse)) -\ \ (()\ `\aqtrue)) -\f +(defmacro andalso + \dqThe andalso form.\dq + ((list e) \ga,e) + ((cons e es) \ga(if ,e (andalso ,\ates) \aqfalse)) + (() \ga\aqtrue)) +\fR .fi .PP This is also possible in a similar style in local functions defined by @@ -775,171 +856,315 @@ .IP .nf \fC -(defun\ foo\ (x\ y) -\ \ "The\ max\ function." -\ \ (macrolet\ ((m\ (a\ b) -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ "Poor\ macro\ definition." -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(if\ (>=\ ,a\ ,b)\ ,a\ ,b))) -\ \ \ \ (m\ x\ y))) -\f +(defun foo (x y) + \dqThe max function.\dq + (macrolet ((m (a b) + \dqPoor macro definition.\dq + \ga(if (>= ,a ,b) ,a ,b))) + (m x y))) +\fR .fi .SH Extended cond .PP -Cond has been extended with the extra test (?= pat expr) which tests if -the result of expr matches pat. -If so it binds the variables in pat which can be used in the cond. +The tests in \fVcond\fR are Erlang tests in that they should return +either \fVtrue\fR or \fVfalse\fR. +If no test succeeds then the \fVcond\fR does not generate an +exception but just returns \fVfalse\fR. +There is a simple catch-all \lqtest\rq \fVelse\fR which must +last and can be used to handle when all tests fail. +.PP +Cond has been extended with the extra test \fV(?= pat expr)\fR which +tests if the result of \fVexpr\fR matches the pattern \fVpat\fR. +If so it binds the variables in \fVpa\fRt which can be used in the +\fVcond\fR. A optional guard is allowed here. An example: .IP .nf \fC -(cond\ ((foo\ x)\ ...) -\ \ \ \ \ \ ((?=\ (cons\ x\ xs)\ (when\ (is_atom\ x))\ (bar\ y)) -\ \ \ \ \ \ \ (fubar\ xs\ (baz\ x))) -\ \ \ \ \ \ ((?=\ (tuple\ \aqok\ x)\ (baz\ y)) -\ \ \ \ \ \ \ (zipit\ x)) -\ \ \ \ \ \ ...\ ) -\f +(cond ((foo x) ...) + ((?= (cons x xs) (when (is_atom x)) (bar y)) + (fubar xs (baz x))) + ((?= (tuple \aqok x) (baz y)) + (zipit x)) + ... + (else \aqyay)) +\fR .fi .SH Records .PP Records are tuples with the record name as first element and the rest of -the fields in order exactly like "normal" Erlang records. -As with Erlang records the default default value is \aqundefined\aq. +the fields in order exactly like \lqnormal\rq Erlang records. +As with Erlang records the default default value is the atom +`undefined'. +.PP +The basic forms for defining a record, creating, accessing and updating +it are: +.IP +.nf +\fC +(define-record name (field | (field) | + (field default-value) | + (field default-value type) ...)) +(record name field value field value ...) +(is-record record name) +(record-index name field) +(record-field record name field) +(record-update record name field value field value ...) +\fR +.fi +.PP +Note that the list of field/value pairs when making or updating a record +is a flat list. +.PP +Note that the old \fVmake-record\fR form has been deprecated and is +replaced by \fVrecord\fR which better matches other constructors +like \fVtuple\fR and \fVmap\fR. +It still exists but should not be used. +.PP +We will explain these forms with a simple example. +To define a record we do: +.IP +.nf +\fC +(define-record person + ((name \dq\dq) + (address \dq\dq (string)) + (age))) +\fR +.fi +.PP +which defines a record \fVperson\fR with the fields \fVname\fR +(default value \fV\dq\dq\fR), \fVaddress\fR (default value +\fV\dq\dq\fR and type \fV(string)\fR) and \fVage\fR. +To make an instance of a \fVperson\fR record we do: +.IP +.nf +\fC +(record person name \dqRobert\dq age 54) +\fR +.fi +.PP +The \fVrecord\fR form is also used to define a pattern. +.PP +We can get the value of the \fVaddress\fR field in a person record +and set it by doing (the variable \fVrobert\fR references a +\fVperson\fR record): +.IP +.nf +\fC +(record-field robert person address) +(record-update robert person address \dqmy home\dq age 55) +\fR +.fi +.PP +Note that we must include the name of the record when accessing it and +there is no need to quote the record and field names as these are always +literal atoms. +.PP +To simplify defining and using records there is a predefined macro: .IP .nf \fC -(defrecord\ name -\ \ field -\ \ (field\ default\-value) -\ \ ...\ ) -\f +(defrecord name + (field) | field + (field default-value) + (field default-value type) + ... ) +\fR .fi .PP -Will create access functions/macros for creation and accessing fields. -The \fCmake\-\f, \fCmatch\-\f and \fCset\-\f forms takes -optional argument pairs field\-name value to get non\-default values. +This will create access macros for record creation and accessing and +updating fields. +The \fVmake-\fR, \fVmatch-\fR and \fVupdate-\fR forms takes +optional argument pairs field-name value to get non-default values. E.g. for .IP .nf \fC -(defrecord\ person -\ \ (name\ "") -\ \ (address\ "") -\ \ age) -\f +(defrecord person + (name \dq\dq) + (address \dq\dq (string)) + (age)) +\fR .fi .PP the following will be generated: .IP .nf \fC -(make\-person\ {{field\ value}}\ ...\ ) -\ (match\-person\ {{field\ value}}\ ...\ ) -\ (is\-person\ r) -\ (fields\-person) -\ (emp\-person\ {{field\ value}}\ ...\ ) -\ (set\-person\ r\ {{field\ value}}\ ...\ ) -\ (person\-name\ r) -\ (person\-name) -\ (set\-person\-name\ r\ name) -\ (person\-age\ r) -\ (person\-age) -\ (set\-person\-age\ r\ age) -\ (person\-address\ r) -\ (set\-person\-address\ r\ address) -\f +(make-person {{field value}} ... ) +(match-person {{field value}} ... ) +(is-person r) +(fields-person) +(update-person r {{field value}} ... ) +(person-name r) +(person-name) +(update-person-name r name) +(person-age r) +(person-age) +(update-person-age r age) +(person-address r) +(person-address) +(update-person-address r address) +\fR .fi .IP \bu 2 -\fC(make\-person\ name\ "Robert"\ age\ 54)\f \- Will create a new -person record with the name field set to "Robert", the age field set to -54 and the address field set to the default "". +\fV(make-person name \dqRobert\dq age 54)\fR - Will create a new +person record with the name field set to \lqRobert\rq, the age field +set to 54 and the address field set to the default \lq\lq. .IP \bu 2 -\fC(match\-person\ name\ name\ age\ 55)\f \- Will match a person -with age 55 and bind the variable name to the name field of the record. +\fV(match-person name name age 55)\fR - Will match a person with age +55 and bind the variable name to the name field of the record. Can use any variable name here. .IP \bu 2 -\fC(is\-person\ john)\f \- Test if john is a person record. -.IP \bu 2 -\fC(emp\-person\ age\ \aq$1)\f \- Create an Ets Match Pattern for -record person where the age field is set to $1 and all other fields are -set to \aq_. +\fV(is-person john)\fR - Test if john is a person record. .IP \bu 2 -\fC(person\-address\ john)\f \- Return the address field of the -person record john. +\fV(person-address john)\fR - Return the address field of the person +record john. .IP \bu 2 -\fC(person\-address)\f \- Return the index of the address field of a +\fV(person-address)\fR - Return the index of the address field of a person record. .IP \bu 2 -\fC(set\-person\-address\ john\ "back\ street")\f \- Sets the -address field of the person record john to "back street". +\fV(update-person-address john \dqback street\dq)\fR - Updates +the address field of the person record john to \lqback street\rq. .IP \bu 2 -\fC(set\-person\ john\ age\ 35\ address\ "front\ street")\f \- In -the person record john set the age field to 35 and the address field to -"front street". +\fV(update-person john age 35 address \dqfront street\dq)\fR - +In the person record john update the age field to 35 and the address +field to \lqfront street\rq. .IP \bu 2 -\fC(fields\-person)\f \- Returns a list of fields for the record. +\fV(fields-person)\fR - Returns a list of fields for the record. This is useful for when using LFE with Mnesia, as the record field names -don\aqt have to be provided manually in the create_table call. +don\cqt have to be provided manually in the create_table call. .IP \bu 2 -\fC(size\-person)\f \- Returns the size of the record tuple. +\fV(size-person)\fR - Returns the size of the record tuple. +.PP +Note that the older now deprecated \fVset-\fR forms are still +generated. +.SH Structs +.PP +Structs in LFE are the same as Elixir structs and have been defined in +the same way so to be truly compatible. +This means that you can use structs defined in Elixr from LFE and +structs defined in LFE from Elixir. +.IP +.nf +\fC +(define-struct (field | (field) | + (field default-value) | + (field default-value type) ...)) +(struct name field value field value ...) +(is-struct struct) +(is-struct struct name) +(struct-field struct name field) +(struct-update struct name field value field value ...) +\fR +.fi +.PP +We will explain these forms with a simple example. +To define a struct we do: +.IP +.nf +\fC +(define-struct ((name \dq\dq) + (address \dq\dq (string)) + (age))) +\fR +.fi +.PP +which defines a struct with the name of the current module with the +fields \fVname\fR (default value \fV\dq\dq\fR), +\fVaddress\fR (default value \fV\dq\dq\fR and type +\fV(string)\fR) and \fVage\fR. +To make an instance of struct we do: +.IP +.nf +\fC +(struct mod-name name \dqRobert\dq age 54) +\fR +.fi +.PP +The \fVstruct\fR form is also used to define a pattern. +.PP +We can get the value of the \fVaddress\fR field in the struct and +set it by doing (the variable \fVrobert\fR references a struct): +.IP +.nf +\fC +(struct-field robert mod-name address) +(struct-update robert mod-name address \dqmy home\dq age 55) +\fR +.fi +.PP +Note that a struct automatically gets the name of the module in which it +is defined so that there can only be one struct defined in a module. +This mirrors how structs are implemented in Elixir. +.PP +Note that we must include the name of the struct when accessing it and +there is no need to quote the struct and field names as these are always +literal atoms. .SH Binaries/bitstrings .PP A binary is .IP .nf \fC -(binary\ seg\ ...\ ) -\f +(binary seg ... ) +\fR .fi .PP -where \fCseg\f is +where \fVseg\fR is .IP .nf \fC -\ \ \ \ \ \ \ \ byte -\ \ \ \ \ \ \ \ string -\ \ \ \ \ \ \ \ (val\ integer|float|binary|bitstring|bytes|bits -\ \ \ \ \ \ \ \ \ \ \ \ \ (size\ n)\ (unit\ n) -\ \ \ \ \ \ \ \ \ \ \ \ \ big\-endian|little\-endian|native\-endian -\ \ \ \ \ \ \ \ \ \ \ \ \ big|little|native -\ \ \ \ \ \ \ \ \ \ \ \ \ signed|unsigned) -\f + byte + string + (val integer | float | binary | bitstring | bytes | bits | + utf8 | utf-8 | utf16 | utf-16 | utf32 | utf-32 + (size n) (unit n) + big-endian | little-endian | native-endian + big | little | native + signed | unsigned) +\fR .fi .PP -\fCval\f can also be a string in which case the specifiers will be +\fVval\fR can also be a string in which case the specifiers will be applied to every character in the string. As strings are just lists of integers these are also valid here. In a binary constant all literal forms are allowed on input but they will always be written as bytes. .SH Maps .PP -A map is: +A map is created with: .IP .nf \fC -(map\ key\ value\ ...\ ) -\f +(map key value ... ) +\fR .fi .PP To access maps there are the following forms: .IP \bu 2 -\fC(map\-get\ map\ key)\f \- Return the value associated with key in -map. +\fV(map-size map)\fR - Return the size of a map. .IP \bu 2 -\fC(map\-set\ map\ key\ val\ ...\ )\f \- Set keys in map to values. +\fV(map-get map key)\fR - Return the value associated with the key +in the map. .IP \bu 2 -\fC(map\-update\ map\ key\ val\ ...\ )\f \- Update keys in map to +\fV(map-set map key val ... )\fR - Set the keys in the map to values. -Note that this form requires all the keys to exist. -.PP -N.B. -This syntax for processing maps has stablized but may change in the -future! +This form can be used to update the values of existing keys and to add +new keys. +.IP \bu 2 +\fV(map-update map key val ... )\fR - Update the keys in the map to +values. +Note that this form requires all the keys to already exist in the map. +.IP \bu 2 +\fV(map-remove map key ... )\fR - Remove the keys in the map. .PP -There is also an alternate short form \fCmap\f, \fCmref\f, -\fCmset\f, \fCmupd\f based on the Maclisp array reference forms. +There are also alternate short forms \fVmsiz\fR, \fVmref\fR, +\fVmset\fR, \fVmupd\fR and \fVmrem\fR based on the Maclisp +array reference forms. They take the same arguments as their longer alternatives. .SH List/binary comprehensions .PP @@ -948,60 +1173,60 @@ .IP .nf \fC -(lc\ (qual\ \ ...)\ expr\ ...\ ) -(list\-comp\ (qual\ \ ...)\ expr\ ...\ ) -\f +(lc (qual ...) expr) +(list-comp (qual ...) expr) +\fR .fi .PP -where the final expr is used to generate the elements of the list. +where the last expr is used to generate the elements of the list. .PP The syntax for binary comprehensions is: .IP .nf \fC -(bc\ (qual\ \ ...)\ expr\ ...\ ) -(binary\-comp\ (qual\ \ ...)\ expr\ ...\ ) -\f +(bc (qual ...) bitstringexpr ) +(binary-comp (qual ...) bitstringexpr) +\fR .fi .PP -where the final expr is a bitseg expr and is used to generate the -elements of the binary. +where the final expr is a bitstring expression and is used to generate +the elements of the binary. .PP The supported qualifiers, in both list/binary comprehensions are: .IP .nf \fC -(<\-\ pat\ {{guard}}\ list\-expr)\ \ \ \ \ \ \ \ \-\ Extract\ elements\ from\ list -(<=\ bin\-pat\ {{guard}}\ binary\-expr)\ \ \-\ Extract\ elements\ from\ binary -(?=\ pat\ {{guard}}\ expr)\ \ \-\ Match\ test\ and\ bind\ variables\ in\ pat -expr\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \-\ Normal\ boolean\ test -\f +(<- pat {{guard}} list-expr) - Extract elements from list +(<= bin-pat {{guard}} binary-expr) - Extract elements from binary +expr - Normal boolean test +\fR .fi .PP Some examples: .IP .nf \fC -(lc\ ((<\-\ v\ (when\ (>\ v\ 5))\ l1) -\ \ \ \ \ (==\ (rem\ v\ 2)\ 0)) -\ \ v) -\f +(lc ((<- v (when (> v 5)) l1) + (== (rem v 2) 0)) + v) +\fR .fi .PP -returns a list of all the even elements of the list \fCl1\f which +returns a list of all the even elements of the list \fVl1\fR which are greater than 5. .IP .nf \fC -(bc\ ((<=\ (f\ float\ (size\ 32))\ b1)\ \ \ \ \ \ \ \ ;Only\ bitseg\ needed -\ \ \ \ \ (>\ f\ 10.0)) -\ \ (:\ io\ fwrite\ "~p\\n"\ (list\ f)) -\ \ (f\ float\ (size\ 64)))\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ;Only\ bitseg\ needed -\f +(bc ((<= (binary (f float (size 32))) b1) + (> f 10.0)) + (progn + (: io fwrite \dq\tip\rsn\dq (list f)) + (binary (f float (size 64))))) +\fR .fi .PP -returns a binary of floats of size 64 of floats which are larger than -10.0 from the binary b1 and of size 32. +returns a binary of floats of size 64 bits which are from the binary b1 +where they are of size 32 bits and larger than 10.0. The returned numbers are first printed. .PP N.B. @@ -1011,39 +1236,38 @@ extract data from the binary. This means that even if a value could be extracted from the binary if the guard fails this value will be lost and extraction will cease. -This is \fINOT\f the same as having following boolean test which may -remove an element but will not stop extraction. +This is \fINOT\fR the same as having following boolean test which +may remove an element but will not stop extraction. Using a guard is probably not what you want! .PP Normal vanilla Erlang does the same thing but does not allow guards. .SH ETS and Mnesia .PP -Apart from \fC(emp\-record\ ...)\f macros for ETS Match Patterns, -which are also valid in Mnesia, LFE also supports match specifications -and Query List Comprehensions. -The syntax for a match specification is the same as for match\-lambdas: +LFE also supports match specifications and Query List Comprehensions. +The syntax for a match specification is the same as for match-lambdas: .IP .nf \fC -(match\-spec -\ \ ((arg\ ...\ )\ {{(when\ e\ ...)}}\ ...)\ \ \ \ \ \ \ \ \ \ \ \ \ \-\ Matches\ clauses -\ \ ...\ ) -\f +(ets-ms + ((arg ... ) {{(when e ...)}} ...) - Matches clauses + ... ) +\fR .fi .PP For example: .IP .nf \fC -(ets:select\ db\ (match\-spec -\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((tuple\ _\ a\ b)\ (when\ (>\ a\ 3))\ (tuple\ \aqok\ b)))) -\f +(ets:select db (ets-ms + ((tuple _ a b) (when (> a 3)) (tuple \aqok b)))) +\fR .fi .PP It is a macro which creates the match specification structure which is -used in \fCets:select\f and \fCmnesia:select\f. -The same \fCmatch\-spec\f macro can also be used with the dbg -module. +used in \fVets:select\fR and \fVmnesia:select\fR. +For tracing instead of the \fVets-ms\fR macro there is the +\fVtrace-ms\fR macro which is also used in conjunction with the +\fVdbg\fR module. The same restrictions as to what can be done apply as for vanilla match specifications: .IP \bu 2 @@ -1063,13 +1287,13 @@ .PP Macros, especially record macros, can freely be used inside match specs. .PP -\fICAVEAT\f Some things which are known not to work in the current +\fICAVEAT\fR Some things which are known not to work in the current version are andalso, orelse and record updates. .SH Query List Comprehensions .PP LFE supports QLCs for mnesia through the qlc macro. It has the same structure as a list comprehension and generates a Query -Handle in the same way as with \fCqlc:q(...)\f. +Handle in the same way as with \fVqlc:q(...)\fR. The handle can be used together with all the combination functions in the module qlc. .PP @@ -1077,15 +1301,15 @@ .IP .nf \fC -(qlc\ (lc\ ((<\-\ (tuple\ k\ v)\ (:\ ets\ table\ e2))\ (==\ k\ i))\ v) -\ \ \ \ \ {{Option}}) -\f +(qlc (lc ((<- (tuple k v) (: ets table e2)) (== k i)) v) + {{Option}}) +\fR .fi .PP Macros, especially record macros, can freely be used inside query list comprehensions. .PP -\fICAVEAT\f Some things which are known not to work in the current +\fICAVEAT\fR Some things which are known not to work in the current version are nested QLCs and let/case/recieve which shadow variables. .SH Predefined LFE functions .PP @@ -1093,13 +1317,13 @@ .IP .nf \fC -(<arith_op>\ expr\ ...) -(<comp_op>\ expr\ ...) -\f +(<arith_op> expr ...) +(<comp_op> expr ...) +\fR .fi .PP -The standard arithmentic operators, + \- * /, and comparison operators, -> >= < =< == /= =:= =/= , can take multiple arguments the same as their +The standard arithmetic operators, + - * /, and comparison operators, > +>= < =< == /= =:= =/= , can take multiple arguments the same as their standard lisp counterparts. This is still experimental and implemented using macros. They do, however, behave like normal functions and evaluate ALL their @@ -1107,34 +1331,34 @@ .IP .nf \fC -(acons\ key\ value\ list) -(pairlis\ keys\ values\ {{list}}) -(assoc\ key\ list) -(assoc\-if\ test\ list) -(assoc\-if\-not\ test\ list) -(rassoc\ value\ list) -(rassoc\-if\ test\ list) -(rassoc\-if\-not\ test\ list) -\f +(acons key value list) +(pairlis keys values {{list}}) +(assoc key list) +(assoc-if test list) +(assoc-if-not test list) +(rassoc value list) +(rassoc-if test list) +(rassoc-if-not test list) +\fR .fi .PP The standard association list functions. .IP .nf \fC -(subst\ new\ old\ tree) -(subst\-if\ new\ test\ tree) -(subst\-if\-not\ new\ test\ tree) -(sublis\ alist\ tree) -\f +(subst new old tree) +(subst-if new test tree) +(subst-if-not new test tree) +(sublis alist tree) +\fR .fi .PP -The standard substituition functions. +The standard substitution functions. .IP .nf \fC -(macroexpand\-1\ expr\ {{environment}}) -\f +(macroexpand-1 expr {{environment}}) +\fR .fi .PP If Expr is a macro call, does one round of expansion, otherwise returns @@ -1142,57 +1366,306 @@ .IP .nf \fC -(macroexpand\ expr\ {{environment}}) -\f +(macroexpand expr {{environment}}) +\fR .fi .PP -Returns the expansion returned by calling macroexpand\-1 repeatedly, +Returns the expansion returned by calling macroexpand-1 repeatedly, starting with Expr, until the result is no longer a macro call. .IP .nf \fC -(macroexpand\-all\ expr\ {{environment}}) -\f +(macroexpand-all expr {{environment}}) +\fR .fi .PP Returns the expansion from the expression where all macro calls have been expanded with macroexpand. .PP NOTE that when no explicit environment is given the macroexpand -functions then only the default built\-in macros will be expanded. +functions then only the default built-in macros will be expanded. Inside macros and in the shell the variable $ENV is bound to the current macro environment. .IP .nf \fC -(eval\ expr\ {{environment}}) -\f +(eval expr {{environment}}) +\fR .fi .PP Evaluate the expression expr. -Note that only the pre\-defined lisp functions, erlang BIFs and exported +Note that only the pre-defined lisp functions, erlang BIFs and exported functions can be called. Also no local variables can be accessed. To access local variables the expr to be evaluated can be wrapped in a let defining these. .PP For example if the data we wish to evaluate is in the variable expr and -it assumes there is a local variable "foo" which it needs to access then -we could evaluate it by calling: +it assumes there is a local variable \lqfoo\rq which it needs to +access then we could evaluate it by calling: +.IP +.nf +\fC +(eval \ga(let ((foo ,foo)) ,expr)) +\fR +.fi +.SS Supplemental Common Lisp Functions +.PP +LFE provides the module cl which contains the following functions which +closely mirror functions defined in the Common Lisp Hyperspec. +Note that the following functions use zero-based indices, like Common +Lisp (unlike Erlang, which start at index `1'). +A major difference between the LFE versions and the Common Lisp versions +of these functions is that the boolean values are the LFE +\fV\aqtrue\fR and \fV\aqfalse\fR. +Otherwise the definitions closely follow the CL definitions and +won\cqt be documented here. +.IP +.nf +\fC +cl:make-lfe-bool cl-value +cl:make-cl-bool lfe-bool + +cl:mapcar function list +cl:maplist function list +cl:mapc function list +cl:mapl function list + +cl:symbol-plist symbol +cl:symbol-name symbol +cl:get symbol pname +cl:get symbol pname default +cl:getl symbol pname-list +cl:putprop symbol value pname +cl:remprop symbol pname + +cl:getf plist pname +cl:getf plist pname default +cl:putf plist value pname ; This does not exist in CL +cl:remf plist pname +cl:get-properties plist pname-list + +cl:elt index sequence +cl:length sequence +cl:reverse sequence +cl:some predicate sequence +cl:every predicate sequence +cl:notany predicate sequence +cl:notevery predicate sequence +cl:reduce function sequence +cl:reduce function sequence \aqinitial-value x +cl:reduce function sequence \aqfrom-end \aqtrue +cl:reduce function sequence \aqinitial-value x \aqfrom-end \aqtrue + +cl:remove item sequence +cl:remove-if predicate sequence +cl:remove-if-not predicate sequence +cl:remove-duplicates sequence + +cl:find item sequence +cl:find-if predicate sequence +cl:find-if-not predicate sequence +cl:find-duplicates sequence +cl:position item sequence +cl:position-if predicate sequence +cl:position-if-not predicate sequence +cl:position-duplicates sequence +cl:count item sequence +cl:count-if predicate sequence +cl:count-if-not predicate sequence +cl:count-duplicates sequence + +cl:car list +cl:first list +cl:cdr list +cl:rest list +cl:nth index list +cl:nthcdr index list +cl:last list +cl:butlast list + +cl:subst new old tree +cl:subst-if new test tree +cl:subst-if-not new test tree +cl:sublis alist tree + +cl:member item list +cl:member-if predicate list +cl:member-if-not predicate list +cl:adjoin item list +cl:union list list +cl:intersection list list +cl:set-difference list list +cl:set-exclusive-or list list +cl:subsetp list list + +cl:acons key data alist +cl:pairlis list list +cl:pairlis list list alist +cl:assoc key alist +cl:assoc-if predicate alost +cl:assoc-if-not predicate alost +cl:rassoc key alist +cl:rassoc-if predicate alost +cl:rassoc-if-not predicate alost + +cl:type-of object +cl:coerce object type +\fR +.fi +.PP +Furthermore, there is an include file which developers may which to +utilize in their LFE programs: +\fV(include-lib \dqlfe/include/cl.lfe\dq)\fR. +Currently this offers Common Lisp predicates, but may include other +useful macros and functions in the future. +The provided predicate macros wrap the various \fVis_*\fR Erlang +functions; since these are expanded at compile time, they are usable in +guards. +The include the following: +.IP +.nf +\fC +(alivep x) +(atomp x) +(binaryp x) +(bitstringp x) +(boolp x) and (booleanp x) +(builtinp x) +(consp x) +(floatp x) +(funcp x) and (functionp x) +(intp x) and (integerp x) +(listp x) +(mapp x) +(numberp x) +(pidp x) +(process-alive-p x) +(recordp x tag) +(recordp x tag size) +(refp x) and (referencep x) +(tuplep x) +(vectorp x) +\fR +.fi +.PP +Non-predicate macros in \fVlfe/include/cl.lfe\fR include: +.IP +.nf +\fC +(dolist ...) +(vector ...) +\fR +.fi +.SS Supplemental Clojure Functions +.PP +From LFE\cqs earliest days, it\cqs Lisp-cousin Clojure (created +around the same time) has inspired LFE developers to create similar, +BEAM-versions of those functions. +These were collected in a separate library and then expanded upon, until +eventually becoming part of the LFE standard library. +.PP +Function definition macros: +.IP +.nf +\fC +(clj:defn ...) +(clj:defn- ...) +(clj:fn ...) +\fR +.fi +.PP +Threading macros: +.IP +.nf +\fC +(clj:-> ...) +(clj:->> ...) +(clj:as-> ...) +(clj:cond-> ...) +(clj:cond->> ...) +(clj:some-> ...) +(clj:some->> ...) +(clj:doto ...) +\fR +.fi +.PP +Conditional macros: +.IP +.nf +\fC +(clj:if-let ...) +(clj:iff-let ...) +(clj:condp ...) +(clj:if-not ...) +(clj:iff-not ...) +(clj:when-not ...) +(clj:not= ...) +\fR +.fi +.PP +Predicate macros: +.IP +.nf +\fC +(clj:atom? x) +(clj:binary? x) +(clj:bitstring? x) +(clj:bool? x) +(clj:boolean? x) +(clj:even? x) +(clj:false? x) +(clj:falsy? x) +(clj:float? x) +(clj:func? x) +(clj:function? x) +(clj:identical? x) +(clj:int? x) +(clj:integer? x) +(clj:map? x) +(clj:neg? x) +(clj:nil? x) +(clj:number? x) +(clj:odd? x) +(clj:pos? x) +(clj:record? x) +(clj:reference? x) +(clj:true? x) +(clj:tuple? x) +(clj:undef? x) +(clj:undefined? x) +(clj:zero? x) +\fR +.fi +.PP +Other: +.IP +.nf +\fC +(clj:str x) +(clj:lazy-seq x) +(clj:conj ...) +(clj:if ...) +\fR +.fi +.PP +Most of the above mentioned macros are available in the \fVclj\fR +include file, the use of which allows developers to forego the +\fVclj:\fR prefix in calls: .IP .nf \fC -(eval\ `(let\ ((foo\ ,foo))\ ,expr)) -\f +(include-lib \dqlfe/include/clj.lfe\dq) +\fR .fi .SH Notes .IP \bu 2 -NYI \- Not Yet Implemented +NYI - Not Yet Implemented .IP \bu 2 N.B. -\- Nota bene (note well) +- Nota bene (note well) .SH SEE ALSO .PP -\fBlfe(1)\f, \fBlfescript(1)\f, \fBlfe_cl(3)\f +\fBlfe(1)\fR, \fBlfescript(1)\fR, \fBlfe_cl(3)\fR .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_io.3 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_io.3
Changed
@@ -1,10 +1,10 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe_io" "3" "2008\-2016" "" "" +.TH "lfe_io" "3" "2008-2019" "" "" .hy .SH NAME .PP -lfe_io \- Lisp Flavoured Erlang (LFE) io functions +lfe_io - Lisp Flavoured Erlang (LFE) io functions .SH SYNOPSIS .PP This module provides a standard set of io functions for LFE. @@ -20,132 +20,145 @@ an error if the form is wrong. .SH DATA TYPES .PP -\fBchars() = char() | chars()\f +\fBchars() = char() | chars()\fR .PP -\fBfilesexpr() = {Sexpr,Line}\f +\fBfilesexpr() = {Sexpr,Line}\fR .PP -This is the format returned by \fClfe_io:parse_file/1\f and is used +This is the format returned by \fClfe_io:parse_file/1\fR and is used by the compiler to give better error information. .SH EXPORTS .PP -\fBread(IoDevice, Prompt) \-> {ok,Sexpr} | {error,ErrorInfo}\f +\fBread(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo} | +eof\fR .PP -Read an s\-expr from the standard input (IoDevice) with a prompt -(Prompt). -Note that this is not line\-oriented in that it stops as soon as it has +Read an s-expr from the standard input (\fCIoDevice\fR) with a +prompt (\fCPrompt\fR). +Note that this is not line-oriented in that it stops as soon as it has consumed enough characters. .PP -\fBread_line(IoDevice, Prompt) \-> {ok,Sexpr} | -{error,ErrorInfo}\f +\fBread_line(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo} | +eof\fR .PP -Read an s\-expr from the standard input (IoDevice) with a prompt -(Prompt). -Note that this is line\-oriented in that it reads whole lines discarding -left\-over characters in the last line. +Read an s-expr from the standard input (\fCIoDevice\fR) with a +prompt (\fCPrompt\fR). +Note that this is line-oriented in that it reads whole lines discarding +left-over characters in the last line. .PP -\fBread_string(String) \-> {ok,Sexpr} | {error,ErrorInfo}\f +\fBread_string(String) -> {ok,Sexpr} | {error,ErrorInfo}\fR .PP -Read an s\-expr from String. +Read an s-expr from \fCString\fR. +Note that this only reads from \fCString\fR discarding left-over +characters at the end of the string. .PP -\fBprint(IoDevice, Sexpr) \-> ok\f +\fBprint(IoDevice, Sexpr) -> ok\fR .PP -Print the s\-expr Sexpr to the standard output (IoDevice). +Print the s-expr \fCSexpr\fR to the standard output +(\fCIoDevice\fR). .PP -\fBprint1(Sexpr) \-> DeepCharList\f +\fBprint1(Sexpr) -> DeepCharList\fR .PP -Return the list of characters which represent the s\-expr Sexpr. +Return the list of characters which represent the s-expr +\fCSexpr\fR. .PP -\fBprettyprint1(Sexpr) \-> DeepCharList\f +\fBprettyprint(IoDevice, Sexpr) -> ok\fR .PP -\fBprettyprint1(Sexpr, Depth) \-> DeepCharList\f +Pretty print the s-expr \fCSexpr\fR to the standard output +(\fCIoDevice\fR). .PP -\fBprettyprint1(Sexpr, Depth, Indentation) \-> DeepCharList\f +\fBprettyprint1(Sexpr) -> DeepCharList\fR .PP -\fBprettyprint1(Sexpr, Depth, Indentation, LineLength) \-> -DeepCharList\f +\fBprettyprint1(Sexpr, Depth) -> DeepCharList\fR .PP -Return the lost of characters which represents the prettyprinted s\-expr -\fCSexpr\f. -Assume we start at indentation Indentation or 0. +\fBprettyprint1(Sexpr, Depth, Indentation) -> DeepCharList\fR .PP -\fBformat(IoDevice, Format, Args) \-> ok\f +\fBprettyprint1(Sexpr, Depth, Indentation, LineLength) -> +DeepCharList\fR .PP -\fBfwrite(IoDevice, Format, Args) \-> ok\f +Return the list of characters which represents the prettyprinted s-expr +\fCSexpr\fR. +Default values for \fCDepth\fR is 30, \fCIndentation\fR is 0 and +\fCLineLength\fR is 80. .PP -\fBformat1(Format, Args) \-> DeepCharList\f +\fBformat(IoDevice, Format, Args) -> ok\fR .PP -\fBfwrite1(Format, Args) \-> DeepCharList\f +\fBfwrite(IoDevice, Format, Args) -> ok\fR +.PP +\fBformat1(Format, Args) -> DeepCharList\fR +.PP +\fBfwrite1(Format, Args) -> DeepCharList\fR .PP Print formatted output. The following commands are valid in the format string: .IP \bu 2 -\fB~w, ~W\f \- print LFE terms +\fB\tiw, \tiW\fR - print LFE terms .IP \bu 2 -\fB~p, ~P\f \- prettyprint LFE terms +\fB\tip, \tiP\fR - prettyprint LFE terms .IP \bu 2 -\fB~s\f \- print a string +\fB\tis\fR - print a string .IP \bu 2 -\fB~e, ~f, ~g\f \- print floats +\fB\tie, \tif, \tig\fR - print floats .IP \bu 2 -\fB~b, ~B\f \- based integers +\fB\tib, \tiB\fR - based integers .IP \bu 2 -\fB~x, ~X\f \- based integers with a prefix +\fB\tix, \tiX\fR - based integers with a prefix .IP \bu 2 -\fB~+, ~#\f \- based integers in vanilla erlang format +\fB\ti+, \ti#\fR - based integers in vanilla erlang format .IP \bu 2 -\fB~c, ~n, ~i\f +\fB\tic, \tin, \tii\fR .PP -Currently they behave as for vanilla erlang except that \fC~w\f, -\fC~W\f, \fC~p\f, \fC~P\f print the terms as LFE sexprs. +Currently they behave as for vanilla erlang except that +\fC\tiw\fR, \fC\tiW\fR, \fC\tip\fR, \fC\tiP\fR +print the terms as LFE sexprs. .PP -\fBread_file(FileName) \-> {ok,Sexpr} | {error,ErrorInfo}\f +\fBread_file(FileName) -> {ok,Sexpr} | {error,ErrorInfo}\fR .PP -Read the file Filename returning a list of s\-exprs (as it should be). +Read the file \fCFilename\fR returning a list of s-exprs (as it +should be). .PP -\fBparse_file(FileName) \-> {ok,FileSexpr} | {error,ErrorInfo}\f +\fBparse_file(FileName) -> {ok,FileSexpr} | {error,ErrorInfo}\fR .PP where .IP .nf \fC -FileSexpr\ =\ filesexpr() -\f +FileSexpr = filesexpr() +\fR .fi .PP -Read the file Filename returning a list of pairs containing s\-expr and -line number of the start of the s\-expr. +Read the file \fCFilename\fR returning a list of pairs containing +s-expr and line number of the start of the s-expr. .PP -\fBscan_sexpr(Cont, Chars ,Line) \-> -{done,Ret,RestChars}|{more,Cont1}\f +\fBscan_sexpr(Cont, Chars ,Line) -> +{done,Ret,RestChars}|{more,Cont1}\fR .PP -This is a re\-entrant call which scans tokens from the input and returns +This is a re-entrant call which scans tokens from the input and returns a parsed sepxr. If there are enough characters to parse a sexpr or it detects and error -then it returns \fC{done,...}\f otherwise it returns -\fC{more,Cont}\f where \fCCont\f is used in the next call to -\fCscan_sexpr\f with more characters to try and parse a sexpr. +then it returns \fC{done,...}\fR otherwise it returns +\fC{more,Cont}\fR where \fCCont\fR is used in the next call to +\fCscan_sexpr\fR with more characters to try and parse a sexpr. This is continued until a sexpr has been parsed. -\fCCont\f is initially \fC\f. +\fCCont\fR is initially \fC\fR. .PP It is not designed to be called directly by an application but used through the i/o system where it can typically be called in an application by: .PP -\fCio:request(In,\ {get_until,unicode,Prompt,Module,scan_sexpr,Line})\f +\fCio:request(In, {get_until,unicode,Prompt,Module,scan_sexpr,Line})\fR .SH ERROR INFORMATION .PP -The \fCErrorInfo\f mentioned above is the standard -\fCErrorInfo\f structure which is returned from all IO modules. +The \fCErrorInfo\fR mentioned above is the standard +\fCErrorInfo\fR structure which is returned from all IO modules. It has the following format: .PP -\fB{ErrorLine,Module,ErrorDescriptor}\f +\fB{ErrorLine,Module,ErrorDescriptor}\fR .PP A string describing the error is obtained with the following call: .IP .nf \fC -apply(Module,\ format_error,\ ErrorDescriptor) -\f +apply(Module, format_error, ErrorDescriptor) +\fR .fi .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_lib.3 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_lib.3
Changed
@@ -1,10 +1,10 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe_lib" "3" "2008\-2016" "" "" +.TH "lfe_lib" "3" "2008-2016" "" "" .hy .SH NAME .PP -lfe_lib \- Lisp Flavoured Erlang (LFE) library module +lfe_lib - Lisp Flavoured Erlang (LFE) library module .SH SYNOPSIS .PP This module contains a collection of library functions for implementing @@ -12,22 +12,22 @@ They are generally not called by the user. .SH EXPORTS .PP -\fBnew_env() \-> Env.\f +\fBnew_env() -> Env.\fR .PP Create a new environment for the evaluator. .PP -\fBadd_env(Env1, Env2) \-> Env.\f +\fBadd_env(Env1, Env2) -> Env.\fR .PP Add environment Env1 to Env2 such that Env1 shadows Env2. .PP -\fBis_erl_bif(Name, Arity) \-> bool().\f +\fBis_erl_bif(Name, Arity) -> bool().\fR .PP -\fBis_guard_bif(Name, Arity) \-> bool().\f +\fBis_guard_bif(Name, Arity) -> bool().\fR .PP Test whether a Name/Arity is a BIF or guard BIF. This works for functions and operators. .PP -\fBis_core_form(Name) \-> bool().\f +\fBis_core_form(Name) -> bool().\fR .PP Test whether Name is one the LFE core forms. .SH AUTHORS
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_macro.3 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_macro.3
Changed
@@ -1,10 +1,10 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe_macro" "3" "2008\-2016" "" "" +.TH "lfe_macro" "3" "2008-2020" "" "" .hy .SH NAME .PP -lfe_macro \- Lisp Flavoured Erlang (LFE) macro expander +lfe_macro - Lisp Flavoured Erlang (LFE) macro expander .SH SYNOPSIS .PP This module provides an interface to the LFE macro expander. @@ -12,80 +12,118 @@ used by applications explicitly wanting to handle a file. .SH DATA TYPES .PP -\fBsexpr()\f +\fBsexpr()\fR .PP -An LFE s\-expression, a list structure. +An LFE s-expression, a list structure. .PP -\fBfilesexpr() = {Sexpr,Line}\f +\fBfilesexpr() = {Sexpr,Line}\fR .PP -This is the format returned by \fClfe_io:parse_file/1\f and is used +This is the format returned by \fClfe_io:parse_file/1\fR and is used by the compiler to give better error information. .PP -\fBenv()\f +\fBenv()\fR .PP This is an macro and evaluation environment as created by -\fClfe_lib:new_env()\f. +\fClfe_lib:new_env()\fR. +.PP +\fBmac_state()\fR +.PP +This is the internal state used by the macro expander. .SH EXPORTS .PP -\fBexpand_forms(FileSexpr, Env) \-> ExpRet\f +\fBexpand_expr(Sexpr, Env) -> {yes,Exp} | no.\fR +.PP +\fBexpand_expr_1(Sexpr, Env) -> {yes,Exp} | no.\fR .PP where .IP .nf \fC -\ \ FileSexpr\ =\ filesexpr() -\ \ Env\ =\ env() -\ \ ExpRet\ =\ {yes,FileSexpr,Env,Warnings}\ |\ {error,Errors,Warnings} -\f +Sexpr = Exp = sexpr() +Env = env() +\fR .fi .PP -\fBmacro_forms(FileSexpr, Env) \-> {FileSexpr,Env}.\f +Test if the top s-expression here is a macro call, if so expand it and +return {yes,Expansion}, if not then return no. +\fCexpand_expr/2\fR will expand the top s-expression as much as +possible while \fCexpand_expr_1/2\fR will only try it once. +These functions use the macro definitions in the environment and the +standard pre-defined macros. +.PP +\fBexpand_expr_all(Sexpr, Env) -> Sexpr.\fR .PP where .IP .nf \fC -FileSexpr\ =\ filesexpr() -Env\ =\ env() -\f +Sexpr = sexpr() +Env = env() +\fR .fi .PP -\fBexpand_expr_all(Sexpr, Env) \-> Sexpr.\f +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. +.PP +\fBexpand_form_init(Deep, Keep) -> MacState\fR .PP where .IP .nf \fC -Sexpr\ =\ sexpr() -Env\ =\ env() -\f + Deep = boolean() + Keep = boolean() + MacState = mac_state() +\fR .fi .PP -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. +Create an internal macro state. +\fCDeep\fR determines whether the form is to be expanded internally +at depth and \fCKeep\fR whether macro definition forms are to be +kept. .PP -\fBexpand_expr(Sexpr, Env) \-> {yes,Exp} | no.\f +\fBexpand_fileforms(FileForm, Env, Deep, Keep) -> ExpRet\fR .PP -\fBexpand_expr_1(Sexpr, Env) \-> {yes,Exp} | no.\f +\fBexpand_fileforms(FileForm, Env, MacState) -> ExpRet\fR .PP where .IP .nf \fC -Sexpr\ =\ Exp\ =\ sexpr() -Env\ =\ env() -\f + FileForm = filesexpr() + Env = env() + Deep = boolean() + Keep = boolean() + MacState = mac_state() + ExpRet = {yes,FileSexpr,Env,Warnings} | + {error,Errors,Warnings} +\fR .fi .PP -Test if the top s\-expression here is a macro call, if so expand it and -return {yes,Expansion}, if not then return no. -\fCexpand_expr/2\f will expand the top s\-expression as much as -possible while \fCexpand_expr_1/2\f will only try it once. -These functions use the macro definitions in the environment and the -standard pre\-defined macros. +expand a sequence of file forms. +.PP +\fBexpand_form(Form, Line, Env, MacState) -> RetState\fR +.PP +\fBexpand_fileform(FileForm, Env, MacState) -> RetState\fR +.PP +where +.IP +.nf +\fC + Form = sexpr() + FileForm = filesexpr() + Line = integer() + Env = env() + MacState = mac_state() + RetState = {ok,Form,Env,Macstate} | + {error,Errors,Warnings,MacState} +\fR +.fi +.PP +Expand a file form using the environment and macro state. .SH SEE ALSO .PP -\fBlfe_comp(3)\f, \fBlfe_gen(3)\f +\fBlfe_comp(3)\fR, \fBlfe_gen(3)\fR .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfe_types.7 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfe_types.7
Changed
@@ -1,11 +1,11 @@ -.\"t -.\" Automatically generated by Pandoc 1.19.2.1 +'\" t +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfe_types" "7" "2016" "" "" +.TH "lfe_types" "7" "2021" "" "" .hy .SH NAME .PP -lfe_types \- LFE Types and Functions Specifications +lfe_types - LFE Types and Functions Specifications .SH TYPES .PP This is a description of the type syntax. @@ -20,119 +20,135 @@ T} _ T{ -\fC(none)\f +\fC(none)\fR T}@T{ -\fCnone()\f +\fCnone()\fR T} T{ -\fC(any)\f +\fC(any)\fR T}@T{ -\fCany()\f +\fCany()\fR T} T{ -\fC(atom)\f +\fC(atom)\fR T}@T{ -\fCatom()\f +\fCatom()\fR T} T{ -\fC(integer)\f +\fC(integer)\fR T}@T{ -\fCinteger()\f +\fCinteger()\fR T} T{ -\fC(range\ i1\ i2)\f +\fC(range i1 i2)\fR T}@T{ -\fCI1..I2\f +\fCI1..I2\fR T} T{ -\fC(float)\f +\fC(float)\fR T}@T{ -\fCfloat()\f +\fCfloat()\fR T} T{ -\fC(bitstring\ m\ n)\f +\fC(bitstring m n)\fR T}@T{ -\fC<<_:M,_:_*N>>\f +\fC<<_:M,_:_*N>>\fR T} T{ -\fC(binary)\f +\fC(binary)\fR T}@T{ -\fC<<_:0,_:_*8>>\f +\fC<<_:0,_:_*8>>\fR T} T{ -\fC(bitstring)\f +\fC(bitstring)\fR T}@T{ -\fC<<_:0,_:_*1>>\f +\fC<<_:0,_:_*1>>\fR T} T{ -\fC\&...\f +\fC...\fR T}@T{ -\fC\&...\f +\fC...\fR T} T{ -\fC(lambda\ any\ <type>)\f +\fC(lambda any <type>)\fR T}@T{ -\fCfun((...)\ \->\ <type>)\f +\fCfun((...) -> <type>)\fR T} T{ -\fC(lambda\ ()\ <type>)\f +\fC(lambda () <type>)\fR T}@T{ -\fCfun(()\ \->\ <type>)\f +\fCfun(() -> <type>)\fR T} T{ -\fC(lambda\ (<tlist>)\ <type>)\f +\fC(lambda (<tlist>) <type>)\fR T}@T{ -\fCfun((<tlist>)\ \->\ <type>)\f +\fCfun((<tlist>) -> <type>)\fR T} T{ -\fC(map)\f +\fC(map)\fR T}@T{ -\fCmap()\f +\fCmap()\fR T} T{ -\fC(map\ <pairlist>)\f +\fC#M()\fR T}@T{ -\fC#{<pairlist>}\f +\fC#{}\fR T} T{ -\fC(tuple)\f +\fC#M(<key> <value> ...)\fR T}@T{ -\fCtuple()\f +\fC#{<pairlist>}\fR T} T{ -\fC(tuple\ <tlist>)\f +\fC(tuple)\fR T}@T{ -\fC{<tlist>}\f +\fCtuple()\fR T} T{ -\fC(UNION\ <tlist>)\f +\fC#()\fR T}@T{ -\fC<type>\ |\ <type>\f +\fC{}\fR +T} +T{ +\fC#(<tlist>)\fR +T}@T{ +\fC{<tlist>}\fR +T} +T{ +\fC(UNION <tlist>)\fR +T}@T{ +\fC<type> | <type>\fR T} .TE .PP Apart from the predefined types in the Erlang type system we also have the following predefined types which cannot be redefined: -\fCUNION\f, \fCcall\f, \fClambda\f and \fCrange\f. -The usage of \fCbitstring\f, \fCtuple\f and \fCmap\f have +\fCUNION\fR, \fCcall\fR, \fClambda\fR and \fCrange\fR. +The usage of \fCbitstring\fR, \fCtuple\fR and \fCmap\fR have also been extended. .PP -The general form of bitstrings is \fC(bitstring\ m\ n)\f which -denotes a bitstring which starts with \fCm\f bits and continues with -segments of \fCn\f bits. -\fC(binary)\f is a short form for a sequence of bytes while -\fC(bitstring)\f is a short form for a sequence of bits. +Note that the type \fC#M()\fR is the empty map and the type +\fC#()\fR is the empty tuple. +We can still use the older \fC(map <key valuelist>)\fR and +\fC(tuple <tlist>)\fR formats when declaring types for maps and +tuples. +.PP +The general form of bitstrings is \fC(bitstring m n)\fR which +denotes a bitstring which starts with \fCm\fR bits and continues +with segments of \fCn\fR bits. +\fC(binary)\fR is a short form for a sequence of bytes while +\fC(bitstring)\fR is a short form for a sequence of bits. There is currently no short form for an empty binary, -\fC(bitstring\ 0\ 0)\f must be used. -.SS Type Declarations of User\-Defined Types +\fC(bitstring 0 0)\fR must be used. +.SS Type Declarations of User-Defined Types .PP -\fB(deftype (type\-name) type\-def)\f +\fB(deftype (type-name) type-def)\fR .PP -\fB(defopaque (type\-name) type\-def)\f +\fB(defopaque (type-name) type-def)\fR .PP -\fB(deftype (type\-name par1 par2) type\-def)\f +\fB(deftype (type-name par1 par2) type-def)\fR .PP -\fB(defopaque (type\-name par1 par2) type\-def)\f +\fB(defopaque (type-name par1 par2) type-def)\fR .PP For unparameterised types the parentheses around the type name are optional. @@ -140,33 +156,33 @@ .IP .nf \fC -(deftype\ foo\ (tuple\ \aqfoo\ (integer)\ (list))) +(deftype foo (tuple \aqfoo (integer) (list))) -(deftype\ bar\ (tuple\ \aqbar\ (integer)\ (list))) -\f +(deftype bar (tuple \aqbar (integer) (list))) +\fR .fi .SS Type Information in Record Declarations .PP \fB(defrecord rec (field1 default1 type1) (field2 default2) -field3)\f +(field3))\fR .PP -Fields with type annotations \fIMUST\f give a default value and -fields without type annotations get the default type \fC(any)\f. +Fields with type annotations \fIMUST\fR give a default value and +fields without type annotations get the default type \fC(any)\fR. .SH SPECIFICATIONS -.SS Type specifications of User\-Defined Functions +.SS Type specifications of User-Defined Functions .PP -\fB(defspec (func\-name arity) function\-spec ...)\f +\fB(defspec (func-name arity) function-spec \&...)\fR .PP where .IP .nf \fC -function\-spec\ =\ (arg\-type\-list\ ret\-type) -function\-spec\ =\ (arg\-type\-list\ ret\-type\ constraint\-list) -arg\-type\-list\ =\ (arg\-type\ ...) -constraint\-list\ =\ (constraint\ ...) -constraint\ =\ (var\ var\-type) -\f +function-spec = (arg-type-list ret-type) +function-spec = (arg-type-list ret-type constraint-list) +arg-type-list = (arg-type ...) +constraint-list = (constraint ...) +constraint = (var var-type) +\fR .fi .PP For multiple types add more function specs. @@ -175,37 +191,52 @@ .IP .nf \fC -(defspec\ foo\ ((pos_integer)\ (pos_integer))) +(defspec foo ((pos_integer) (pos_integer))) -(defspec\ (foo\ 1) -\ \ ((pos_integer)\ (pos_integer)) -\ \ ((integer)\ (integer))) +(defspec (foo 1) + ((pos_integer) (pos_integer)) + ((integer) (integer))) -(defspec\ (remove\-if\ 2) -\ \ ((lambda\ ((any))\ (boolean))\ (list)\ (list))) -\f +(defspec (remove-if 2) + ((lambda ((any)) (boolean)) (list) (list))) +\fR .fi .PP Or with constraints: .IP .nf \fC -(defspec\ id\ ((X)\ X\ ((X\ (tuple))))) +(defspec id ((X) X ((X (tuple))))) -(defspec\ (foo\ 1) -\ \ ((tuple\ X\ (integer))\ X\ ((X\ (atom)))) -\ \ ((list\ Y)\ Y\ ((Y\ (number))))) +(defspec (foo 1) + ((tuple X (integer)) X ((X (atom)))) + ((list Y) Y ((Y (number))))) -(defspec\ (remove\-if\ 2) -\ \ (pred\ (list)\ (list)\ (pred\ (lambda\ ((any))\ (boolean))))) -\f +(defspec (remove-if 2) + (pred (list) (list) (pred (lambda ((any)) (boolean))))) +\fR .fi .PP -Note that a constraint variable doesn\aqt need to start with an -upper\-case like an Erlang variable, though in some case it may be -easier to read. +Note that a constraint variable doesn\cqt need to start with an +upper-case like an Erlang variable, though in some case it may be easier +to read. .PP -Note we are using the alternate list form with \fC\ \f instead of +Note we are using the alternate list form with \fC \fR instead of parentheses to make it easier to see the function arguments. +.SH Types and function specifications in the module definition +.PP +Types can also be defined in the module declaration, for example: +.IP +.nf +\fC +(defmodule this-module + ... + (type ((foo-type) (tuple \aqfoo (integer) (list))) + ((bar-type) (tuple \aqbar (integer) (list)))) + (spec ((foo 1) ((integer) (foo-type))) + ((id 1) (x x ((x (tuple)))))) + ...) +\fR +.fi .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/man/lfescript.1 -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/man/lfescript.1
Changed
@@ -1,10 +1,10 @@ -.\" Automatically generated by Pandoc 1.19.2.1 +.\" Automatically generated by Pandoc 2.11.2 .\" -.TH "lfescript" "1" "2013\-2016" "" "" +.TH "lfescript" "1" "2013-2016" "" "" .hy .SH NAME .PP -lfescript \- Lisp Flavoured Erlang (LFE) scripting support +lfescript - Lisp Flavoured Erlang (LFE) scripting support .SH SYNOPSIS .PP lfescript provides support for running short LFE programs without having @@ -12,24 +12,24 @@ arguments. .SH EXPORTS .PP -\fBscript\-name script\-arg1 script\-arg2 ...\f +\fBscript-name script-arg1 script-arg2 \&...\fR .PP -\fBlfescript lfescript\-flags script\-name script\-arg1 script\-arg2 -\&...\f +\fBlfescript lfescript-flags script-name script-arg1 script-arg2 +\&...\fR .PP lfescript runs a script written in LFE. .PP -\fBlfescript:script_name() \-> File\f +\fBlfescript:script_name() -> File\fR .PP Types: .IP .nf \fC -File\ =\ filename() -\f +File = filename() +\fR .fi .PP -The \fCscript_name/0\f function returns the name of the lfescript +The \fCscript_name/0\fR function returns the name of the lfescript being executed. If the function is invoked outside the context of an lfescript, the behavior is undefined. @@ -39,28 +39,28 @@ .IP .nf \fC -$\ cat\ factorial -#!\ /usr/bin/env\ lfescript -;;\ \-*\-\ mode:\ lfe\ \-*\- -;;!\ \-smp\ enable\ \-sname\ factorial\ \-mnesia\ debug\ verbose +$ cat factorial +#! /usr/bin/env lfescript +;; -*- mode: lfe -*- +;;! -smp enable -sname factorial -mnesia debug verbose -(defun\ main -\ \ ((list\ string) -\ \ \ (try -\ \ \ \ \ \ \ (let*\ ((n\ (list_to_integer\ string)) -\ \ \ \ \ \ \ \ \ \ \ \ \ \ (f\ (fac\ n))) -\ \ \ \ \ \ \ \ \ (lfe_io:format\ "factorial\ ~w\ =\ ~w\\n"\ (list\ n\ f))) -\ \ \ \ \ (catch -\ \ \ \ \ \ \ ((tuple\ _\ _\ _)\ (usage))))) -\ \ (_\ (usage))) +(defun main + ((list string) + (try + (let* ((n (list_to_integer string)) + (f (fac n))) + (lfe_io:format \dqfactorial \tiw = \tiw\rsn\dq (list n f))) + (catch + ((tuple _ _ _) (usage))))) + (_ (usage))) -(defun\ fac -\ \ (0\ 1) -\ \ (n\ (*\ n\ (fac\ (\-\ n\ 1))))) +(defun fac + (0 1) + (n (* n (fac (- n 1))))) -(defun\ usage\ () -\ \ (lfe_io:format\ "usage:\ factorial\ integer\\n"\ ())) -\f +(defun usage () + (lfe_io:format \dqusage: factorial integer\rsn\dq ())) +\fR .fi .PP The header of the LFE script is different from a normal LFE module. @@ -73,15 +73,15 @@ .IP .nf \fC -;;!\ \-smp\ enable\ \-sname\ factorial\ \-mnesia\ debug\ verbose -\f +;;! -smp enable -sname factorial -mnesia debug verbose +\fR .fi .PP In the example the second line is an optional directive to Emacs which causes it to enter LFE mode when editing the script file. .PP The rest of the file contains LFE source code. -It must always the function \fCmain/1\f. +It must always contain the function \fCmain/1\fR. When the script is run this function will be called with a list of strings representing the arguments with which the script was called. It is possible to define, include and use macros in the source code. @@ -90,15 +90,15 @@ If there are errors the script will not run and it will terminate with exit status 127. Otherwise the code will be interpreted. -If the function \fCmain/1\f returns successfully then the exit +If the function \fCmain/1\fR returns successfully then the exit status for the script will be 0 but if an exception is raised then exit status will be 127. .SH OPTIONS .PP The following option is accepted by lfescript .IP \bu 2 -\fC\-s\f \- Only perform a syntactic and semantic check of the -script file. +\fC-s\fR - Only perform a syntactic and semantic check of the script +file. Warnings and errors (if any) are written to the standard output, but the script will not be run. The exit status will be 0 if there were no errors, and 127 otherwise. @@ -106,21 +106,21 @@ Unrecognised options are ignored. .SH ENVIRONMENT VARIABLES .PP -\fBLFESCRIPT_EMULATOR\f +\fBLFESCRIPT_EMULATOR\fR .PP The command used to start the emulator. -Default is \aqerl\aq. +Default is `erl'. This can be useful for passing arguments into the emulator, for example .IP .nf \fC -LFESCRIPT_EMULATOR="erl\ \-pa\ sune" -\f +LFESCRIPT_EMULATOR=\dqerl -pa sune\dq +\fR .fi .PP will add the directory sune to the code path. .SH SEE ALSO .PP -\fBlfe(1)\f, \fBlfe_guide(7)\f +\fBlfe(1)\fR, \fBlfe_guide(7)\fR .SH AUTHORS Robert Virding.
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfe.1.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfe.1.md
Changed
@@ -1,6 +1,6 @@ % lfe(1) % Robert Virding -% 2008-2016 +% 2008-2020 # NAME @@ -40,14 +40,6 @@ Clear the REPL output. -**(doc | describe Mod)** - -**(doc | describe Mod:Mac)** - -**(doc | describe Mod:Fun/Arity)** - -Print out documentation of a module/macro/function. - **(ec File Options)** Compile and load an Erlang file. @@ -69,11 +61,23 @@ Print usage info. +**(h Mod)** + +**(h Mod Mac)** + +**(h Mod Fun Arity)** + +Print out help information of a module/macro/function. + **(i (list Pid ...))** Print information about a list of pids. If no list is given then print information about currently running processes in the system. +**(i x y z)** + +Print information about the about #Pid<x.y.z> + **(l Module ...)** Load modules. @@ -122,7 +126,7 @@ **(reset-environment)** Resets the environment to its initial state. This will clear all -variables, functions an macros that have been set. +variables, functions and macros that have been set. **(run File)** @@ -176,7 +180,7 @@ **``*``, ``**``, ``***``** -The values of the previous 3 expressions. +The values of the previous three expressions. **``-``** @@ -221,8 +225,9 @@ Flags that LFE recognizes include the following: +* ``-nobanner`` - starts LFE without showing the banner * ``-h`` or ``--help`` - provides command line usage help -* ``-e`` or ``-eval`` - evaluates a given sexpr +* ``-e`` or ``-eval`` - evaluates a given sexpr in a string * ``-prompt`` - users may supply a value here to override the default ``lfe>`` prompt; note that ``-prompt classic`` will set the prompt to the original ``>`` and ``-prompt`` with no @@ -233,6 +238,17 @@ prompt value containing the string ``~node`` (which will be substituted with the actual name of the node). +There can be multiple string expressions to be evaluated; each one +must be prefixed with an ``-e`` or ``-eval``. String expressions are +run in the LFE repl so shell commands and functions are allowed. They +are all run in the same invocation of the repl so: + +``` +$ lfe -e "(set aaa 42)" -e "(set bbb 84)" -e "(pp (tuple aaa bbb))" +#(42 84) +``` + +If there are string expressions then the LFE repl will ``not`` be run. # RUNNING LFE SHELL SCRIPTS @@ -253,10 +269,16 @@ **script-args** -A list of the arguments to the script as strings. If -no arguments have been given then this will be an -empty list. +A list of the arguments to the script as strings. If no arguments have +been given then this will be an empty list. + +Note that if there are any string expressions to be evaluated then +these must come before the name of the script file and its +arguments. These expressions will be evaluated before the script and +the script will use the environment from the string expressions. +It is possible to run both string expressions and an LFE shell script +and they are then run in the same LFE repl. # SEE ALSO
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfe_clj.3.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfe_clj.3.md
Changed
@@ -10,7 +10,7 @@ # SYNOPSIS -This module provides Clojure-inpired functions and macros for use in LFE. +This module provides Clojure-inspired functions and macros for use in LFE. # EXPORTS @@ -593,7 +593,7 @@ Return a nullary function that returns a cons cell with `start` as the head and a nullary function, `(next func (funcall func start step) step)` as the tail. The result can be treated as a (possibly infinite) lazy list, which only -computes subseqeuent values as needed. +computes subsequent values as needed. **(lazy-seq seq)** @@ -653,7 +653,7 @@ Return a list of lists of `n` items each, at offsets `step` apart. Use the elements of `pad` as necessary to complete the last partition up to `n` -elements. In case there are not enough padding elements, return a parition with +elements. In case there are not enough padding elements, return a partition with less than `n` items. **(partition-all n lst)**
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfe_comp.3.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfe_comp.3.md
Changed
@@ -56,6 +56,10 @@ linted LFE code in the files <Module>.lint. No object files are produced. Mainly useful for debugging and interest. +* ``to_erlang``, ``to-erlang`` - Print a listing of the Erlang AST in + the file <Module>.erl. 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 @@ -123,7 +127,7 @@ Compile the forms as an LFE module returning a binary. This function takes the same options as ``lfe_comp:file/1/2``. When generating Errors and Warnings the "line number" is the index -of the form in which the error occured. +of the form in which the error occurred. **format_error(Error) -> Chars**
View file
_service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfe_docs.3.md
Added
@@ -0,0 +1,33 @@ +% lfe_docs(3) +% Robert Virding +% 2016 + + +# NAME + +lfe_docs - Lisp Flavoured Erlang (LFE) documentation handling. + + +# SYNOPSIS + +This module provides functions to parse docstrings in LFE module +sources in EEP48 format. + +# EXPORTS + +**make_chunk(Mod, CompilerInfo) -> {ok,DocsChunk}** + +Parse a module's docstrings and return a documentation chunk. + +**make_docs_info(Mod, CompilerInfo) -> {ok,DocsInfo}** + +Parse a module's docstrings and return the documentation info. + +**get_module_docs(Module | Binary) -> {ok,DocsInfo} | {error,Error}** + +Extract the documentation from a module documentation chunk and return +it in the documentation format of the current Erlang version. + +# SEE ALSO + +**lfe_comp(3)**, **lfe_macro(3)**
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfe_guide.7.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfe_guide.7.md
Changed
@@ -1,15 +1,15 @@ % lfe_guide(7) % Robert Virding -% 2008-2016 +% 2008-2020 # NAME lfe_guide - Lisp Flavoured Erlang User Guide -# SYNPOSIS +# SYNOPSIS -Note: {{ ... }} is use to denote optional syntax. +Note: {{ ... }} is used to denote optional syntax. # LITERALS AND SPECIAL SYNTACTIC RULES @@ -35,7 +35,7 @@ * Binary notation (alternative form): ``` - #*0 #b*10101 #*-1100 + #*0 #*10101 #*-1100 ``` * Octal notation: @@ -53,7 +53,7 @@ * Hexadecimal notation: ``` - #xc0ffe 0x-01 + #xc0ffe #x-01 ``` * Notation with explicit base (up to 36): @@ -100,7 +100,7 @@ 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 +The one thing to watch out for is that you cannot omit the part before or after the decimal point if it is zero. E.g. the following are not valid forms: ``100.`` or ``.125``. @@ -125,7 +125,7 @@ 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) then typing the -actual unicode letter. +actual Unicode letter. ### Binary Strings @@ -226,7 +226,7 @@ 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: ``` @@ -296,12 +296,16 @@ (tset tuple index val) (binary seg ... ) (map key val ...) -(map-get m k) (map-set m k v ...) (map-update m k v ...) +(map-size map) (msiz m) +(map-get map key) (mref m k) +(map-set map key val ...) (mset m k v ...) +(map-update map key val ...) (mupd m k v ...) +(map-remove map key ...) (mrem m k k ...) (lambda (arg ...) ...) (match-lambda ((arg ... ) {{(when e ...)}} ...) - Matches clauses ... ) -(function func-name arity) - Function references +(function func-name arity) - Function reference (function mod-name func-name arity) (let ((pat {{(when e ...)}} e) ...) @@ -330,19 +334,37 @@ {{(case ((pat {{(when e ...)}} ... ) ... ))}} {{(catch - (((tuple type value ignore) {{(when e ...)}} - - Must be tuple of length 3! + ((tuple type value stacktrace)|_ {{(when e ...)}} + - Must be tuple of length 3 or just _! ... ) ... )}} {{(after ... )}}) (funcall func arg ... ) -(call mod func arg ... ) - Call to Mod:Func(Arg, ... ) +(call mod func arg ... ) - Call to Mod:Func(Arg, ... ) + +(define-record name fields) +(record name field val ...) +(is-record record name) +(record-index name field) +(record-field record name field) +(record-update record name field val ...) + +(define-struct fields) +(struct field val ...) +(is-struct struct) +(is-struct struct name) +(struct-field struct name field) +(struct-update struct name field val ...) (define-module name meta-data attributes) (extend-module meta-data attributes) (define-function name meta-data lambda|match-lambda) (define-macro name meta-data lambda|match-lambda) + +(define-type type definition) +(define-opaque-type type definition) +(define-function-spec func spec) ``` ## Basic macro forms @@ -354,8 +376,9 @@ (call 'mod 'func arg ... ) (? {{timeout {{default}} }}) (++ ... ) -(list* ...) -(let* (...) ... ) +(-- ... ) +(list* ... ) +(let* (... ) ... ) (flet ((name (arg ...) {{doc-string}} ...) ...) ...) @@ -363,18 +386,21 @@ (fletrec ((name (arg ...) {{doc-string}} ...) ...) ...) -(cond ... - {{(?= pat expr)}} - ... ) +(cond (test body ...) + ... + ((?= pat expr) ...) + ... + (else ...)) (andalso ... ) (orelse ... ) (fun func arity) (fun mod func arity) -(lc (qual ...) ...) -(list-comp (qual ...) ...) -(bc (qual ...) ...) -(binary-comp (qual ...) ...) -(match-spec ...) +(lc (qual ...) expr) +(list-comp (qual ...) expr) +(bc (qual ...) bitstringexpr) +(binary-comp (qual ...) bitstringexpr) +(ets-ms ...) +(trace-ms ...) ``` ## Common Lisp inspired macros @@ -404,20 +430,7 @@ (prog2 ...) (defmodule name ...) (defrecord name ...) -``` - -## Older Scheme inspired macros - -``` -(define (name arg ...) ...) -(define name lambda|match-lambda) -(define-syntax name - (syntax-rules (pat exp) ...)|(macro (pat body) ...)) -(let-syntax ((name ...) - ...) - ...) -(begin ...) -(define-record name ...) +(defstruct ...) ``` # Patterns @@ -452,7 +465,7 @@ # Guards Wherever a pattern occurs (in let, case, receive, lc, etc.) it can be -followed by an optional guard which has the form (when test ...). +followed by an optional guard which has the form ``(when test ...)``. Guard tests are the same as in vanilla Erlang and can contain the following guard expressions: @@ -465,9 +478,16 @@ (tuple gexpr ...) (tref gexpr gexpr) (binary ...) -(progn gtest ...) - Sequence of guard tests -(if gexpr gexpr gexpr) -(type-test e) +(record ...) - Also the macro versions +(is-record ...) +(record-field ...) +(record-index ...) +(map ...) +(msiz ...) (map-size ...) +(mref ...) (map-get ...) +(mset ...) (map-set ...) +(mupd ...) (map-update ...) +(type-test e) - Type tests (guard-bif ...) - Guard BIFs, arithmetic, boolean and comparison operators ``` @@ -533,6 +553,7 @@ arguments. In the final ``(zop x y)`` both ``x`` and ``y`` come from the function arguments as the ``let`` does not export ``x``. + # Function Binding and Scoping Functions are lexically scoped and bound by the top-level ``defun`` @@ -555,8 +576,8 @@ This means that it is perfectly legal to shadow BIFs by imports, BIFs/imports by top-level functions and BIFs/imports/top-level by -``fletrec``s. In this respect there is nothing special about BIfs, they -just behave as prefined imported functions, a whopping big ``(import +``fletrec``s. In this respect there is nothing special about BIFs, they +just behave as predefined imported functions, a whopping big ``(import (from erlang ...))``. EXCEPT that we know about guard BIFs and expression BIFs. If you want a private version of ``spawn`` then define it, there will be no warnings. @@ -568,42 +589,70 @@ # Module definition +The basic forms for defining a module and extending its metadata and +attributes are: + ``` -(defmodule name - "This is the module documentation." - (export (f 2) (g 1) ... ) - (export all) ;Export all functions - (import (from mod (f1 2) (f2 1) ... ) - (rename mod ((f1 2) sune) ((f2 1) kurt) ... )) - (import (prefix mod mod-prefix)) - NYI - (attr-1 value-1 value-2) - ... ) +(define-module name meta-data attributes) +(extend-module meta-data attributes) ``` -Can have multiple export and import declarations within module -declaration. The ``(export all)`` declaration is allowed together with -other export declarations and overrides them. Other attributes which -are not recognised by the compiler are allowed and are simply passed -on to the module and can be accessed through ``module_info/0-1``. +The valid meta data is ``(type typedef ...)``, ``(opaque typedef ...)``, +``(spec function-spec ...)`` and ``(record record-def ...)``. +Each can take multiple definitions in one meta form. +Attributes declarations have the syntax ``(attribute value-1 ...)`` +where the attribute value is a list off the values in the declaration -# Parameterized modules +To simplify defining modules there is a predefined macro: ``` -(defmodule (name par1 par2 ... ) +(defmodule name + "This is the module documentation." + (export (f 2) (g 1) ... ) + (export all) ;Export all functions + (import (from mod (f1 2) (f2 1) ... ) + (rename mod ((g1 2) m-g1) ((g2 1) m-g2) ... )) + (module-alias (really-long-module-name rlmn) ...) + (attr-1 value-1 value-2) + {meta meta-data ...) ... ) ``` -Define a parameterized module which behaves the same way as in vanilla -Erlang. For now avoid defining functions 'new' and 'instance'. - +We can have multiple export and import attributes within module +declaration. The ``(export all)`` attribute is allowed together with +other export attributes and overrides them. Other attributes which are +not recognized by the compiler are allowed and are simply passed on to +the module and can be accessed with the ``module_info/0-1`` functions. + +In the ``import`` attribute the ``(from mod (f1 2) ...)`` means that +the call ``(f1 'everything 42)`` will be converted by the compiler to +``(mod:f1 'everything 42))`` while the ``(rename mod ((g2 2) m-g1) +...)`` means that the call ``(m-g1 'everything 42)`` will be converted +to ``(mod:g1 'everything 42)``. The ``rename`` form can be used as +compact way of indicating the imported function's module. Note that +when importing a module + +* the compiler does no checking on that module at all +* in the ``rename`` above the functions ``g1/2`` and ``g2/1`` aren't +automatically imported, only the "renamed" functions. +* we do not really see in the code that we are calling a function in +another module + +In the ``module-alias`` attribute the ``(really-long-module-name +rlmn)`` declaration means that the call ``(lrmn:foo 'everything 42)`` +will be converted by the compiler to ``(really-long-module-name:foo +'everything 42)``. This is often used to write short module names in +the code when calling functions in modules with long names. It is in +many ways better than using ``import`` as it does not hide that we are +calling a function in another module. # Macros Macro calls are expanded in both body and patterns. This can be very useful to have both make and match macros, but be careful with names. -A macro is function of two argument which is a called with a list of +A macro is function of two arguments which is a called with a list of the arguments to the macro call and the current macro environment. It can be either a lambda or a match-lambda. The basic forms for defining macros are: @@ -614,7 +663,14 @@ ...) ``` -Macros are definitely NOT hygienic in any form. +Macros are definitely NOT hygienic in any form. However, variable +scoping and variable immutability remove most of the things that can +cause unhygienic macros. It can be done but you are not going to do it +by mistake. The only real issue is if you happen to be using a +variable which has the same name as one which the macro generates, +that can cause problems. The work around for this is to give variables +created in the macro expansion really weird names like `| - foo - |` +which no one in their right mind would use. To simplify writing macros there are a number of predefined macros: @@ -643,7 +699,7 @@ The macro functions created by defmacro and macrolet automatically add the second argument with the current macro environment with the name -$ENV. This allows explicit expansion of macros inside the macro and +`$ENV`. This allows explicit expansion of macros inside the macro and also manipulation of the macro environment. No changes to the environment are exported outside the macro. @@ -678,18 +734,21 @@ defined before the macro is used. Scheme's syntax rules are an easy way to define macros where the body -is just a simple expansion. These are supported with ``defsyntax`` and -``syntaxlet``. Note that the patterns are only the arguments to the macro -call and do not contain the macro name. So using them we would get: +is just a simple expansion. The are implemented the the module `scm` +and are supported with ``scm:define-syntax`` and ``scm:let-syntax`` +and the equivalent ``scm:defsyntax`` and ``scm:syntaxlet``. Note that +the patterns are only the arguments to the macro call and do not +contain the macro name. So using them we would get: ``` -(defsyntax andalso +(scm:defsyntax andalso (() 'true) ((e) e) ((e . es) (case e ('true (andalso . es)) ('false 'false)))) ``` -N.B. These are definitely NOT hygienic. +There is an include file "include/scm.lfe" which defines macros so the +names don't have to be prefixed with ``scm:``. *CAVEAT* While it is perfectly legal to define a Core form as a macro these will silently be ignored by the compiler. @@ -737,10 +796,16 @@ # Extended cond -Cond has been extended with the extra test (?= pat expr) which tests -if the result of expr matches pat. If so it binds the variables in pat -which can be used in the cond. A optional guard is allowed here. An -example: +The tests in ``cond`` are Erlang tests in that they should return +either ``true`` or ``false``. If no test succeeds then the ``cond`` +does not generate an exception but just returns ``false``. There is a +simple catch-all "test" ``else`` which must last and can be used to +handle when all tests fail. + +Cond has been extended with the extra test ``(?= pat expr)`` which +tests if the result of ``expr`` matches the pattern ``pat``. If so it +binds the variables in ``pa``t which can be used in the ``cond``. A optional +guard is allowed here. An example: ``` (cond ((foo x) ...) @@ -748,7 +813,8 @@ (fubar xs (baz x))) ((?= (tuple 'ok x) (baz y)) (zipit x)) - ... ) + ... + (else 'yay)) ``` @@ -756,43 +822,102 @@ Records are tuples with the record name as first element and the rest of the fields in order exactly like "normal" Erlang records. As with -Erlang records the default default value is 'undefined'. +Erlang records the default default value is the atom 'undefined'. + +The basic forms for defining a record, creating, accessing and +updating it are: + +``` +(define-record name (field | (field) | + (field default-value) | + (field default-value type) ...)) +(record name field value field value ...) +(is-record record name) +(record-index name field) +(record-field record name field) +(record-update record name field value field value ...) +``` + +Note that the list of field/value pairs when making or updating a +record is a flat list. + +Note that the old ``make-record`` form has been deprecated and is +replaced by ``record`` which better matches other constructors like +``tuple`` and ``map``. It still exists but should not be used. + +We will explain these forms with a simple example. To define a record +we do: + +``` +(define-record person + ((name "") + (address "" (string)) + (age))) +``` + +which defines a record ``person`` with the fields ``name`` (default +value ``""``), ``address`` (default value ``""`` and type +``(string)``) and ``age``. To make an instance of a ``person`` record +we do: + +``` +(record person name "Robert" age 54) +``` + +The ``record`` form is also used to define a pattern. + +We can get the value of the ``address`` field in a person record and +set it by doing (the variable ``robert`` references a ``person`` +record): + +``` +(record-field robert person address) +(record-update robert person address "my home" age 55) +``` + +Note that we must include the name of the record when accessing it and +there is no need to quote the record and field names as these are +always literal atoms. + +To simplify defining and using records there is a predefined macro: ``` (defrecord name - field + (field) | field (field default-value) + (field default-value type) ... ) ``` -Will create access functions/macros for creation and accessing -fields. The ``make-``, ``match-`` and ``set-`` forms takes optional -argument pairs field-name value to get non-default values. E.g. for +This will create access macros for record creation and accessing and +updating fields. The ``make-``, ``match-`` and ``update-`` forms takes +optional argument pairs field-name value to get non-default values. +E.g. for ``` (defrecord person (name "") - (address "") - age) + (address "" (string)) + (age)) ``` the following will be generated: ``` (make-person {{field value}} ... ) - (match-person {{field value}} ... ) - (is-person r) - (fields-person) - (emp-person {{field value}} ... ) - (set-person r {{field value}} ... ) - (person-name r) - (person-name) - (set-person-name r name) - (person-age r) - (person-age) - (set-person-age r age) - (person-address r) - (set-person-address r address) +(match-person {{field value}} ... ) +(is-person r) +(fields-person) +(update-person r {{field value}} ... ) +(person-name r) +(person-name) +(update-person-name r name) +(person-age r) +(person-age) +(update-person-age r age) +(person-address r) +(person-address) +(update-person-address r address) ``` * ``(make-person name "Robert" age 54)`` - @@ -807,22 +932,18 @@ * ``(is-person john)`` - Test if john is a person record. -* ``(emp-person age '$1)`` - - Create an Ets Match Pattern for record person where the age - field is set to $1 and all other fields are set to '_. - * ``(person-address john)`` - Return the address field of the person record john. * ``(person-address)`` - Return the index of the address field of a person record. -* ``(set-person-address john "back street")`` - - Sets the address field of the person record john to +* ``(update-person-address john "back street")`` - + Updates the address field of the person record john to "back street". -* ``(set-person john age 35 address "front street")`` - - In the person record john set the age field to 35 and the +* ``(update-person john age 35 address "front street")`` - + In the person record john update the age field to 35 and the address field to "front street". * ``(fields-person)`` - @@ -833,6 +954,63 @@ * ``(size-person)`` - Returns the size of the record tuple. +Note that the older now deprecated ``set-`` forms are still +generated. + +# Structs + +Structs in LFE are the same as Elixir structs and have been defined +in the same way so to be truly compatible. This means that you can use +structs defined in Elixr from LFE and structs defined in LFE from +Elixir. + +``` +(define-struct (field | (field) | + (field default-value) | + (field default-value type) ...)) +(struct name field value field value ...) +(is-struct struct) +(is-struct struct name) +(struct-field struct name field) +(struct-update struct name field value field value ...) +``` + +We will explain these forms with a simple example. To define a struct +we do: + +``` +(define-struct ((name "") + (address "" (string)) + (age))) +``` + +which defines a struct with the name of the current module with the +fields ``name`` (default value ``""``), ``address`` (default value +``""`` and type ``(string)``) and ``age``. To make an instance of +struct we do: + +``` +(struct mod-name name "Robert" age 54) +``` + +The ``struct`` form is also used to define a pattern. + +We can get the value of the ``address`` field in the struct and set it +by doing (the variable ``robert`` references a struct): + +``` +(struct-field robert mod-name address) +(struct-update robert mod-name address "my home" age 55) +``` + +Note that a struct automatically gets the name of the module in which +it is defined so that there can only be one struct defined in a +module. This mirrors how structs are implemented in Elixir. + +Note that we must include the name of the struct when accessing it and +there is no need to quote the struct and field names as these are +always literal atoms. + # Binaries/bitstrings A binary is @@ -844,13 +1022,14 @@ where ``seg`` is ``` - byte - string - (val integer|float|binary|bitstring|bytes|bits - (size n) (unit n) - big-endian|little-endian|native-endian - big|little|native - signed|unsigned) + byte + string + (val integer | float | binary | bitstring | bytes | bits | + utf8 | utf-8 | utf16 | utf-16 | utf32 | utf-32 + (size n) (unit n) + big-endian | little-endian | native-endian + big | little | native + signed | unsigned) ``` ``val`` can also be a string in which case the specifiers will be applied @@ -861,7 +1040,7 @@ # Maps -A map is: +A map is created with: ``` (map key value ... ) @@ -869,22 +1048,26 @@ To access maps there are the following forms: +* ``(map-size map)`` - + Return the size of a map. + * ``(map-get map key)`` - - Return the value associated with key in map. + Return the value associated with the key in the map. * ``(map-set map key val ... )`` - - Set keys in map to values. + Set the keys in the map to values. This form can be used to update + the values of existing keys and to add new keys. * ``(map-update map key val ... )`` - - Update keys in map to values. Note that this form requires all - the keys to exist. + Update the keys in the map to values. Note that this form requires all + the keys to already exist in the map. -N.B. This syntax for processing maps has stablized but may change in -the future! +* ``(map-remove map key ... )`` - + Remove the keys in the map. -There is also an alternate short form ``map``, ``mref``, ``mset``, -``mupd`` based on the Maclisp array reference forms. They take the -same arguments as their longer alternatives. +There are also alternate short forms ``msiz``, ``mref``, ``mset``, +``mupd`` and ``mrem`` based on the Maclisp array reference forms. They +take the same arguments as their longer alternatives. # List/binary comprehensions @@ -893,29 +1076,28 @@ list comprehensions is: ``` -(lc (qual ...) expr ... ) -(list-comp (qual ...) expr ... ) +(lc (qual ...) expr) +(list-comp (qual ...) expr) ``` -where the final expr is used to generate the elements of the list. +where the last expr is used to generate the elements of the list. The syntax for binary comprehensions is: ``` -(bc (qual ...) expr ... ) -(binary-comp (qual ...) expr ... ) +(bc (qual ...) bitstringexpr ) +(binary-comp (qual ...) bitstringexpr) ``` -where the final expr is a bitseg expr and is used to generate the -elements of the binary. +where the final expr is a bitstring expression and is used to generate +the elements of the binary. The supported qualifiers, in both list/binary comprehensions are: ``` (<- pat {{guard}} list-expr) - Extract elements from list (<= bin-pat {{guard}} binary-expr) - Extract elements from binary -(?= pat {{guard}} expr) - Match test and bind variables in pat -expr - Normal boolean test +expr - Normal boolean test ``` Some examples: @@ -930,15 +1112,16 @@ greater than 5. ``` -(bc ((<= (f float (size 32)) b1) ;Only bitseg needed +(bc ((<= (binary (f float (size 32))) b1) (> f 10.0)) - (: io fwrite "~p\n" (list f)) - (f float (size 64))) ;Only bitseg needed + (progn + (: io fwrite "~p\n" (list f)) + (binary (f float (size 64))))) ``` -returns a binary of floats of size 64 of floats which are larger than -10.0 from the binary b1 and of size 32. The returned numbers are first -printed. +returns a binary of floats of size 64 bits which are from the binary +b1 where they are of size 32 bits and larger than 10.0. The returned +numbers are first printed. N.B. A word of warning when using guards when extracting elements from a binary. When a match/guard fails for a binary no more attempts will @@ -953,13 +1136,11 @@ # ETS and Mnesia -Apart from ``(emp-record ...)`` macros for ETS Match Patterns, which are -also valid in Mnesia, LFE also supports match specifications and Query -List Comprehensions. The syntax for a match specification is the same -as for match-lambdas: +LFE also supports match specifications and Query List Comprehensions. +The syntax for a match specification is the same as for match-lambdas: ``` -(match-spec +(ets-ms ((arg ... ) {{(when e ...)}} ...) - Matches clauses ... ) ``` @@ -967,14 +1148,15 @@ For example: ``` -(ets:select db (match-spec +(ets:select db (ets-ms ((tuple _ a b) (when (> a 3)) (tuple 'ok b)))) ``` It is a macro which creates the match specification structure which is -used in ``ets:select`` and ``mnesia:select``. The same ``match-spec`` -macro can also be used with the dbg module. The same restrictions as to -what can be done apply as for vanilla match specifications: +used in ``ets:select`` and ``mnesia:select``. For tracing instead of +the ``ets-ms`` macro there is the ``trace-ms`` macro which is also +used in conjunction with the ``dbg`` module. The same restrictions as +to what can be done apply as for vanilla match specifications: - There is only a limited number of BIFs which are allowed - There are some special functions only for use with dbg @@ -1022,7 +1204,7 @@ (<comp_op> expr ...) ``` -The standard arithmentic operators, + - * /, and +The standard arithmetic operators, + - * /, and comparison operators, > >= < =< == /= =:= =/= , can take multiple arguments the same as their standard lisp counterparts. This is still experimental and implemented @@ -1049,7 +1231,7 @@ (subst-if-not new test tree) (sublis alist tree) ``` -The standard substituition functions. +The standard substitution functions. ``` (macroexpand-1 expr {{environment}}) @@ -1096,6 +1278,232 @@ (eval `(let ((foo ,foo)) ,expr)) ``` +## Supplemental Common Lisp Functions + +LFE provides the module cl which contains the following functions +which closely mirror functions defined in the Common Lisp +Hyperspec. Note that the following functions use zero-based indices, +like Common Lisp (unlike Erlang, which start at index '1'). A major +difference between the LFE versions and the Common Lisp versions of +these functions is that the boolean values are +the LFE `'true` and `'false`. Otherwise the definitions closely follow the +CL definitions and won't be documented here. + +``` +cl:make-lfe-bool cl-value +cl:make-cl-bool lfe-bool + +cl:mapcar function list +cl:maplist function list +cl:mapc function list +cl:mapl function list + +cl:symbol-plist symbol +cl:symbol-name symbol +cl:get symbol pname +cl:get symbol pname default +cl:getl symbol pname-list +cl:putprop symbol value pname +cl:remprop symbol pname + +cl:getf plist pname +cl:getf plist pname default +cl:putf plist value pname ; This does not exist in CL +cl:remf plist pname +cl:get-properties plist pname-list + +cl:elt index sequence +cl:length sequence +cl:reverse sequence +cl:some predicate sequence +cl:every predicate sequence +cl:notany predicate sequence +cl:notevery predicate sequence +cl:reduce function sequence +cl:reduce function sequence 'initial-value x +cl:reduce function sequence 'from-end 'true +cl:reduce function sequence 'initial-value x 'from-end 'true + +cl:remove item sequence +cl:remove-if predicate sequence +cl:remove-if-not predicate sequence +cl:remove-duplicates sequence + +cl:find item sequence +cl:find-if predicate sequence +cl:find-if-not predicate sequence +cl:find-duplicates sequence +cl:position item sequence +cl:position-if predicate sequence +cl:position-if-not predicate sequence +cl:position-duplicates sequence +cl:count item sequence +cl:count-if predicate sequence +cl:count-if-not predicate sequence +cl:count-duplicates sequence + +cl:car list +cl:first list +cl:cdr list +cl:rest list +cl:nth index list +cl:nthcdr index list +cl:last list +cl:butlast list + +cl:subst new old tree +cl:subst-if new test tree +cl:subst-if-not new test tree +cl:sublis alist tree + +cl:member item list +cl:member-if predicate list +cl:member-if-not predicate list +cl:adjoin item list +cl:union list list +cl:intersection list list +cl:set-difference list list +cl:set-exclusive-or list list +cl:subsetp list list + +cl:acons key data alist +cl:pairlis list list +cl:pairlis list list alist +cl:assoc key alist +cl:assoc-if predicate alost +cl:assoc-if-not predicate alost +cl:rassoc key alist +cl:rassoc-if predicate alost +cl:rassoc-if-not predicate alost + +cl:type-of object +cl:coerce object type +``` + +Furthermore, there is an include file which developers may which to utilize in +their LFE programs: `(include-lib "lfe/include/cl.lfe")`. Currently this offers +Common Lisp predicates, but may include other useful macros and functions in +the future. The provided predicate macros wrap the various `is_*` Erlang +functions; since these are expanded at compile time, they are usable in guards. +The include the following: + +``` +(alivep x) +(atomp x) +(binaryp x) +(bitstringp x) +(boolp x) and (booleanp x) +(builtinp x) +(consp x) +(floatp x) +(funcp x) and (functionp x) +(intp x) and (integerp x) +(listp x) +(mapp x) +(numberp x) +(pidp x) +(process-alive-p x) +(recordp x tag) +(recordp x tag size) +(refp x) and (referencep x) +(tuplep x) +(vectorp x) +``` + +Non-predicate macros in `lfe/include/cl.lfe` include: + +``` +(dolist ...) +(vector ...) +``` +## Supplemental Clojure Functions + +From LFE's earliest days, it's Lisp-cousin Clojure (created around the same time) +has inspired LFE developers to create similar, BEAM-versions of those functions. +These were collected in a separate library and then expanded upon, until +eventually becoming part of the LFE standard library. + +Function definition macros: + +``` +(clj:defn ...) +(clj:defn- ...) +(clj:fn ...) +``` + +Threading macros: + +``` +(clj:-> ...) +(clj:->> ...) +(clj:as-> ...) +(clj:cond-> ...) +(clj:cond->> ...) +(clj:some-> ...) +(clj:some->> ...) +(clj:doto ...) +``` + +Conditional macros: + +``` +(clj:if-let ...) +(clj:iff-let ...) +(clj:condp ...) +(clj:if-not ...) +(clj:iff-not ...) +(clj:when-not ...) +(clj:not= ...) +``` + +Predicate macros: + +``` +(clj:atom? x) +(clj:binary? x) +(clj:bitstring? x) +(clj:bool? x) +(clj:boolean? x) +(clj:even? x) +(clj:false? x) +(clj:falsy? x) +(clj:float? x) +(clj:func? x) +(clj:function? x) +(clj:identical? x) +(clj:int? x) +(clj:integer? x) +(clj:map? x) +(clj:neg? x) +(clj:nil? x) +(clj:number? x) +(clj:odd? x) +(clj:pos? x) +(clj:record? x) +(clj:reference? x) +(clj:true? x) +(clj:tuple? x) +(clj:undef? x) +(clj:undefined? x) +(clj:zero? x) +``` + +Other: + +``` +(clj:str x) +(clj:lazy-seq x) +(clj:conj ...) +(clj:if ...) +``` + +Most of the above mentioned macros are available in the `clj` include file, +the use of which allows developers to forego the `clj:` prefix in calls: + +``` +(include-lib "lfe/include/clj.lfe") +``` + # Notes * NYI - Not Yet Implemented
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfe_io.3.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfe_io.3.md
Changed
@@ -1,6 +1,6 @@ % lfe_io(3) % Robert Virding -% 2008-2016 +% 2008-2019 # NAME @@ -35,29 +35,34 @@ # EXPORTS -**read(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo}** +**read(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo} | eof** -Read an s-expr from the standard input (IoDevice) with a prompt -(Prompt). Note that this is not line-oriented in that it stops as soon +Read an s-expr from the standard input (``IoDevice``) with a prompt +(``Prompt``). Note that this is not line-oriented in that it stops as soon as it has consumed enough characters. -**read_line(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo}** +**read_line(IoDevice, Prompt) -> {ok,Sexpr} | {error,ErrorInfo} | eof** -Read an s-expr from the standard input (IoDevice) with a prompt -(Prompt). Note that this is line-oriented in that it reads whole lines +Read an s-expr from the standard input (``IoDevice``) with a prompt +(``Prompt``). Note that this is line-oriented in that it reads whole lines discarding left-over characters in the last line. **read_string(String) -> {ok,Sexpr} | {error,ErrorInfo}** -Read an s-expr from String. +Read an s-expr from ``String``. Note that this only reads from ``String`` +discarding left-over characters at the end of the string. **print(IoDevice, Sexpr) -> ok** -Print the s-expr Sexpr to the standard output (IoDevice). +Print the s-expr ``Sexpr`` to the standard output (``IoDevice``). **print1(Sexpr) -> DeepCharList** -Return the list of characters which represent the s-expr Sexpr. +Return the list of characters which represent the s-expr ``Sexpr``. + +**prettyprint(IoDevice, Sexpr) -> ok** + +Pretty print the s-expr ``Sexpr`` to the standard output (``IoDevice``). **prettyprint1(Sexpr) -> DeepCharList** @@ -67,9 +72,9 @@ **prettyprint1(Sexpr, Depth, Indentation, LineLength) -> DeepCharList** -Return the lost of characters which represents the -prettyprinted s-expr ``Sexpr``. Assume we start at indentation -Indentation or 0. +Return the list of characters which represents the prettyprinted +s-expr ``Sexpr``. Default values for ``Depth`` is 30, ``Indentation`` +is 0 and ``LineLength`` is 80. **format(IoDevice, Format, Args) -> ok** @@ -96,7 +101,7 @@ **read_file(FileName) -> {ok,Sexpr} | {error,ErrorInfo}** -Read the file Filename returning a list of s-exprs (as it +Read the file ``Filename`` returning a list of s-exprs (as it should be). **parse_file(FileName) -> {ok,FileSexpr} | {error,ErrorInfo}** @@ -107,7 +112,7 @@ FileSexpr = filesexpr() ``` -Read the file Filename returning a list of pairs containing +Read the file ``Filename`` returning a list of pairs containing s-expr and line number of the start of the s-expr. **scan_sexpr(Cont, Chars ,Line) -> {done,Ret,RestChars}|{more,Cont1}**
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfe_macro.3.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfe_macro.3.md
Changed
@@ -1,6 +1,6 @@ % lfe_macro(3) % Robert Virding -% 2008-2016 +% 2008-2020 # NAME @@ -32,28 +32,30 @@ This is an macro and evaluation environment as created by ``lfe_lib:new_env()``. +**mac_state()** -# EXPORTS - -**expand_forms(FileSexpr, Env) -> ExpRet** +This is the internal state used by the macro expander. -where +# EXPORTS -``` - FileSexpr = filesexpr() - Env = env() - ExpRet = {yes,FileSexpr,Env,Warnings} | {error,Errors,Warnings} -``` +**expand_expr(Sexpr, Env) -> {yes,Exp} | no.** -**macro_forms(FileSexpr, Env) -> {FileSexpr,Env}.** +**expand_expr_1(Sexpr, Env) -> {yes,Exp} | no.** where ``` -FileSexpr = filesexpr() +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. + **expand_expr_all(Sexpr, Env) -> Sexpr.** where @@ -67,23 +69,55 @@ or just the default macros. Note that any eventual new macro definitions will be lost. -**expand_expr(Sexpr, Env) -> {yes,Exp} | no.** +**expand_form_init(Deep, Keep) -> MacState** -**expand_expr_1(Sexpr, Env) -> {yes,Exp} | no.** +where + +``` + Deep = boolean() + Keep = boolean() + MacState = mac_state() +``` + +Create an internal macro state. ``Deep`` determines whether the form +is to be expanded internally at depth and ``Keep`` whether macro +definition forms are to be kept. + +**expand_fileforms(FileForm, Env, Deep, Keep) -> ExpRet** + +**expand_fileforms(FileForm, Env, MacState) -> ExpRet** where ``` -Sexpr = Exp = sexpr() -Env = env() + FileForm = filesexpr() + Env = env() + Deep = boolean() + Keep = boolean() + MacState = mac_state() + ExpRet = {yes,FileSexpr,Env,Warnings} | + {error,Errors,Warnings} ``` -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. +expand a sequence of file forms. + +**expand_form(Form, Line, Env, MacState) -> RetState** + +**expand_fileform(FileForm, Env, MacState) -> RetState** + +where + +``` + Form = sexpr() + FileForm = filesexpr() + Line = integer() + Env = env() + MacState = mac_state() + RetState = {ok,Form,Env,Macstate} | + {error,Errors,Warnings,MacState} +``` + +Expand a file form using the environment and macro state. # SEE ALSO
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfe_types.7.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfe_types.7.md
Changed
@@ -1,6 +1,6 @@ % lfe_types(7) % Robert Virding -% 2016 +% 2021 # NAME @@ -27,9 +27,11 @@ | `(lambda () <type>)` | `fun(() -> <type>)` | | `(lambda (<tlist>) <type>)` | `fun((<tlist>) -> <type>)` | | `(map)` | `map()` | - | `(map <pairlist>)` | `#{<pairlist>}` | + | `#M()` | `#{}` | + | `#M(<key> <value> ...)` | `#{<pairlist>}` | | `(tuple)` | `tuple()` | - | `(tuple <tlist>)` | `{<tlist>}` | + | `#()` | `{}` | + | `#(<tlist>)` | `{<tlist>}` | | `(UNION <tlist>)` | `<type> | <type>` | Apart from the predefined types in the Erlang type system we also have @@ -37,6 +39,10 @@ `call`, `lambda` and `range`. The usage of `bitstring`, `tuple` and `map` have also been extended. +Note that the type `#M()` is the empty map and the type `#()` is the +empty tuple. We can still use the older `(map <key valuelist>)` and +`(tuple <tlist>)` formats when declaring types for maps and tuples. + The general form of bitstrings is `(bitstring m n)` which denotes a bitstring which starts with `m` bits and continues with segments of `n` bits. `(binary)` is a short form for a sequence of bytes while @@ -65,7 +71,7 @@ ## Type Information in Record Declarations -**(defrecord rec (field1 default1 type1) (field2 default2) field3)** +**(defrecord rec (field1 default1 type1) (field2 default2) (field3))** Fields with type annotations *MUST* give a default value and fields without type annotations get the default type `(any)`. @@ -119,3 +125,18 @@ Note we are using the alternate list form with ` ` instead of parentheses to make it easier to see the function arguments. + +# Types and function specifications in the module definition + + +Types can also be defined in the module declaration, for example: + +``` +(defmodule this-module + ... + (type ((foo-type) (tuple 'foo (integer) (list))) + ((bar-type) (tuple 'bar (integer) (list)))) + (spec ((foo 1) ((integer) (foo-type))) + ((id 1) (x x ((x (tuple)))))) + ...) +```
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/lfescript.1.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/lfescript.1.md
Changed
@@ -80,11 +80,11 @@ Emacs which causes it to enter LFE mode when editing the script file. -The rest of the file contains LFE source code. It must always -the function ``main/1``. When the script is run this function will -be called with a list of strings representing the arguments -with which the script was called. It is possible to define, -include and use macros in the source code. +The rest of the file contains LFE source code. It must always contain +the function ``main/1``. When the script is run this function will be +called with a list of strings representing the arguments with which +the script was called. It is possible to define, include and use +macros in the source code. The source code is checked and warnings and errors will be printed. If there are errors the script will not run and it
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/src/version_history.md -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/src/version_history.md
Changed
@@ -117,7 +117,7 @@ Added ``(export all)`` attribute to module definition. Added new records which allow giving default values as in vanilla Erlang. -Records are still compatible with vanilla Erlang but now more pratical +Records are still compatible with vanilla Erlang but now more practical to use. NOTE this change is not backwards compatible as syntax for ``(make- ...)`` and ``(match- ...)`` have changed. Also added general multiple ``(set- ...)`` macro. @@ -126,13 +126,13 @@ functions to be defined when compiling the forms. These are useful for more complex macros. -Better and more documention. The documentation is still normal text +Better and more documentation. The documentation is still normal text files as Edoc and are not in agreement on how things should work. ## v0.3 This is the first version with the modified internal core forms and -macro intefaces for the new CL-inspired style and the older Scheme-inspired +macro interfaces for the new CL-inspired style and the older Scheme-inspired style. Two new modules have been added: @@ -148,7 +148,7 @@ ``-pa`` to find modules if necessary. ``lfe_gen`` is a trial interface for using LFE for dynamic code -generation. LFE is much easier to generate as an Erkang list than +generation. LFE is much easier to generate as an Erlang list than Erlang forms. This module helps with defining and compiling a module. Note, that while it works, this module is very experimental and may change. @@ -161,7 +161,7 @@ keep variables and functions separate and while Core Erlang tries to hide this fact it does not fully succeed. In fact, it is actually impossible to do this given Erlang's property of being able to have -many functions of the same name but with different arites. +many functions of the same name but with different arities. While this is not as elegant and forces the use of funcall to call functions bound to variables it works better. @@ -187,13 +187,13 @@ ```cl (tuple 'ok a b) - ; this is eqivalent to {ok,A,B} + ; this is equivalent to {ok,A,B} #('ok a b) - ; this is eqivalent to {quote,ok,a,b} + ; this is equivalent to {quote,ok,a,b} (binary (f float (size 32)) (rest binary)) - ; this is eqivalent to <<F:32/float,Rest:binary>> + ; this is equivalent to <<F:32/float,Rest:binary>> ``` @@ -213,7 +213,7 @@ It is not yet possible to define functions/macros in the shell but that should use soon be possible. You should also then be able to do -regurgítate which would write all the definitions out to a file. +regurgitate which would write all the definitions out to a file. Running a shell other than the standard erlang one is a bit difficult so I have included a patched version of user_drv.erl from @@ -237,4 +237,3 @@ There is now a lisp prettyprinter in ``lfe_io``. Unfortunately the io functions in ``lfe_io`` are not always obviously named from a lisp viewpoint. -
View file
_service:tar_scm:lfe-1.3.tar.gz/doc/user_guide.txt -> _service:tar_scm:lfe-2.1.1.tar.gz/doc/user_guide.txt
Changed
@@ -3,10 +3,10 @@ NAME - lfe_guide - Lisp Flavoured Erlang User Guide + lfe_guide ‐ Lisp Flavoured Erlang User Guide -SYNPOSIS - Note: {{ ... }} is use to denote optional syntax. +SYNOPSIS + Note: {{ ... }} is used to denote optional syntax. LITERALS AND SPECIAL SYNTACTIC RULES Integers @@ -14,27 +14,27 @@ · Regular decimal notation: - 1234 -123 0 + 1234 ‐123 0 · Binary notation: - #b0 #b10101 #b-1100 + #b0 #b10101 #b‐1100 · Binary notation (alternative form): - #*0 #b*10101 #*-1100 + #*0 #*10101 #*‐1100 · Octal notation: - #o377 #o-111 + #o377 #o‐111 · Explicitly decimal notation: - #d1234 #d-123 #d0 + #d1234 #d‐123 #d0 · Hexadecimal notation: - #xc0ffe 0x-01 + #xc0ffe #x‐01 · Notation with explicit base (up to 36): @@ -50,58 +50,58 @@ #\x1f42d; In all these forms, the case of the indicating letter is not signifi‐ - cant, i.e. #b1010 and #B1010 are identical as are #16rf00 and #16Rf00. + cant, 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. #36rHel‐ - loWorld is valid and the same number as #36Rhelloworld and #36rHEL‐ + 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. #36rHel‐ + loWorld is valid and the same number as #36Rhelloworld and #36rHEL‐ LOWORLD. 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 + 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 num‐ + 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 num‐ bers: - 1.0 +1.0 -1.0 1.0e10 1.111e-10 + 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 be‐ - fore or after the decimal point if it is zero. E.g. the following are - not valid forms: 100. or .125. + The one thing to watch out for is that you cannot omit 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 + 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) then typing the ac‐ - tual unicode letter. + 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 view‐ + able with regular fonts. E.g. "Cat: \\x1f639;" might be easier to + type (and view on output devices without a Unicode font) then typing + the actual Unicode letter. Binary Strings Binary strings are just like list strings but they are represented dif‐ - ferently in the virtual machine. The simple syntax is #"...", e.g. - #"This is a binary string \n with some \"escaped\" and quot‐ - ed (\\x1f639;) characters" + ferently 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(...), de‐ - scribed below), e.g. #B("a"), #"a", and #B(97) are all the same binary + scribed below), e.g. #B("a"), #"a", and #B(97) are all the same binary string. Character Escaping @@ -109,7 +109,7 @@ escaped name: | Escaped name | Character | - |--------------+-----------------| + |‐‐‐‐‐‐‐‐‐‐‐‐‐‐+‐‐‐‐‐‐‐‐‐‐‐‐‐‐‐‐‐| | \b | Backspace | | \t | Tab | | \n | Newline | @@ -120,21 +120,21 @@ | \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. + 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 + 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(‐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 @@ -142,13 +142,13 @@ > #B((#"a" binary) (#"b" binary)) #"ab" - Learn more about "segments" of binary data e.g. in "Learn You Some Er‐ - lang (http://learnyousomeerlang.com/starting-out-for-real#bit-syntax)" - <http://learnyousomeerlang.com/starting-out-for-real#bit-syntax>. + Learn more about “segments” of binary data e.g. in “Learn You Some Er‐ + lang (http://learnyousomeerlang.com/starting‐out‐for‐real#bit‐syntax)” + <http://learnyousomeerlang.com/starting‐out‐for‐real#bit‐syntax>. Lists - Lists are formed either as ( ... ) or ... where the optional ele‐ - ments of the list are separated by some form or whitespace. For exam‐ + Lists are formed either as ( ... ) or ... where the optional ele‐ + ments of the list are separated by some form or whitespace. For exam‐ ple: () @@ -163,33 +163,33 @@ so valid. Maps - Maps are written as #M(key1 value1 key2 value2 ...) The empty map is + Maps are written as #M(key1 value1 key2 value2 ...) 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 sur‐ - prisingly 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). + Simple examples are foo, Foo, foo‐bar, :foo. But also somewhat sur‐ + prisingly 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, basically - all of the latin-1 character set without control character, whitespace, + Symbol names can contain a surprising breadth or characters, 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). + symbol’s name (but they are allowed as subsequent letters). I.e. these are all legal symbols: foo, foo, µ#, ±1, 451°F. - Symbols can be explicitly constructed by wrapping their name in verti‐ - cal bars, e.g. |foo|, |symbol name with spaces|. In this case the - name can contain any character of in the range from 0 to 255 (or even - none, i.e. || is a valid symbol). The vertical bar in the symbol name - needs to be escaped: |symbol with a vertical bar \| in its name| (simi‐ - larly you will obviously have to escape the escape character as well). + Symbols can be explicitly constructed by wrapping their name in verti‐ + cal bars, e.g. |foo|, |symbol name with spaces|. In this case the name + can contain any character of in the range from 0 to 255 (or even none, + i.e. || is a valid symbol). The vertical bar in the symbol name needs + to be escaped: |symbol with a vertical bar \| in its name| (similarly + you will obviously have to escape the escape character as well). Comments Comments come in two forms: line comments and block comments. @@ -198,8 +198,8 @@ line. Block comments are written as #| comment text |# where the comment text - may span multiple lines but my not contain another block comment, i.e. - it may not contain the character sequence #|. + may span multiple lines but my not contain another block comment, + i.e. it may not contain the character sequence #|. Evaluation While Reading #.(... some expression ...). E.g. #.(+ 1 1) will evaluate the (+ 1 1) @@ -217,27 +217,31 @@ (tset tuple index val) (binary seg ... ) (map key val ...) - (map-get m k) (map-set m k v ...) (map-update m k v ...) + (map‐size map) (msiz m) + (map‐get map key) (mref m k) + (map‐set map key val ...) (mset m k v ...) + (map‐update map key val ...) (mupd m k v ...) + (map‐remove map key ...) (mrem m k k ...) (lambda (arg ...) ...) - (match-lambda - ((arg ... ) {{(when e ...)}} ...) - Matches clauses + (match‐lambda + ((arg ... ) {{(when e ...)}} ...) ‐ Matches clauses ... ) - (function func-name arity) - Function references - (function mod-name func-name arity) + (function func‐name arity) ‐ Function reference + (function mod‐name func‐name arity) (let ((pat {{(when e ...)}} e) ...) ... ) - (let-function ((name lambda|match-lambda) - Local functions + (let‐function ((name lambda|match‐lambda) ‐ Local functions ... ) ... ) - (letrec-function ((name lambda|match-lambda) - Local functions + (letrec‐function ((name lambda|match‐lambda) ‐ Local functions ... ) ... ) - (let-macro ((name lambda-match-lambda) - Local macros + (let‐macro ((name lambda‐match‐lambda) ‐ Local macros ...) ...) (progn ... ) - (if test true-expr {{false-expr}}) + (if test true‐expr {{false‐expr}}) (case e (pat {{(when e ...)}} ...) ... )) @@ -251,19 +255,37 @@ {{(case ((pat {{(when e ...)}} ... ) ... ))}} {{(catch - (((tuple type value ignore) {{(when e ...)}} - - Must be tuple of length 3! + ((tuple type value stacktrace)|_ {{(when e ...)}} + ‐ Must be tuple of length 3 or just _! ... ) ... )}} {{(after ... )}}) (funcall func arg ... ) - (call mod func arg ... ) - Call to Mod:Func(Arg, ... ) + (call mod func arg ... ) ‐ Call to Mod:Func(Arg, ... ) - (define-module name meta-data attributes) - (extend-module meta-data attributes) + (define‐record name fields) + (record name field val ...) + (is‐record record name) + (record‐index name field) + (record‐field record name field) + (record‐update record name field val ...) - (define-function name meta-data lambda|match-lambda) - (define-macro name meta-data lambda|match-lambda) + (define‐struct fields) + (struct field val ...) + (is‐struct struct) + (is‐struct struct name) + (struct‐field struct name field) + (struct‐update struct name field val ...) + + (define‐module name meta‐data attributes) + (extend‐module meta‐data attributes) + + (define‐function name meta‐data lambda|match‐lambda) + (define‐macro name meta‐data lambda|match‐lambda) + + (define‐type type definition) + (define‐opaque‐type type definition) + (define‐function‐spec func spec) Basic macro forms (: mod func arg ... ) => @@ -272,44 +294,48 @@ (call 'mod 'func arg ... ) (? {{timeout {{default}} }}) (++ ... ) - (list* ...) - (let* (...) ... ) - (flet ((name (arg ...) {{doc-string}} ...) + (‐‐ ... ) + (list* ... ) + (let* (... ) ... ) + (flet ((name (arg ...) {{doc‐string}} ...) ...) ...) (flet* (...) ... ) - (fletrec ((name (arg ...) {{doc-string}} ...) + (fletrec ((name (arg ...) {{doc‐string}} ...) ...) ...) - (cond ... - {{(?= pat expr)}} - ... ) + (cond (test body ...) + ... + ((?= pat expr) ...) + ... + (else ...)) (andalso ... ) (orelse ... ) (fun func arity) (fun mod func arity) - (lc (qual ...) ...) - (list-comp (qual ...) ...) - (bc (qual ...) ...) - (binary-comp (qual ...) ...) - (match-spec ...) + (lc (qual ...) expr) + (list‐comp (qual ...) expr) + (bc (qual ...) bitstringexpr) + (binary‐comp (qual ...) bitstringexpr) + (ets‐ms ...) + (trace‐ms ...) Common Lisp inspired macros - (defun name (arg ...) {{doc-string}} ...) + (defun name (arg ...) {{doc‐string}} ...) (defun name - {{doc-string}} + {{doc‐string}} ((argpat ...) ...) ...) - (defmacro name (arg ...) {{doc-string}} ...) - (defmacro name arg {{doc-string}} ...) + (defmacro name (arg ...) {{doc‐string}} ...) + (defmacro name arg {{doc‐string}} ...) (defmacro name - {{doc-string}} + {{doc‐string}} ((argpat ...) ...) ...) (defsyntax name (pat exp) ...) - (macrolet ((name (arg ...) {{doc-string}} ...) + (macrolet ((name (arg ...) {{doc‐string}} ...) ...) ...) (syntaxlet ((name (pat exp) ...) @@ -319,48 +345,38 @@ (prog2 ...) (defmodule name ...) (defrecord name ...) - - Older Scheme inspired macros - (define (name arg ...) ...) - (define name lambda|match-lambda) - (define-syntax name - (syntax-rules (pat exp) ...)|(macro (pat body) ...)) - (let-syntax ((name ...) - ...) - ...) - (begin ...) - (define-record name ...) + (defstruct ...) Patterns - Written as normal data expressions where symbols are variables and use - quote to match explicit values. Binaries and tuples have special syn‐ + Written as normal data expressions where symbols are variables and use + quote to match explicit values. Binaries and tuples have special syn‐ tax. - {ok,X} -> (tuple 'ok x) - error -> 'error - {yes,X|Xs} -> (tuple 'yes (cons x xs)) - <<34,U:16,F/float>> -> (binary 34 (u (size 16)) (f float)) - P|Ps=All -> (= (cons p ps) all) + {ok,X} ‐> (tuple 'ok x) + error ‐> 'error + {yes,X|Xs} ‐> (tuple 'yes (cons x xs)) + <<34,U:16,F/float>> ‐> (binary 34 (u (size 16)) (f float)) + P|Ps=All ‐> (= (cons p ps) all) - Repeated variables are supported in patterns and there is an automatic + Repeated variables are supported in patterns and there is an automatic comparison of values. - _ as the "don't care" variable is supported. This means that the sym‐ - bol _, which is a perfectly valid symbol, can never be bound through + _ as the “don’t care” variable is supported. This means that the sym‐ + bol _, which is a perfectly valid symbol, can never be bound through pattern matching. - Aliases are defined with the (= pattern1 pattern2) pattern. As in Er‐ + Aliases are defined with the (= pattern1 pattern2) pattern. As in Er‐ lang patterns they can be used anywhere in a pattern. CAVEAT The lint pass of the compiler checks for aliases and if they are - possible to match. If not an error is flagged. This is not the best - way. Instead there should be a warning and the offending clause re‐ - moved, but later passes of the compiler can't handle this yet. + possible to match. If not an error is flagged. This is not the best + way. Instead there should be a warning and the offending clause re‐ + moved, but later passes of the compiler can’t handle this yet. Guards - Wherever a pattern occurs (in let, case, receive, lc, etc.) it can be - followed by an optional guard which has the form (when test ...). - Guard tests are the same as in vanilla Erlang and can contain the fol‐ + Wherever a pattern occurs (in let, case, receive, lc, etc.) it can be + followed by an optional guard which has the form (when test ...). + Guard tests are the same as in vanilla Erlang and can contain the fol‐ lowing guard expressions: (quote e) @@ -371,25 +387,32 @@ (tuple gexpr ...) (tref gexpr gexpr) (binary ...) - (progn gtest ...) - Sequence of guard tests - (if gexpr gexpr gexpr) - (type-test e) - (guard-bif ...) - Guard BIFs, arithmetic, + (record ...) ‐ Also the macro versions + (is‐record ...) + (record‐field ...) + (record‐index ...) + (map ...) + (msiz ...) (map‐size ...) + (mref ...) (map‐get ...) + (mset ...) (map‐set ...) + (mupd ...) (map‐update ...) + (type‐test e) ‐ Type tests + (guard‐bif ...) ‐ Guard BIFs, arithmetic, boolean and comparison operators - An empty guard, (when), always succeeds as there is no test which + An empty guard, (when), always succeeds as there is no test which fails. This simplifies writing macros which handle guards. Comments in Function Definitions - Inside functions defined with defun LFE permits optional comment - strings in the Common Lisp style after the argument list. So we can + Inside functions defined with defun LFE permits optional comment + strings in the Common Lisp style after the argument list. So we can have: (defun max (x y) "The max function." (if (>= x y) x y)) - Optional comments are also allowed in match style functions after the + Optional comments are also allowed in match style functions after the function name and before the clauses: (defun max @@ -397,7 +420,7 @@ ((x y) (when (>= x y)) x) ((x y) y)) - This is also possible in a similar style in local functions defined by + This is also possible in a similar style in local functions defined by flet and fletrec: (defun foo (x y) @@ -408,9 +431,9 @@ (m x y))) Variable Binding and Scoping - Variables are lexically scoped and bound by lambda, match-lambda and - let forms. All variables which are bound within these forms shadow - variables bound outside but other variables occurring in the bodies of + Variables are lexically scoped and bound by lambda, match‐lambda and + let forms. All variables which are bound within these forms shadow + variables bound outside but other variables occurring in the bodies of these forms will be imported from the surrounding environments.No vari‐ ables are exported out of the form. So for example the following func‐ tion: @@ -420,22 +443,22 @@ (zap x z)) (zop x y)) - The variable y in the call (zip y) comes from the function arguments. + The variable y in the call (zip y) comes from the function arguments. However, the x bound in the let will shadow the x from the arguments so - in the call (zap x z) the x is bound in the let while the z comes from - the function arguments. In the final (zop x y) both x and y come from + in the call (zap x z) the x is bound in the let while the z comes from + the function arguments. In the final (zop x y) both x and y come from the function arguments as the let does not export x. Function Binding and Scoping - Functions are lexically scoped and bound by the top-level defun and by - the macros flet and fletrec. LFE is a Lisp-2 so functions and vari‐ - ables have separate namespaces and when searching for function both + Functions are lexically scoped and bound by the top‐level defun and by + the macros flet and fletrec. LFE is a Lisp‐2 so functions and vari‐ + ables have separate namespaces and when searching for function both name and arity are used. This means that when calling a function which - has been bound to a variable using (funcall func-var arg ...) is re‐ - quired to call lambda/match-lambda bound to a variable or used as a + has been bound to a variable using (funcall func‐var arg ...) is re‐ + quired to call lambda/match‐lambda bound to a variable or used as a value. - Unqualified functions shadow as stated above which results in the fol‐ + Unqualified functions shadow as stated above which results in the fol‐ lowing order within a module, outermost to innermost: · Predefined Erlang BIFs @@ -444,62 +467,101 @@ · Imports - · Top-level defines + · Top‐level defines · Flet/fletrec · Core forms, these can never be shadowed - This means that it is perfectly legal to shadow BIFs by imports, - BIFs/imports by top-level functions and BIFs/imports/top-level by fle‐ - trecs. In this respect there is nothing special about BIfs, they just - behave as prefined imported functions, a whopping big (import (from er‐ - lang ...)). EXCEPT that we know about guard BIFs and expression BIFs. - If you want a private version of spawn then define it, there will be no - warnings. + This means that it is perfectly legal to shadow BIFs by imports, + BIFs/imports by top‐level functions and BIFs/imports/top‐level by fle‐ + trecs. In this respect there is nothing special about BIFs, they just + behave as predefined imported functions, a whopping big (import (from + erlang ...)). EXCEPT that we know about guard BIFs and expression + BIFs. If you want a private version of spawn then define it, there + will be no warnings. - CAVEAT This does not hold for the supported core forms. These can be - shadowed by imports or redefined but the compiler will always use the + CAVEAT This does not hold for the supported core forms. These can be + shadowed by imports or redefined but the compiler will always use the core meaning and never an alternative. Silently! Module definition + The basic forms for defining a module and extending its metadata and + attributes are: + + (define‐module name meta‐data attributes) + (extend‐module meta‐data attributes) + + The valid meta data is (type typedef ...), (opaque typedef ...), (spec + function‐spec ...) and (record record‐def ...). Each can take multiple + definitions in one meta form. + + Attributes declarations have the syntax (attribute value‐1 ...) where + the attribute value is a list off the values in the declaration + + To simplify defining modules there is a predefined macro: + (defmodule name "This is the module documentation." (export (f 2) (g 1) ... ) (export all) ;Export all functions (import (from mod (f1 2) (f2 1) ... ) - (rename mod ((f1 2) sune) ((f2 1) kurt) ... )) - (import (prefix mod mod-prefix)) - NYI - (attr-1 value-1 value-2) + (rename mod ((g1 2) m‐g1) ((g2 1) m‐g2) ... )) + (module‐alias (really‐long‐module‐name rlmn) ...) + (attr‐1 value‐1 value‐2) + {meta meta‐data ...) ... ) - Can have multiple export and import declarations within module declara‐ - tion. The (export all) declaration is allowed together with other ex‐ - port declarations and overrides them. Other attributes which are not - recognised by the compiler are allowed and are simply passed on to the - module and can be accessed through module_info/0-1. + We can have multiple export and import attributes within module decla‐ + ration. The (export all) attribute is allowed together with other ex‐ + port attributes and overrides them. Other attributes which are not + recognized by the compiler are allowed and are simply passed on to the + module and can be accessed with the module_info/0‐1 functions. -Parameterized modules - (defmodule (name par1 par2 ... ) - ... ) + In the import attribute the (from mod (f1 2) ...) means that the call + (f1 'everything 42) will be converted by the compiler to (mod:f1 'ev‐ + erything 42)) while the (rename mod ((g2 2) m‐g1) ...) means that the + call (m‐g1 'everything 42) will be converted to (mod:g1 'everything + 42). The rename form can be used as compact way of indicating the im‐ + ported function’s module. Note that when importing a module + + · the compiler does no checking on that module at all - Define a parameterized module which behaves the same way as in vanilla - Erlang. For now avoid defining functions 'new' and 'instance'. + · in the rename above the functions g1/2 and g2/1 aren’t automatically + imported, only the “renamed” functions. + + · we do not really see in the code that we are calling a function in + another module + + In the module‐alias attribute the (really‐long‐module‐name rlmn) decla‐ + ration means that the call (lrmn:foo 'everything 42) will be converted + by the compiler to (really‐long‐module‐name:foo 'everything 42). This + is often used to write short module names in the code when calling + functions in modules with long names. It is in many ways better than + using import as it does not hide that we are calling a function in an‐ + other module. Macros - Macro calls are expanded in both body and patterns. This can be very + Macro calls are expanded in both body and patterns. This can be very useful to have both make and match macros, but be careful with names. - A macro is function of two argument which is a called with a list of - the arguments to the macro call and the current macro environment. It - can be either a lambda or a match-lambda. The basic forms for defining + A macro is function of two arguments which is a called with a list of + the arguments to the macro call and the current macro environment. It + can be either a lambda or a match‐lambda. The basic forms for defining macros are: - (define-macro name meta-data lambda|match-lambda) - (let-macro ((name lambda|match-lambda) + (define‐macro name meta‐data lambda|match‐lambda) + (let‐macro ((name lambda|match‐lambda) ...) - Macros are definitely NOT hygienic in any form. + Macros are definitely NOT hygienic in any form. However, variable + scoping and variable immutability remove most of the things that can + cause unhygienic macros. It can be done but you are not going to do it + by mistake. The only real issue is if you happen to be using a vari‐ + able which has the same name as one which the macro generates, that can + cause problems. The work around for this is to give variables created + in the macro expansion really weird names like | ‐ foo ‐ | which no one + in their right mind would use. To simplify writing macros there are a number of predefined macros: @@ -514,7 +576,7 @@ ment list. For example: (defmacro double (a) `(+ ,a ,a)) - (defmacro my-list args `(list ,@args)) + (defmacro my‐list args `(list ,@args)) (defmacro andalso ((list e) `,e) ((cons e es) `(if ,e (andalso ,@es) 'false)) @@ -529,61 +591,64 @@ ment are exported outside the macro. User defined macros shadow the predefined macros so it is possible to - redefine the built-in macro definitions. However, see the caveat be‐ + redefine the built‐in macro definitions. However, see the caveat be‐ low! Yes, we have the backquote. It is implemented as a macro so it is ex‐ panded at macro expansion time. Local functions that are only available at compile time and can be - called by macros are defined using eval-when-compile: + called by macros are defined using eval‐when‐compile: (defmacro foo (x) ... - (foo-helper m n) + (foo‐helper m n) ...) - (eval-when-compile - (defun foo-helper (a b) + (eval‐when‐compile + (defun foo‐helper (a b) ...) ) - There can be many eval-when-compile forms. Functions defined within an - eval-when-compile are mutually recursive but they can only call other - local functions defined in an earlier eval-when-compile and macros de‐ - fined earlier in the file. Functions defined in eval-when-compile + There can be many eval‐when‐compile forms. Functions defined within an + eval‐when‐compile are mutually recursive but they can only call other + local functions defined in an earlier eval‐when‐compile and macros de‐ + fined earlier in the file. Functions defined in eval‐when‐compile which are called by macros can defined after the macro but must be de‐ fined before the macro is used. - Scheme's syntax rules are an easy way to define macros where the body - is just a simple expansion. These are supported with defsyntax and - syntaxlet. Note that the patterns are only the arguments to the macro - call and do not contain the macro name. So using them we would get: + Scheme’s syntax rules are an easy way to define macros where the body + is just a simple expansion. The are implemented the the module scm and + are supported with scm:define‐syntax and scm:let‐syntax and the equiva‐ + lent scm:defsyntax and scm:syntaxlet. Note that the patterns are only + the arguments to the macro call and do not contain the macro name. So + using them we would get: - (defsyntax andalso + (scm:defsyntax andalso (() 'true) ((e) e) ((e . es) (case e ('true (andalso . es)) ('false 'false)))) - N.B. These are definitely NOT hygienic. + There is an include file “include/scm.lfe” which defines macros so the + names don’t have to be prefixed with scm:. - CAVEAT While it is perfectly legal to define a Core form as a macro + CAVEAT While it is perfectly legal to define a Core form as a macro these will silently be ignored by the compiler. Comments in Macro Definitions - Inside macros defined with defmacro LFE permits optional comment - strings in the Common Lisp style after the argument list. So we can + Inside macros defined with defmacro LFE permits optional comment + strings in the Common Lisp style after the argument list. So we can have: (defmacro double (a) "Double macro." `(+ ,a ,a)) - Optional comments are also allowed in match style macros after the + Optional comments are also allowed in match style macros after the macro name and before the clauses: - (defmacro my-list args + (defmacro my‐list args "List of arguments." `(list ,@args)) @@ -593,7 +658,7 @@ ((cons e es) `(if ,e (andalso ,@es) 'false)) (() `'true)) - This is also possible in a similar style in local functions defined by + This is also possible in a similar style in local functions defined by macrolet: (defun foo (x y) @@ -604,85 +669,182 @@ (m x y))) Extended cond + The tests in cond are Erlang tests in that they should return either + true or false. If no test succeeds then the cond does not generate an + exception but just returns false. There is a simple catch‐all “test” + else which must last and can be used to handle when all tests fail. + Cond has been extended with the extra test (?= pat expr) which tests if - the result of expr matches pat. If so it binds the variables in pat - which can be used in the cond. A optional guard is allowed here. An - example: + the result of expr matches the pattern pat. If so it binds the vari‐ + ables in pat which can be used in the cond. A optional guard is al‐ + lowed here. An example: (cond ((foo x) ...) ((?= (cons x xs) (when (is_atom x)) (bar y)) (fubar xs (baz x))) ((?= (tuple 'ok x) (baz y)) (zipit x)) - ... ) + ... + (else 'yay)) Records Records are tuples with the record name as first element and the rest - of the fields in order exactly like "normal" Erlang records. As with - Erlang records the default default value is 'undefined'. + of the fields in order exactly like “normal” Erlang records. As with + Erlang records the default default value is the atom ‘undefined’. + + The basic forms for defining a record, creating, accessing and updating + it are: + + (define‐record name (field | (field) | + (field default‐value) | + (field default‐value type) ...)) + (record name field value field value ...) + (is‐record record name) + (record‐index name field) + (record‐field record name field) + (record‐update record name field value field value ...) + + Note that the list of field/value pairs when making or updating a + record is a flat list. + + Note that the old make‐record form has been deprecated and is replaced + by record which better matches other constructors like tuple and map. + It still exists but should not be used. + + We will explain these forms with a simple example. To define a record + we do: + + (define‐record person + ((name "") + (address "" (string)) + (age))) + + which defines a record person with the fields name (default value ""), + address (default value "" and type (string)) and age. To make an in‐ + stance of a person record we do: + + (record person name "Robert" age 54) + + The record form is also used to define a pattern. + + We can get the value of the address field in a person record and set it + by doing (the variable robert references a person record): + + (record‐field robert person address) + (record‐update robert person address "my home" age 55) + + Note that we must include the name of the record when accessing it and + there is no need to quote the record and field names as these are al‐ + ways literal atoms. + + To simplify defining and using records there is a predefined macro: (defrecord name - field - (field default-value) + (field) | field + (field default‐value) + (field default‐value type) ... ) - Will create access functions/macros for creation and accessing fields. - The make-, match- and set- forms takes optional argument pairs - field-name value to get non-default values. E.g. for + This will create access macros for record creation and accessing and + updating fields. The make‐, match‐ and update‐ forms takes optional + argument pairs field‐name value to get non‐default values. E.g. for (defrecord person (name "") - (address "") - age) + (address "" (string)) + (age)) the following will be generated: - (make-person {{field value}} ... ) - (match-person {{field value}} ... ) - (is-person r) - (fields-person) - (emp-person {{field value}} ... ) - (set-person r {{field value}} ... ) - (person-name r) - (person-name) - (set-person-name r name) - (person-age r) - (person-age) - (set-person-age r age) - (person-address r) - (set-person-address r address) - - · (make-person name "Robert" age 54) - Will create a new person record - with the name field set to "Robert", the age field set to 54 and the - address field set to the default "". - - · (match-person name name age 55) - Will match a person with age 55 and + (make‐person {{field value}} ... ) + (match‐person {{field value}} ... ) + (is‐person r) + (fields‐person) + (update‐person r {{field value}} ... ) + (person‐name r) + (person‐name) + (update‐person‐name r name) + (person‐age r) + (person‐age) + (update‐person‐age r age) + (person‐address r) + (person‐address) + (update‐person‐address r address) + + · (make‐person name "Robert" age 54) ‐ Will create a new person record + with the name field set to “Robert”, the age field set to 54 and the + address field set to the default ““. + + · (match‐person name name age 55) ‐ Will match a person with age 55 and bind the variable name to the name field of the record. Can use any variable name here. - · (is-person john) - Test if john is a person record. - - · (emp-person age '$1) - Create an Ets Match Pattern for record person - where the age field is set to $1 and all other fields are set to '_. + · (is‐person john) ‐ Test if john is a person record. - · (person-address john) - Return the address field of the person record + · (person‐address john) ‐ Return the address field of the person record john. - · (person-address) - Return the index of the address field of a person + · (person‐address) ‐ Return the index of the address field of a person record. - · (set-person-address john "back street") - Sets the address field of - the person record john to "back street". + · (update‐person‐address john "back street") ‐ Updates the address + field of the person record john to “back street”. + + · (update‐person john age 35 address "front street") ‐ In the person + record john update the age field to 35 and the address field to + “front street”. + + · (fields‐person) ‐ Returns a list of fields for the record. This is + useful for when using LFE with Mnesia, as the record field names + don’t have to be provided manually in the create_table call. + + · (size‐person) ‐ Returns the size of the record tuple. + + Note that the older now deprecated set‐ forms are still generated. + +Structs + Structs in LFE are the same as Elixir structs and have been defined in + the same way so to be truly compatible. This means that you can use + structs defined in Elixr from LFE and structs defined in LFE from + Elixir. + + (define‐struct (field | (field) | + (field default‐value) | + (field default‐value type) ...)) + (struct name field value field value ...) + (is‐struct struct) + (is‐struct struct name) + (struct‐field struct name field) + (struct‐update struct name field value field value ...) - · (set-person john age 35 address "front street") - In the person - record john set the age field to 35 and the address field to "front - street". + We will explain these forms with a simple example. To define a struct + we do: - · (fields-person) - Returns a list of fields for the record. This is - useful for when using LFE with Mnesia, as the record field names - don't have to be provided manually in the create_table call. + (define‐struct ((name "") + (address "" (string)) + (age))) - · (size-person) - Returns the size of the record tuple. + which defines a struct with the name of the current module with the + fields name (default value ""), address (default value "" and type + (string)) and age. To make an instance of struct we do: + + (struct mod‐name name "Robert" age 54) + + The struct form is also used to define a pattern. + + We can get the value of the address field in the struct and set it by + doing (the variable robert references a struct): + + (struct‐field robert mod‐name address) + (struct‐update robert mod‐name address "my home" age 55) + + Note that a struct automatically gets the name of the module in which + it is defined so that there can only be one struct defined in a module. + This mirrors how structs are implemented in Elixir. + + Note that we must include the name of the struct when accessing it and + there is no need to quote the struct and field names as these are al‐ + ways literal atoms. Binaries/bitstrings A binary is @@ -691,13 +853,14 @@ where seg is - byte - string - (val integer|float|binary|bitstring|bytes|bits - (size n) (unit n) - big-endian|little-endian|native-endian - big|little|native - signed|unsigned) + byte + string + (val integer | float | binary | bitstring | bytes | bits | + utf8 | utf‐8 | utf16 | utf‐16 | utf32 | utf‐32 + (size n) (unit n) + big‐endian | little‐endian | native‐endian + big | little | native + signed | unsigned) val can also be a string in which case the specifiers will be applied to every character in the string. As strings are just lists of inte‐ @@ -705,97 +868,101 @@ are allowed on input but they will always be written as bytes. Maps - A map is: + A map is created with: (map key value ... ) To access maps there are the following forms: - · (map-get map key) - Return the value associated with key in map. + · (map‐size map) ‐ Return the size of a map. - · (map-set map key val ... ) - Set keys in map to values. + · (map‐get map key) ‐ Return the value associated with the key in the + map. - · (map-update map key val ... ) - Update keys in map to values. Note - that this form requires all the keys to exist. + · (map‐set map key val ... ) ‐ Set the keys in the map to values. This + form can be used to update the values of existing keys and to add new + keys. - N.B. This syntax for processing maps has stablized but may change in - the future! + · (map‐update map key val ... ) ‐ Update the keys in the map to values. + Note that this form requires all the keys to already exist in the + map. - There is also an alternate short form map, mref, mset, mupd based on - the Maclisp array reference forms. They take the same arguments as - their longer alternatives. + · (map‐remove map key ... ) ‐ Remove the keys in the map. + + There are also alternate short forms msiz, mref, mset, mupd and mrem + based on the Maclisp array reference forms. They take the same argu‐ + ments as their longer alternatives. List/binary comprehensions - List/binary comprehensions are supported as macros. The syntax for + List/binary comprehensions are supported as macros. The syntax for list comprehensions is: - (lc (qual ...) expr ... ) - (list-comp (qual ...) expr ... ) + (lc (qual ...) expr) + (list‐comp (qual ...) expr) - where the final expr is used to generate the elements of the list. + where the last expr is used to generate the elements of the list. The syntax for binary comprehensions is: - (bc (qual ...) expr ... ) - (binary-comp (qual ...) expr ... ) + (bc (qual ...) bitstringexpr ) + (binary‐comp (qual ...) bitstringexpr) - where the final expr is a bitseg expr and is used to generate the ele‐ - ments of the binary. + where the final expr is a bitstring expression and is used to generate + the elements of the binary. The supported qualifiers, in both list/binary comprehensions are: - (<- pat {{guard}} list-expr) - Extract elements from list - (<= bin-pat {{guard}} binary-expr) - Extract elements from binary - (?= pat {{guard}} expr) - Match test and bind variables in pat - expr - Normal boolean test + (<‐ pat {{guard}} list‐expr) ‐ Extract elements from list + (<= bin‐pat {{guard}} binary‐expr) ‐ Extract elements from binary + expr ‐ Normal boolean test Some examples: - (lc ((<- v (when (> v 5)) l1) + (lc ((<‐ v (when (> v 5)) l1) (== (rem v 2) 0)) v) - returns a list of all the even elements of the list l1 which are + returns a list of all the even elements of the list l1 which are greater than 5. - (bc ((<= (f float (size 32)) b1) ;Only bitseg needed + (bc ((<= (binary (f float (size 32))) b1) (> f 10.0)) - (: io fwrite "~p\n" (list f)) - (f float (size 64))) ;Only bitseg needed + (progn + (: io fwrite "~p\n" (list f)) + (binary (f float (size 64))))) - returns a binary of floats of size 64 of floats which are larger than - 10.0 from the binary b1 and of size 32. The returned numbers are first - printed. + returns a binary of floats of size 64 bits which are from the binary b1 + where they are of size 32 bits and larger than 10.0. The returned num‐ + bers are first printed. N.B. A word of warning when using guards when extracting elements from - a binary. When a match/guard fails for a binary no more attempts will - be made to extract data from the binary. This means that even if a - value could be extracted from the binary if the guard fails this value + a binary. When a match/guard fails for a binary no more attempts will + be made to extract data from the binary. This means that even if a + value could be extracted from the binary if the guard fails this value will be lost and extraction will cease. This is NOT the same as having - following boolean test which may remove an element but will not stop + following boolean test which may remove an element but will not stop extraction. Using a guard is probably not what you want! Normal vanilla Erlang does the same thing but does not allow guards. ETS and Mnesia - Apart from (emp-record ...) macros for ETS Match Patterns, which are - also valid in Mnesia, LFE also supports match specifications and Query - List Comprehensions. The syntax for a match specification is the same - as for match-lambdas: + LFE also supports match specifications and Query List Comprehensions. + The syntax for a match specification is the same as for match‐lambdas: - (match-spec - ((arg ... ) {{(when e ...)}} ...) - Matches clauses + (ets‐ms + ((arg ... ) {{(when e ...)}} ...) ‐ Matches clauses ... ) For example: - (ets:select db (match-spec + (ets:select db (ets‐ms ((tuple _ a b) (when (> a 3)) (tuple 'ok b)))) - It is a macro which creates the match specification structure which is - used in ets:select and mnesia:select. The same match-spec macro can - also be used with the dbg module. The same restrictions as to what can - be done apply as for vanilla match specifications: + It is a macro which creates the match specification structure which is + used in ets:select and mnesia:select. For tracing instead of the ets‐ + ms macro there is the trace‐ms macro which is also used in conjunction + with the dbg module. The same restrictions as to what can be done ap‐ + ply as for vanilla match specifications: · There is only a limited number of BIFs which are allowed @@ -807,29 +974,29 @@ · For dbg it takes a single parameter which must a list or a variable N.B. the current macro neither knows nor cares whether it is being - used in ets/mnesia or in dbg. It is up to the user to get this right. + used in ets/mnesia or in dbg. It is up to the user to get this right. - Macros, especially record macros, can freely be used inside match + Macros, especially record macros, can freely be used inside match specs. - CAVEAT Some things which are known not to work in the current version + CAVEAT Some things which are known not to work in the current version are andalso, orelse and record updates. Query List Comprehensions - LFE supports QLCs for mnesia through the qlc macro. It has the same - structure as a list comprehension and generates a Query Handle in the - same way as with qlc:q(...). The handle can be used together with + LFE supports QLCs for mnesia through the qlc macro. It has the same + structure as a list comprehension and generates a Query Handle in the + same way as with qlc:q(...). The handle can be used together with all the combination functions in the module qlc. For example: - (qlc (lc ((<- (tuple k v) (: ets table e2)) (== k i)) v) + (qlc (lc ((<‐ (tuple k v) (: ets table e2)) (== k i)) v) {{Option}}) - Macros, especially record macros, can freely be used inside query list + Macros, especially record macros, can freely be used inside query list comprehensions. - CAVEAT Some things which are known not to work in the current version + CAVEAT Some things which are known not to work in the current version are nested QLCs and let/case/recieve which shadow variables. Predefined LFE functions @@ -838,8 +1005,8 @@ (<arith_op> expr ...) (<comp_op> expr ...) - The standard arithmentic operators, + - * /, and comparison operators, - > >= < =< == /= =:= =/= , can take multiple arguments the same as their + The standard arithmetic operators, + ‐ * /, and comparison operators, > + >= < =< == /= =:= =/= , can take multiple arguments the same as their standard lisp counterparts. This is still experimental and implemented using macros. They do, however, behave like normal functions and eval‐ uate ALL their arguments before doing the arithmetic/comparisons opera‐ @@ -848,58 +1015,267 @@ (acons key value list) (pairlis keys values {{list}}) (assoc key list) - (assoc-if test list) - (assoc-if-not test list) + (assoc‐if test list) + (assoc‐if‐not test list) (rassoc value list) - (rassoc-if test list) - (rassoc-if-not test list) + (rassoc‐if test list) + (rassoc‐if‐not test list) The standard association list functions. (subst new old tree) - (subst-if new test tree) - (subst-if-not new test tree) + (subst‐if new test tree) + (subst‐if‐not new test tree) (sublis alist tree) - The standard substituition functions. + The standard substitution functions. - (macroexpand-1 expr {{environment}}) + (macroexpand‐1 expr {{environment}}) If Expr is a macro call, does one round of expansion, otherwise returns Expr. (macroexpand expr {{environment}}) - Returns the expansion returned by calling macroexpand-1 repeatedly, + Returns the expansion returned by calling macroexpand‐1 repeatedly, starting with Expr, until the result is no longer a macro call. - (macroexpand-all expr {{environment}}) + (macroexpand‐all expr {{environment}}) - Returns the expansion from the expression where all macro calls have + Returns the expansion from the expression where all macro calls have been expanded with macroexpand. - NOTE that when no explicit environment is given the macroexpand func‐ - tions then only the default built-in macros will be expanded. Inside + NOTE that when no explicit environment is given the macroexpand func‐ + tions then only the default built‐in macros will be expanded. Inside macros and in the shell the variable $ENV is bound to the current macro environment. (eval expr {{environment}}) - Evaluate the expression expr. Note that only the pre-defined lisp - functions, erlang BIFs and exported functions can be called. Also no + Evaluate the expression expr. Note that only the pre‐defined lisp + functions, erlang BIFs and exported functions can be called. Also no local variables can be accessed. To access local variables the expr to be evaluated can be wrapped in a let defining these. For example if the data we wish to evaluate is in the variable expr and - it assumes there is a local variable "foo" which it needs to access + it assumes there is a local variable “foo” which it needs to access then we could evaluate it by calling: (eval `(let ((foo ,foo)) ,expr)) + Supplemental Common Lisp Functions + LFE provides the module cl which contains the following functions which + closely mirror functions defined in the Common Lisp Hyperspec. Note + that the following functions use zero‐based indices, like Common Lisp + (unlike Erlang, which start at index ‘1’). A major difference between + the LFE versions and the Common Lisp versions of these functions is + that the boolean values are the LFE 'true and 'false. Otherwise the + definitions closely follow the CL definitions and won’t be documented + here. + + cl:make‐lfe‐bool cl‐value + cl:make‐cl‐bool lfe‐bool + + cl:mapcar function list + cl:maplist function list + cl:mapc function list + cl:mapl function list + + cl:symbol‐plist symbol + cl:symbol‐name symbol + cl:get symbol pname + cl:get symbol pname default + cl:getl symbol pname‐list + cl:putprop symbol value pname + cl:remprop symbol pname + + cl:getf plist pname + cl:getf plist pname default + cl:putf plist value pname ; This does not exist in CL + cl:remf plist pname + cl:get‐properties plist pname‐list + + cl:elt index sequence + cl:length sequence + cl:reverse sequence + cl:some predicate sequence + cl:every predicate sequence + cl:notany predicate sequence + cl:notevery predicate sequence + cl:reduce function sequence + cl:reduce function sequence 'initial‐value x + cl:reduce function sequence 'from‐end 'true + cl:reduce function sequence 'initial‐value x 'from‐end 'true + + cl:remove item sequence + cl:remove‐if predicate sequence + cl:remove‐if‐not predicate sequence + cl:remove‐duplicates sequence + + cl:find item sequence + cl:find‐if predicate sequence + cl:find‐if‐not predicate sequence + cl:find‐duplicates sequence + cl:position item sequence + cl:position‐if predicate sequence + cl:position‐if‐not predicate sequence + cl:position‐duplicates sequence + cl:count item sequence + cl:count‐if predicate sequence + cl:count‐if‐not predicate sequence + cl:count‐duplicates sequence + + cl:car list + cl:first list + cl:cdr list + cl:rest list + cl:nth index list + cl:nthcdr index list + cl:last list + cl:butlast list + + cl:subst new old tree + cl:subst‐if new test tree + cl:subst‐if‐not new test tree + cl:sublis alist tree + + cl:member item list + cl:member‐if predicate list + cl:member‐if‐not predicate list + cl:adjoin item list + cl:union list list + cl:intersection list list + cl:set‐difference list list + cl:set‐exclusive‐or list list + cl:subsetp list list + + cl:acons key data alist + cl:pairlis list list + cl:pairlis list list alist + cl:assoc key alist + cl:assoc‐if predicate alost + cl:assoc‐if‐not predicate alost + cl:rassoc key alist + cl:rassoc‐if predicate alost + cl:rassoc‐if‐not predicate alost + + cl:type‐of object + cl:coerce object type + + Furthermore, there is an include file which developers may which to + utilize in their LFE programs: (include‐lib "lfe/include/cl.lfe"). + Currently this offers Common Lisp predicates, but may include other + useful macros and functions in the future. The provided predicate + macros wrap the various is_* Erlang functions; since these are expanded + at compile time, they are usable in guards. The include the following: + + (alivep x) + (atomp x) + (binaryp x) + (bitstringp x) + (boolp x) and (booleanp x) + (builtinp x) + (consp x) + (floatp x) + (funcp x) and (functionp x) + (intp x) and (integerp x) + (listp x) + (mapp x) + (numberp x) + (pidp x) + (process‐alive‐p x) + (recordp x tag) + (recordp x tag size) + (refp x) and (referencep x) + (tuplep x) + (vectorp x) + + Non‐predicate macros in lfe/include/cl.lfe include: + + (dolist ...) + (vector ...) + + Supplemental Clojure Functions + From LFE’s earliest days, it’s Lisp‐cousin Clojure (created around the + same time) has inspired LFE developers to create similar, BEAM‐versions + of those functions. These were collected in a separate library and + then expanded upon, until eventually becoming part of the LFE standard + library. + + Function definition macros: + + (clj:defn ...) + (clj:defn‐ ...) + (clj:fn ...) + + Threading macros: + + (clj:‐> ...) + (clj:‐>> ...) + (clj:as‐> ...) + (clj:cond‐> ...) + (clj:cond‐>> ...) + (clj:some‐> ...) + (clj:some‐>> ...) + (clj:doto ...) + + Conditional macros: + + (clj:if‐let ...) + (clj:iff‐let ...) + (clj:condp ...) + (clj:if‐not ...) + (clj:iff‐not ...) + (clj:when‐not ...) + (clj:not= ...) + + Predicate macros: + + (clj:atom? x) + (clj:binary? x) + (clj:bitstring? x) + (clj:bool? x) + (clj:boolean? x) + (clj:even? x) + (clj:false? x) + (clj:falsy? x) + (clj:float? x) + (clj:func? x) + (clj:function? x) + (clj:identical? x) + (clj:int? x) + (clj:integer? x) + (clj:map? x) + (clj:neg? x) + (clj:nil? x) + (clj:number? x) + (clj:odd? x) + (clj:pos? x) + (clj:record? x) + (clj:reference? x) + (clj:true? x) + (clj:tuple? x) + (clj:undef? x) + (clj:undefined? x) + (clj:zero? x) + + Other: + + (clj:str x) + (clj:lazy‐seq x) + (clj:conj ...) + (clj:if ...) + + Most of the above mentioned macros are available in the clj include + file, the use of which allows developers to forego the clj: prefix in + calls: + + (include‐lib "lfe/include/clj.lfe") + Notes - · NYI - Not Yet Implemented + · NYI ‐ Not Yet Implemented - · N.B. - Nota bene (note well) + · N.B. ‐ Nota bene (note well) SEE ALSO lfe(1), lfescript(1), lfe_cl(3) @@ -909,4 +1285,4 @@ - 2008-2016 lfe_guide(7) + 2008‐2020 lfe_guide(7)
View file
_service:tar_scm:lfe-1.3.tar.gz/emacs/inferior-lfe.el -> _service:tar_scm:lfe-2.1.1.tar.gz/emacs/inferior-lfe.el
Changed
@@ -1,6 +1,6 @@ ;;; inferior-lfe.el --- Inferior Lisp Flavoured Erlang mode -;; Copyright (c) 2012-2013 Robert Virding +;; Copyright (c) 2012-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -29,6 +29,7 @@ (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) + (define-key map "\C-j" 'inferior-lfe-newline-and-maybe-indent) map) "Keymap for inferior LFE mode.") @@ -41,15 +42,22 @@ (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) +(define-key lfe-mode-map "\C-c\C-k" 'lfe-compile) ; Erlang mode convention ;; (defvar inferior-lfe-program "lfe -pa /Users/rv/erlang/lfe/ebin -env TERM vt100" -(defvar inferior-lfe-program "lfe" - "*Program name for invoking an inferior LFE in Inferior LFE mode.") +(defcustom inferior-lfe-program "lfe" + "*Program name for invoking an inferior LFE in Inferior LFE mode." + :group 'lfe + :type 'string) -(defvar inferior-lfe-program-options '("-pa" "/Users/rv/erlang/lfe/ebin") +(defcustom inferior-lfe-program-options '("-pa" "/Users/rv/erlang/lfe/ebin") "*The options used when activating the LFE shell. -This must be a list of strings.") +This must be a list of strings. +You may add the following command line options: +- \"-nobanner\"." + :group 'lfe + :type '(repeat string)) (defvar inferior-lfe-prompt "^^>*>+ *" "*Regexp to recognise prompts in the Inferior LFE mode.") @@ -64,6 +72,15 @@ "*Input matching this regexp are not saved on the history list. Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters.") +(defvar inferior-lfe-indent-on-Cj nil + "*Defines if on C-j the line is indented.") + +(defvar inferior-lfe-check-if-rebar-project nil + "*Checks if there is a `rebar.config' file within the 4 levels of nested folders. +If yes, then there will be a prompt on starting inferior-lfe +to choose whether to run the lfe process using rebar3, +else lfe will be run as usual.") + ;;;###autoload (defun inferior-lfe-mode () "Major mode for interacting with an inferior LFE process. @@ -96,31 +113,36 @@ (save-excursion (let ((end (point))) (backward-sexp) - (buffer-substring (point) end)))) + (buffer-substring (max (point) (comint-line-beginning-position)) end)))) + +(defun inferior-lfe--is-rebar-project () + "Return the project root directory." + (locate-dominating-file default-directory "rebar.config")) + +(defun inferior-lfe--start-rebar-lfe () + (string= (read-answer "Rebar3 project detected. Start lfe repl using rebar3? " + '(("yes" ?y "use rebar3") + ("no" ?n "use regular lfe"))) + "yes")) ;;;###autoload -(defun inferior-lfe (cmd) +(defun inferior-lfe () "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: ") - ()))) - (let (prog opts) - (if cmd - (setq prog "sh" - opts (list "-i" "-c" cmd)) - (setq prog inferior-lfe-program - opts (append inferior-lfe-program-options - '("-env" "TERM" "vt100")))) +Start the shell `inferior-lfe-program' `inferior-lfe-program-options' -env TERM vt100. +If a rebar project is found you are prompted (see `inferior-lfe-check-if-rebar-project') +and can choose to run lfe using rebar3." + (interactive) + (let ((prog inferior-lfe-program) + (opts (append inferior-lfe-program-options + '("-env" "TERM" "vt100"))) + (rebar-project-root (inferior-lfe--is-rebar-project))) + (when (and inferior-lfe-check-if-rebar-project + rebar-project-root + (inferior-lfe--start-rebar-lfe)) + (setq prog "sh" + opts (list "-i" "-c" (concat "TERM=\"vt100\";" + (format "cd %s" rebar-project-root) + "; rebar3 lfe repl")))) (unless (comint-check-proc "*inferior-lfe*") (set-buffer (apply (function make-comint) "inferior-lfe" prog nil opts)) @@ -128,13 +150,18 @@ (setq inferior-lfe-buffer "*inferior-lfe*") (pop-to-buffer "*inferior-lfe*"))) -;; (apply (function make-comint) -;; "inferior-lfe" "sh" nil -;; (quote ("-i" "-c" ". /Users/rv/.bashrc ; lfe -env TERM vt100"))) - ;;;###autoload (defalias 'run-lfe 'inferior-lfe) +(defun inferior-lfe-newline-and-maybe-indent () + "Sends a newline and indents the line when `inferior-lfe-indent-on-Cj' is true." + (interactive) + (save-restriction + (narrow-to-region comint-last-input-start (point-max)) + (insert "\n") + (when inferior-lfe-indent-on-Cj + (lisp-indent-line)))) + (defun lfe-eval-region (start end &optional and-go) "Send the current region (from `START' to `END') to the inferior LFE process. `AND-GO' means switch to the LFE buffer afterwards." @@ -149,6 +176,14 @@ (interactive "P") (lfe-eval-region (save-excursion (backward-sexp) (point)) (point) and-go)) +(defun lfe-compile () + "Compiles the LFE module in the current buffer using the inferior LFE process." + (interactive) + (let ((file (buffer-file-name))) + (comint-send-string (inferior-lfe-proc) "(c \"") + (comint-send-string (inferior-lfe-proc) file) + (comint-send-string (inferior-lfe-proc) "\")\n"))) + (defun switch-to-lfe (eob-p) "Switch to the inferior Lisp process buffer. When `EOB-P' is given, position cursor at end of buffer."
View file
_service:tar_scm:lfe-1.3.tar.gz/emacs/lfe-indent.el -> _service:tar_scm:lfe-2.1.1.tar.gz/emacs/lfe-indent.el
Changed
@@ -1,6 +1,6 @@ ;;; lfe-indent.el --- Lisp Flavoured Erlang indent mode -;; Copyright (c) 2015 Robert Virding +;; Copyright (c) 2015-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/emacs/lfe-mode.el -> _service:tar_scm:lfe-2.1.1.tar.gz/emacs/lfe-mode.el
Changed
@@ -1,6 +1,6 @@ ;;; lfe-mode.el --- Lisp Flavoured Erlang mode -;; Copyright (c) 2012-2015 Robert Virding +;; Copyright (c) 2012-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -208,6 +208,7 @@ "match-lambda" "progn" "receive" "try" "when" ;; Core macro forms. "andalso" "bc" "binary-comp" "cond" "do" + "dbg-ms" "ets-ms" "table-ms" "trace-ms" "flet" "flet*" "fletrec" "fun" "lc" "list-comp" "let*" "match-spec" "macrolet" "orelse"
View file
_service:tar_scm:lfe-1.3.tar.gz/emacs/lfe-start.el -> _service:tar_scm:lfe-2.1.1.tar.gz/emacs/lfe-start.el
Changed
@@ -1,6 +1,6 @@ ;;; lfe-start.el --- Initialise the LFE mode package -;; Copyright (c) 2012-2013 Robert Virding +;; Copyright (c) 2012-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/church.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/church.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013-2020 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. @@ -21,19 +21,21 @@ ;; ;; Here is some example usage: ;; -;; > (slurp '"church.lfe") +;; $ ./bin/lfe +;; +;; lfe> (slurp "examples/church.lfe") ;; #(ok church) -;; > (zero) +;; lfe> (zero) ;; #Fun<lfe_eval.10.53503600> -;; > (church->int1 (zero)) +;; lfe> (church->int1 (zero)) ;; 0 -;; > (church->int1 (three)) +;; lfe> (church->int1 (three)) ;; 3 -;; > (church->int1 (five)) +;; lfe> (church->int1 (five)) ;; 5 -;; > (church->int2 #'five/0) +;; lfe> (church->int2 #'five/0) ;; 5 -;; > (church->int2 (lambda () (get-church 25))) +;; lfe> (church->int2 (lambda () (get-church 25))) ;; 25 (defmodule church
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/core-macros.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/core-macros.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2015 Robert Virding +;; Copyright (c) 2008-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -25,6 +25,15 @@ ;; recursive more syntax pattern based expansion. This to show ;; different styles of doing the same thing. +;; Here is some example usage: +;; +;; $ ./bin/lfe +;; +;; lfe> (include-file "examples/core-macros.lfe") +;; () +;; lfe> (:: init get_status) +;; #(started started) + (defmacro caar (x) `(car (car ,x))) (defmacro cadr (x) `(car (cdr ,x))) (defmacro cdar (x) `(cdr (car ,x))) @@ -96,7 +105,7 @@ (() `'false))) ;; This version of backquote is almost an exact copy of a quasiquote -;; expander for Scheme by André van Tonder. It is very compact and +;; expander for Scheme by André van Tonder. It is very compact and ;; with some cons/append optimisations we have added produces quite ;; reasonable code.
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/ets_demo.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/ets_demo.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 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,15 +21,34 @@ ;; with ets:match/match_object and match specifications with ;; ets:select. +;; Here is some example usage: +;; +;; $ ./bin/lfe +;; +;; lfe> (c "examples/ets_demo.lfe") +;; (#(module ets_demo)) +;; lfe> (set db (ets_demo:new)) +;; #Ref<0.2772763705.1333133315.72774> +;; lfe> (ets_demo:by_place db 'london) +;; #(((paul driver) (fred waiter) (john painter) (bert waiter)) +;; (#(person paul london driver) +;; #(person fred london waiter) +;; #(person john london painter) +;; #(person bert london waiter))) + (defmodule ets_demo - (export (new 0) (by_place 2) (by_place_ms 2) (not_painter 2))) + (export + (new 0) + (by_place 2) + (by_place_ms 2) + (not_painter 2))) ;; Define a simple person record to work on. (defrecord person name place job) ;; Create an initialse the ets table. (defun new () - (let ((db (: ets new 'ets_demo '(#(keypos 2) set)))) + (let ((db (ets:new 'ets_demo '(#(keypos 2) set)))) (let ((people '( ;; First some people in London. #(fred london waiter) @@ -49,27 +68,27 @@ #(fritz berlin painter) #(kurt berlin driver) #(hans berlin waiter) - #(franz berlin waiter) - ))) - (: lists foreach (match-lambda - ((tuple n p j) - (: ets insert db (make-person name n place p job j)))) + #(franz berlin waiter)))) + (lists:foreach + (match-lambda + ((tuple n p j) + (ets:insert db (make-person name n place p job j)))) people)) - db)) ;Return the table + db)) ;; Return the table ;; Match records by place using match, match_object and the emp-XXXX macro. (defun by_place (db place) - (let ((s1 (: ets match db (emp-person name '$1 place place job '$2))) - (s2 (: ets match_object db (emp-person place place)))) + (let ((s1 (ets:match db (emp-person name '$1 place place job '$2))) + (s2 (ets:match_object db (emp-person place place)))) (tuple s1 s2))) ;; Use match specifications to match records (defun by_place_ms (db place) - (: ets select db (match-spec ((match-person name n place p job j) - (when (=:= place p)) - (list 'p n j))))) + (ets:select db (match-spec ((match-person name n place p job j) + (when (=:= place p)) + (list 'p n j))))) (defun not_painter (db place) - (: ets select db (match-spec ((match-person name n place p job j) - (when (=:= place p) (=/= j 'painter)) - (list 'p n j))))) + (ets:select db (match-spec ((match-person name n place p job j) + (when (=:= place p) (=/= j 'painter)) + (list 'p n j)))))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/fizzbuzz.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/fizzbuzz.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Sean Chalmers +;; Copyright (c) 2008-2020 Sean Chalmers ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -23,11 +23,28 @@ ;; There are no doubt more interesting or extensible ways of solving FizzBuzz, ;; however I felt this was a good example of using both Pattern Matching and ;; Higher Order Functions (lists:map/2) in a very simplistic way. + +;; Here is some example usage: +;; +;; $ ./bin/lfe +;; +;; lfe> (c "examples/fizzbuzz.lfe") +;; (#(module fizzbuzz)) +;; lfe> (fizzbuzz:buzz 1) +;; (1) +;; lfe> (fizzbuzz:buzz 2) +;; (1 2) +;; lfe> (fizzbuzz:buzz 5) +;; (1 2 "Buzz" 4 "Fizz") +;; lfe> (fizzbuzz:buzz 10) +;; (1 2 "Buzz" 4 "Fizz" "Buzz" 7 8 "Buzz" "Fizz") + (defmodule fizzbuzz - (export (buzz 1) - (buzz1 1) - (buzz2 1) - (buzz3 1))) + (export + (buzz 1) + (buzz1 1) + (buzz2 1) + (buzz3 1))) (defun get-fizz (n) ;; Request a FizzBuzz result for a given number. @@ -46,11 +63,11 @@ (defun buzz (n) ;; This is the basic version, takes an argument ;; and attempts to create result list of results. - (: lists map + (lists:map ;; Wrap our call to 'get-fizz in a lambda (lambda (x) (get-fizz x)) ;; Create a list of numbers from one to n - (: lists seq 1 n))) + (lists:seq 1 n))) (defun buzz1 ;; This version utilises pattern matching and guard to @@ -58,7 +75,7 @@ ;; unwanted arguments. ;; Only run the FizzBuzz solution when we have a positive ;; whole number that is greater than zero - (n (when (and (: erlang is_integer n) + (n (when (and (erlang:is_integer n) (> n 0))) ;; woo! (buzz n))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/gps1.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/gps1.lfe
Changed
@@ -1,6 +1,7 @@ ;; -*- Mode: LFE; -*- ;; Code from Paradigms of Artificial Intelligence Programming -;; Copyright (c) 1991 Peter Norvig +;; Copyright (c) 1991 Peter Norvig, Common Lisp version +;; Copyright (c) 2008-2020 Robert Virding ;; File : gps1.lisp ;; Author : Peter Norvig, Robert Virding @@ -12,9 +13,11 @@ ;; ;; Here is some example usage for a successful run: ;; -;; > (slurp '"examples/gps1.lfe") +;; $ ./bin/lfe +;; +;; lfe> (slurp "examples/gps1.lfe") ;; #(ok gps1) -;; > (gps '(son-at-home car-needs-battery have-money have-phone-book) +;; lfe> (gps '(son-at-home car-needs-battery have-money have-phone-book) ;; '(son-at-school) ;; (school-ops)) ;; executing 'look-up-number' @@ -24,11 +27,11 @@ ;; executing 'shop-installs-battery' ;; executing 'drive-son-to-school' ;; solved -;; > +;; lfe> ;; ;; Here is an unsuccessful run: ;; -;; > (gps '(son-at-home car-needs-battery have-money have-phone-book) +;; lfe> (gps '(son-at-home car-needs-battery have-money have-phone-book) ;; '(son-at-school have-money) ;; (school-ops)) ;; executing 'look-up-number' @@ -38,14 +41,16 @@ ;; executing 'shop-installs-battery' ;; executing 'drive-son-to-school' ;; false -;; > +;; lfe> ;; ;; And a trivial run (for Saturdays!): ;; -;; > (gps '(son-at-home) '(son-at-home) (school-ops)) +;; lfe> (gps '(son-at-home) '(son-at-home) (school-ops)) ;; solved ;; +(include-lib "lfe/include/scm.lfe") + ;; Define macros for global variable access. This is a hack and very naughty! (defsyntax defvar (name val (let ((v val)) (put 'name v) v))) @@ -58,10 +63,20 @@ ;; Module definition. (defmodule gps1 - (export (gps 2) (gps 3) (school-ops 0)) - (import (from lists (member 2) (all 2) (any 2)) - ;; Rename lists functions to be more CL like. - (rename lists ((all 2) every) ((any 2) some) ((filter 2) find-all)))) + (export + (gps 2) + (gps 3) + (school-ops 0)) + (import + (from lists + (member 2) + (all 2) + (any 2)) + ;; Rename lists functions to be more CL like. + (rename lists + ((all 2) every) + ((any 2) some) + ((filter 2) find-all)))) ;; An operation. (defrecord op @@ -95,7 +110,7 @@ (defun apply-op (op) (if (every (fun achieve 1) (op-preconds op)) (progn - (: io fwrite '"executing ~p\n" (list (op-action op))) + (io:fwrite "executing ~p\n" (list (op-action op))) (setvar *state* (set-difference (getvar *state*) (op-del-list op))) (setvar *state* (union (getvar *state*) (op-add-list op))) 'true)))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/guessing-game.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/guessing-game.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013-2020 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. @@ -20,8 +20,9 @@ ;; This file contains a simple demo for guessing a random number, chosen by ;; "the computer". To use, do the following: ;; -;; $ ../bin/lfe -pa ../ebin -;; > (slurp '"examples/guessing-game.lfe") +;; $ ./bin/lfe +;; +;; > (slurp "examples/guessing-game.lfe") ;; #(ok guessing-game) ;; > (main) ;; Guess the number I have chosen, between 1 and 10. @@ -37,23 +38,25 @@ ;; > (defmodule guessing-game - (export (main 0))) + (export + (main 0))) (defun get-player-guess () - (let (((tuple 'ok (list guessed)) (: io fread '"Guess number: " '"~d"))) + (let (((tuple 'ok (list guessed)) (io:fread "Guess number: " "~d"))) guessed)) (defun check-guess (answer guessed) (cond ((== answer guessed) - (: io format '"Well-guessed!!~n")) + (io:format "Well-guessed!!~n") + 'game-over) ((/= answer guessed) - (if (> answer guessed) (: io format '"Your guess is too low.~n")) - (if (< answer guessed) (: io format '"Your guess is too high.~n")) + (if (> answer guessed) (io:format "Your guess is too low.~n")) + (if (< answer guessed) (io:format "Your guess is too high.~n")) (check-guess answer (get-player-guess))))) (defun main () - (: io format '"Guess the number I have chosen, between 1 and 10.~n") + (io:format "Guess the number I have chosen, between 1 and 10.~n") (check-guess - (: random uniform 10) + (random:uniform 10) (get-player-guess)))
View file
_service:tar_scm:lfe-2.1.1.tar.gz/examples/guessing-game2.lfe
Added
@@ -0,0 +1,99 @@ +;; Copyright (c) 2020 Duncan McGreggor <oubiwann@cogitat.io> +;; +;; 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 : guessing-game2.lfe +;; Author : Duncan McGreggor +;; Purpose : Demonstrating a random-number guessing game (classic BASIC-era +;; demo) using a simple client and server, message-passing, and +;; pattern-matching + +;; This file contains a simple demo for guessing a random number, chosen by +;; "the computer". Outwardly, this example behaves exactly like the first +;; guessing game example. Internally, however, this one differs significantly: +;; +;; 1. It uses a record to track game state +;; 2. It has abstrated a client behaviour and a server behaviour +;; 3. It uses message-passing between these two +;; 4. It uses pattern matching of records in the function heads as well as the +;; receives to perform flow control (instead of the 'cond' and `if` forms) +;; +;; To use, do the following: +;; +;; $ ./bin/lfe +;; +;; > (slurp "examples/guessing-game2.lfe") +;; #(ok guessing-game) +;; lfe> (main) +;; Guess the number I have chosen, between 1 and 10. +;; Guess number: 1 +;; Your guess is too low. +;; Guess number: 10 +;; Your guess is too high. +;; Guess number: 5 +;; Your guess is too low. +;; Guess number: 7 +;; Your guess is too high. +;; Guess number: 6 +;; Well-guessed!! +;; game-over + +(defmodule guessing-game2 + (export + (main 0))) + +(defrecord state + server + client + answer + guess + status) + +(defun guess-server + (((match-state answer a)) + (receive + ((= (match-state client p guess g) game) (when (== g a)) + (! p (set-state-status game 'game-over))) + ((= (match-state client p guess g) game) (when (> g a)) + (! p (set-state-status game 'too-high)) + (guess-server game)) + ((= (match-state client p guess g) game) (when (< g a)) + (! p (set-state-status game 'too-low)) + (guess-server game))))) + +(defun guess-client + (((match-state status 'game-over)) + (io:format "Well-guessed!!~n") + 'game-over) + (((= (match-state status 'started) game)) + (io:format "Guess the number I have chosen, between 1 and 10.~n") + (guess-client (set-state-status game 'running))) + (((= (match-state status 'too-high) game)) + (io:format "Your guess is too high.~n") + (guess-client (set-state-status game 'running))) + (((= (match-state status 'too-low) game)) + (io:format "Your guess is too low.~n") + (guess-client (set-state-status game 'running))) + (((= (match-state server p) game)) + (let ((`#(ok (,g)) (io:fread "Guess number: " "~d"))) + (! p (set-state game client (self) guess g)) + (receive + (game (guess-client game)))))) + +(defun main () + (let* ((a (random:uniform 10)) + (s (make-state answer a + guess 'undefined + status 'started)) + (p (spawn (lambda () (guess-server s))))) + (guess-client (set-state-server s p))))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/http-async.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/http-async.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013-2020 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. @@ -64,33 +64,35 @@ ;; Here is some example usage from the REPL: ;; -;; > (slurp '"examples/http-async.lfe") +;; $ ./bin/lfe +;; +;; lfe> (slurp "examples/http-async.lfe") ;; #(ok http-async) -;; > (get-pages (list '"http://lfe.github.io/")) +;; lfe> (get-pages (list "http://lfe.io/")) ;; Result: {{"HTTP/1.1",200,"OK"}, ;; {"cache-control","max-age=600"}, ;; {"connection","keep-alive"}, ;; ... ;; ok -;; > +;; lfe> ;; ;; The get-pages function starts the inets service for you. If you would like ;; to call get-page directly (without first having called get-pages), you'll ;; have to start that yourself: ;; -;; > (: inets start) -;; > (get-page '"http://lfe.github.io/") +;; lfe> (inets:start) +;; lfe> (ssl:start) +;; lfe> (get-page "https://lfe.io/") ;; Result: {{"HTTP/1.1",200,"OK"}, ;; {"cache-control","max-age=600"}, ;; {"connection","keep-alive"}, ;; ... ;; ok -;; > +;; lfe> (defmodule http-async (export all)) - (defun parse-args (flag) "Given one or more command-line arguments, extract the passed values. @@ -105,8 +107,8 @@ ) In this example, the value assigned to the arg variable would be a list containing the values my-value-1 and my-value-2." - (let (((tuple 'ok data) (: init get_argument flag))) - (: lists merge data))) + (let (((tuple 'ok data) (init:get_argument flag))) + (lists:merge data))) (defun get-pages () "With no argument, assume 'url parameter was passed via command line." @@ -115,8 +117,9 @@ (defun get-pages (urls) "Start inets and make (potentially many) HTTP requests." - (: inets start) - (: plists map + (inets:start) + (ssl:start) + (plists:map (lambda (x) (get-page x)) urls)) @@ -127,9 +130,9 @@ (request-data (tuple url headers)) (http-options ()) (request-options (list (tuple 'sync 'false)))) - (: httpc request method request-data http-options request-options) + (httpc:request method request-data http-options request-options) (receive ((tuple 'http (tuple request-id (tuple 'error reason))) - (: io format '"Error: ~p~n" (list reason))) + (io:format "Error: ~p~n" (list reason))) ((tuple 'http (tuple request-id result)) - (: io format '"Result: ~p~n" (list result)))))) + (io:format "Result: ~p~n" (list result))))))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/http-sync.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/http-sync.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013-2020 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. @@ -49,27 +49,30 @@ ;; Here is some example usage from the REPL: ;; -;; > (slurp '"examples/http-sync.lfe") +;; $ ./bin/lfe +;; +;; lfe> (slurp "examples/http-sync.lfe") ;; #(ok http-sync) -;; > (get-pages (list '"http://lfe.github.io/")) +;; lfe> (get-pages (list "http://lfe.github.io/")) ;; Result: {{"HTTP/1.1",200,"OK"}, ;; {"cache-control","max-age=600"}, ;; {"connection","keep-alive"}, ;; ... ;; ok -;; > +;; lfe> ;; ;; The get-pages function starts the inets service for you. If you would like ;; to call get-page directly, you'll have to start that yourself: ;; -;; > (: inets start) -;; > (get-page '"http://lfe.github.io/") +;; lfe> (inets:start) +;; lfe> (ssl:start) +;; lfe> (get-page "http://lfe.github.io/") ;; Result: {{"HTTP/1.1",200,"OK"}, ;; {"cache-control","max-age=600"}, ;; {"connection","keep-alive"}, ;; ... ;; ok -;; > +;; lfe> (defmodule http-sync (export all)) @@ -88,8 +91,8 @@ ) In this example, the value assigned to the arg variable would be a list containing the values my-value-1 and my-value-2." - (let (((tuple 'ok data) (: init get_argument flag))) - (: lists merge data))) + (let (((tuple 'ok data) (init:get_argument flag))) + (lists:merge data))) (defun get-pages () "With no argument, assume 'url parameter was passed via command line." @@ -98,15 +101,16 @@ (defun get-pages (urls) "Start inets and make (potentially many) HTTP requests." - (: inets start) - (: lists map + (inets:start) + (ssl:start) + (lists:map (lambda (x) (get-page x)) urls)) (defun get-page (url) "Make a single HTTP request." - (case (: httpc request url) + (case (httpc:request url) ((tuple 'ok result) - (: io format '"Result: ~p~n" (list result))) + (io:format "Result: ~p~n" (list result))) ((tuple 'error reason) - (: io format '"Error: ~p~n" (list reason))))) + (io:format "Error: ~p~n" (list reason)))))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/internal-state.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/internal-state.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013, 2015 Duncan McGreggor <oubiwann@gmail.com> +;; Copyright (c) 2013-2020 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,60 +22,63 @@ ;; ;; To use the code below in LFE, do the following: ;; -;; $ ./bin/lfe -pa ./ebin +;; $ ./bin/lfe ;; -;; > (slurp "examples/internal-state.lfe") +;; lfe> (slurp "examples/internal-state.lfe") ;; #(ok internal-state) -;; > (set acct (new-account "Alice" 100.00 0.06)) +;; lfe> (set acct (new-account "Alice" 100.00 0.06)) ;; #Fun<lfe_eval.10.53503600> -;; > (send acct 'name) +;; lfe> (send acct 'name) ;; "Alice" -;; > (send acct 'balance) +;; lfe> (send acct 'balance) ;; 100.0 -;; > (set acct (send acct 'apply-interest)) +;; lfe> (set acct (send acct 'apply-interest)) ;; #Fun<lfe_eval.10.53503600> -;; > (send acct 'balance) +;; lfe> (send acct 'balance) ;; 106.0 -;; > (set acct (send acct 'withdraw 54.90)) +;; lfe> (set acct (send acct 'withdraw 54.90)) ;; #Fun<lfe_eval.10.53503600> -;; > (set acct (send acct 'withdraw 54.90)) +;; lfe> (set acct (send acct 'withdraw 54.90)) ;; exception error: insufficient-funds ;; -;; > (send acct 'balance) +;; lfe> (send acct 'balance) ;; 51.1 -;; > (set acct (send acct 'deposit 1000)) +;; lfe> (set acct (send acct 'deposit 1000)) ;; #Fun<lfe_eval.10.53503600> -;; > (set acct (send acct 'withdraw 54.90)) +;; lfe> (set acct (send acct 'withdraw 54.90)) ;; #Fun<lfe_eval.10.53503600> -;; > (set acct (send acct 'withdraw 54.90)) +;; lfe> (set acct (send acct 'withdraw 54.90)) ;; #Fun<lfe_eval.10.53503600> -;; > (set acct (send acct 'withdraw 54.90)) +;; lfe> (set acct (send acct 'withdraw 54.90)) ;; #Fun<lfe_eval.10.53503600> -;; > (send acct 'balance) +;; lfe> (send acct 'balance) ;; 886.4 -;; > (set acct (send acct 'apply-interest)) +;; lfe> (set acct (send acct 'apply-interest)) ;; #Fun<lfe_eval.10.53503600> -;; > (send acct 'balance) +;; lfe> (send acct 'balance) ;; 939.584 (defmodule internal-state - (export all)) + (export all)) (defun new-account (name balance interest-rate) (lambda (message) (case message ('withdraw (lambda (amt) - (if (=< amt balance) - (new-account name (- balance amt) interest-rate) - (error 'insufficient-funds)))) - ('deposit (lambda (amt) (new-account name (+ balance amt) interest-rate))) - ('balance (lambda () balance)) - ('name (lambda () name)) + (if (=< amt balance) + (new-account name (- balance amt) interest-rate) + (error 'insufficient-funds)))) + ('deposit (lambda (amt) + (new-account name (+ balance amt) interest-rate))) + ('balance (lambda () + balance)) + ('name (lambda () + name)) ('apply-interest (lambda () - (new-account - name - (+ balance (* balance interest-rate)) - interest-rate)))))) + (new-account + name + (+ balance (* balance interest-rate)) + interest-rate)))))) (defun send (object method-name) "This is a generic function, used to call into the given object (class @@ -90,21 +93,21 @@ ;; 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)) +;; lfe> (set acct (init-account "Alice" 1000 0.1)) ;; <0.37.0> -;; > (snd acct 'name) +;; lfe> (snd acct 'name) ;; "Alice" -;; > (snd acct 'balance) +;; lfe> (snd acct 'balance) ;; 1000 -;; > (snd acct 'apply-interest) +;; lfe> (snd acct 'apply-interest) ;; 1.1e3 -;; > (snd acct 'deposit 1000) +;; lfe> (snd acct 'deposit 1000) ;; 2.1e3 -;; > (snd acct 'balance) +;; lfe> (snd acct 'balance) ;; 2.1e3 -;; > (snd acct 'withdraw 2000) +;; lfe> (snd acct 'withdraw 2000) ;; 100.0 -;; > (snd acct 'withdraw 101) +;; lfe> (snd acct 'withdraw 101) ;; #(error insufficient-funds) (defun account-class (name balance interest-rate)
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/joes-fav.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/joes-fav.lfe
Changed
@@ -1,5 +1,5 @@ ;; Copyright (c) 2013 Joe Armstrong <joearms@gmail.com>, Original Erlang version -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io>, LFE version +;; Copyright (c) 2013-2020 Duncan McGreggor <oubiwann@gmail.com>, LFE version ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -22,27 +22,28 @@ ;; ;; Here is some example usage: ;; -;; > (slurp '"examples/joes-fav.lfe") +;; $ ./bin/lfe +;; +;; lfe> (slurp "examples/joes-fav.lfe") ;; #(ok joes-fav) ;; ;; Quick sanity check: ;; -;; > (factorial 10) +;; lfe> (factorial 10) ;; 3628800 -;; > (factorial 20) +;; lfe> (factorial 20) ;; 2432902008176640000 -;; > (factorial 50) +;; lfe> (factorial 50) ;; 30414093201713378043612608166064768844377641568960512000000000000 ;; ;; Now, for the real thing: ;; -;; > (run-it) +;; lfe> (run-it) ;; 30414093201713378043612608166064768844377641568960512000000000000 ;; (defmodule joes-fav (export all)) - (defun universal-server () (receive ((tuple 'become server-function)
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/lfe_eval.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/lfe_eval.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -32,7 +32,7 @@ (from orddict (find 2) (store 3))) (deprecated #(eval 1) #(eval 2))) -(defun eval (e) (eval e (: lfe_env new))) +(defun eval (e) (eval e (lfe_env:new))) (defun eval (e env) (eval-expr e env)) @@ -42,16 +42,16 @@ ;; expr(Sexpr, Env) -> Value ;; Evaluate the sexpr, first expanding all macros. -(defun expr (e) (expr e (: lfe_env new))) +(defun expr (e) (expr e (lfe_env:new))) (defun expr (e env) - (let ((exp (: lfe_macro expand_expr_all e env))) + (let ((exp (lfe_macro:expand_expr_all e env))) (eval-expr exp env))) ;; gexpr(guardtest) -> Value ;; gexpr(guardtest, env) -> Value -(defun gexpr (gt) (gexpr gt (: lfe_env new))) +(defun gexpr (gt) (gexpr gt (lfe_env:new))) (defun gexpr (gt env) (eval-gexpr gt env)) @@ -62,7 +62,7 @@ ;; internally. Args should already be evaluated. (defun apply (f args) - (apply f args (: lfe_env new))) + (apply f args (lfe_env:new))) (defun apply (f args env) (eval-apply-expr f args env)) @@ -72,11 +72,11 @@ ;; (guard guard) -> true | false ;; (guard guard env) -> true | false -(defun body (b) (body b (: lfe_env new))) +(defun body (b) (body b (lfe_env:new))) (defun body (b env) (eval-body b env)) -(defun guard (g) (guard g (: lfe_env new))) +(defun guard (g) (guard g (lfe_env:new))) (defun guard (g env) (eval-guard g env)) @@ -125,7 +125,7 @@ ((cons 'try body) (eval-try body env)) ((list* 'funcall f as) - (: erlang apply (eval-expr f env) (eval-list as env))) + (erlang:apply (eval-expr f env) (eval-list as env))) ((cons 'call body) (eval-call body env)) ;; General function calls. @@ -133,19 +133,19 @@ ;; Note that macros have already been expanded here. (let ((ar (length es))) ;Arity (case (get_fbinding fun ar env) - ((tuple 'yes m f) (: erlang apply m f (eval-list es env))) + ((tuple 'yes m f) (erlang:apply m f (eval-list es env))) ((tuple 'yes f) (eval-apply f (eval-list es env) env)) - ('no (: erlang error (tuple 'unbound_func (tuple fun ar))))))) + ('no (erlang:error (tuple 'unbound_func (tuple fun ar))))))) ((cons f es) - (: erlang error (tuple 'bad_form 'application))) + (erlang:error (tuple 'bad_form 'application))) (e (if (is_atom e) (case (get_vbinding e env) ((tuple 'yes val) val) - (no (: erlang error (tuple 'unbound_symb e)))) + (no (erlang:error (tuple 'unbound_symb e)))) e)))) ;Atoms evaluate to themselves (defun eval-list (es env) - (: lists map (lambda (e) (eval-expr e env)) es)) + (lists:map (lambda (e) (eval-expr e env)) es)) (defun eval-body (body env) (case body @@ -263,7 +263,7 @@ ((list 'unit n) (when (is_integer n) (> n 0)) (set-spec-unit sp n)) ;; Illegal spec. - (_ (: erlang error (tuple 'illegal_bitspec spec))))) + (_ (erlang:error (tuple 'illegal_bitspec spec))))) ;; (eval-exp-bitseg value type size unit sign endian) -> binary(). @@ -282,7 +282,7 @@ (case (bit_size val) (size (when (=:= (rem size un) 0)) (binary (val bitstring (size size)))) - (_ (: erlang error 'bad_arg)))) + (_ (erlang:error 'bad_arg)))) ((tuple 'binary sz un _ _) (binary (val bitstring (size (* sz un))))))) @@ -343,8 +343,7 @@ (14 (lambda (a b c d e f g h i j k l m n) (apply-lambda args body (list a b c d e f g h i j k l m n) env))) (15 (lambda (a b c d e f g h i j k l m n o) - (apply-lambda args body (list a b c d e f g h i j k l m n o) env))) - ))) + (apply-lambda args body (list a b c d e f g h i j k l m n o) env)))))) (defun apply-lambda (args body vals env) (fletrec ((bind-args @@ -386,8 +385,7 @@ (14 (lambda (a b c d e f g h i j k l m n) (apply-match-clauses cls (list a b c d e f g h i j k l m n) env))) (15 (lambda (a b c d e f g h i j k l m n o) - (apply-match-clauses cls (list a b c d e f g h i j k l m n o) env))) - )) + (apply-match-clauses cls (list a b c d e f g h i j k l m n o) env))))) (defun match-lambda-arity (cls) (length (caar cls))) @@ -401,8 +399,8 @@ (case (match-when (cons 'list pats) as body env) ((tuple 'yes body1 vbs) (eval-body body1 (add_vbindings vbs env))) ('no (apply-match-clauses cls as env))) - (: erlang error 'badarity))) - (_ (: erlang error 'function_clause)))) + (erlang:error 'badarity))) + (_ (erlang:error 'function_clause)))) ;; (eval-let (PatBindings . Body) Env) -> Value. @@ -414,13 +412,13 @@ (let ((val (eval-expr e env0))) (case (match pat val env0) ((tuple 'yes bs) (add_vbindings bs env)) - ('no (: erlang error (tuple 'badmatch val)))))) + ('no (erlang:error (tuple 'badmatch val)))))) ((list pat (= (cons 'when _) g) e) env (let ((val (eval-expr e env0))) (case (match-when pat val (list g) env0) ((tuple 'yes '() bs) (add_vbindings bs env)) - ('no (: erlang error (tuple 'badmatch val)))))) - (_ _ (: erlang error (tuple 'bad_form 'let)))) + ('no (erlang:error (tuple 'badmatch val)))))) + (_ _ (erlang:error (tuple 'bad_form 'let)))) env0 vbs))) (eval-body b env))) @@ -437,7 +435,7 @@ ((list v (= (list* 'match-lambda (cons pats _) _) f)) e (when (is_atom v)) (add v (length pats) f env0 e)) - (_ _ (: erlang error (tuple 'bad_form 'let-function)))) + (_ _ (erlang:error (tuple 'bad_form 'let-function)))) env0 fbs))) (eval-body body env)))) @@ -454,8 +452,8 @@ ((list v (= (list* 'match-lambda (cons pats _) _) f)) (when (is_atom v)) (tuple v (length pats) f)) - (_ (: erlang error (tuple 'bad_form 'letrec-function))))) - (fbs1 (: lists map map-fun fbs0)) + (_ (erlang:error (tuple 'bad_form 'letrec-function))))) + (fbs1 (lists:map map-fun fbs0)) (env1 (make_letrec_env fbs1 env0))) (eval-body body env1))) @@ -472,7 +470,7 @@ (defun init_letrec_env (env) (tuple () env)) (defun make_letrec_env (fbs0 env) - (let ((fbs (: lists map (lambda (fb) + (let ((fbs (lists:map (lambda (fb) (let (((tuple v ar body) fb)) (tuple v ar (tuple 'letrec body fbs0 env)))) fbs0))) @@ -513,10 +511,10 @@ ;; Macros are expanded first. (defun eval-apply-expr (func es env) - (case (: lfe_macro expand_expr_all func env) + (case (lfe_macro:expand_expr_all func env) ((list* 'lambda args body) (apply-lambda args body es env)) ((cons 'match-lambda cls) (apply-match-clauses cls es env)) - (fun (when (is_function fun)) (: erlang apply fun es)))) + (fun (when (is_function fun)) (erlang:apply fun es)))) ;; (eval-if body env) -> value @@ -526,7 +524,7 @@ (case (eval-expr test env) ('true (eval-expr true env)) ('false (eval-expr false env)) - (_ (: erlang error 'if_clause))))) + (_ (erlang:error 'if_clause))))) (case body ((list test true) (eval-if test true 'false)) ((list test true false) (eval-if test true false))))) @@ -541,7 +539,7 @@ (case (match-clause v cls env) ((tuple 'yes b vbs) (eval-body b (add_vbindings vbs env))) - ('no (: erlang error (tuple 'case_clause v))))) + ('no (erlang:error (tuple 'case_clause v))))) (defun match-clause (v cls env) (case cls @@ -653,10 +651,10 @@ (catch ((tuple class error _) ;; Get stack trace explicitly. - (let ((stk (: erlang get_stacktrace))) + (let ((stk (erlang:get_stacktrace))) (case catch ((list cls) (eval-catch-clauses (tuple class error stk) cls env)) - (() (: erlang raise class error stk)))))) + (() (erlang:raise class error stk)))))) (after (case after ((list b) (eval-body b env)) @@ -668,7 +666,7 @@ ((tuple 'yes b vbs) (eval-body b (add_vbindings vbs env))) ('no (eval-catch-clauses v cls env)))) ((tuple class val stk) () _ - (: erlang raise class val stk))) + (erlang:raise class val stk))) (defun eval-call (b env) (case b @@ -676,7 +674,7 @@ (let ((m (eval-expr m env)) (f (eval-expr f env)) (as (eval-list as env))) - (: erlang apply m f as))))) + (erlang:apply m f as))))) ;; (match-when pattern value body env) -> #('yes restbody bindings) | 'no. ;; Try to match pattern and evaluate guard. @@ -707,7 +705,7 @@ ;; A body is a sequence of tests which must all succeed. (defun eval-gbody (es env) - (: lists all (lambda (e) (eval-gexpr e env)) es)) + (lists:all (lambda (e) (eval-gexpr e env)) es)) ;; (eval-gexpr sexpr environment) -> value. ;; Evaluate a guard sexpr in the current environment. @@ -733,23 +731,23 @@ (let ((f (eval-gexpr f env)) (ar (length as))) (case (get_gbinding f ar env) - ((tuple 'yes m f) (: erlang apply m f (eval-glist as env))) - (_ (: erlang error (tuple 'unbound_func (tuple f (length as)))))))) + ((tuple 'yes m f) (erlang:apply m f (eval-glist as env))) + (_ (erlang:error (tuple 'unbound_func (tuple f (length as)))))))) ((cons f as) (when (is_atom f)) (let ((ar (length as))) (case (get_gbinding f ar env) - ((tuple 'yes m f) (: erlang apply m f (eval-glist as env))) - ('no (: erlang error (tuple 'unbound_func (tuple f ar))))))) + ((tuple 'yes m f) (erlang:apply m f (eval-glist as env))) + ('no (erlang:error (tuple 'unbound_func (tuple f ar))))))) ((cons f es) ;Everything else not allowed - (: erlang error 'illegal_guard)) + (erlang:error 'illegal_guard)) (e (if (is_atom e) (case (get_vbinding e env) ((tuple 'yes val) val) - (no (: erlang error (tuple 'unbound_symb e)))) + (no (erlang:error (tuple 'unbound_symb e)))) e)))) ;Atoms evaluate to themselves (defun eval-glist (es env) - (: lists map (lambda (e) (eval-gexpr e env)) es)) + (lists:map (lambda (e) (eval-gexpr e env)) es)) ;; (eval-gbinary bitsegs env) -> binary. ;; Construct a binary from bitsegs. This code is taken from eval_bits.erl.
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/messenger-back.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/messenger-back.lfe
Changed
@@ -1,10 +1,10 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013-2020 Duncan McGreggor <oubiwann@cogitat.io> ;; ;; 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 +;; 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, @@ -15,46 +15,49 @@ ;; File : messenger-back.lfe ;; Author : Duncan McGreggor ;; Purpose : Demonstrating bidirectional message passing between the shell and -;; a spawned process. +;; a spawned process. ;; This file contains a simple demo for passing messages to an Erlang process ;; in LFE and the sending a message back to the calling process. To use, do the ;; following: ;; -;; $ ./bin/lfe -pa ./ebin -;; > (c '"examples/messenger-back") -;; #(module messenger-back) -;; > (: messenger-back send-message (self) '"Well, I was able to extend the original entry a bit, yes.") -;; #(<0.25.0> "Well, I was able to extend the original entry a bit, yes.") -;; Received message: 'Well, I was able to extend the original entry a bit, yes.' -;; > Sending message to process <0.25.0> ... -;; (: messenger-back send-message (self) '"And what does it say now?") -;; #(<0.25.0> "And what does it say now?") -;; Received message: 'And what does it say now?' -;; > Sending message to process <0.25.0> ... -;; (: messenger-back send-message (self) '"Mostly harmless.") -;; #(<0.25.0> "Mostly harmless.") -;; Received message: 'Mostly harmless.' -;; > Sending message to process <0.25.0> ... +;; $ ./bin/lfe +;; +;; lfe> (c "examples/messenger-back") +;; #(module messenger-back) +;; lfe> (messenger-back:send-message (self) "Well, I was able to extend the original entry a bit, yes.") +;; #(<0.25.0> "Well, I was able to extend the original entry a bit, yes.") +;; Received message: 'Well, I was able to extend the original entry a bit, yes.' +;; lfe> Sending message to process <0.25.0> ... +;; (messenger-back:send-message (self) "And what does it say now?") +;; #(<0.25.0> "And what does it say now?") +;; Received message: 'And what does it say now?' +;; lfe> Sending message to process <0.25.0> ... +;; (messenger-back:send-message (self) "Mostly harmless.") +;; #(<0.25.0> "Mostly harmless.") +;; Received message: 'Mostly harmless.' +;; lfe> Sending message to process <0.25.0> ... ;; With the messages sent and then resent back to the process whose ID was ;; presented, we can check to see that the calling process received the ;; information, as planned: ;; -;; > (: c flush) -;; Shell got {"Well, I was able to extend the original entry a bit, yes."} -;; Shell got {"And what does it say now?"} -;; Shell got {"Mostly harmless."} -;; > +;; lfe> (c:flush) +;; Shell got {"Well, I was able to extend the original entry a bit, yes."} +;; Shell got {"And what does it say now?"} +;; Shell got {"Mostly harmless."} +;; lfe> ;; (defmodule messenger-back - (export (print-result 0) (send-message 2))) + (export + (print-result 0) + (send-message 2))) (defun print-result () (receive ((tuple pid msg) - (: io format '"Received message: '~s'~n" (list msg)) - (: io format '"Sending message to process ~p ...~n" (list pid)) + (io:format "Received message: '~s'~n" (list msg)) + (io:format "Sending message to process ~p ...~n" (list pid)) (! pid (tuple msg)) (print-result))))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/messenger.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/messenger.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013-2020 Duncan McGreggor <oubiwann@cogitat.io> ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -19,26 +19,28 @@ ;; This file contains a simple demo for passing messages to an Erlang process ;; in LFE. To use, do the following: ;; -;; $ ../bin/lfe -pa ../ebin -;; > (c '"messenger") -;; #(module messenger) -;; > (set pid (spawn 'messenger 'print-result ())) -;; <0.34.0> -;; > (! pid '"Zaphod was here.") -;; "Zaphod was here." -;; Received message: 'Zaphod was here.' -;; > (! pid '"Ford is missing.") -;; "Ford is missing." -;; Received message: 'Ford is missing.' -;; > (! pid '"Arthur is pining for Trillian.") -;; "Arthur is pining for Trillian." -;; Received message: 'Arthur is pining for Trillian.' +;; $ ./bin/lfe +;; +;; lfe> (c "examples/messenger") +;; #(module messenger) +;; lfe> (set pid (spawn 'messenger 'print-result ())) +;; <0.34.0> +;; lfe> (! pid "Zaphod was here.") +;; "Zaphod was here." +;; Received message: 'Zaphod was here.' +;; lfe> (! pid "Ford is missing.") +;; "Ford is missing." +;; Received message: 'Ford is missing.' +;; lfe> (! pid "Arthur is pining for Trillian.") +;; "Arthur is pining for Trillian." +;; Received message: 'Arthur is pining for Trillian.' (defmodule messenger - (export (print-result 0))) + (export + (print-result 0))) (defun print-result () (receive (msg - (: io format '"Received message: '~s'~n" (list msg)) + (io:format "Received message: '~s'~n" (list msg)) (print-result))))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/mnesia_demo.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/mnesia_demo.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 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,8 +21,27 @@ ;; together with mnesia:match_object, match specifications with ;; mnesia:select and Query List Comprehensions. +;; $ ./bin/lfe +;; +;; lfe> (c "examples/mnesia_demo.lfe") +;; +;; lfe> (set db (mnesia_demo:new)) +;; ok +;; lfe> (mnesia_demo:by_place 'london) +;; #(atomic +;; (#(person paul london driver) +;; #(person fred london waiter) +;; #(person john london painter) +;; #(person bert london waiter))) + (defmodule mnesia_demo - (export (new 0) (by_place 1) (by_place_ms 1) (by_place_qlc 1))) + (export + (new 0) + (by_place 1) + (by_place_ms 1) + ;; XXX - Currently broken; see https://github.com/lfe/lfe/issues/397 + ;; (by_place_qlc 1) + )) (defrecord person name @@ -31,8 +50,8 @@ (defun new () ;; Start mnesia and create a table, we will get an in memory only schema. - (: mnesia start) - (: mnesia create_table + (mnesia:start) + (mnesia:create_table 'person `(#(attributes ,(fields-person)))) ;; Initialise the table. @@ -55,37 +74,38 @@ #(fritz berlin painter) #(kurt berlin driver) #(hans berlin waiter) - #(franz berlin waiter) - ))) - (: lists foreach (match-lambda - ((tuple n p j) - (: mnesia transaction - (lambda () - (let ((new (make-person name n place p job j))) - (: mnesia write new)))))) - people))) + #(franz berlin waiter)))) + (lists:foreach + (match-lambda + ((tuple n p j) + (mnesia:transaction + (lambda () + (let ((new (make-person name n place p job j))) + (mnesia:write new)))))) + people))) ;; Match records by place using match_object and the emp-XXXX macro. (defun by_place (place) - (: mnesia transaction - (lambda () (: mnesia match_object (emp-person place place))))) + (mnesia:transaction + (lambda () (mnesia:match_object (emp-person place place))))) ;; Use match specifications to match records (defun by_place_ms (place) - (let ((f (lambda () (: mnesia select 'person + (let ((f (lambda () (mnesia:select 'person (match-spec ((match-person name n place p job j) (when (=:= p place)) (tuple n j))))))) - (: mnesia transaction f))) + (mnesia:transaction f))) +;; XXX - Currently broken; see https://github.com/lfe/lfe/issues/397 ;; Use Query List Comprehensions to match records -(defun by_place_qlc (place) - (let ((f (lambda () - (let ((q (qlc (lc ((<- person (: mnesia table 'person)) - (=:= (person-place person) place)) - person)))) - (: qlc e q))))) - (: mnesia transaction f))) +;; (defun by_place_qlc (place) +;; (let ((f (lambda () +;; (let ((q (qlc (lc ((<- person (mnesia:table 'person)) +;; (=:= (person-place person) place)) +;; person)))) +;; (qlc:e q))))) +;; (mnesia:transaction f))) ;; Ignore this ;; (qlc ((<- A (call 'qlc 'q (tuple 'qlc_lc (match-lambda (() (tuple 'simple_v1 'X (match-lambda (() (cons 1 (cons 2 (cons 3 ()))))) 42))) 'undefined)))) A)
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/object-via-closure.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/object-via-closure.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@gmail.com> +;; Copyright (c) 2013-2020 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,61 +26,61 @@ ;; ;; To use the code below in LFE, do the following: ;; -;; $ .bin/lfe -pa .ebin +;; $ ./bin/lfe ;; ;; Load the file and create a fish-class instance: ;; -;; > (slurp "examples/object-via-closure.lfe") +;; lfe> (slurp "examples/object-via-closure.lfe") ;; #(ok object-via-closure) -;; > (set mommy-fish (fish-class "Carp")) +;; lfe> (set mommy-fish (fish-class "Carp")) ;; #Fun<lfe_eval.10.91765564> ;; ;; Execute some of the basic methods: ;; -;; > (send mommy-fish 'species) +;; lfe> (send mommy-fish 'species) ;; "Carp" -;; > (send mommy-fish 'move 17) +;; lfe> (send mommy-fish 'move 17) ;; The Carp swam 17 feet! ;; ok -;; > (send mommy-fish 'id) -;; "47eebe91a648f042fc3fb278df663de5" +;; lfe> (send mommy-fish 'id) +;; "c0ec94b9de24657c51ba180768542b27" ;; ;; Now let's look at "modifying" state data (e.g., children counts): ;; -;; > (send mommy-fish 'children) +;; lfe> (send mommy-fish 'children) ;; () -;; > (send mommy-fish 'children-count) +;; lfe> (send mommy-fish 'children-count) ;; 0 -;; > (set `(,mommy-fish ,baby-fish-1) (send mommy-fish 'reproduce)) +;; lfe> (set `(,mommy-fish ,baby-fish-1) (send mommy-fish 'reproduce)) ;; (#Fun<lfe_eval.10.91765564> #Fun<lfe_eval.10.91765564>) -;; > (send mommy-fish 'id) -;; "47eebe91a648f042fc3fb278df663de5" -;; > (send baby-fish-1 'id) -;; "fdcf35983bb496650e558a82e34c9935" -;; > (send mommy-fish 'children-count) +;; lfe> (send mommy-fish 'id) +;; "c0ec94b9de24657c51ba180768542b27" +;; lfe> (send baby-fish-1 'id) +;; "5f31a47f000b5d173faa2793ea2ec876" +;; lfe> (send mommy-fish 'children-count) ;; 1 -;; > (set `(,mommy-fish ,baby-fish-2) (send mommy-fish 'reproduce)) +;; lfe> (set `(,mommy-fish ,baby-fish-2) (send mommy-fish 'reproduce)) ;; (#Fun<lfe_eval.10.91765564> #Fun<lfe_eval.10.91765564>) -;; > (send baby-fish-2 'id) -;; "3e64e5c20fb742dd88dac1032749c2fd" -;; > (send mommy-fish 'children-count) +;; lfe> (send baby-fish-2 'id) +;; "2f40b14a4394f3b7a57d4e9048bbb19e" +;; lfe> (send mommy-fish 'children-count) ;; 2 -;; > (send mommy-fish 'info) -;; id: "47eebe91a648f042fc3fb278df663de5" -;; species: "Carp" -;; children: "fdcf35983bb496650e558a82e34c9935", -;; "3e64e5c20fb742dd88dac1032749c2fd" +;; lfe> (send mommy-fish 'info) +;; (#(id "c0ec94b9de24657c51ba180768542b27") +;; #(species "Carp") +;; #(children +;; ("5f31a47f000b5d173faa2793ea2ec876" "2f40b14a4394f3b7a57d4e9048bbb19e"))) ;; ok (defmodule object-via-closure - (export all)) + (export all)) (defun fish-class (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 ())) + (fish-class species '())) (defun fish-class (species children) "This contructor is mostly useful as a way of abstracting out the id @@ -88,10 +88,7 @@ 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)) - (formatted-id (car - (io_lib:format "~32.16.0b" (list id))))) - (fish-class species children formatted-id))) + (fish-class species children (gen-id))) (defun fish-class (species children id) "This is the constructor used internally, once the children and fish id are @@ -107,10 +104,9 @@ (lambda (self) children)) ('info (lambda (self) - (io:format "id: ~p~nspecies: ~p~nchildren: ~p~n" - `(,(send self 'id) - ,(send self 'species) - ,(send self 'children))))) + `(#(id ,(send self 'id)) + #(species ,(send self 'species)) + #(children ,(send self 'children))))) ('move (lambda (self distance) (io:format "The ~s ~s ~p feet!~n" @@ -135,4 +131,9 @@ (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 + (funcall (funcall object method-name) object arg)) + +(defun gen-id () + (let (((binary (id (size 128))) (crypto:strong_rand_bytes 16))) + (io_lib:format "~32.16.0b" (list id)))) +
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/object-via-process.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/object-via-process.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@gmail.com> +;; Copyright (c) 2013-2020 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,50 +26,50 @@ ;; ;; To use the code below in LFE, do the following: ;; -;; $ ./bin/lfe -pa ./ebin +;; $ ./bin/lfe ;; ;; Load the file and create a fish-class instance: ;; -;; > (slurp "examples/object-via-process.lfe") +;; lfe> (slurp "examples/object-via-process.lfe") ;; #(ok object-via-process) -;; > (set mommy-fish (init-fish "Carp")) -;; <0.33.0> +;; lfe> (set mommy-fish (init-fish "Carp")) +;; #Pid<0.33.0> ;; ;; Execute some of the basic methods: ;; -;; > (send mommy-fish 'species) +;; lfe> (send mommy-fish 'species) ;; "Carp" -;; > (send mommy-fish 'move 17) +;; lfe> (send mommy-fish 'move 17) ;; "The Carp swam 17 feet!" -;; > (send mommy-fish 'id) +;; lfe> (send mommy-fish 'id) ;; "47eebe91a648f042fc3fb278df663de5" ;; ;; Now let's look at modifying state data (e.g., children counts): ;; -;; > (send mommy-fish 'children) +;; lfe> (send mommy-fish 'children) ;; () -;; > (send mommy-fish 'children-count) +;; lfe> (send mommy-fish 'children-count) ;; 0 -;; > (set baby-fish-1 (send mommy-fish 'reproduce)) -;; <0.34.0> -;; > (send baby-fish-1 'id) +;; lfe> (set baby-fish-1 (send mommy-fish 'reproduce)) +;; #Pid<0.34.0> +;; lfe> (send baby-fish-1 'id) ;; "fdcf35983bb496650e558a82e34c9935" -;; > (send mommy-fish 'children-count) +;; lfe> (send mommy-fish 'children-count) ;; 1 -;; > (set baby-fish-2 (send mommy-fish 'reproduce)) -;; <0.35.0> -;; > (send baby-fish-2 'id) +;; lfe> (set baby-fish-2 (send mommy-fish 'reproduce)) +;; #Pid<0.35.0> +;; lfe> (send baby-fish-2 'id) ;; "3e64e5c20fb742dd88dac1032749c2fd" -;; > (send mommy-fish 'children-count) +;; lfe> (send mommy-fish 'children-count) ;; 2 -;; > (send mommy-fish 'info) +;; lfe> (send mommy-fish 'info) ;; (#(id "f05064ffcf92d7b3e72968fd481abbd0") ;; #(species "Carp") ;; #(children ;; ("d53a426c732c938f996a1c2520bb621f" "15fede691ab3f96e9e3df248d37b7b55"))) (defmodule object-via-process - (export all)) + (export all)) (defun init-fish (species) "This is the constructor that will be used most often, only requiring that @@ -83,11 +83,8 @@ 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)) - (formatted-id (car - (io_lib:format "~32.16.0b" `(,id))))) (spawn (lambda () - (fish-class species children formatted-id))))) + (fish-class species children (gen-id))))) (defun fish-class (species children id) "This function is intended to be spawned as a separate process which is @@ -135,3 +132,7 @@ (! object `#(,(self) ,method-name ,arg)) (receive (data data))) + +(defun gen-id () + (let (((binary (id (size 128))) (crypto:strong_rand_bytes 16))) + (io_lib:format "~32.16.0b" (list id))))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/ping_pong.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/ping_pong.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) Tim Dysinger tim <<-on->> dysinger.net +;; Copyright (c) 2009-2020 Tim Dysinger tim <<-on->> dysinger.net ;; Permission is hereby granted, free of charge, to any person obtaining a copy ;; of this software and associated documentation files (the "Software"), to deal @@ -18,41 +18,75 @@ ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN ;; THE SOFTWARE. +;; To use the code below in LFE, do the following: +;; +;; $ ./bin/lfe +;; +;; Compile this example and run it: +;; +;; lfe> (c "examples/ping_pong.lfe") +;; (#(module ping_pong)) +;; lfe> (ping_pong:start_link) +;; #(ok #Pid<0.196.0>) +;; lfe> (ping_pong:ping) +;; #(pong 1) +;; lfe> (ping_pong:stop) +;; ok + (defmodule ping_pong - (export (start_link 0) (ping 0)) - (export (init 1) (handle_call 3) (handle_cast 2) - (handle_info 2) (terminate 2) (code_change 3)) - (behaviour gen_server)) ;Just indicates intent + (export + (start_link 0) + (start 0) + (stop 0) + (ping 0)) + (export + (init 1) + (handle_call 3) + (handle_cast 2) + (handle_info 2) + (terminate 2) + (code_change 3)) + (behaviour gen_server)) ; Just indicates intent + +;; Management API (defun start_link () - (: gen_server start_link - (tuple 'local 'ping_pong) 'ping_pong (list) (list))) + (gen_server:start_link + #(local ping_pong) 'ping_pong '() '())) + +(defun start () + (gen_server:start + #(local ping_pong) 'ping_pong '() '())) + +(defun stop () + (gen_server:stop 'ping_pong)) ;; Client API (defun ping () - (: gen_server call 'ping_pong 'ping)) + (gen_server:call 'ping_pong 'ping)) ;; Gen_server callbacks -(defrecord state (pings 0)) +(defrecord state + (pings 0)) (defun init (args) - (tuple 'ok (make-state pings 0))) + `#(ok ,(make-state pings 0))) (defun handle_call (req from state) (let* ((new-count (+ (state-pings state) 1)) (new-state (set-state-pings state new-count))) - (tuple 'reply (tuple 'pong new-count) new-state))) + `#(reply #(pong ,new-count) ,new-state))) (defun handle_cast (msg state) - (tuple 'noreply state)) + `#(noreply ,state)) (defun handle_info (info state) - (tuple 'noreply state)) + `#(noreply ,state)) (defun terminate (reason state) 'ok) (defun code_change (old-vers state extra) - (tuple 'ok state)) + `#(ok ,state))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/ring.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/ring.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2014 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2014-2020 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. @@ -31,13 +31,14 @@ ;; ;; To use the code below in LFE, do the following: ;; -;; $ make compile -;; $ cd examples -;; $ ../bin/lfe -pa ../ebin -smp disable -noshell -run ring main 503 50000000 +;; $ ./bin/lfe ;; -;; This should give the following output: +;; Compile this example and run it: ;; -;; Result: 292 +;; lfe> (c "examples/ring.lfe") +;; (#(module ring)) +;; lfe> (ring:main '(503 50000000)) +;; Result:: 292 ;; (defmodule ring (export @@ -45,9 +46,7 @@ (roundtrip 2))) (defun main (args) - (apply - #'start-ring/2 - (lists:map #'list_to_integer/1 args))) + (apply #'start-ring/2 args)) (defun start-ring (process-count traversal-count) (let ((batch (make-processes process-count traversal-count))) @@ -61,12 +60,12 @@ (lists:seq process-count 2 -1))) (defun make-process (id pid) - (spawn 'ring 'roundtrip (list id pid))) + (spawn 'ring 'roundtrip `(,id ,pid))) (defun roundtrip (id pid) (receive (1 - (io:fwrite '"Result: ~b~n" (list id)) + (io:fwrite "Result: ~b~n" `(,id)) (erlang:halt)) (data (! pid (- data 1))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/sample-lfe-shellscript -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/sample-lfe-shellscript
Changed
@@ -2,7 +2,7 @@ ;; -*- mode: lfe -*- ;;! -smp enable -sname factorial -mnesia debug verbose ;; -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013-2020 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. @@ -21,10 +21,11 @@ ;; Purpose : Demonstrating usage of lfe ;; To use this script make sure you have run "make install" from the -;; lfe working directory +;; lfe working directory and then (temporarily) set the PATH: ;; ;; At this point, you can call this script directly: ;; +;; $ export PATH=$(pwd)/bin:$PATH ;; $ examples/sample-lfe-shellscript ;; usage: examples/sample-lfescript <integer> ;; @@ -39,7 +40,7 @@ (n (* n (fac (- n 1))))) (defun usage () - (: lfe_io format "usage: ~s <integer>\n" (list script-name))) + (lfe_io:format "usage: ~s <integer>\n" (list script-name))) ;; Now do it (case script-args @@ -47,7 +48,7 @@ (try (let* ((n (list_to_integer string)) (f (fac n))) - (: lfe_io format '"factorial ~w = ~w\n" (list n f))) + (lfe_io:format "factorial ~w = ~w\n" (list n f))) (catch ((tuple _ _ _) (usage))))) (() (usage)))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/sample-lfescript -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/sample-lfescript
Changed
@@ -2,7 +2,7 @@ ;; -*- mode: lfe -*- ;;! -smp enable -sname factorial -mnesia debug verbose ;; -;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io> +;; Copyright (c) 2013-2020 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. @@ -25,6 +25,7 @@ ;; ;; At this point, you can call this script directly: ;; +;; $ export PATH=$(pwd)/bin:$PATH ;; $ examples/sample-lfescript ;; usage: examples/sample-lfescript <integer> ;; @@ -41,7 +42,7 @@ (try (let* ((n (list_to_integer string)) (f (fac n))) - (: lfe_io format '"factorial ~w = ~w\n" (list n f))) + (lfe_io:format "factorial ~w = ~w\n" (list n f))) (catch ((tuple _ _ _) (usage))))) (_ (usage))) @@ -51,5 +52,5 @@ (n (* n (fac (- n 1))))) (defun usage () - (let ((script-name (: escript script_name))) - (: lfe_io format '"usage: ~s <integer>\n" (list script-name)))) + (let ((script-name (escript:script_name))) + (lfe_io:format "usage: ~s <integer>\n" (list script-name))))
View file
_service:tar_scm:lfe-1.3.tar.gz/examples/simple-erl-exercises.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/examples/simple-erl-exercises.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Sean Chalmers +;; Copyright (c) 2008-2020 Sean Chalmers ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -35,15 +35,16 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmodule exercises - (export (convert 1) - (perimeter 1) - (min 1) - (max 1) - (min_max 1) - (min_max2 1) - (start_pong 1) - (start_ring 2) - (start_star 2))) + (export + (convert 1) + (perimeter 1) + (min 1) + (max 1) + (min_max 1) + (min_max2 1) + (start_pong 1) + (start_ring 2) + (start_star 2))) ;; SIMPLE SEQUENTIAL EXERCISES @@ -66,7 +67,7 @@ (tuple 'square (* 4 side))) ;; Circle ((tuple 'circle radius) (when (is_number radius)) - (tuple 'circle (: math pow (* (: math pi) radius) 2))) + (tuple 'circle (math:pow (* (math:pi) radius) 2))) ;; Triangle ((tuple 'triangle a b c) (when (is_number a) (is_number b) @@ -79,10 +80,10 @@ ;; I know lists:max/1 and lists:min/1 exist, that isn't the point. (defun min ((cons x xs) - (: lists foldl (fun erlang min 2) x xs))) + (lists:foldl (fun erlang min 2) x xs))) (defun max ((cons x xs) - (: lists foldl (fun erlang max 2) x xs))) + (lists:foldl (fun erlang max 2) x xs))) (defun min_max (col) ;; Flavourless min_max/1 implementation. @@ -90,7 +91,7 @@ ;; Alternative min_max without the little helpers (defun min_max2 (col) - (let-function (gief (match-lambda (f (cons x xs) (: lists foldl f x xs)))) + (let-function (gief (match-lambda (f (cons x xs) (lists:foldl f x xs)))) ;; Create a tuple using our temp function above. (tuple (gief (fun erlang min 2) col) (gief (fun erlang max 2) col)))) @@ -104,16 +105,16 @@ ((list a b) (list a b))) (defun swedish_date () - (: lists foldl ;; I heart fold + (lists:foldl ;; I heart fold (lambda (x acc) (++ acc (nom-date (integer_to_list x)))) () ;; This is our accumulator - (tuple_to_list (: erlang date)))) + (tuple_to_list (erlang:date)))) (defun create-pids-one-arg (fn arg col) ;; I ended up using this pattern a few times in the next couple of ;; exercises so I pulled it out into it's own function. - (: lists map (lambda (_) (spawn (MODULE) fn (list arg))) col)) + (lists:map (lambda (_) (spawn (MODULE) fn (list arg))) col)) (defun pong (n) ;; This is the pong receiver. @@ -125,7 +126,7 @@ 'ok) ;; We've received a message, bump the counter and send it back. ((tuple 'ping from count) - (: io format '"caught ball~n" (list)) + (io:format "caught ball~n" (list)) (! from (tuple 'ping (self) (+ count 1))) ;; Make sure we're still here to get the next message. (pong n)))) @@ -139,7 +140,7 @@ (defun start_ring (n-rings n-msgs) ;; Create the desired number of "servers" in the ring. (let ((cons x xs) - (create-pids-one-arg 'ring n-msgs (: lists seq 1 n-rings))) + (create-pids-one-arg 'ring n-msgs (lists:seq 1 n-rings))) ;; Get it rolling. (! x (tuple 'pass (++ xs (list x)) 0)))) @@ -151,12 +152,12 @@ ;; We've reached the maxiumum number of messages ((tuple 'pass (cons x xs) msg) (when (== msg n-msgs)) ;; State our intentions. - (: io format '"Shutting Down.~n" '()) + (io:format "Shutting Down.~n" '()) ;; Ensure we trigger the shut down of all remaining rings. (! x (tuple 'pass (ring-col x xs) msg))) ;; We've received a message, pass it on to the next ring. ((tuple 'pass (cons x xs) msg) - (: io format '"Recieved Message~n" '()) + (io:format "Recieved Message~n" '()) (! x (tuple 'pass (ring-col x xs) (+ msg 1))) ;; Make sure we're still around to receive the next one. (ring n-msgs))))) @@ -167,7 +168,7 @@ ;; until the list is exhausted. (() 'done) ;; No more stars, we're done here. ((cons x xs) - (: io format '"Sent message to star~n" '()) + (io:format "Sent message to star~n" '()) (! x (tuple 'msg (self))) (receive ;; Wait until the star replies before moving on to the next one. ;; Recur into the rest of the list. @@ -176,18 +177,18 @@ (defun start_star ;; Start our star communication process ((n-stars n-msgs) (when (is_number n-stars) (is_number n-msgs)) ;; Use the function from earlier to create our list of pids - (let* (stars (create-pids-one-arg 'star n-stars (: lists seq 1 n-stars))) + (let* (stars (create-pids-one-arg 'star n-stars (lists:seq 1 n-stars))) ;; For every message, trigger a sequence of communication with every ;; star. This is inside the let* so I can deliberately discard the ;; value and not be yelled at by the compiler. - (_ (lc ((<- _ (: lists seq 1 n-msgs))) (contact_stars stars))) + (_ (lc ((<- _ (lists:seq 1 n-msgs))) (contact_stars stars))) ;; Ensure all the star processes are killed off. (lc ((<- star stars)) (! star 'die))))) (defun star (x) ;; Our star receiver function (receive ((tuple 'msg from) ;; Received a message from the core. - (: io format '"Received msg from center~n" '()) + (io:format "Received msg from center~n" '()) (! from 'ok) (star x)) ('die 'ok))) ;; Received instruction to die from the core.
View file
_service:tar_scm:lfe-1.3.tar.gz/get_comp_opts.escript -> _service:tar_scm:lfe-2.1.1.tar.gz/get_comp_opts.escript
Changed
@@ -3,36 +3,15 @@ %% Define a number of compiler options. We first work out the current %% Erlang version and from the we can define the various options. -%% Bloody useful. --define(IF(Test,True,False), case Test of true -> True; false -> False end). - -%% 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 NEW_CORE_REC for new core definition of records (19). - --define(HAS_MAPS_OPT, "-DHAS_MAPS=true"). --define(FULL_KEYS_OPT, "-DHAS_FULL_KEYS=true"). --define(NEW_REC_OPT, "-DNEW_REC_CORE=true"). --define(NEW_RAND_OPT, "-DNEW_RAND=true"). +%% Define the makefile variables HAS_MAPS, HAS_FULL_KEYS, +%% NEW_REC_CORE, NEW_RAND, HAS_FLOOR, HAS_CEIL and NEW_STACKTRACE +%% depending on version of Erlang. main(_) -> Version = otp_release(), CompOpts = comp_opts(Version), file:write_file("comp_opts.mk", "COMP_OPTS = " ++ CompOpts ++ "\n"). -comp_opts(Version) -> - Copts0 = "-DERLANG_VERSION=\\\"" ++ Version ++ "\\\"", - Copts1 = ?IF(Version >= "17", Copts0 ++ " " ++ ?HAS_MAPS_OPT, Copts0), - Copts2 = ?IF(Version >= "18", Copts1 ++ " " ++ ?FULL_KEYS_OPT, Copts1), - Copts3 = ?IF(Version >= "19", - Copts2 ++ append_copts(?NEW_REC_OPT,?NEW_RAND_OPT), - Copts2), - Copts3. - -append_copts(Copt|Copts) -> - " " ++ Copt ++ append_copts(Copts); -append_copts() -> . - %% Get the release number. %% We have stolen the idea and most of the code from rebar3. @@ -60,3 +39,23 @@ end end end. + +comp_opts(Version) -> + Copts0 = "-DERLANG_VERSION=\\\"" ++ Version ++ "\\\"" ++ " ", + Copts0 ++ append_copts(Version, {"17","HAS_MAPS"}, + {"18","HAS_FULL_KEYS"}, + {"19","NEW_REC_CORE"}, + {"19","NEW_RAND"}, + {"20","NEW_BOOL_GUARD"}, + {"20","HAS_FLOOR"}, + {"20","HAS_CEIL"}, + {"21","NEW_STACKTRACE"}, + {"23","EEP48"}). + +append_copts(Version, {Ver,Opt}|Opts) -> + Rest = append_copts(Version, Opts), + if Version >= Ver -> + "-D" ++ Opt ++ "=true" ++ " " ++ Rest; + true -> Rest + end; +append_copts(_Version, ) -> .
View file
_service:tar_scm:lfe-1.3.tar.gz/include/clj.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/include/clj.lfe
Changed
@@ -17,6 +17,8 @@ ;;; Conditional macros. +(defmacro if-let args `(clj:if-let ,@args)) +(defmacro iff-let args `(clj:iff-let ,@args)) (defmacro condp args `(clj:condp ,@args)) (defmacro if-not args `(clj:if-not ,@args)) (defmacro iff args `(clj:iff ,@args))
View file
_service:tar_scm:lfe-1.3.tar.gz/include/match-spec.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/include/match-spec.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-2.1.1.tar.gz/include/scm.lfe
Added
@@ -0,0 +1,23 @@ +;; Copyright (c) 2020 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 : scm.erl +;; Author : Robert Virding +;; Purpose : Lisp Flavoured Erlang scheme include macros + +(defmacro begin args `(scm:begin ,@args)) +(defmacro define args `(scm:define ,@args)) +(defmacro define-syntax args `(scm:define-syntax ,@args)) +(defmacro let-syntax args `(scm:let-syntax ,@args)) +(defmacro defsyntax args `(scm:defsyntax ,@args))
View file
_service:tar_scm:lfe-1.3.tar.gz/rebar.config -> _service:tar_scm:lfe-2.1.1.tar.gz/rebar.config
Changed
@@ -2,20 +2,37 @@ {erl_opts, debug_info}. -{profiles, {test, {deps, proper}}}. +%% IMPORTANT! Versions of proper are calculated dynamically in the 'rebar.config.script' file, at the end; +%% DO NOT set/change the proper version here! +{profiles, {test, {deps, proper}, + {plugins, {rebar3_proper, {git, "https://github.com/ferd/rebar3_proper", {tag, "0.12.1"}}}}, + {src_dirs, "src", "test"}}, + {dialyzer, }}. + +%% XXX Commenting this out due to weird recursion issues with rebar3_lfe ... +%% Do we remember why we need this? I _thought_ it was to help with +%% publishing LFE to hex.pm; once we remember, we should add a code +%% for future reference. +%% This issue is tracked here: +%% * https://github.com/lfe/lfe/issues/461 +%% Long term solution being tracked here: +%% * https://github.com/lfe/lfe/issues/460 +%% {plugins, +%% {rebar3_lfe, "0.3.1"} +%% }. {pre_hooks, {"(linux|darwin|solaris|freebsd|netbsd|openbsd)", ct, - "bin/lfe bin/lfec" + "bin/lfescript bin/lfec" " -o $REBAR_DEPS_DIR/lfe/test" " test/*_SUITE.lfe"}, {"(linux|darwin|solaris|freebsd|netbsd|openbsd)", eunit, - "bin/lfe bin/lfec" + "bin/lfescript bin/lfec" " -o $REBAR_DEPS_DIR/lfe/ebin" - " test/clj-tests.lfe"}, + " test/clj-tests.lfe test/maps-tests.lfe"}, %% TODO: Test this on a win32 box %% {"win32", ct, - %% "bin/lfe bin/lfec -o $REBAR_DEPS_DIR/lfe/test test/*_SUITE.lfe"} + %% "bin/lfescript bin/lfec -o $REBAR_DEPS_DIR/lfe/test test/*_SUITE.lfe"} {"(linux|darwin|solaris|freebsd|netbsd|openbsd)", app_compile, - "bin/lfe bin/lfec -o $REBAR_DEPS_DIR/lfe/ebin src/*.lfe"} + "bin/lfescript bin/lfec -o $REBAR_DEPS_DIR/lfe/ebin src/*.lfe"} %% TODO: equivalent win32 hook }.
View file
_service:tar_scm:lfe-1.3.tar.gz/rebar.config.script -> _service:tar_scm:lfe-2.1.1.tar.gz/rebar.config.script
Changed
@@ -1,56 +1,99 @@ %% -*- mode: erlang; indent-tabs-mode: nil -*- -Conf0 = CONFIG, -HasOpt = {d,'HAS_MAPS',true}, -FullOpt = {d,'HAS_FULL_KEYS',true}, -RecOpt = {d,'NEW_REC_CORE',true}, -RandOpt = {d,'NEW_RAND',true}, +Conf0 = CONFIG, %The original config -%% Get the release number. -%% We have stolen the idea and most of the code from rebar3. +%% Do a deep set stepping down a list of keys replacing/adding last +%% with value. Named funs would be nicer but not always available. -Version = case erlang:system_info(otp_release) of - $R,N1|Rest when is_integer(N1) -> - %% If OTP <= R16, take the digits. - N1|Rest; - Rel -> - File = filename:join(code:root_dir(),"releases",Rel,"OTP_VERSION"), - case file:read_file(File) of - {error, _} -> Rel; - {ok, Vsn} -> - Size = byte_size(Vsn), - %% The shortest vsn string consists of at least - %% two digits followed by "\n". Therefore, it's - %% safe to assume Size >= 3. - case binary:part(Vsn, {Size, -3}) of - <<"**\n">> -> - binary:bin_to_list(Vsn, {0, Size - 3}); - _ -> - binary:bin_to_list(Vsn, {0, Size - 1}) - end +SetConf = fun (K, Val, Ps, _F) -> + %% Replace the whole K field with Val. + Val|proplists:delete(K, Ps); + (K|Ks, Val, Ps, F) -> + %% Step down and build coming up. + case lists:keyfind(K, 1, Ps) of + {K,Kps} -> + lists:keyreplace(K, 1, Ps, {K,F(Ks, Val, Kps, F)}); + false -> Ps ++ {K,F(Ks, Val, , F)} end end, -%% These are the macros we add to the configuration. +%% Get the release number. +%% We have stolen the idea and most of the code from rebar3. + +OTPRelease = + fun () -> + case erlang:system_info(otp_release) of + $R,N1|Rest when is_integer(N1) -> + %% If OTP <= R16, take the digits. + N1|Rest; + Rel -> + File = filename:join(code:root_dir(),"releases",Rel,"OTP_VERSION"), + case file:read_file(File) of + {error, _} -> Rel; + {ok, Vsn} -> + Size = byte_size(Vsn), + %% The shortest vsn string consists of at least + %% two digits followed by "\n". Therefore, it's + %% safe to assume Size >= 3. + case binary:part(Vsn, {Size, -3}) of + <<"**\n">> -> + binary:bin_to_list(Vsn, {0, Size - 3}); + _ -> + binary:bin_to_list(Vsn, {0, Size - 1}) + end + end + end + end, + +Version = OTPRelease(), + +%% Collect the macro definitions we will add to the compiler options. +%% Named funs would be nicer but not always available. + +AppendCopts = fun (Version, {Ver,Opt}|Opts, F) -> + Rest = F(Version, Opts, F), + if Version >= Ver -> + {d,Opt,true}|Rest; + true -> + Rest + end; + (_Version, , _F) -> + end, Copts0 = {d,'ERLANG_VERSION',Version}, -Copts1 = if Version >= "17" -> Copts0 ++ HasOpt; - true -> Copts0 - end, -Copts2 = if Version >= "18" -> Copts1 ++ FullOpt; - true -> Copts1 - end, -Copts3 = if Version >= "19" -> Copts2 ++ RecOpt,RandOpt; - true -> Copts2 - end, -Copts = Copts3, %This is it - -%% Now add them. - -case lists:keyfind(erl_opts, 1, Conf0) of - {erl_opts,Opts} -> %Existing erl_opts - NewOpts = {erl_opts,Opts ++ Copts}, - lists:keyreplace(erl_opts, 1, Conf0, NewOpts); - false -> %No erl_opts - Conf0 ++ {erl_opts,Copts} -end. +Copts = Copts0 ++ AppendCopts(Version, + {"17",'HAS_MAPS'}, + {"18",'HAS_FULL_KEYS'}, + {"19",'NEW_REC_CORE'}, + {"19",'NEW_RAND'}, + {"20",'NEW_BOOL_GUARD'}, + {"20",'HAS_FLOOR'}, + {"20",'HAS_CEIL'}, + {"21",'NEW_STACKTRACE'}, + {"23",'EEP48'}, + AppendCopts), + +%% Ensure they are in erl_opts. + +Conf1 = case lists:keyfind(erl_opts, 1, Conf0) of + {erl_opts,Opts} -> %Existing erl_opts + NewOpts = {erl_opts,Opts ++ Copts}, + lists:keyreplace(erl_opts, 1, Conf0, NewOpts); + false -> %No erl_opts + Conf0 ++ {erl_opts,Copts} + end, + +%% Get the proper dep we will add to profiles-test-deps. + +Prop = if + Version =< "17" -> {proper, "1.1.1-beta"}; + Version =< "21" -> {proper, "1.3.0"}; + Version =< "23" -> {proper, "1.4.0"}; + true -> proper + end, + +%% Ensure we have set the right value of proper dep. + +Conf2 = SetConf(profiles,test,deps,proper, Prop, Conf1, SetConf), + +Conf2.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/NOTES -> _service:tar_scm:lfe-2.1.1.tar.gz/src/NOTES
Changed
@@ -1,4 +1,4 @@ - Copyright (c) 2013 Robert Virding + Copyright (c) 2013-2020 Robert Virding Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/cl.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/src/cl.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2015-2016 Robert Virding +;; Copyright (c) 2015-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -48,7 +48,9 @@ (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)) + (type-of 1) (coerce 2) + ;; System + (posix-argv 0)) (export-macro ;; Export control structure macros. do @@ -74,16 +76,16 @@ (defmacro do args "vars (end-test result) body" (let* ((`(,pars (,test ,ret) . ,body) args) - ((tuple vs is cs) - (lists:foldr (match-lambda - ((list v i c) (tuple vs is cs) - (tuple (cons v vs) (cons i is) (cons c cs)))) - (tuple () () ()) pars))) + ((tuple vs is cs) + (lists:foldr (match-lambda + ((list v i c) (tuple vs is cs) + (tuple (cons v vs) (cons i is) (cons c cs)))) + (tuple () () ()) pars))) `(letrec-function ((|\|-do-func-\|| - (lambda ,vs - (if ,test ,ret - (let ((do-state (progn . ,body))) - (|\|-do-func-\|| . ,cs)))))) + (lambda ,vs + (if ,test ,ret + (let ((do-state (progn . ,body))) + (|\|-do-func-\|| . ,cs)))))) (|\|-do-func-\|| . ,is)))) (defun mapcar (func list) @@ -234,7 +236,7 @@ (defun length (seq (when (is_list seq)) - (length seq)) + (erlang:length seq)) ;To ensure we call system length (seq (when (is_tuple seq)) (tuple_size seq))) @@ -683,7 +685,7 @@ (cond ((io_lib:printable_latin1_list x) 'string) ((io_lib:printable_unicode_list x) 'unicode) ((?= `(,a . ,b) (when (not (is_list b))) x) 'cons) - ('true 'list))) + (else 'list))) ((x) (when (is_function x)) 'function) ((x) (when (is_binary x))
View file
_service:tar_scm:lfe-1.3.tar.gz/src/clj.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/src/clj.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2015-2016 Robert Virding +;; Copyright (c) 2015-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -59,7 +59,8 @@ `(defun ,@args)) (defmacro fn args - "Equivalent to `lambda`." + "args + Equivalent to `lambda`." `(lambda ,@args)) ;;; Threading macros. @@ -184,7 +185,8 @@ (some->>* args)) (defmacro doto - "Evaluate all given `sexps` and functions in order, + "x . sexps + Evaluate all given `sexps` and functions in order, for their side effects, with the value of `x` as the first argument and return `x`." (`(,x . ,sexps) @@ -207,7 +209,8 @@ `(case ,test ('false ,else) ('undefined ,else) - (,patt ,then)))) + (,patt ,then) + (_ ,else)))) (case args ((list (list patt test) then) (exp-if-let patt test then `'undefined)) ((list (list patt test) then else) (exp-if-let patt test then else))))) @@ -221,7 +224,8 @@ `(case ,test ('false 'undefined) ('undefined 'undefined) - (,patt ,@body)))) + (,patt ,@body) + (_ 'undefined)))) (defmacro condp args "pred expr . clauses @@ -278,7 +282,8 @@ (_ 'undefined)))) (defmacro not= - "Same as `(not (== ...))`." + "exp + Same as `(not (== ...))`." (`(,x) `'false) (`(,x ,y . ,more) `(not (== ,x ,y ,@more)))) @@ -344,7 +349,8 @@ N.B. `record?/2` may yield unexpected results, due to difference between the Erlang and LFE compilers. As such, whenever possible, prefer `record?/3`." ;; NOTE: record-tag must be an atom - (`(,x ,record-tag) `(is_record ,x ,record-tag)) + (`(,x ,record-tag) `(andalso (is_tuple ,x) + (=:= (tref ,x 1) ,record-tag))) (`(,x ,record-tag ,size) `(is_record ,x ,record-tag ,size))) (defmacro reference? (x) @@ -389,7 +395,7 @@ (defmacro even? (x) "Return `'true` if `x` is even." - `(clj:zero? ,(band 1 x))) + `(clj:zero? (band 1 ,x))) (defmacro zero? (x) "Return `'true` if `x` is zero." @@ -574,7 +580,7 @@ (sets:is_element elem data)) ((ordsets:is_set data) (ordsets:is_element elem data)) - ('true 'false)))) + (else 'false)))) ;;; Sequence functions. @@ -777,7 +783,7 @@ ((dict? data) (-get-in-dict data keys not-found)) ((list? data) (-get-in-list data keys not-found)) ((map? data) (-get-in-map data keys not-found)) - ('true not-found)))) + (else not-found)))) (defn- -get-in (func data `(,key) not-found
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe.app.src -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe.app.src
Changed
@@ -1,5 +1,5 @@ -%% -*- erlang -*- -%% Copyright (c) 2013-2016 Robert Virding +%% -*- mode: erlang; indent-tabs-mode: nil -*- +%% Copyright (c) 2013-2021 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,19 +15,23 @@ {application, lfe, {description, "Lisp Flavored Erlang (LFE)"}, - {vsn, "1.3"}, - {modules,cl,clj,lfe,lfe_bits,lfe_codegen,lfe_comp,lfe_doc, - 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}, + {vsn, "2.1.1"}, + {modules,cl,clj,lfe,lfe_abstract_code,lfe_bits,lfe_codegen, + lfe_codelift,lfe_comp,lfe_docs,lfe_edlin_expand, + lfe_env,lfe_eval,lfe_eval_bits,lfe_gen,lfe_init, + lfe_internal,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_macro_struct,lfe_ms,lfe_parse,lfe_qlc,lfe_scan, + lfe_shell,lfe_shell_docs,lfe_struct,lfe_translate, + lfe_types,lfescript,scm}, {registered, }, {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/"}}, - {files, "src", "include", "bin", "rebar.*", "README.md", "LICENSE"} + {links, {"Github", "https://github.com/lfe/lfe"}, + {"Main site", "https://lfe.io/"}, + {"Documentation", "https://lfe.io/use/#reference"}}, + {files, "README.md", "LICENSE", "src", "c_src", "include", "bin", + "rebar.*", "*akefile", "*.escript"} }.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2016 Robert Virding +%% Copyright (c) 2016-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe.hrl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe.hrl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2014-2015 Robert Virding +%% Copyright (c) 2014-2020 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,3 +21,22 @@ -define(BQ(E), backquote,E). -define(C(E), comma,E). -define(C_A(E), 'comma-at',E). + +%% Some commonly used macros. + +%% 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. + +%% Define CATCH to handle deprecated get_stacktrace/0 +-ifdef(NEW_STACKTRACE). +-define(CATCH(C, E, S), C:E:S ->). +-else. +-define(CATCH(C, E, S), C:E -> S = erlang:get_stacktrace(),). +-endif. + +%% Bloody useful +-define(IF(Test,True,False), case Test of true -> True; false -> False end).
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_abstract_code.erl
Added
@@ -0,0 +1,50 @@ +%% Copyright (c) 2017-2020 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_abstract_code.erl +%%% Author : Robert Virding +%%% Purpose : Extract LFE abstract code for BEAM data. + +%% This has been copied from erl_abstract_code.erl. + +-module(lfe_abstract_code). +-export(debug_info/4). + +%% debug_info(Format, Module, Data, Options) -> {ok,Code} | {error,Error}. + +debug_info(_Format, _Module, {none,_Copts}, _Opts) -> + {error, missing}; +debug_info(erlang_v1, _Mod, {AbstrCode,_CompilerOpts}, _Opts) -> + {ok,AbstrCode}; +debug_info(core_v1, _Mod, {AbstrCode,CompilerOpts}, Opts) -> + CoreOpts = add_core_returns(delete_reports(CompilerOpts ++ Opts)), + try compile:noenv_forms(AbstrCode, CoreOpts) of + {ok,_,Core,_} -> {ok,Core}; + _Error -> {error,failed_conversion} + catch + error:_E -> {error,failed_conversion} + end; +debug_info(_Format, _, _Data, _) -> + {error,unknown_format}. + +delete_reports(Opts) -> + Opt || Opt <- Opts, not is_report_option(Opt). + +is_report_option(report) -> true; +is_report_option(report_errors) -> true; +is_report_option(report_warnings) -> true; +is_report_option(_) -> false. + +add_core_returns(Opts) -> + to_core,return_errors,return_warnings ++ Opts.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_bits.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_bits.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2011-2013 Robert Virding +%% Copyright (c) 2011-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_codegen.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_codegen.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2017 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -14,1719 +14,385 @@ %%% File : lfe_codegen.erl %%% Author : Robert Virding -%%% Purpose : Lisp Flavoured Erlang code generator (to core Erlang). - -%%% We have to be very careful to generate annotations in exactly the -%%% same way as the erlang compiler does and in the same places. -%%% Dialyzer is very finnicky about this and seriously fails if things -%%% are not as it expects them to be. Note that now the whole -%%% annotation is passed into the constructor functions, not just the -%%% line number. +%%% Purpose : Lisp Flavoured Erlang code generator (to Erlang AST). + +%%% We must be careful to generate code in the right order so as not +%%% to generate something the Erlang AST compiler won't find errors +%%% that are due to ordering but don't really exist. We first collect +%%% and generate all the "real" attributes from the module forms which +%%% must be first but we keep type/spec/record declarations in the +%%% same relative place as in the original file. %%% -%%% We make temporary variables of the form ' <num> ', which while -%%% they are not guaranteed to be unique are pretty unlikely. +%%% Note that for (export all) we only export the top-level functions +%%% defined in the module, not any of the lambda lifted functions. +%%% This means that we cannot generate "-compile(export_all)." but +%%% must explicitly export the functions. +%%% +%%% Having import from and rename forces us to explicitly convert the +%%% call as we can't use an import attribute to do this properly for +%%% us. Hence we collect the imports here and pass them into +%%% lfe_translate. +%%% +%%% Module aliases are also collected here and passed on to +%%% lfe_translate. -module(lfe_codegen). --export(module/2). - --compile(export_all). +-export(module/2,format_error/1). --import(lists, member/2,keysearch/3,reverse/1, - all/2,map/2,foldl/3,foldr/3,mapfoldl/3,mapfoldr/3, - concat/1,zipwith/3). --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_env/2, - add_vbinding/3,get_vbinding/2,add_fbinding/4, - add_ibinding/5,get_gbinding/3). +%% -compile(export_all). +-include("lfe.hrl"). -include("lfe_comp.hrl"). -%% 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. - --define(Q(E), quote,E). %We do a lot of quoting! - --record(cg, {module=, %Module name - exps=, %Exports (ordsets) - imps=, %Imports (orddict) - pref=, %Prefixes - atts=, %Attrubutes - mets=, %Metadata - defs=, %Function definitions. - env=, %Environment - anno=, %Current annotation - opts=, %Options - file=, %File name - func=, %Current function - line=0, %Current line - vc=0, %Variable counter - fc=0 %Function counter +-record(lfe_cg, {module=, %Module name + mline=0, %Module definition line + exports=ordsets:new(), %Exports + imports=orddict:new(), %Imports + aliases=orddict:new(), %Aliases + onload=, %Onload + atts=, %Attrubutes + defs=, %Defined top-level functions + opts=, %Options + file=, %File name + func=, %Current function + errors=, %Errors + warnings= %Warnings }). -%% module(ModuleForms, CompInfo) -> {ModuleName,CoreModule} +%% Errors. +format_error({illegal_code,Code}) -> + lfe_io:format1(<<"illegal ~w code">>, Code). + +%% module(ModuleForms, CompInfo) -> +%% {ok,ModuleName,ASTModule,Warning} | {error,Error,Warning}. module(Mfs, #cinfo{opts=Opts,file=File}) -> - St0 = #cg{opts=Opts,file=File}, - {Core,St1} = compile_module(Mfs, St0), - {St1#cg.module,Core}. + St0 = #lfe_cg{opts=Opts,file=File}, + {AST,St1} = compile_module(Mfs, St0), + %% io:format("imps ~p\n", St1#lfe_cg.imports), + return_status(AST, St1). -%% compile_module(ModuleForms, State) -> {CoreModule,State}. +return_status(AST, #lfe_cg{module=M,errors=}=St) -> + {ok,M,AST,St#lfe_cg.warnings}; +return_status(_AST, St) -> + {error,St#lfe_cg.errors,St#lfe_cg.warnings}. compile_module(Mfs, St0) -> - {Fbs,St1} = collect_module(Mfs, St0), - Core = c_module(c_atom(none), , ), - compile_forms(Fbs, St1, Core). - -%% collect_module(ModuleForms, State) -> {Fbs,State}. -%% Collect forms and module data. Returns function bindings and puts -%% module data into state. - -collect_module(Mfs, St0) -> - {Fds,St1} = lists:foldl(fun collect_form/2, {,St0}, Mfs), - {lists:reverse(Fds),St1}. - -%% collect_form(Form, Line, State} -> {FuncDefs,State}. -%% Collect valid forms and module data. Returns forms and put module -%% data into state. - -collect_form({'define-module',Mod,Metas,Atts,L}, {Fds,St0}) -> - St1 = collect_metas(Metas, L, St0#cg{module=Mod,anno=L}), - {Fds,collect_attrs(Atts, L, St1)}; -collect_form({'extend-module',Meta,Atts,L}, {Fds,St0}) -> - St1 = collect_metas(Meta, L, St0#cg{anno=L}), - {Fds,collect_attrs(Atts, L, St1)}; -collect_form({'define-type',Type,Def,L}, {Fds,St}) -> - {Fds,collect_meta(type,Type,Def, L, St#cg{anno=L})}; -collect_form({'define-opaque-type',Type,Def,L}, {Fds,St}) -> - {Fds,collect_meta(opaque,Type,Def, L, St#cg{anno=L})}; -collect_form({'define-function-spec',Func,Spec,L}, {Fds,St}) -> - {Fds,collect_meta(spec,Func,Spec, L, St#cg{anno=L})}; -collect_form({'define-function',Name,_Meta,Def,L}, {Fds,St}) -> - %% Ignore the meta data. - {{Name,Def,L}|Fds,St}; -%% Ignore macro definitions and eval-when-compile forms. -collect_form({'define-macro'|_,_}, {Fds,St}) -> {Fds,St}; -collect_form({'eval-when-compile'|_,_}, {Fds,St}) -> {Fds,St}. - -%% collect_metas(Metas, Line, State) -> State. -%% Collect module metadata which is to be compiled. Only type -%% information is to be kept. - -collect_metas(Ms, L, St) -> - foldl(fun (M, S) -> collect_meta(M, L, S) end, St, Ms). - -collect_meta(type|Tds, L, #cg{mets=Ms}=St) -> - St#cg{mets=Ms ++ {type,Tds,L}}; -collect_meta(opaque|Tds, L, #cg{mets=Ms}=St) -> - St#cg{mets=Ms ++ {opaque,Tds,L}}; -collect_meta(spec|Sps, L, #cg{mets=Ms}=St) -> - St#cg{mets=Ms ++ {spec,Sps,L}}; -collect_meta(record|Rds, L, #cg{mets=Ms}=St) -> - St#cg{mets=Ms ++ {record,Rds,L}}; -collect_meta(_M, _L, St) -> St. %Ignore the rest - -%% collect_attrs(Attributes, Line, State) -> State. -%% Collect module attributes and fill in the #cg state record. Need -%% to ignore all eventual doc attributes. - -collect_attrs(As, L, St) -> - %% io:format("ca: ~p\n", As), - foldl(fun (A, S) -> collect_attr(A, L, S) end, St, As). - -collect_attr(export|Es, _, St) -> collect_exps(Es, St); -collect_attr(import|Is, _, St) -> collect_imps(Is, St); -collect_attr(doc|_, _, St) -> St; %Don't save doc attribute! -collect_attr(N|Vs, L, #cg{atts=As}=St) -> - St#cg{atts=As ++ {N,Vs,L}}. %Probably not many - -collect_exps(all, St) -> St#cg{exps=all}; %Propagate all -collect_exps(_, #cg{exps=all}=St) -> St; -collect_exps(Es, #cg{exps=Exps0}=St) -> - %% Add exports to export set. - Exps1 = foldl(fun (F,A, E) -> add_element({F,A}, E) end, - Exps0, Es), - St#cg{exps=Exps1}. - -collect_imps(Is, St) -> - foldl(fun (I, S) -> collect_imp(I, S) end, St, Is). - -collect_imp('from',Mod|Fs, St) -> - collect_imp(fun (F,A, Imps) -> store({F,A}, F, Imps) end, - 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); -collect_imp('prefix',Mod,Pre, St) -> - Pstr = atom_to_list(Pre), %Store prefix as string - St#cg{pref=store(Pstr, Mod, St#cg.pref)}. - -collect_imp(Fun, Mod, St, Fs) -> - Imps0 = safe_fetch(Mod, St#cg.imps, ), - 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 (Attr) -> - %% io:format("ca: ~p\n", Attr), - comp_attribute(Attr) - end, St1#cg.atts), - Mets = map(fun (Meta) -> - %% io:format("cm: ~p\n", Meta), - comp_metadata(Meta) - end, St1#cg.mets), - %% Both the attributes and saved metadata end up in the attributes. - Catts = Mets ++ Atts, - %% Compile the functions. - {Cdefs,St2} = mapfoldl(fun (D, St) -> comp_define(D, Env, St) end, - St1, St1#cg.defs), - %% Build the final core module structure. - Core1 = update_c_module(Core0, c_atom(St2#cg.module), Exps, Catts, Cdefs), - %% Maybe print lots of debug info. - ?DEBUG("#cg: ~p\n", St2, St2#cg.opts), - ?DEBUG("core_lint: ~p\n", (catch core_lint:module(Core1)), St2#cg.opts), - ?DEBUG("#core: ~p\n", Core1, St2#cg.opts), - %% ?DEBUG("core_pp: ~p\n", - %% (catch io:put_chars(core_pp:format(Core1),$\n)), St2#cg.opts), - {Core1,St2}. - -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). - -add_exports(all, _) -> all; -add_exports(Old, More) -> union(Old, More). - -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). - -%% comp_attribute(Attribute) -> CoreAttr. -%% Compile attributes. - -comp_attribute({N,V,Line}) -> - Ann = Line, - {ann_c_lit(Ann, N),ann_c_lit(Ann, V)}. - -%% comp_metadata(Metadata) -> CoreAttr. -%% Compile metadata handling the special cases. - -comp_metadata({type,Types,Line}) -> - comp_type_metadata(type, Types, Line); -comp_metadata({opaque,Types,Line}) -> - comp_type_metadata(opaque, Types, Line); -comp_metadata({spec,Specs,Line}) -> - comp_spec_metadata(Specs, Line); -comp_metadata({record,Records,Line}) -> - comp_record_metadata(Records, Line); -comp_metadata({N,V,Line}) -> - Ann = Line, - {ann_c_lit(Ann, N),ann_c_lit(Ann, V)}. - -comp_type_metadata(Attr, Types, Line) -> - Ann = Line, - Tfun = fun (Type|Args,Def) -> - {Type, - lfe_types:to_type_def(Def, Ann), - lfe_types:to_type_defs(Args, Ann)} - end, - Tdefs = Tfun(Type) || Type <- Types , - {ann_c_lit(Ann, Attr),ann_c_lit(Ann, Tdefs)}. - -comp_spec_metadata(Specs, Line) -> - Ann = Line, - Sfun = fun (N,Ar,Spec) -> - {{N,Ar},lfe_types:to_func_spec_list(Spec, Ann)} - end, - Fspecs = Sfun(Spec) || Spec <- Specs , - {ann_c_lit(Ann, spec),ann_c_lit(Ann, Fspecs)}. - -%% comp_record_metadata(Records, Line) -> Metadata. -%% Format depends on whether 18 and older or newer. - --ifdef(NEW_REC_CORE). -comp_record_metadata(Recs, Line) -> - Ann = Line, - Rfun = fun (Name|Fields) -> - {Name, comp_record_field(Fdef, Ann) || Fdef <- Fields } - end, - Rs = Rfun(Rec) || Rec <- Recs , - {ann_c_lit(Ann, record),ann_c_lit(Ann, Rs)}. --else. -comp_record_metadata(Recs, Line) -> - Ann = Line, - Rfun = fun (Name|Fields) -> - {{record,Name}, - comp_record_field(Fdef, Ann) || Fdef <- Fields } - end, - Rs = Rfun(Rec) || Rec <- Recs , - {ann_c_lit(Ann, type),ann_c_lit(Ann, Rs)}. --endif. - -comp_record_field(F,D,T, Ann) -> + %% Collect all the module attributes and output them first. + St1 = collect_mod_defs(Mfs, St0), + Attrs = compile_attributes(St1), + %% Now we do the meta, function and record forms in order. Here we + %% can get translation errors. + %% Forms = compile_forms(Mfs, St1), + {Forms,St2} = + try + {compile_forms(Mfs, St1),St1} + catch + error:{illegal_code,Line,Code} -> + {,add_error(Line, {illegal_code,Code}, St1)} + end, + {Attrs ++ Forms,St2}. + +%% collect_mod_defs(ModuleForms, State) -> State. +%% Collect the attribute information in define-module and +%% extend-module's which must be first in the output file. + +collect_mod_defs(Mfs, St) -> + lists:foldl(fun collect_mod_def/2, St, Mfs). + +collect_mod_def({'define-module',Mod,_Metas,Attrs,Line}, St0) -> + St1 = coll_mdef_attrs(Attrs, Line, St0), + St1#lfe_cg{module=Mod,mline=Line}; +collect_mod_def({'extend-module',_Metas,Attrs,Line}, St0) -> + coll_mdef_attrs(Attrs, Line, St0); +collect_mod_def({'define-struct',_Fields,Line}, St) -> + %% Export the struct functions. + coll_mdef_attr(export,'__struct__',0,'__struct__',1, Line, St); +collect_mod_def({'define-function',Name,_Meta,Def,Line}, + #lfe_cg{defs=Defs}=St) -> + %% Must save all functions for export all. + St#lfe_cg{defs=Defs ++ {Name,Def,Line}}; +collect_mod_def(_Form, St) -> St. %Ignore everything else here + +%% coll_mdef_attrs(Attributes, Line, State) -> State. +%% Collect all the module attributes. + +coll_mdef_attrs(Attrs, Line, St) -> + lists:foldl(fun (A, S) -> coll_mdef_attr(A, Line, S) end, St, Attrs). + +coll_mdef_attr(export|Es, _Line, St) -> + coll_mdef_exps(Es, St); +coll_mdef_attr(import|Is, _Line, St) -> + coll_mdef_imps(Is, St); +coll_mdef_attr('module-alias'|As, _Line, St) -> + coll_mdef_aliases(As, St); +coll_mdef_attr(on_load,Onload, _Line, St) -> + coll_mdef_onload(Onload, St); +%% Explicitly ignore any doc or record information here. +coll_mdef_attr(doc|_, _Line, St) -> St; +coll_mdef_attr(record|_, _Line, St) -> St; +%% Save anything else and get the format right. +coll_mdef_attr(Name,Val, Line, #lfe_cg{atts=As}=St) -> + St#lfe_cg{atts=As ++ {Name,Val,Line}}; +coll_mdef_attr(Name|Vals, Line, #lfe_cg{atts=As}=St) -> + St#lfe_cg{atts=As ++ {Name,Vals,Line}}. + +%% coll_mdef_exps(Export, State) -> State. +%% Collect exports special casing 'all'. + +coll_mdef_exps(all, St) -> St#lfe_cg{exports=all}; +coll_mdef_exps(_Exps, #lfe_cg{exports=all}=St) -> St; +coll_mdef_exps(Exps, #lfe_cg{exports=Exps0}=St) -> + Exps1 = lists:foldl(fun (F,A, E) -> ordsets:add_element({F,A}, E) end, + Exps0, Exps), + St#lfe_cg{exports=Exps1}. + +%% coll_mdef_imps(Imports, State) -> State. +%% Collect imports keeping track of local and imported names. + +coll_mdef_imps(Imps, St) -> + lists:foldl(fun (I, S) -> coll_mdef_imp(I, S) end, St, Imps). + +coll_mdef_imp('from',Mod|Fs, St) -> + Ifun = fun (F,A, Ifs) -> orddict:store({F,A}, {Mod,F}, Ifs) end, + coll_mdef_imp(Ifun, St, Fs); +coll_mdef_imp('rename',Mod|Fs, St) -> + %% Get it right here, R is the renamed local called function, F is + %% the name in the other module. + Ifun = fun (F,A,R, Ifs) -> orddict:store({R,A}, {Mod,F}, Ifs) end, + coll_mdef_imp(Ifun, St, Fs). + +coll_mdef_imp(Fun, #lfe_cg{imports=Imps0}=St, Fs) -> + Imps1 = lists:foldl(Fun, Imps0, Fs), + St#lfe_cg{imports=Imps1}. + +%% coll_mdef_aliases(Aliases, State) -> State. +%% Collect the module aliases. + +coll_mdef_aliases(As, #lfe_cg{aliases=Als0}=St) -> + Als1 = lists:foldl(fun (M,A, Mas) -> orddict:store(A, M, Mas) end, + Als0, As), + St#lfe_cg{aliases=Als1}. + +%% coll_mdef_onload(Onload, State) -> +%% Collect the on_load function name. + +coll_mdef_onload(Name,Ar, St) -> + St#lfe_cg{onload={Name,Ar}}. + +%% compile_attributes(State) -> MdefAST. +%% Compile the module attributes. + +compile_attributes(St) -> + Exp = comp_export(St), + Imps = comp_imports(St), + Onload = comp_onload(St), + Atts = comp_attributes(St), + Mline = St#lfe_cg.mline, + %% Collect all the attributes. + AST = make_attribute(file, {St#lfe_cg.file,Mline}, Mline), + make_attribute(module, St#lfe_cg.module, Mline), + Exp | + Onload ++ Imps ++ Atts, + AST. + +%% compile_forms(ModuleForms, State) -> AST. +%% Compile the function and record forms into Erlang ASTs. + +compile_forms(Forms, St) -> + lists:flatmap(fun (F) -> compile_form(F, St) end, Forms). + +compile_form({'define-module',_Mod,Metas,_Attrs,Line}, St) -> + comp_mod_metas(Metas, Line, St); +compile_form({'extend-module',Metas,_Attrs,Line}, St) -> + comp_mod_metas(Metas, Line, St); +compile_form({'define-type',Type,Def,Line}, _St) -> + comp_type_def(type, Type, Def, Line); +compile_form({'define-opaque-type',Type,Def,Line}, _St) -> + comp_type_def(opaque, Type, Def, Line); +compile_form({'define-function-spec',Func,Spec,Line}, _St) -> + comp_function_spec(Func, Spec, Line); +compile_form({'define-record',Name,Fields,Line}, _St) -> + comp_record_def(Name, Fields, Line); +compile_form({'define-struct',Fields,Line}, St) -> + comp_struct_def(Fields, Line, St); +compile_form({'define-function',Name,_Meta,Def,Line}, St) -> + comp_function_def(Name, Def, Line, St); +%% Ignore anything else for now. Hopefully there shouldn't be anything +%% else. +compile_form(_Other, _St) -> . + +%% comp_mod_metas(Metas, Line, State) -> AST. + +comp_mod_metas(Metas, Line, _St) -> + lists:flatmap(fun (M) -> comp_mod_meta(M, Line) end, Metas). + +comp_mod_meta(type|Tdefs, Line) -> + lists:flatmap(fun (Tdef) -> comp_type_def(type, Tdef, Line) end, Tdefs); +comp_mod_meta(opaque|Tdefs, Line) -> + lists:flatmap(fun (Tdef) -> comp_type_def(opaque, Tdef, Line) end, Tdefs); +comp_mod_meta(spec|Fspecs, Line) -> + Fun = fun (Fspec) -> comp_function_spec(Fspec, Line) end, + lists:flatmap(Fun, Fspecs); +comp_mod_meta(record|Rdefs, Line) -> + Fun = fun (Rdef) -> comp_record_def(Rdef, Line) end, + lists:flatmap(Fun, Rdefs); +comp_mod_meta(_Meta, _Line) -> . + +%% comp_type_def(Attr, TypeDef, Line) -> AST. +%% comp_type_def(Attr, Type, Def, Line) -> AST. + +comp_type_def(Attr, Type,Def, Line) -> + comp_type_def(Attr, Type, Def, Line). + +comp_type_def(Attr, Type|Args, Def, Line) -> + Tdef = {Type, + lfe_types:to_type_def(Def, Line), + lfe_types:to_type_defs(Args, Line)}, + make_attribute(Attr, Tdef, Line). + +%% comp_function_spec(FuncSpec, Line) -> AST. +%% comp_function_spec(Func, Spec, Line) -> AST. + +comp_function_spec(Func|Spec, Line) -> + comp_function_spec(Func, Spec, Line). + +comp_function_spec(Name,Ar, Spec, Line) -> + Sdef = {{Name,Ar},lfe_types:to_func_spec_list(Spec, Line)}, + make_attribute(spec, Sdef, Line). + +%% comp_function_def(Func, Def, Line, State) -> AST. +%% Lambda lift the function returning all the functions. + +comp_function_def(Name, Def, Line, #lfe_cg{imports=Imps,aliases=Aliases}) -> + %% This also returns the defined top function. + Lfs = lfe_codelift:function(Name, Def, Line), + lists:map(fun ({N,D,L}) -> + {'fun',_,{clauses,Clauses}} = + lfe_translate:to_expr(D, L, {Imps,Aliases}), + {function,L,N,func_arity(D),Clauses} + end, Lfs). + +%% comp_record_def(RecordDef, Line) -> Attribute. +%% comp_record_def(Name, Fields, Line) -> Attribute. +%% Format depends on whether 18 and older or newer. Meta is not +%% passed on. + +comp_record_def(Name,Fields, Line) -> + comp_record_def(Name, Fields, Line). + +comp_record_def(Name, Fields, Line) -> + Fdefs = comp_record_field(Fdef, Line) || Fdef <- Fields , + make_record_attribute(Name, Fdefs, Line). + +comp_record_field(F,D,T, Line) -> {typed_record_field, - comp_untyped_field(F,D, Ann), - lfe_types:to_type_def(T, Ann)}; -comp_record_field(Fd, Ann) -> - comp_untyped_field(Fd, Ann). - -comp_untyped_field(F,?Q(undefined), Ann) -> %No need for undefined default - {record_field,Ann,{atom,Ann,F}}; -comp_untyped_field(F,D, Ann) -> - {record_field,Ann,{atom,Ann,F},lfe_trans:to_expr(D, Ann)}; -comp_untyped_field(F, Ann) -> - {record_field,Ann,{atom,Ann,F}}. - -%% comp_define(DefForm, Env, State) -> {Corefunc,State}. -%% Compile a top-level define. Sets current function name. Be careful -%% with annotations as dialyzer then sometimes goes crazy. - -comp_define({Name,Def,L}, Env, St) -> - Ann = L, - Cf = {Name,func_arity(Def)}, %Is useful - comp_func(Name, Def, Env, L, St#cg{func=Cf,line=L,vc=0,fc=0,anno=Ann}). - -%% comp_body(BodyList, Env, Line, State) -> {CoreBody,State}. -%% Compile a body list of expressions. - -comp_body(E, Env, L, St) -> comp_expr(E, Env, L, St); -comp_body(E|Es, Env, L, St0) -> - {Ce,St1} = comp_expr(E, Env, L, St0), - {Cb,St2} = comp_body(Es, Env, L, St1), - {append_c_seq(Ce, Cb, L),St2}; %Flatten nested sequences -comp_body(, _, _, St) -> {c_nil(),St}. %Empty body returns - -%% append_c_seq(Expr, Body, Line) -> {CoreBody}. -%% Create a c_seq with Expr and Body by appending Body to the end of -%% Expr c_seq chain if there is one. We get flat sequence. - -append_c_seq(Ce, Cb, L) -> - case is_c_seq(Ce) of - true -> - update_c_seq(Ce, seq_arg(Ce), append_c_seq(seq_body(Ce), Cb, L)); - false -> ann_c_seq(L, Ce, Cb) - end. - -%% comp_expr(Expr, Env, Line, State) -> {CoreExpr,State}. -%% Compile an expression. - -%% Handle the Core data special forms. -comp_expr(quote,E, _, _, St) -> {comp_lit(E),St}; -comp_expr(cons,H,T, Env, L, St) -> - Cons = fun (Ch,Ct, _, _, Sta) -> {c_cons(Ch, Ct),Sta} end, - comp_args(H,T, Cons, Env, L, St); -comp_expr(car,E, Env, L, St) -> %Provide lisp names - comp_bif_call(hd, E, Env, L, St); -comp_expr(cdr,E, Env, L, St) -> - comp_bif_call(tl, E, Env, L, St); -comp_expr(list|Es, Env, L, St) -> - List = fun (Ces, _, _, Sta) -> - {foldr(fun (E, T) -> c_cons(E, T) end, c_nil(), Ces),Sta} - end, - comp_args(Es, List, Env, L, St); -comp_expr(tuple|As, Env, L, St) -> - Args = fun (Args, _, _, Sta) -> {c_tuple(Args),Sta} end, - comp_args(As, Args, Env, L, St); -comp_expr(tref,Tup,I, Env, L, St) -> - comp_bif_call(element, I,Tup, Env, L, St); -comp_expr(tset,Tup,I,V, Env, L, St) -> - comp_bif_call(setelement, I,Tup,V, Env, L, St); -comp_expr(binary|Segs, Env, L, St) -> - comp_binary(Segs, Env, L, St); %And bitstring as well -comp_expr(map|As, Env, L, St) -> - comp_map(As, Env, L, St); -comp_expr('mref',Map,K, Env, L, St) -> - %% Sneaky, but no other real option for now. - comp_expr(call,?Q(maps),?Q(get),K,Map, Env, L, St); -comp_expr('mset',Map|As, Env, L, St) -> - comp_set_map(Map, As, Env, L, St); -comp_expr('mupd',Map|As, Env, L, St) -> - comp_upd_map(Map, As, Env, L, St); -comp_expr('map-get',Map,K, Env, L, St) -> - comp_expr('mref',Map,K, Env, L, St); -comp_expr('map-set',Map|As, Env, L, St) -> - comp_expr('mset',Map|As, Env, L, St); -comp_expr('map-update',Map|As, Env, L, St) -> - comp_expr('mupd',Map|As, Env, L, St); -comp_expr(function,F,Ar, Env, L, St) -> - %% In general case create a lambda. - Args = new_vars(Ar), - Body = F|Args, - comp_lambda(Args, Body, Env, L, St); -comp_expr(function,M,F,Ar, Env, L, St) -> - %% The arguments are all literals. - comp_bif_call(make_fun, ?Q(M),?Q(F),Ar, Env, L, St); -%% Handle the Core closure special forms. -comp_expr(lambda,Args|Body, Env, L, St) -> - comp_lambda(Args, Body, Env, L, St); -comp_expr('match-lambda'|Cls, Env, L, St) -> - comp_match_lambda(Cls, Env, L, St); -comp_expr('let',Vbs|Body, Env, L, St) -> - comp_let(Vbs, Body, Env, L, St); -comp_expr('let-function',Fbs|Body, Env, L, St) -> - comp_let_function(Fbs, Body, Env, L, St); -comp_expr('letrec-function',Fbs|Body, Env, L, St) -> - comp_letrec_function(Fbs, Body, Env, L, St); -%% (let-syntax ...) should never be seen here! -%% Handle the Core control special forms. -comp_expr('progn'|Body, Env, L, St) -> - comp_body(Body, Env, L, St); -comp_expr('if'|Body, Env, L, St) -> - comp_if(Body, Env, L, St); -comp_expr('case',Expr|Cls, Env, L, St) -> - comp_case(Expr, Cls, Env, L, St); -comp_expr('receive'|Cls, Env, L, St0) -> - {Ccs,Ct,Ca,St1} = rec_clauses(Cls, Env, L, St0), - {ann_c_receive(L, Ccs, Ct, Ca),St1}; -comp_expr('catch'|Body, Env, L, St0) -> - {Cb,St1} = comp_body(Body, Env, L, St0), - {ann_c_catch(L, Cb),St1}; -comp_expr('try'|B, Env, L, St) -> - comp_try(B, Env, L, St); -comp_expr('funcall',F|As, Env, L, St) -> - comp_funcall(F, As, Env, L, St); -%%comp_expr(call,quote,erlang,quote,primop|As, Env, L, St) -> -%% An interesting thought to open up system. -comp_expr(call,M,N|As, Env, L, St) -> - %% Call a function in another module. - Call = fun (Cm,Cn|Cas, _, Li, Sta) -> - Ann = line_file_anno(Li, Sta), - {ann_c_call(Ann, Cm, Cn, Cas),Sta} - end, - comp_args(M,N|As, Call, Env, L, St); -%% General function calls. -comp_expr(Fun|As, Env, L, St) when is_atom(Fun) -> - %% Fun is a symbol which is either a known BIF or function. - Call = fun (Cas, En, Li, Sta) -> - Ar = length(Cas), - Ann = line_file_anno(Li, Sta), - case get_fbinding(Fun, Ar, En) of - {yes,M,F} -> %BIF or import - {ann_c_call(Ann, c_atom(M), c_atom(F), Cas),Sta}; - {yes,Name} -> - %% Might have been renamed, use real function name. - {ann_c_apply(Ann, c_fname(Name, Ar), Cas),Sta}; - no -> - %% io:format("ce: ~p\n", {{Fun,Ar},En}), - error(foo) - end - end, - comp_args(As, Call, Env, L, St); -comp_expr(Symb, _, _, St) when is_atom(Symb) -> - {c_var(Symb),St}; -%% Everything is a literal constant (nil, tuples, numbers, binaries, maps). -comp_expr(Const, _, _, St) -> - {comp_lit(Const),St}. - -%% get_fbinding(NAme, Arity, Env) -> -%% {yes,Module,Fun} | {yes,Binding} | no. -%% Get the function binding. Locally bound function takes precedence -%% over auto-imported BIFs. - -get_fbinding(Name, Ar, Env) -> - case lfe_env:get_fbinding(Name, Ar, Env) of - {yes,_,_}=Yes -> Yes; %Imported function - {yes,_}=Yes -> Yes; %Bound function - no -> - case lfe_internal:is_lfe_bif(Name, Ar) of - true -> {yes,lfe,Name}; %Auto-imported LFE BIF - false -> - case lfe_internal:is_erl_bif(Name, Ar) of - true -> %Auto-imported Erlang BIF - {yes,erlang,Name}; - false -> no - end - end - end. - -%% comp_bif_call(Bif, Args, Env, Line, State) -> {Call,State}. -%% Call a BIF in the erlang module. - -comp_bif_call(Bif, As, Env, L, St) -> - Call = fun(Cas, _, Li, Sta) -> - Ann = line_file_anno(Li, Sta), - {ann_c_call(Ann, c_atom(erlang), c_atom(Bif), Cas),Sta} - end, - comp_args(As, Call, Env, L, St). - -%% comp_args(Args, CallFun, Env, Line, State) -> {Call,State}. -%% Sequentialise the evaluation of Args building the Call at the -%% bottom. For non-simple arguments use let to break the arg -%% evaluation out from the main call. - -comp_args(As, Call, Env, L, St0) -> - {Cas,St1} = mapfoldl(fun (A, St) -> comp_expr(A, Env, L, St) end, St0, As), - simple_seq(Cas, Call, Env, L, St1). - -%% simple_seq(CoreExps, Then, Env, Line, State) -> {Cepxr,State}. -%% Sequentialise the evaluation of a sequence of core expressions -%% using let's for non-simple exprs, and call Then with the simple -%% core sequence. Cannot use a simple foldr as we pass data both in -%% and out. - -simple_seq(Ces, Then, Env, L, St) -> simple_seq(Ces, Then, , Env, L, St). - -simple_seq(Ce|Ces, Then, Ses, Env, L, St0) -> - %% Use erlang core compiler lib which does what we want. - case is_simple(Ce) of - true -> simple_seq(Ces, Then, Ce|Ses, Env, L, St0); - false -> - {Cv,St1} = new_c_var(L, St0), - {Rest,St2} = simple_seq(Ces, Then, Cv|Ses, Env, L, St1), - {ann_c_let(L, Cv, Ce, Rest),St2} - end; -simple_seq(, Then, Ses, Env, L, St) -> - Then(reverse(Ses), Env, L, St). - -%% comp_lambda(Args, Body, Env, Line, State) -> {c_fun(),State}. -%% Compile a (lambda (...) ...). - -comp_lambda(Args, Body0, Env, L, St0) -> - {Cvs,Pvs,Ts,St1} = comp_lambda_args(Args, L, St0), - Body1 = add_guard_tests(Ts, Body0), - {Cb,St2} = comp_body(Body1, add_vbindings(Pvs, Env), L, St1), - Ann = line_file_anno(L, St2), - {ann_c_fun(Ann, Cvs, Cb),St2}. - -comp_lambda_args(Args, L, St) -> - foldr(fun (A, {Cvs,Pvs0,Ts0,St0}) -> - {Cv,Pvs1,Ts1,St1} = pat_symb(A, L, Pvs0, Ts0, St0), - {Cv|Cvs,Pvs1,Ts1,St1} - end, {,,,St}, Args). - -%% lambda_arity(Args|_) -> length(Args). - -%% comp_match_lambda(Clauses, Env, Line, State) -> {c_fun(),State}. -%% (match-lambda (Pat ...) ...). - -comp_match_lambda(Cls, Env, L, St0) -> - Ar = match_lambda_arity(Cls), - {Cvs,St1} = new_c_vars(Ar, L, St0), - {Ccs,St2} = comp_match_clauses(Cls, Env, L, St1), - {Fvs,St3} = new_c_vars(Ar, L, St2), - Cf = func_fail(Fvs, L, St3), - Ann = line_file_anno(L, St3), - Cb = ann_c_case(Ann, ann_c_values(Ann, Cvs), Ccs ++ Cf), - {ann_c_fun(Ann, Cvs, Cb),St3}. - -func_fail(Fvs, L, #cg{func=F}=St) -> - %% We need function_name anno to generate function_clause error. - fail_clause(Fvs, c_tuple(c_atom(function_clause)|Fvs), - {function_name,F}, L, St). - -%% match_lambda_arity(MatchClauses) -> int(). - -match_lambda_arity(Pats|_|_) -> length(Pats). - -comp_match_clauses(Cls, Env, L, St) -> - mapfoldl(fun (Cl, Sta) -> comp_match_clause(Cl, Env, L, Sta) end, - St, Cls). - -%% comp_match_clause(Clause, Env, L, State) -> {c_clause(),State}. -%% (Pats (when Guard) . Body) -%% Pats is here a list of patterns which are the function clause -%% arguments. This must be compiled to a list of patterns not a -%% pattern with a list! - -comp_match_clause(Pats|Body0, Env0, L, St0) -> - Pfun = fun (P, {Pvsa,Vtsa,Sta}) -> - {Cp,Pvsb,Vtsb,Stb} = pattern(P, L, Pvsa, Vtsa, Sta), - {Cp,{Pvsb,Vtsb,Stb}} - end, - {Cps,{Pvs,Vts,St1}} = mapfoldl(Pfun, {,,St0}, Pats), - %% io:format("~p\n", {Cps,Vts}), - Env1 = add_vbindings(Pvs, Env0), - Body1 = add_guard_tests(Vts, Body0), - {Cg,Cb,St2} = comp_clause_body(Body1, Env1, L, St1), - Ann = line_file_anno(L, St2), - {ann_c_clause(Ann, Cps, Cg, Cb),St2}. - -add_guard_tests(, Body) -> Body; -add_guard_tests(Ts, 'when'|Guard|Body) -> - 'when'|Ts ++ Guard|Body; -add_guard_tests(Ts, Body) -> - 'when'|Ts|Body. - -%% comp_let(VarBindings, Body, Env, L, State) -> {c_let()|c_case(),State}. -%% Compile a let expr. First evaluate all the value expressions in -%% parallel so they don't inherit variables, then build nested cases -%% to do matching optimising case where value bound to variable. Use -%% nested cases so match fail only give one value. Probably not worth -%% the effort as optimiser would do it. - -comp_let(Vbs, B, Env, L, St0) -> - {Cvs,Ces,Cms,St1} = comp_let_vbs(Vbs, Env, L, St0), - {Cb,St2} = comp_let_body(Cms, B, add_vbindings(Cvs, Env), L, St1), - %% Build nesting let which evaluates expressions first. - {ann_c_let(L, Cvs, ann_c_values(L, Ces), Cb),St2}. - -comp_let_vbs(Vbs, Env, L, St) -> - Fun = fun (V,E, {Cvs,Ces,Cms,St0}) when is_atom(V) -> - {Ce,St1} = comp_expr(E, Env, L, St0), - {c_var(V)|Cvs,Ce|Ces,Cms,St1}; - (P,E, {Cvs,Ces,Cms,St0}) -> - {V,St1} = new_var(St0), - {Ce,St2} = comp_expr(E, Env, L, St1), - {c_var(V)|Cvs,Ce|Ces,{P,,V}|Cms,St2}; - (P,'when'|G,E, {Cvs,Ces,Cms,St0}) -> - {V,St1} = new_var(St0), - {Ce,St2} = comp_expr(E, Env, L, St1), - {c_var(V)|Cvs,Ce|Ces,{P,G,V}|Cms,St2} - end, - lists:foldr(Fun, {,,,St}, Vbs). - -comp_let_body({P,G,V}|Cms, B, Env0, L, St0) -> - Cv = c_var(V), - {Cp,Pvs,Vts,St1} = pattern(P, L, St0), - Env1 = add_vbindings(Pvs, Env0), - {Cg,St2} = comp_guard(Vts ++ G, Env1, L, St1), - {Cb,St3} = comp_let_body(Cms, B, Env1, L, St2), - Cf = let_fail(Cv, L, St3), - {ann_c_case(L, Cv, ann_c_clause(L, Cp, Cg, Cb),Cf),St3}; -comp_let_body(, B, Env, L, St0) -> - {Cb,St1} = comp_body(B, Env, L, St0), - {Cb,St1}. - -let_fail(Cv, L, St) -> - fail_clause(Cv, c_tuple(c_atom(badmatch),Cv), , L, St). - -%% comp_let_function(FuncBindngs, Body, Env, Line, State) -> -%% {c_letrec(),State}. -%% Compile an flet. This is complicated by the fact that Core only -%% has letrec so we have to some name munging of the functions to -%% avoid recursive definitions. - -comp_let_function(Fbs0, B, Env0, L, St0) -> - %% Munge names of functions. Don't use new_symb as we want to link - %% new names to original. - Nfun = fun (Old,Def, S0) -> - {New,S1} = new_fun_name(atom_to_list(Old), S0), - {{Old,New,Def},S1} - end, - {Nfbs,St1} = mapfoldl(Nfun, St0, Fbs0), - %% Now compile functions in old environment. - Ffun = fun ({_,New,Def}, St) -> comp_func(New, Def, Env0, L, St) end, - {Cfs,St2} = mapfoldl(Ffun, St1, Nfbs), - %% Add local functions Env mapping old name to new. - Efun = fun ({Old,New,Def}, E) -> - add_fbinding(Old, func_arity(Def), New, E) - end, - Env1 = foldl(Efun, Env0, Nfbs), - {Cb,St3} = comp_body(B, Env1, L, St2), - {ann_c_letrec(L, Cfs, Cb),St3}. - -%% comp_letrec_function(FuncBindngs, Body, Env, Line, State) -> -%% {c_letrec(),State}. - -comp_letrec_function(Fbs, B, Env0, L, St0) -> - %% Add local functions Env. - Efun = fun (Name,Def, E) -> - add_fbinding(Name, func_arity(Def), Name, E) - end, - Env1 = foldl(Efun, Env0, Fbs), - %% Now compile functions in new environment. - Ffun = fun (Name,Def, St) -> comp_func(Name, Def, Env1, L, St) end, - {Cfs,St1} = mapfoldl(Ffun, St0, Fbs), - {Cb,St2} = comp_body(B, Env1, L, St1), - {ann_c_letrec(L, Cfs, Cb),St2}. - -%% func_arity(FuncDef) -> Arity. -%% Return the arity of a function definition. + comp_untyped_field(F,D, Line), + lfe_types:to_type_def(T, Line)}; +comp_record_field(Fd, Line) -> + comp_untyped_field(Fd, Line). + +comp_untyped_field(F,?Q(undefined), Line) -> + %% No need for undefined default. + {record_field,Line,{atom,Line,F}}; +comp_untyped_field(F,D, Line) -> + {record_field,Line,{atom,Line,F},lfe_translate:to_expr(D, Line)}; +comp_untyped_field(F, Line) -> + {record_field,Line,{atom,Line,F}}; +comp_untyped_field(F, Line) -> + {record_field,Line,{atom,Line,F}}. -func_arity(lambda,Args|_) -> length(Args); -func_arity('match-lambda'|Cls) -> - match_lambda_arity(Cls). - -%% comp_func(FuncName, FuncDef, Env, L, State) -> {{Fname,Cfun},State}. -%% NEVER annotate the Fname c-form, dialyzer goes crazy then for some -%% strange reason! - -comp_func(Name, lambda,Args|Body, Env, L, St0) -> - Cf = c_fname(Name, length(Args)), - {Cfun,St1} = comp_lambda(Args, Body, Env, L, St0), - {{Cf,Cfun},St1}; -comp_func(Name, 'match-lambda'|Cls, Env, L, St0) -> - Cf = c_fname(Name, match_lambda_arity(Cls)), - {Cfun,St1} = comp_match_lambda(Cls, Env, L, St0), - {{Cf,Cfun},St1}. - -%% comp_if(IfBody, Env, Line, State) -> {c_case(),State}. -%% Compile in if form to a case testing the Test expression. - -comp_if(Test,True, Env, L, St) -> - comp_if(Test, True, ?Q(false), Env, L, St); -comp_if(Test,True,False, Env, L, St) -> - comp_if(Test, True, False, Env, L, St). - -comp_if(Te, Tr, Fa, Env, L, St0) -> - {Cte,St1} = comp_expr(Te, Env, L, St0), %Test expression - {Ctr,St2} = comp_expr(Tr, Env, L, St1), %True expression - {Cfa,St3} = comp_expr(Fa, Env, L, St2), %False expression - True = c_atom(true), - False = c_atom(false), - Ctrue = ann_c_clause(L, True, Ctr), - Cfalse = ann_c_clause(L, False, Cfa), - Cfail = if_fail(L, St3), - {ann_c_case(L, Cte, Ctrue,Cfalse,Cfail),St3}. - -%% This produces code which is harder to optimise, strangely enough. -%% comp_if(Te, Tr, Fa, Env, L, St0) -> -%% {Cte,St1} = comp_expr(Te, Env, L, St0), %Test expression -%% {Ctr,St2} = comp_expr(Tr, Env, L, St1), %True expression -%% {Cfa,St3} = comp_expr(Fa, Env, L, St2), %False expression -%% If = fun (Ctest, _, _, St) -> -%% True = c_atom(true), -%% False = c_atom(false), -%% Ctrue = ann_c_clause(L, True, Ctr), -%% Cfalse = ann_c_clause(L, Fail, Cfa), -%% Cfail = if_fail(L, St), -%% {ann_c_case(L, Ctest, Ctrue,Cfalse,Cfail),St} -%% end, -%% simple_seq(Cte, If, Env, L, St3). - -if_fail(L, St) -> - Cv = c_var(omega), - fail_clause(Cv, c_atom(if_clause), , L, St). - -%% fail_clause(Pats, Arg, FailAnno, Line, State) -> Clause. -%% Build a general failure clause. No line number in the clause, but -%% append the line number and file name to the annotation. - -fail_clause(Pats, Arg, Fann, L, St) -> - Ann = line_file_anno(L, St), - ann_c_clause(comp_gen_anno(L, St), %It is compiler generated - Pats, ann_c_primop(Fann ++ Ann, c_atom(match_fail), Arg)). - -%% comp_case(Expr, Clauses, Env, Line, State) -> {c_case(),State}. -%% Compile a case. - -comp_case(E, Cls, Env, L, St0) -> - {Ce,St1} = comp_expr(E, Env, L, St0), - {Ccs,St2} = case_clauses(Cls, Env, L, St1), - Cf = case_fail(L, St2), - {ann_c_case(L, Ce, Ccs ++ Cf),St2}. - -case_clauses(Cls, Env, L, St) -> - mapfoldl(fun (Cl, Sta) -> comp_clause(Cl, Env, L, Sta) end, - St, Cls). - -case_fail(L, St) -> - Cv = c_var(omega), - fail_clause(Cv, c_tuple(c_atom(case_clause),Cv), , L, St). - -%% rec_clauses(RecClauses, Env, Line, State) -> {Clause,Timeout,After,State}. - -rec_clauses('after',T|B, Env, L, St0) -> - {Ct,St1} = comp_expr(T, Env, L, St0), - {Ca,St2} = comp_body(B, Env, L, St1), - {,Ct,Ca,St2}; -rec_clauses(Cl|Cls, Env, L, St0) -> - {Cc,St1} = comp_clause(Cl, Env, L, St0), - {Ccs,Ct,Ca,St2} = rec_clauses(Cls, Env, L, St1), - {Cc|Ccs,Ct,Ca,St2}; -rec_clauses(, _, _, St) -> - {,c_atom(infinity),c_atom(true),St}. - -%% comp_clause(Clause, Env, Line, State) -> {c_clause(),State}. -%% This is a case/receive clause where the is only one pattern. - -comp_clause(Pat|Body0, Env0, L, St0) -> - {Cp,Pvs,Vts,St1} = pattern(Pat, L, St0), - Env1 = add_vbindings(Pvs, Env0), - Body1 = add_guard_tests(Vts, Body0), - {Cg,Cb,St2} = comp_clause_body(Body1, Env1, L, St1), - {ann_c_clause(L, Cp, Cg, Cb),St2}. - -comp_clause_body('when'|Guard|Body, Env, L, St0) -> - {Cg,St1} = comp_guard(Guard, Env, L, St0), - {Cb,St2} = comp_body(Body, Env, L, St1), - {Cg,Cb,St2}; -comp_clause_body(Body, Env, L, St0) -> - {Cb,St1} = comp_body(Body, Env, L, St0), - {c_atom(true),Cb,St1}. - -%% comp_try(Body, Env, Line, State) -> {c_try(),State}. -%% Compile a try. We know that case is optional but must have at -%% least one of catch or after. Complicated by the behaviour of the -%% after which means we split try with all parts into two try's. - -comp_try(E|Body, Env, L, St) -> - %% Separate try body into separate bits, none if not there. - Case = tag_tail(Body, 'case'), - Catch = tag_tail(Body, 'catch'), - After = tag_tail(Body, 'after'), - comp_try(E, Case, Catch, After, Env, L, St). %Now build the bugger - -%% comp_try(Exp, Case, Catch, After, Env, L, St) -> {c_try(),State}. - -comp_try(E, Case, , , Env, L, St0) -> - %% No catch or after - (try E (case ...)) - %% This is compiler generated. - {Ce,St1} = comp_expr(E, Env, L, St0), - {Cv,Cc,St2} = try_case(Case, Env, L, St1), - {_,Val,Info=Evs,St3} = new_c_vars(3, L, St2), %Tag, Value, Info - After = raise_primop(Info,Val, L, St2), - Ann = line_file_anno(L, St3), - {ann_c_try(Ann, Ce, Cv, Cc, Evs, After),St3}; -comp_try(E, Case, Catch, , Env, L, St0) -> - %% No after - (try E (case ...) (catch ...)) - {Ce,St1} = comp_expr(E, Env, L, St0), - {Cv,Cc,St2} = try_case(Case, Env, L, St1), - {Evs,Ecs,St3} = try_exception(Catch, Env, L, St2), - Ann = line_file_anno(L, St3), - {ann_c_try(Ann, Ce, Cv, Cc, Evs, Ecs),St3}; -comp_try(E, , , After, Env, L, St0) -> - %% Just after - (try E (after ...)) - {Ce,St1} = comp_expr(E, Env, L, St0), - {Cv,St2} = new_c_var(L, St1), - {Ca,St3} = comp_body(After, Env, L, St2), - Cb = ann_c_seq(L, Ca, Cv), - {Evs,Ecs,St4} = try_after(After, Env, L, St3), - Ann = line_file_anno(L, St4), - {ann_c_try(Ann, Ce, Cv, Cb, Evs, Ecs),St4}; -comp_try(E, Case, Catch, After, Env, L, St) -> - %% Both catch and after - (try E (case ...) (catch ...) (after ...)) - %% The case where all options are given. - Try = 'try',E,'case'|Case,'catch'|Catch, - comp_try(Try, , , After, Env, L, St). - -%% try_case(CaseClauses, Env, Line, State) -> {Var,c_case()|c_var(),State}. -%% Case is optional, no case just returns value. - -try_case(, _, L, St0) -> %No case, just return value - {Cv,St1} = new_c_var(L, St0), - {Cv,Cv,St1}; -try_case(Cls, Env, L, St0) -> - {Cv,St1} = new_c_var(L, St0), - {Ccs,St2} = case_clauses(Cls, Env, L, St1), - Cf = try_case_fail(L, St2), - {Cv,ann_c_case(L, Cv, Ccs ++ Cf),St2}. - -try_case_fail(L, St) -> - Cv = c_var(omega), - fail_clause(Cv, c_tuple(c_atom(try_clause),Cv), , L, St). - -%% try_exception(CatchClauses, Env, L, State) -> {Vars,c_case(),State}. - -try_exception(Cls, Env, L, St0) -> - %% Note that Tag is not needed for rethrow - it is already in Info. - {Cvs,St1} = new_c_vars(3, L, St0), %Tag, Value, Info - {Ccs,St2} = case_clauses(Cls, Env, L, St1), - _,Val,Info = Cvs, - Arg = c_tuple(Cvs), - Fc = ann_c_clause(comp_gen_anno(L, St2), %It is compiler generated - Arg, raise_primop(Info,Val, L, St2)), - Excp = ann_c_case(L, Arg, Ccs ++ Fc), - {Cvs,Excp,St2}. - -%% try_after(AfterBody, Env, L, State) -> {Vars,After,State}. - -try_after(B, Env, L, St0) -> - %% Note that Tag is not needed for rethrow - it is already in Info. - {_,Val,Info=Cvs,St1} = new_c_vars(3, L, St0), %Tag, Value, Info - {Cb,St2} = comp_body(B, Env, L, St1), - After = ann_c_seq(L, Cb, raise_primop(Info,Val, L, St2)), - {Cvs,After,St2}. - -raise_primop(Args, L, _) -> - ann_c_primop(L, c_atom(raise), Args). - -tag_tail(Tag|Tail|_, Tag) -> Tail; -tag_tail(_|Try, Tag) -> tag_tail(Try, Tag); -tag_tail(, _) -> . - -%% comp_funcall(Function, Args, Env, Line, State) -> {Core,State}. -%% Special case if Function is directly function, lambda or -%% match-lambda, convert to a let. Might be useful in macros. We can -%% do this is the lambda body is still "inside" the outer -%% function. If handling of function changes then may need to be -%% changed. - -comp_funcall(function,F,Ar=Func, As, Env, L, St) -> - if Ar == length(As) -> %Check right number of args - Las = new_vars(Ar), - comp_funcall_let(Las, F|Las, As, Env, L, St); - true -> %Catch arg mismatch at runtime - comp_funcall_1(Func, As, Env, L, St) - end; -comp_funcall(lambda,Las|Body=Func, As, Env, L, St) -> - if length(Las) == length(As) -> %Check right number of args - comp_funcall_let(Las, Body, As, Env, L, St); - true -> %Catch arg mismatch at runtime - comp_funcall_1(Func, As, Env, L, St) - end; -comp_funcall('match-lambda'|Cls=Func, As, Env, L, St0) -> - case match_lambda_arity(Cls) == length(As) of - true -> - %% Expand comp_let as we need to special case body. - {Cf,St1} = comp_match_lambda(Cls, Env, L, St0), - Cvs = fun_vars(Cf), - Cb = fun_body(Cf), - Efun = fun (E, St) -> comp_expr(E, Env, L, St) end, - {Ces,St2} = mapfoldl(Efun, St1, As), - {ann_c_let(L, Cvs, ann_c_values(L, Ces), Cb),St2}; - false -> %Catch arg mismatch at runtime - comp_funcall_1(Func, As, Env, L, St0) - end; -comp_funcall(Func, As, Env, L, St0) -> - comp_funcall_1(Func, As, Env, L, St0). %Naively just do it. - -comp_funcall_let(Las, Body, As, Env, L, St) -> - %% Convert into a let. Would like to sequentialise eval of - %% args here but leave that to let. - Vbs = zipwith(fun (V, E) -> V,E end, Las, As), - comp_let(Vbs, Body, Env, L, St). - -comp_funcall_1(Func, As, Env, L, St0) -> - App = fun (Cf|Cas, _, Li, St) -> - Ann = line_file_anno(Li, St), - {ann_c_apply(Ann, Cf, Cas),St} - end, - comp_args(Func|As, App, Env, L, St0). - -%% comp_binary(Segs, Env, Line, State) -> {CbinaryExpr,State}. -%% Compile a binary. - -comp_binary(Segs, Env, L, St0) -> - Vsps = get_bitsegs(Segs), - comp_bitsegs(Vsps, Env, L, St0). - -get_bitsegs(Segs) -> - foldr(fun (Seg, Vs) -> get_bitseg(Seg, Vs) end, , Segs). - -%% get_bitseg(Bitseg, ValSpecs) -> ValSpecs. -%% A bitseg is either an atomic value, a list of value and specs, or -%% a string. Note that this function can prepend a list of valspecs. - -get_bitseg(Val|Specs=F, Vsps) -> - case is_integer_list(F) of %Is bitseg a string? - true -> %A string - {Sz,Ty} = get_bitspecs(), - foldr(fun (V, Vs) -> {V,Sz,Ty}|Vs end, Vsps, F); - false -> %A value and spec - {Sz,Ty} = get_bitspecs(Specs), - case is_integer_list(Val) of %Is val a string? - true -> foldr(fun (V, Vs) -> {V,Sz,Ty}|Vs end, Vsps, Val); - false -> {Val,Sz,Ty}|Vsps %The default - end - end; -get_bitseg(Val, Vsps) -> - {Sz,Ty} = get_bitspecs(), - {Val,Sz,Ty}|Vsps. - -get_bitspecs(Ss) -> - {ok,Sz,Ty} = lfe_bits:get_bitspecs(Ss), - {Sz,Ty}. - -is_integer_list(I|Is) when is_integer(I) -> - is_integer_list(Is); -is_integer_list() -> true; -is_integer_list(_) -> false. - -%% comp_bitsegs(ValSpecs, Env, Line, State) -> {CBitSegs,State}. -%% Compile the bitsegements sequentialising them with simple_seq. - -comp_bitsegs(Vsps, Env, L, St) -> - comp_bitsegs(Vsps, , Env, L, St). - -comp_bitsegs(Vsp|Segs, Csegs, Env, L, St0) -> - {Cval,Csize,Un,Ty,Fs,St1} = comp_bitseg(Vsp, Env, L, St0), - %% Sequentialise Val and Size if necessary, then do rest - Next = fun (Cv,Csz, En, Li, St) -> - Cs = c_bitstr(Cv, Csz, Un, Ty, Fs), - comp_bitsegs(Segs, Cs|Csegs, En, Li, St) - end, - simple_seq(Cval,Csize, Next, Env, L, St1); -comp_bitsegs(, Csegs, _, L, St) -> - {ann_c_binary(L, reverse(Csegs)),St}. - -%% comp_bitseg(ValSpec, Env, Line, State) -> {Cval,Csize,Unit,Type,Fs,State}. -%% Need to handle some special cases. - -comp_bitseg({Val,_,{Ty,_,Si,En}}, Env, L, St0) - when Ty =:= utf8 ; Ty =:= utf16 ; Ty =:= utf32 -> - %% Special case utf types. - {Cval,St1} = comp_expr(Val, Env, L, St0), - Undef = c_atom(undefined), - {Cval,Undef,Undef,c_atom(Ty),c_lit(Si,En),St1}; -comp_bitseg({Val,all,{binary,_,_,_}=Ty}, Env, L, St) -> - comp_bitseg({Val,?Q(all),Ty}, Env, L, St); -comp_bitseg({Val,Sz,{Ty,Un,Si,En}}, Env, L, St0) -> - {Cval,St1} = comp_expr(Val, Env, L, St0), - {Csize,St2} = comp_expr(Sz, Env, L, St1), - {Cval,Csize,c_int(Un),c_atom(Ty),c_lit(Si,En),St2}. - -%% comp_map(Args, Env, Line, State) -> {Core,State}. -%% comp_set_map(Map, Args, Line, State) -> {Core,State}. -%% comp_upd_map(Map, Args, Line, State) -> {Core,State}. - --ifdef(HAS_MAPS). - -%% There is no need to check for HAS_FULL_KEYS here as the linter will -%% catch the limited code. The setting/updating maps operations need -%% to be wrapped with an 'if' which does an explicit test that the map -%% argument is a map. This does not have exactly the same structure -%% and annotations as a "normal" 'if'. - -comp_map(Args, Env, Line, St0) -> - Mapper = fun (Cas, _, L, St1) -> - Cpairs = comp_map_pairs(Cas, assoc, L), - {ann_c_map(L, c_lit(#{}), Cpairs),St1} - end, - comp_args(Args, Mapper, Env, Line, St0). - -comp_set_map(Map, Args, Env, Line, St) -> - comp_modify_map(Map, Args, assoc, Env, Line, St). - -comp_upd_map(Map, Args, Env, Line, St) -> - comp_modify_map(Map, Args, exact, Env, Line, St). - -comp_modify_map(Map, Args, Key, Env, Line, St0) -> - %% Evaluate map, keys and values and build modify form. - Mapper = fun (Cm|Cas, E, L, St) -> - Cpairs = comp_map_pairs(Cas, Key, L), - comp_map_test(Cm, Cpairs, E, L, St) - end, - comp_args(Map|Args, Mapper, Env, Line, St0). - -comp_map_test(Cm, Cpairs, _, L, St) -> - %% Build map type tester. - Ann = line_file_anno(L, St), - Cmap = ann_c_clause(compiler_generated|Ann, , - ann_c_call(Ann, ann_c_atom(Ann, erlang), - ann_c_atom(Ann, is_map), Cm), - ann_c_map(Ann, Cm, Cpairs)), - Cfail = map_fail(Cm, L, St), - {ann_c_case(Ann, ann_c_values(Ann, ), Cmap,Cfail),St}. - -map_fail(_Map, L, St) -> - Fann = {eval_failure,badmap}, - fail_clause(, c_atom(badmap), Fann, L, St). -%% fail_clause(, c_tuple(c_atom(badmap),Map), Fann, L, St). - -comp_map_pairs(K,V|Ps, Op, L) -> - ann_c_map_pair(L, c_lit(Op), K, V)|comp_map_pairs(Ps, Op, L); -comp_map_pairs(, _, _) -> . --else. -%% These are just dummy functions which will never be called as -%% lfe_lint will catch these forms. - -comp_map(_, _, _, St) -> {c_lit(map),St}. -comp_set_map(_, _, _, _, St) -> {c_lit(map),St}. -comp_upd_map(_, _, _, _, St) -> {c_lit(map),St}. --endif. - -%% comp_guard(GuardTests, Env, Line, State) -> {CoreGuard,State}. -%% Can compile much of the guard as an expression but must wrap it -%% all in a try, which we do here. This try handles exceptions in the -%% guard and has a very rigid structure. - -comp_guard(, _, _, St) -> {c_atom(true),St}; %The empty guard -comp_guard(Gts, Env, L, St0) -> - {Ce,St1} = comp_guard_tests(Gts, Env, L, St0), %Guard expression - %% Can hard code the rest! - Cv = c_var('Try'), - Evs = c_var('T'),c_var('R'), %Why only two? - False = c_atom(false), %Exception returns false - Ann = line_file_anno(L, St1), - {ann_c_try(Ann, Ce, Cv, Cv, Evs, False),St1}. - -%% comp_guard_tests(GuardTests, Env, Line, State) -> {CoreTest,State}. -%% Compile a guard test, making sure it returns a boolean value. We -%% do this in a naive way by always explicitly comparing the result -%% to 'true' and letting the optimiser clean this up. Ignore errors. - -comp_guard_tests(Gts, Env, Line, St0) -> - {Gas,St1} = mapfoldl(fun (Gt, St) -> comp_guard_test(Gt, Env, Line, St) end, - St0, Gts), - Ands = fun guard_ands/4, - simple_seq(Gas, Ands, Env, Line, St1). - -guard_ands(Ga, _, _, St) -> {Ga,St}; -guard_ands(G1,G2, _, Line, St) -> - {ann_c_call(Line, c_atom(erlang), c_atom('and') , G1,G2), St}; -guard_ands(G1,G2|Gas, Env, Line, St0) -> - {Cv,St1} = new_c_var(Line, St0), - {Gr,St2} = guard_ands(Cv|Gas, Env, Line, St1), - And = ann_c_call(Line, c_atom(erlang), c_atom('and'), G1,G2), - {ann_c_let(Line, Cv, And, Gr),St2}. - -%% comp_guard_test(Test, Env, Line, State) -> {CoreTest,State}. -%% Compile one test. We try to avoid generating an unnecessary true -%% test by checking the test and only adding one when we know the -%% test won't automatically return a boolean value. - -comp_guard_test(quote,Bool, _, _, St) when is_boolean(Bool) -> - {c_atom(Bool),St}; %A small optimisation -comp_guard_test(call,quote,erlang,quote,Op|Args=Test, Env, L, St) -> - comp_guard_test_1(Test, Op, Args, Env, L, St); -comp_guard_test(Op|Args=Test, Env, L, St) -> - comp_guard_test_1(Test, Op, Args, Env, L, St); -comp_guard_test(Symb, _, L, St) when is_atom(Symb) -> - Ann = comp_gen_anno(L, St), - {ann_c_call(Ann, c_atom(erlang), c_atom('=:='), c_var(Symb),c_atom(true)), - St}; -comp_guard_test(_, _, _, St) -> - %% Everything else always will always fail. - {c_atom(false),St}. - -comp_guard_test_1(Test, Op, Args, Env, L, St0) -> - Ar = length(Args), - %% Check if this is a boolean test, else add a boolean test. - case erl_internal:bool_op(Op, Ar) orelse - erl_internal:comp_op(Op, Ar) orelse - erl_internal:type_test(Op, Ar) of - true -> %It's already boolean - comp_gexpr(Test, Env, L, St0); - false -> %No it's not, then make it one - Call = fun (Cas, _, Li, St) -> - Ann = comp_gen_anno(Li, St), - {ann_c_call(Ann, c_atom(erlang), c_atom('=:='), Cas), - St} - end, - comp_gargs(Test,?Q(true), Call, Env, L, St0) - end. - -%% comp_gexpr(Expr, Env, Line, State) -> {CoreExpr,State}. - -%% Handle the Core data special forms. -comp_gexpr(quote,E, _, _, St) -> {comp_lit(E),St}; -comp_gexpr(cons,H,T, Env, L, St0) -> - Cons = fun (Ch,Ct, _, _, St1) -> {c_cons(Ch, Ct),St1} end, - comp_gargs(H,T, Cons, Env, L, St0); -comp_gexpr(car,E, Env, L, St) -> %Provide lisp names - comp_gcall(hd, E, Env, L, St); -comp_gexpr(cdr,E, Env, L, St) -> - comp_gcall(tl, E, Env, L, St); -comp_gexpr(list|Es, Env, L, St0) -> - List = fun (Ces, _, _, St1) -> - {foldr(fun (E, T) -> c_cons(E, T) end, c_nil(), Ces),St1} - end, - comp_gargs(Es, List, Env, L, St0); -comp_gexpr(tuple|As, Env, L, St0) -> - Tuple = fun (Args, _, _, St1) -> {c_tuple(Args),St1} end, - comp_gargs(As, Tuple, Env, L, St0); -comp_gexpr(tref,Tup,I, Env, L, St) -> - comp_gcall(element, I,Tup, Env, L, St); -comp_gexpr(binary|Segs, Env, L, St) -> - comp_binary(Segs, Env, L, St); %And bitstring as well -%% Map operations are not allowed in guards. -%% Handle the Core closure special forms. -%% (let-syntax ...) should never be seen here! -%% Handle the Core control special forms. -comp_gexpr('progn'|Body, Env, L, St) -> - comp_guard_tests(Body, Env, L, St); -comp_gexpr('if'|Body, Env, L, St) -> - comp_gif(Body, Env, L, St); -comp_gexpr(call,quote,erlang,quote,Fun|As, Env, L, St) -> - comp_gcall(Fun, As, Env, L, St); -%% Finally the not so general case. -comp_gexpr(Fun|As, Env, L, St) -> - comp_gcall(Fun, As, Env, L, St); -comp_gexpr(Symb, _, _, St) when is_atom(Symb) -> - {c_var(Symb),St}; -%% Everything is a literal constant (nil, tuples, numbers, binaries). -comp_gexpr(Const, _, _, St) -> - {comp_lit(Const),St}. - -%% comp_gcall(Function, Args, Env, Line, State) -> {Call,State}. -%% Only guard BIFs can be called in the guard. - -comp_gcall(Fun, As, Env, L, St) -> - Call = fun (Cas, _, Li, Sta) -> - Ann = line_file_anno(Li, Sta), - {ann_c_call(Ann, c_atom(erlang), c_atom(Fun), Cas),Sta} - end, - comp_gargs(As, Call, Env, L, St). - -%% comp_gargs(Args, CallFun, Env, Line, State) -> {Call,State}. - -comp_gargs(As, Call, Env, L, St0) -> - {Cas,St1} = mapfoldl(fun (A, St) -> comp_gexpr(A, Env, L, St) end, St0, As), - simple_seq(Cas, Call, Env, L, St1). - -%% comp_gif(IfBody, Env, Line, State) -> {c_case(),State}. -%% Compile in if form to a case testing the Test expression. - -comp_gif(Test,True, Env, L, St) -> - comp_gif(Test, True, ?Q(false), Env, L, St); -comp_gif(Test,True,False, Env, L, St) -> - comp_gif(Test, True, False, Env, L, St). - -comp_gif(Te, Tr, Fa, Env, L, St0) -> - {Cte,St1} = comp_gexpr(Te, Env, L, St0), %Test expression - {Ctr,St2} = comp_gexpr(Tr, Env, L, St1), %True test - {Cfa,St3} = comp_gexpr(Fa, Env, L, St2), %False test - True = c_atom(true), - False = c_atom(false), - Omega = c_var(omega), - Ctrue = ann_c_clause(L, True, Ctr), - Cfalse = ann_c_clause(L, False, Cfa), - Cfail = ann_c_clause(comp_gen_anno(L, St3), Omega, Omega), - {ann_c_case(L, Cte, Ctrue,Cfalse,Cfail),St3}. - -%% This produces code which is harder to optimise, strangely enough. -%% comp_gif(Te, Tr, Fa, Env, L, St0) -> -%% {Cte,St1} = comp_gexpr(Te, Env, L, St0), %Test expression -%% {Ctr,St2} = comp_gexpr(Tr, Env, L, St1), %True expression -%% {Cfa,St3} = comp_gexpr(Fa, Env, L, St2), %False expression -%% If = fun (Ctest, _, _, St) -> -%% True = c_atom(true), -%% False = c_atom(false), -%% Omega = c_var(omega), -%% Ctrue = ann_c_clause(L, True, Ctr), -%% Cfalse = ann_c_clause(L, False, Cfa), -%% Cfail = ann_c_clause(comp_gen_anno(L, St3), Omega, Omega), -%% {ann_c_case(L, Ctest, Ctrue,Cfalse,Cfail),St} -%% end, -%% simple_seq(Cte, If, Env, L, St3). - -%% comp_lit(Value) -> LitExpr. -%% Make a literal expression from an Erlang value. Try to make it as -%% literal as possible. This function will fail if the value is not -%% expressable as a literal (for instance, a pid). - -comp_lit(H|T) -> - Ch = comp_lit(H), - Ct = comp_lit(T), - %% c_cons is smart and can handle head and tail both literals. - c_cons(Ch, Ct); -comp_lit() -> c_nil(); -comp_lit(T) when is_tuple(T) -> - Es = comp_lit_list(tuple_to_list(T)), - %% c_tuple is smart and can handle a list of literals. - c_tuple(Es); -comp_lit(A) when is_atom(A) -> c_atom(A); -comp_lit(I) when is_integer(I) -> c_int(I); -comp_lit(F) when is_float(F) -> c_float(F); -comp_lit(Bin) when is_bitstring(Bin) -> - Bits = comp_lit_bitsegs(Bin), - ann_c_binary(, Bits); -comp_lit(Map) when ?IS_MAP(Map) -> - comp_lit_map(Map). - -comp_lit_list(Vals) -> comp_lit(V) || V <- Vals . - -is_lit_list(Es) -> all(fun (E) -> is_literal(E) end, Es). - -comp_lit_bitsegs(<<B:8,Bits/bitstring>>) -> %Next byte - c_byte_bitseg(B, 8)|comp_lit_bitsegs(Bits); -comp_lit_bitsegs(<<>>) -> ; %Even bytes -comp_lit_bitsegs(Bits) -> %Size < 8 - N = bit_size(Bits), - <<B:N>> = Bits, - c_byte_bitseg(B, N). - -c_byte_bitseg(B, Sz) -> - c_bitstr(c_lit(B), c_int(Sz), c_int(1), c_atom(integer), - c_lit(unsigned,big)). - --ifdef(HAS_MAPS). -comp_lit_map(Map) -> - Pairs = comp_lit_map_pairs(maps:to_list(Map)), - ann_c_map(, c_lit(#{}), Pairs). - -comp_lit_map_pairs({K,V}|Ps) -> - ann_c_map_pair(, c_lit(assoc), comp_lit(K), comp_lit(V))| - comp_lit_map_pairs(Ps); -comp_lit_map_pairs() -> . +-ifdef(NEW_REC_CORE). +make_record_attribute(Name, Fdefs, Line) -> + make_attribute(record, {Name,Fdefs}, Line). -else. -comp_lit_map(_) -> c_lit(map). +make_record_attribute(Name, Fdefs, Line) -> + make_attribute(type, {{record,Name},Fdefs}, Line). -endif. -%% pattern(Pattern, Line, Status) -> {CorePat,PatVars,VarTests,State}. -%% Compile a pattern into a Core term. Handle quoted sexprs here -%% especially for symbols which then become variables instead of -%% atoms. - -pattern(Pat, L, St) -> pattern(Pat, L, , , St). - -pattern(quote,E, _, Vs, Ts, St) -> {pat_lit(E),Vs,Ts,St}; -pattern('=',P1,P2, L, Vs0, Ts0, St0) -> - %% Core can only alias against a variable so there is work to do! - {Cp1,Vs1,Ts1,St1} = pattern(P1, L, Vs0, Ts0, St0), - {Cp2,Vs2,Ts2,St2} = pattern(P2, L, Vs0, Ts1, St1), - Cp = pat_alias(Cp1, Cp2), - {Cp,union(Vs1, Vs2),Ts2,St2}; -pattern(cons,H,T, L, Vs0, Ts0, St0) -> - {Ch,Vs1,Ts1,St1} = pattern(H, L, Vs0, Ts0, St0), - {Ct,Vs2,Ts2,St2} = pattern(T, L, Vs1, Ts1, St1), - {c_cons(Ch, Ct),Vs2,Ts2,St2}; -pattern(list|Ps, L, Vs, Ts, St) -> - pat_list(Ps, L, Vs, Ts, St); -pattern(tuple|Ps, L, Vs0, Ts0, St0) -> - Fun = fun (P, {Vsa,Tsa,Sta}) -> - {Cp,Vsb,Tsb,Stb} = pattern(P, L, Vsa, Tsa, Sta), - {Cp,{Vsb,Tsb,Stb}} +%% comp_struct_def(Fields, Line, State) -> Forms. +%% Create the struct definition function + +comp_struct_def(Fields, Line, #lfe_cg{module=Mod}=St) -> + %% The default struct. + DefStr = comp_struct_map(Mod, Fields), + %% The default __struct__/0/1 functions. + Str0 = comp_function_def('__struct__', lambda,,DefStr, Line, St), + Str1 = comp_function_def( + '__struct__', + lambda,assocs, + call,?Q(lists),?Q(foldl), + 'match-lambda',tuple,x,y,acc, + call,?Q(maps),?Q(update),x,y,acc, + DefStr,assocs, + Line, St), + Str0 ++ Str1. + +comp_struct_map(Mod, Fields) -> + Fun = fun (F,D|_) -> {F,D}; + (F) -> {F,'nil'}; + (F) -> {F,'nil'} end, - {Cps,{Vs1,Ts1,St1}} = mapfoldl(Fun, {Vs0,Ts0,St0}, Ps), - {c_tuple(Cps),Vs1,Ts1,St1}; -pattern(binary|Segs, L, Vs, Ts, St) -> - pat_binary(Segs, L, Vs, Ts, St); -pattern(map|As, L, Vs, Ts, St) -> - pat_map(As, L, Vs, Ts, St); -%% This allows us to use ++ macro in patterns. -%% pattern(call,quote,erlang,quote,'++',A1,A2, L, Vs, St) -> -%% Pat = foldr(fun (H, T) -> cons,H,T end, A2, A1), -%% pattern(Pat, L, Vs, St); -%% Compile old no contructor list forms. -pattern(H|T, L, Vs0, Ts0, St0) -> - {Ch,Vs1,Ts1,St1} = pattern(H, L, Vs0, Ts0, St0), - {Ct,Vs2,Ts2,St2} = pattern(T, L, Vs1, Ts1, St1), - {c_cons(Ch, Ct),Vs2,Ts2,St2}; -pattern(, _, Vs, Ts, St) -> {c_nil(),Vs,Ts,St}; -%% Literals. -pattern(Bin, _, Vs, Ts, St) when is_bitstring(Bin) -> - {pat_lit(Bin),Vs,Ts,St}; -pattern(Tup, _, Vs, Ts, St) when is_tuple(Tup) -> - {pat_lit(Tup),Vs,Ts,St}; -pattern(Symb, L, Vs, Ts,St) when is_atom(Symb) -> - pat_symb(Symb, L, Vs, Ts, St); %Variable -pattern(Numb, _, Vs, Ts, St) when is_number(Numb) -> - {c_lit(Numb),Vs,Ts,St}. - -pat_list(P|Ps, L, Vs0, Ts0, St0) -> - {Cp,Vs1,Ts1,St1} = pattern(P, L, Vs0, Ts0, St0), - {Cps,Vs2,Ts2,St2} = pat_list(Ps, L, Vs1, Ts1, St1), - {c_cons(Cp, Cps),Vs2,Ts2,St2}; -pat_list(, _, Vs, Ts, St) -> {c_nil(),Vs,Ts,St}. - -pat_symb('_', L, Vs, Ts, St0) -> %Don't care variable. - {Cv,St1} = new_c_var(L, St0), - {Cv,Vs,Ts,St1}; %Not added to variables -pat_symb(Symb, _, Vs, Ts, St0) -> - case is_element(Symb, Vs) of - true -> %Replace and add test - {New,St1} = new_var(St0), - {c_var(New),Vs,'=:=',Symb,New|Ts,St1}; - false -> %Just add variable - {c_var(Symb),add_element(Symb, Vs),Ts,St0} - end. - -%% pat_alias(CorePat, CorePat) -> AliasPat. -%% Normalise aliases. This has been taken from v3_core.erl in the -%% erlang compiler. This is more complicated in core as we can -%% sometimes get structures as "literal". Trap bad aliases by -%% throwing 'nomatch' as these should have been caught in lfe_lint. - -pat_alias(Cp1, Cp2) -> - %% io:format("pa: ~p\n", {Cp1,Cp2}), - case {cerl:type(Cp1),cerl:type(Cp2)} of - {var,_} -> c_alias(Cp1, Cp2); - {_,var} -> c_alias(Cp2, Cp1); - {cons,literal} -> - pat_alias_cons(Cp1, Cp2); - {literal,cons} -> - pat_alias_cons(Cp2, Cp1); - {cons,cons} -> - c_cons(pat_alias(cons_hd(Cp1), cons_hd(Cp2)), - pat_alias(cons_tl(Cp1), cons_tl(Cp2))); - {tuple,literal} -> - pat_alias_tuple(Cp1, Cp2); - {literal,tuple} -> - pat_alias_tuple(Cp2, Cp1); - {tuple,tuple} -> - c_tuple(pat_alias_list(tuple_es(Cp1), tuple_es(Cp2))); - {alias,alias} -> - Cv1 = alias_var(Cp1), - Cv2 = alias_var(Cp2), - if Cv1 =:= Cv2 -> - pat_alias(alias_pat(Cp1), alias_pat(Cp2)); - true -> - c_alias(Cv1, c_alias(Cv2, pat_alias(alias_pat(Cp1), - alias_pat(Cp2)))) - end; - {alias,_} -> - c_alias(alias_var(Cp1), pat_alias(alias_pat(Cp1), Cp2)); - {_,alias} -> - c_alias(alias_var(Cp2), pat_alias(Cp1, alias_pat(Cp2))); - _ -> - %% Check that they are the same except for annotation. - case {set_ann(Cp1, ),set_ann(Cp2, )} of - {P,P} -> Cp1; - _ -> throw({nomatch,Cp1,Cp2}) - end - end. - -pat_alias_cons(Ccons, Clit) -> - case lit_val(Clit) of - H|T -> - %% Must be sure to build a #c_cons{} here - pat_alias(Ccons, c_cons_skel(c_lit(H), c_lit(T))); - _ -> throw(nomatch) - end. - -pat_alias_tuple(Ctup, Clit) -> - case lit_val(Clit) of - Tup when is_tuple(Tup) -> - update_c_tuple(Ctup, - pat_alias_list(tuple_es(Ctup), data_es(Clit))); - _ -> throw(nomatch) - end. - -%% pat_alias_list(A1, A2) -> A. - -pat_alias_list(A1|A1s, A2|A2s) -> - pat_alias(A1, A2)|pat_alias_list(A1s, A2s); -pat_alias_list(, ) -> ; -pat_alias_list(_, _) -> throw(nomatch). - -%% pat_binary(Segs, Line, PatVars, VarTests, State) -> -%% {c_binary(),PatVars,VarTests,State}. - -pat_binary(Segs, L, Vs0, Ts0, St0) -> - Vsps = get_bitsegs(Segs), - {Csegs,Vs1,Ts1,St1} = pat_bitsegs(Vsps, L, Vs0, Ts0, St0), - {ann_c_binary(L, Csegs),Vs1,Ts1,St1}. - -%% pat_bitsegs(Segs, Line, PatVars, VarTests, State) -> -%% {CBitsegs,PatVars,VarTests,State}. - -pat_bitsegs(Segs, L, Vs0, Ts0, St0) -> - {Csegs,{Vs1,Ts1,St1}} = - mapfoldl(fun (S, {Vsa,Tsa,Sta}) -> - {Cs,Vsb,Tsb,Stb} = pat_bitseg(S, L, Vsa, Tsa, Sta), - {Cs,{Vsb,Tsb,Stb}} - end, {Vs0,Ts0,St0}, Segs), - {Csegs,Vs1,Ts1,St1}. - -%% pat_bitseg(Seg, Line, PatVars, State) -> {c_bitstr(),PatVars,State}. -%% ??? Should noenv be lfe_env:new() instead ??? -%% ??? We know its correct so why worry? ??? - -pat_bitseg({Pat,_,{Ty,_,Si,En}}, L, Vs0, Ts0, St0) - when Ty =:= utf8 ; Ty =:= utf16 ; Ty =:= utf32 -> - %% Special case utf types. - {Cpat,Vs1,Ts1,St1} = pattern(Pat, L, Vs0, Ts0, St0), - Undef = c_atom(undefined), - {c_bitstr(Cpat,Undef,Undef,c_atom(Ty),c_lit(Si,En)),Vs1,Ts1,St1}; -pat_bitseg({Pat,all,{binary,_,_,_}=Ty}, L, Vs, Ts, St) -> - pat_bitseg({Pat,?Q(all),Ty}, L, Vs, Ts, St); -pat_bitseg({Pat,Sz,{Ty,Un,Si,En}}, L, Vs0, Ts0, St0) -> - {Cpat,Vs1,Ts1,St1} = pattern(Pat, L, Vs0, Ts0, St0), - {Csize,St2} = comp_expr(Sz, noenv, L, St1), - {c_bitstr(Cpat, Csize, c_int(Un), c_atom(Ty), c_lit(Si,En)),Vs1,Ts1,St2}. - --ifdef(HAS_MAPS). -%% pat_map(Args, Line, PatVars, State) -> {c_map(),PatVars,State}. - -pat_map(Args, L, Vs0, Ts0, St0) -> - {Pairs,Vs1,Ts1,St1} = pat_map_pairs(Args, L, Vs0, Ts0, St0), - %% Build #c_map{} then fill it in. - Map = ann_c_map_pattern(L, Pairs), %Must us this for a pattern - {Map,Vs1,Ts1,St1}. - -pat_map_pairs(K,V|As, L, Vs0, Ts0, St0) -> - Ck = pat_map_key(K), - {Cv,Vs1,Ts1,St1} = pattern(V, L, Vs0, Ts0, St0), - {Cps,Vs2,Ts2,St2} = pat_map_pairs(As, L, Vs1, Ts1, St1), - {ann_c_map_pair(L, c_lit(exact), Ck, Cv)|Cps, - Vs2,Ts2,St2}; -pat_map_pairs(, _, Vs, Ts, St) -> {,Vs,Ts,St}. - -pat_map_key(quote,L) -> pat_lit(L); -pat_map_key(L) -> pat_lit(L). --else. -pat_map(_, _, Vs, Ts, St) -> {c_lit(map),Vs,Ts,St}. --endif. - -%% pat_lit(Value) -> LitExpr. -%% Make a literal expression from an Erlang value. Make it as literal -%% as is required for a pattern. This function will fail if the value -%% is not expressable as a literal (for instance, a pid). - -pat_lit(H|T) -> - Ch = pat_lit(H), - Ct = pat_lit(T), - %% c_cons is smart and can handle head and tail both literals. - c_cons(Ch, Ct); -pat_lit() -> c_nil(); -pat_lit(T) when is_tuple(T) -> - Es = pat_lit_list(tuple_to_list(T)), - %% c_tuple is smart and can handle a list of literals. - c_tuple(Es); -pat_lit(A) when is_atom(A) -> c_atom(A); -pat_lit(I) when is_integer(I) -> c_int(I); -pat_lit(F) when is_float(F) -> c_float(F); -pat_lit(Bin) when is_bitstring(Bin) -> - Bits = pat_lit_bitsegs(Bin), - ann_c_binary(, Bits); -pat_lit(Map) when ?IS_MAP(Map) -> - pat_lit_map(Map). - -pat_lit_list(Vals) -> pat_lit(V) || V <- Vals . - -pat_lit_bitsegs(<<B:8,Bits/bitstring>>) -> %Next byte - c_byte_bitseg(B, 8)|pat_lit_bitsegs(Bits); -pat_lit_bitsegs(<<>>) -> ; %Even bytes -pat_lit_bitsegs(Bits) -> %Size < 8 - N = bit_size(Bits), - <<B:N>> = Bits, - c_byte_bitseg(B, N). - --ifdef(HAS_MAPS). -pat_lit_map(Map) -> - Pairs = pat_lit_map_pairs(maps:to_list(Map)), - ann_c_map(, c_lit(#{}), Pairs). - -pat_lit_map_pairs({K,V}|Ps) -> - ann_c_map_pair(, c_lit(assoc), pat_lit(K), pat_lit(V))| - pat_lit_map_pairs(Ps); -pat_lit_map_pairs() -> . --else. -pat_lit_map(_) -> c_lit(map). --endif. - -%% line_file_anno(Line, State) -> Anno. -%% Make annotation with line number and file. - -line_file_anno(L, St) -> - L,{file,St#cg.file}. + Args = lists:map(Fun, Fields), + maps:from_list({'__struct__',Mod}|Args). -%% comp_gen_anno(Line, State) -> Anno. -%% Make annotation with line number and compiler_generated. +%% comp_export(State) -> Attribute. +%% comp_imports(State) -> Attribute. +%% comp_on_load(State) -> Attribute. +%% comp_attributes(State) -> Attribute. +%% Currently we don't add the import attributes. -comp_gen_anno(L, _) -> - L,compiler_generated. +comp_export(#lfe_cg{exports=Exps,defs=Defs,mline=Line}) -> + Es = if Exps =:= all -> + {F,func_arity(Def)} || {F,Def,_} <- Defs ; + true -> Exps %Already in right format + end, + make_attribute(export, Es, Line). -%% new_symb(State) -> {Symbol,State}. -%% Create a hopefully new unused symbol. +comp_imports(_St) -> . -%% new_symb(St) -> -%% C = St#cg.vc, -%% {list_to_atom("|=" ++ integer_to_list(C) ++ "=|"),St#cg{vc=C+1}}. +comp_onload(#lfe_cg{onload={Func,Ar},mline=Line}) -> + make_attribute(on_load, {Func,Ar}, Line); +comp_onload(#lfe_cg{onload=}) -> . -new_fun_name(Pre, St) -> - C = St#cg.fc, - {list_to_atom("'" ++ Pre ++ "~" ++ integer_to_list(C)),St#cg{fc=C+1}}. +comp_attributes(#lfe_cg{atts=Atts}) -> + lists:map(fun comp_attribute/1, Atts). -%% new_vars(N) -> Vars. +%% comp_attribute({spec,Func|Spec,Line}) -> +%% hd(comp_func_spec(Func, Spec, Line)); %We know! +comp_attribute({'export-type',Ts,Line}) -> + Ets = lists:map(fun (T,A) -> {T,A} end, Ts), + make_attribute(export_type, Ets, Line); +comp_attribute({Name,Val,Line}) -> + make_attribute(Name, Val, Line). -new_vars(N) when N > 0 -> - V = list_to_atom(integer_to_list(N)), - V|new_vars(N-1); -new_vars(0) -> . +%% make_attribute(Name, Value, Line) -> Atttribute. -%% new_var(State) -> {VarName,State}. -%% new_c_var(Line, State) -> {c_var(),State}. -%% Create a hopefully new core variable. +make_attribute(Name, Val, Line) -> + {attribute,Line,Name,Val}. -new_var(#cg{vc=C}=St) -> - {list_to_atom(lists:concat(" ",C," ")),St#cg{vc=C+1}}. - -new_c_var(_, St0) -> - {Name,St1} = new_var(St0), - {c_var(Name),St1}. +%% func_arity(FuncDef) -> Arity. +%% Return the arity of a function definition. -new_c_vars(N, L, St) -> new_c_vars(N, L, St, ). +func_arity(lambda,Args|_) -> length(Args); +func_arity('match-lambda'|Cls) -> + match_lambda_arity(Cls). -new_c_vars(N, L, St0, Vs) when N > 0 -> - {V,St1} = new_c_var(L, St0), - new_c_vars(N-1, L, St1, V|Vs); -new_c_vars(0, _, St, Vs) -> {Vs,St}. +%% match_lambda_arity(MatchClauses) -> int(). -add_vbindings(Vs, Env) -> - foldl(fun (V, E) -> add_vbinding(V, dummy, E) end, Env, Vs). +match_lambda_arity(Pats|_|_) -> length(Pats). %% safe_fetch(Key, Dict, Default) -> Value. +%% Fetch a value with a default if it doesn't exist. -safe_fetch(Key, D, Def) -> - case find(Key, D) of - {ok,Val} -> Val; - error -> Def - end. - -%% is_simple(CoreExp) -> bool(). -%% Test if CoreExp is simple, i.e. just constructs terms. - -is_simple(Ce) -> - case cerl:type(Ce) of - var -> true; - literal -> true; - cons -> - is_simple(cons_hd(Ce)) andalso is_simple(cons_tl(Ce)); - tuple -> - is_simple_list(tuple_es(Ce)); - binary -> - is_simple_bin(binary_segments(Ce)); - _ -> false - end. - -is_simple_list(Es) -> all(fun is_simple/1, Es). - -is_simple_bin(Ss) -> - all(fun (Seg) -> - is_simple(bitstr_val(Seg)) andalso is_simple(bitstr_size(Seg)) - end, Ss). - -%% Constructor functions for building Core forms. These now just call -%% functions in cerl. - -c_module(Name, Exp, Defs) -> - cerl:c_module(Name, Exp, Defs). - -update_c_module(Mod, Name, Exp, Atts, Defs) -> - cerl:update_c_module(Mod, Name, Exp, Atts, Defs). - -ann_c_call(Ann, M, F, As) -> - cerl:ann_c_call(Ann, M, F, As). - -ann_c_try(Ann, E, Vs, B, Evs, H) -> - cerl:ann_c_try(Ann, E, Vs, B, Evs, H). - -ann_c_fun(Ann, Vs, B) -> - cerl:ann_c_fun(Ann, Vs, B). - -fun_vars(Fun) -> cerl:fun_vars(Fun). -fun_body(Fun) -> cerl:fun_body(Fun). - -ann_c_primop(Ann, N, As) -> - cerl:ann_c_primop(Ann, N, As). - -ann_c_let(Ann, Vs, A, B) -> - cerl:ann_c_let(Ann, Vs, A, B). - -ann_c_letrec(Ann, Defs, B) -> - cerl:ann_c_letrec(Ann, Defs, B). - -ann_c_catch(Ann, Body) -> - cerl:ann_c_catch(Ann, Body). - -ann_c_receive(Ann, Cs, To, A) -> - cerl:ann_c_receive(Ann, Cs, To, A). - -ann_c_case(Ann, E, Cs) -> - cerl:ann_c_case(Ann, E, Cs). - -%% Clause functions. -ann_c_clause(Ann, Ps, B) -> %Default true guard - cerl:ann_c_clause(Ann, Ps, B). - -ann_c_clause(Ann, Ps, G, B) -> - cerl:ann_c_clause(Ann, Ps, G, B). +%% safe_fetch(Key, D, Def) -> +%% case orddict:find(Key, D) of +%% {ok,Val} -> Val; +%% error -> Def +%% end. -%% Expression sequence functions. -ann_c_seq(Ann, A, B) -> - cerl:ann_c_seq(Ann, A, B). +%% add_error(Line, Error, State) -> State. -update_c_seq(Node, A, B) -> - cerl:update_c_seq(Node, A, B). - -is_c_seq(Node) -> cerl:is_c_seq(Node). - -seq_arg(Seq) -> cerl:seq_arg(Seq). -seq_body(Seq) -> cerl:seq_body(Seq). - -c_fname(N, A) -> cerl:c_fname(N, A). - -ann_c_apply(Ann, Op, As) -> - cerl:ann_c_apply(Ann, Op, As). - -ann_c_values(Ann, Vs) -> cerl:ann_c_values(Ann, Vs). - -%% General annotation access functions. -get_ann(Node) -> cerl:get_ann(Node). -set_ann(Node, Ann) -> cerl:set_ann(Node, Ann). - -c_alias(Var, Pat) -> cerl:c_alias(Var, Pat). -alias_var(Alias) -> cerl:alias_var(Alias). -alias_pat(Alias) -> cerl:alias_pat(Alias). - -%% Atomic data type functions. -c_atom(A) -> cerl:c_atom(A). -ann_c_atom(Ann, A) -> cerl:ann_c_atom(Ann, A). -c_int(I) -> cerl:c_int(I). -c_float(F) -> cerl:c_float(F). -c_nil() -> cerl:c_nil(). - -%% Literal value functions. -ann_c_lit(Ann, Val) -> cerl:ann_abstract(Ann, Val). %Generic literal -c_lit(Val) -> cerl:abstract(Val). -is_literal(Node) -> cerl:is_literal(Node). -lit_val(Lit) -> cerl:concrete(Lit). - -data_es(Data) -> cerl:data_es(Data). - -c_cons(Hd, Tl) -> cerl:c_cons(Hd, Tl). -c_cons_skel(Hd, Tl) -> cerl:c_cons_skel(Hd, Tl). -cons_hd(Cons) -> cerl:cons_hd(Cons). -cons_tl(Cons) -> cerl:cons_tl(Cons). - -c_tuple(Es) -> cerl:c_tuple(Es). -update_c_tuple(Tup, Es) -> - cerl:update_c_tuple(Tup, Es). -tuple_es(Tup) -> cerl:tuple_es(Tup). - -c_var(N) -> cerl:c_var(N). - -ann_c_binary(Ann, Segs) -> cerl:ann_c_binary(Ann, Segs). -update_c_binary(Bin, Segs) -> - cerl:update_c_binary(Bin, Segs). -binary_segments(Bin) -> cerl:binary_segments(Bin). - -c_bitstr(Val, Sz, Un, Ty, Fs) -> - cerl:c_bitstr(Val, Sz, Un, Ty, Fs). -update_c_bitstr(Bit, Val, Sz, Un, Ty, Fs) -> - cerl:update_c_bitstr(Bit, Val, Sz, Un, Ty, Fs). -bitstr_val(Bit) -> cerl:bitstr_val(Bit). -bitstr_size(Bit) -> cerl:bitstr_size(Bit). -bitstr_unit(Bit) -> cerl:bitstr_unit(Bit). -bitstr_type(Bit) -> cerl:bitstr_type(Bit). -bitstr_flags(Bit) -> cerl:bitstr_flags(Bit). - --ifdef(HAS_MAPS). -ann_c_map(Ann, Arg, Ps) -> - cerl:ann_c_map(Ann, Arg, Ps). - -%% ann_c_map_pattern(Ann, Pairs) -> Map -%% This function will come first in 18. Until then this is a little -%% tricky as ann_c_map will create a literal if the map pattern is a -%% literal and this is NOT what the compiler wants. - -ann_c_map_pattern(Ann, Ps) -> - case erlang:function_exported(cerl, ann_c_map_pattern, 2) of - true -> - cerl:ann_c_map_pattern(Ann, Ps); - false -> - Map0 = ann_c_map(Ann, dummy, Ps), - update_c_map(Map0, c_lit(#{}), Ps) - end. - -update_c_map(Map, Arg, Ps) -> - cerl:update_c_map(Map, Arg, Ps). - -ann_c_map_pair(Ann, Op, Key, Val) -> - cerl:ann_c_map_pair(Ann, Op, Key, Val). --endif. +add_error(L, E, #lfe_cg{errors=Errs}=St) -> + St#lfe_cg{errors=Errs ++ {L,?MODULE,E}}.
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_codelift.erl
Added
@@ -0,0 +1,910 @@ +%% Copyright (c) 2008-2018 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_codelift.erl +%%% Author : Robert Virding +%%% Purpose : Lisp Flavoured Erlang lambda lifting local functions. + +%%% Lambda lift local functions to the top-level. We do this ourselves +%%% to have better control and to be able to do non-recursive +%%% functions in a better way. + +-module(lfe_codelift). + +-export(record/3,function/3). + +-export(comp_define/1). +-export(lift_func/2,lift_expr/3,ivars_expr/1). + +-export(test/1). + +%% 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(cl, {func=, %Current function + arity=0, + line=0, + vc=0, %Local variable index + fc=0 %Local function index + }). + +%% comp_define(DefForm) -> Funcs + +comp_define({Name,Def,Line}) -> + Fs = 'define-function',N,,D || {N,D,_} <- function(Name, Def, Line) , + progn|Fs. + +%% record(Name, Fields, Line) -> {RecDef,Functions}. +%% Lambda lift the record field definitions and return the lifted +%% fields and generated functions. + +record(Name, Fs, Line) -> + St0 = #cl{func=Name,arity=record,line=Line,vc=0,fc=0}, + {Lfs,Fncs,St1} = lift_rec_fields(Fs, , St0), + {Lfncs,,_} = lift_loop(Fncs, St1), + {Lfs,Lfncs}. + +%% function(Name, Def, Line) -> {Name,Def,Line}. +%% Lambda lift all the local functions and return a list of all +%% functions. + +function(Name, Def, Line) -> + Ar = func_arity(Def), + St = #cl{func=Name,arity=Ar,line=Line,vc=0,fc=0}, + %% Lambda lift the function. + Func = {Name,Def,Line}, + {Funcs,,_} = lift_loop(Func, St), + %% io:format("codelift ~p\n", {Func,Funcs}), + Funcs. + +%% lift_loop(Functions, State) -> {TopFuncs,LiftedFuncs,State}. +%% Repeatedly traverse Functions and LiftedFunctions until everything +%% has been lifted. Return all as TopFuncs. + +lift_loop(Funcs0, St0) -> + {Funcs1,Lds,St1} = lift_funcs(Funcs0, St0), + if Lds =:= -> + {Funcs1,,St1}; + true -> + {Lfuncs,Lds1,St2} = lift_loop(Lds, St1), + {Funcs1 ++ Lfuncs,Lds1,St2} + end. + +%% lift_func(Name, Definiton, State) -> {Functions,State}. +%% Lambda lift the local functions in an a function. Return a list of +%% the resulting functions. + +lift_func({Name,Def0,L}, St0) -> + {Def1,Lds,St1} = lift_expr(Def0, , St0), + {{Name,Def1,L},Lds,St1}. + +lift_funcs(Defs, St) -> + Fun = fun (Func0, {Funcs, Lds0, St0}) -> + {Func1,Lds,St1} = lift_func(Func0, St0), + {Func1|Funcs,Lds ++ Lds0,St1} + end, + lists:foldl(Fun, {,,St}, Defs). + +%% lift_expr(Expr, LocalDefs, State) -> {AST,LocalDefs,State}. +%% Lambda lift the local functions in an expression. + +%% Core data special forms. +lift_expr(?Q(E), Lds, St) -> {?Q(E),Lds,St}; +%% Record special forms. +lift_expr('record',Name|Args, Lds0, St0) -> + {Largs,Lds1,St1} = lift_rec_args(Args, Lds0, St0), + {'record',Name|Largs,Lds1,St1}; +%% make-record has been deprecated but we sill accept it for now. +lift_expr('make-record',Name|Args, Lds0, St0) -> + {Largs,Lds1,St1} = lift_rec_args(Args, Lds0, St0), + {'make-record',Name|Largs,Lds1,St1}; +lift_expr('is-record',E,Name, Lds0, St0) -> + {Le,Lds1,St1} = lift_expr(E, Lds0, St0), + {'is-record',Le,Name,Lds1,St1}; +lift_expr('record-index',_Name,_F=Ri, Lds, St) -> + {Ri,Lds,St}; +lift_expr('record-field',E,Name,F, Lds0, St0) -> + {Le,Lds1,St1} = lift_expr(E, Lds0, St0), + {'record-field',Le,Name,F,Lds1,St1}; +lift_expr('record-update',E,Name|Args, Lds0, St0) -> + {Le,Lds1,St1} = lift_expr(E, Lds0, St0), + {Largs,Lds2,St2} = lift_rec_args(Args, Lds1, St1), + {'record-update',Le,Name|Largs,Lds2,St2}; +%% Struct special forms. +lift_expr('struct',Name|Args, Lds0, St0) -> + {Largs,Lds1,St1} = lift_rec_args(Args, Lds0, St0), + {'struct',Name|Largs,Lds1,St1}; +lift_expr('is-struct',E, Lds0, St0) -> + {Le,Lds1,St1} = lift_expr(E, Lds0, St0), + {'is-struct',Le,Lds1,St1}; +lift_expr('is-struct',E,Name, Lds0, St0) -> + {Le,Lds1,St1} = lift_expr(E, Lds0, St0), + {'is-struct',Le,Name,Lds1,St1}; +lift_expr('struct-field',E, Name,F, Lds0, St0) -> + {Le,Lds1,St1} = lift_expr(E, Lds0, St0), + {'struct-field',Le,Name,F,Lds1,St1}; +lift_expr('struct-update',E,Name|Args, Lds0, St0) -> + {Le,Lds1,St1} = lift_expr(E, Lds0, St0), + {Largs,Lds2,St2} = lift_rec_args(Args, Lds1, St1), + {'struct-update',Le,Name|Largs,Lds2,St2}; +%% Function forms. +lift_expr(function,_,_=Func, Lds, St) -> + {Func,Lds,St}; +lift_expr(function,_,_,_=Func, Lds, St) -> + {Func,Lds,St}; +%% Core closure special forms. +lift_expr(lambda,Args|Body0, Lds0, St0) -> + {Body1,Lds1,St1} = lift_exprs(Body0, Lds0, St0), + {lambda,Args|Body1,Lds1,St1}; +lift_expr('match-lambda'|Cls0, Lds0, St0) -> + {Cls1,Lds1,St1} = lift_cls(Cls0, Lds0, St0), + {'match-lambda'|Cls1,Lds1,St1}; +lift_expr('let',Vbs|Body, Lds, St) -> + lift_let(Vbs, Body, Lds, St); +lift_expr('let-function',Fbs|Body, Lds, St) -> + lift_let_function(Fbs, Body, Lds, St); +lift_expr('letrec-function',Fbs|Body, Lds, St) -> + lift_letrec_function(Fbs, Body, Lds, St); +%% Core control special forms. +lift_expr(progn|Body0, Lds0, St0) -> + {Body1,Lds1,St1} = lift_exprs(Body0, Lds0, St0), + {progn|Body1,Lds1,St1}; +lift_expr('if'|Body0, Lds0, St0) -> + {Body1,Lds1,St1} = lift_exprs(Body0, Lds0, St0), + {'if'|Body1,Lds1,St1}; +lift_expr('case',Expr|Cls, Lds, St) -> + lift_case(Expr, Cls, Lds, St); +lift_expr('catch'|Body0, Lds0, St0) -> + {Body1,Lds1,St1} = lift_exprs(Body0, Lds0, St0), + {'catch'|Body1,Lds1,St1}; +lift_expr('try'|Try, Lds, St) -> + lift_try(Try, Lds, St); +lift_expr(funcall|Body0, Lds0, St0) -> + {Body1,Lds1,St1} = lift_exprs(Body0, Lds0, St0), + {funcall|Body1,Lds1,St1}; +%% List/binary comprehensions. +lift_expr('lc',Qs,E, Lds, St) -> + lift_comp('lc', Qs, E, Lds, St); +lift_expr('list-comp',Qs,E, Lds, St) -> + lift_comp('list-comp', Qs, E, Lds, St); +lift_expr('bc',Qs,E, Lds, St) -> + lift_comp('bc', Qs, E, Lds, St); +lift_expr('binary-comp',Qs,E, Lds, St) -> + lift_comp('binary-comp', Qs, E, Lds, St); +%% Finally the general cases. +lift_expr(call|Body0, Lds0, St0) -> + {Body1,Lds1,St1} = lift_exprs(Body0, Lds0, St0), + {call|Body1,Lds1,St1}; +lift_expr(Func|Args0, Lds0, St0) when is_atom(Func) -> + {Args1,Lds1,St1} = lift_exprs(Args0, Lds0, St0), + {Func|Args1,Lds1,St1}; +lift_expr(Lit, Lds, St) -> {Lit,Lds,St}. + +lift_exprs(Exprs, Lds, St) -> + Fun = fun (E0, {Es,Lds0,St0}) -> + {E1,Lds1,St1} = lift_expr(E0, Lds0, St0), + {E1|Es,Lds1,St1} + end, + lists:foldr(Fun, {,Lds,St}, Exprs). + +lift_rec_fields(F,V|Type|Fs, Lds0, St0) -> + {Lv,Lds1,St1} = lift_expr(V, Lds0, St0), + {Lfs,Lds2,St2} = lift_rec_fields(Fs, Lds1, St1), + {F,Lv|Type|Lfs,Lds2,St2}; +lift_rec_fields(F|Fs, Lds0, St0) -> + {Lfs,Lds1,St1} = lift_rec_fields(Fs, Lds0, St0), + {F|Lfs,Lds1,St1}; +lift_rec_fields(, Lds, St) -> {,Lds,St}. + +lift_rec_args(F,V|As, Lds0, St0) -> + {Lv,Lds1,St1} = lift_expr(V, Lds0, St0), + {Las,Lds2,St2} = lift_rec_args(As, Lds1, St1), + {F,Lv|Las,Lds2,St2}; +lift_rec_args(, Lds, St) -> {,Lds,St}. + +lift_let(Vbs0, Body0, Lds0, St0) -> + Fun = fun (Pat,'when'|_=G,Expr0, {Ldsa,Sta}) -> + {Expr1,Ldsb,Stb} = lift_expr(Expr0, Ldsa, Sta), + {Pat,G,Expr1,{Ldsb,Stb}}; + (Pat,Expr0, {Ldsa,Sta}) -> + {Expr1,Ldsb,Stb} = lift_expr(Expr0, Ldsa, Sta), + {Pat,Expr1,{Ldsb,Stb}} + end, + {Vbs1,{Lds1,St1}} = lists:mapfoldl(Fun, {Lds0,St0}, Vbs0), + {Body1,Lds2,St2} = lift_exprs(Body0, Lds1, St1), + {'let',Vbs1|Body1,Lds2,St2}. + +%% lift_let_function(FuncBindings, LocalDefines, State) -> +%% {LocalBody,LocalDefines,State}. +%% We can check imported vars separately for each local function as +%% they do not know of each other. + +lift_let_function(Fbs0, Body0, Lds0, St0) -> + %% Build new name function binding and name transform data. + Line = St0#cl.line, + Nfun = fun (Name,Def0, Ts, Sta) -> + Ar = func_arity(Def0), + {New,Stb} = new_local_fun_name(Name, Ar, Sta), + %% Get the imported variables. + Ivs = ivars_expr(Def0, , ), + Def1 = append_ivars(Def0, Ivs), + {{New,Def1,Line},{trans,Name,Ar,New,Ivs}|Ts,Stb} + end, + %% Transform calls in the body. + {Fbs1,Trans,St1} = mapfoldl2(Nfun, , St0, Fbs0), + Lds1 = Fbs1 ++ Lds0, + %% Apply tranformations to Body. + Bfun = fun ({trans,Name,Ar,New,Ivs}, B) -> + trans_expr(B, Name, Ar, New, Ivs) + end, + Body1 = lists:foldl(Bfun, progn|Body0, Trans), + lift_expr(Body1, Lds1, St1). + +%% lift_letrec_function(FuncBindings, LocalDefines, State) -> +%% {LocalBody,LocalDefines,State}. +%% We cheat a bit when checking imported vars, we just take the union +%% of the variables from all the local functions and pass them to all +%% functions. + +lift_letrec_function(Fbs0, Body0, Lds0, St0) -> + %% Get the imported variables. + Ifun = fun (_,Def, Ivs) -> ivars_expr(Def, , Ivs) end, + Ivars = lists:foldl(Ifun, , Fbs0), + %% Build new name function binding and name transform data. + Line = St0#cl.line, + Nfun = fun (Name,Def0, Ts, Sta) -> + Ar = func_arity(Def0), + {New,Stb} = new_local_fun_name(Name, Ar, Sta), + Def1 = append_ivars(Def0, Ivars), + {{New,Def1,Line},{trans,Name,Ar,New}|Ts,Stb} + end, + {Fbs1,Trans,St1} = mapfoldl2(Nfun, , St0, Fbs0), + %% Transform calls in the letrec form. + Tfun = fun ({trans,Name,Ar,New}, Fbs) -> + Ffun = fun ({Nn,Def0,L}) -> + Def1 = trans_expr(Def0, Name, Ar, New, Ivars), + {Nn,Def1,L} + end, + lists:map(Ffun, Fbs) + end, + Fbs2 = lists:foldl(Tfun, Fbs1, Trans), + Lds1 = Fbs2 ++ Lds0, + %% Apply tranformations to Body. + Bfun = fun ({trans,Name,Ar,New}, B) -> + trans_expr(B, Name, Ar, New, Ivars) + end, + Body1 = lists:foldl(Bfun, progn|Body0, Trans), + {Body2,Lds2,St2} = lift_expr(Body1, Lds1, St1), + {Body2,Lds2,St2}. + +append_ivars(lambda,Args|Body, Ivars) -> + lambda,Args ++ Ivars|Body; +append_ivars('match-lambda'|Cls0, Ivars) -> + Fun = fun (Pats|Body) -> Pats ++ Ivars|Body end, + Cls1 = lists:map(Fun, Cls0), + 'match-lambda'|Cls1. + +lift_cls(Cls, Lds, St) -> + Fun = fun (Pats,'when'|_=G|Body0, {Cls0,Lds0,St0}) -> + {Body1,Lds1,St1} = lift_exprs(Body0, Lds0, St0), + {Pats,G|Body1|Cls0,Lds1,St1}; + (Pats|Body0, {Cls0,Lds0,St0}) -> + {Body1,Lds1,St1} = lift_exprs(Body0, Lds0, St0), + {Pats|Body1|Cls0,Lds1,St1} + end, + lists:foldr(Fun, {,Lds,St}, Cls). %From the right! + +lift_case(Expr0, Cls0, Lds0, St0) -> + {Expr1,Lds1,St1} = lift_expr(Expr0, Lds0, St0), + {Cls1,Lds2,St2} = lift_cls(Cls0, Lds1, St1), + {'case',Expr1|Cls1,Lds2,St2}. + +%% lift_try(TryBody, LocalDefs, State) -> {TryBody,LocalDefs,State}. +%% Step down the try body lifting the local functions. + +lift_try(Try0, Lds0, St0) -> + Fun = fun (T0, {L0,S0}) -> + {T1,L1,S1} = lift_try_1(T0, L0, S0), + {T1,{L1,S1}} + end, + {Try1,{Lds1,St1}} = lists:mapfoldl(Fun, {Lds0,St0}, Try0), + {'try'|Try1,Lds1,St1}. + +lift_try_1('case'|Case0, Lds0, St0) -> + {Case1,Lds1,St1} = lift_cls(Case0, Lds0, St0), + {'case'|Case1,Lds1,St1}; +lift_try_1('catch'|Catch0, Lds0, St0) -> + {Catch1,Lds1,St1} = lift_cls(Catch0, Lds0, St0), + {'catch'|Catch1,Lds1,St1}; +lift_try_1('after'|After0, Lds0, St0) -> + {After1,Lds1,St1} = lift_exprs(After0, Lds0, St0), + {'after'|After1,Lds1,St1}; +lift_try_1(E, Lds, St) -> %The try expression. + lift_expr(E, Lds, St). + +%% lift_comp(Commprehension, Qualifiers, Expr, LocalDefs, State) -> +%% {Comprehension,LocalDefs,State}. +%% Lift comprehensions. Only the expressions in the comprehensions +%% need to be lifted, no guards or patterns. + +lift_comp(Comp, Qs0, E0, Lds0, St0) -> + %% io:format("lc ~p\n", Comp,Qs0,E0), + {Qs1,Lds1,St1} = lift_comp_quals(Qs0, Lds0, St0), + {E1,Lds2,St2} = lift_expr(E0, Lds1, St1), + {Comp,Qs1,E1,Lds2,St2}. + +lift_comp_quals(Qs, Lds, St) -> + lists:foldr(fun (Q0, {Qs0,Lds0,St0}) -> + {Q1,Lds1,St1} = lift_comp_qual(Q0, Lds0, St0), + {Q1|Qs0,Lds1,St1} + end, {,Lds,St}, Qs). + +lift_comp_qual('<-',Pat,E0, Lds0, St0) -> + {E1,Lds1,St1} = lift_expr(E0, Lds0, St0), + {'<-',Pat,E1,Lds1,St1}; +lift_comp_qual('<-',Pat,G,E0, Lds0, St0) -> + {E1,Lds1,St1} = lift_expr(E0, Lds0, St0), + {'<-',Pat,G,E1,Lds1,St1}; +lift_comp_qual('<=',Pat,E0, Lds0, St0) -> + {E1,Lds1,St1} = lift_expr(E0, Lds0, St0), + {'<=',Pat,E1,Lds1,St1}; +lift_comp_qual('<=',Pat,G,E0, Lds0, St0) -> + {E1,Lds1,St1} = lift_expr(E0, Lds0, St0), + {'<=',Pat,G,E1,Lds1,St1}; +lift_comp_qual(Test, Lds, St) -> + lift_expr(Test, Lds, St). + +%% trans_expr(Call, OldName, Arity, NewName, ImportedVars) -> Expr. +%% Translate function call from old Name to New and add imported +%% variables. + +%% Core data special forms. +trans_expr(?Q(E), _, _, _, _) -> ?Q(E); +trans_expr(binary|Segs0, Old, Ar, New, Ivars) -> + Segs1 = trans_bitsegs(Segs0, Old, Ar, New, Ivars), + binary|Segs1; +%% Record forms. +trans_expr('record',Rname|Args, Old, Ar, New, Ivars) -> + Targs = trans_rec_args(Args, Old, Ar, New, Ivars), + 'record',Rname|Targs; +%% make-record has been deprecated but we sill accept it for now. +trans_expr('make-record',Rname|Args, Old, Ar, New, Ivars) -> + Targs = trans_rec_args(Args, Old, Ar, New, Ivars), + 'make-record',Rname|Targs; +trans_expr('is-record',E,Rname, Old, Ar, New, Ivars) -> + Te = trans_expr(E, Old, Ar, New, Ivars), + 'is-record',Te,Rname; +trans_expr('record-index',_Name,_F=Ri, _, _, _, _) -> + Ri; %Nothing to do here +trans_expr('record-field',E,Rname,F, Old, Ar, New, Ivars) -> + Te = trans_expr(E, Old, Ar, New, Ivars), + 'record-field',Te,Rname,F; +trans_expr('record-update',E,Rname|Args, Old, Ar, New, Ivars) -> + Te = trans_expr(E, Old, Ar, New, Ivars), + Targs = trans_rec_args(Args, Old, Ar, New, Ivars), + 'record-update',Te,Rname|Targs; +%% Function forms. +trans_expr(function,F,A=Func, Old, Ar, New, Ivars) -> + if F =:= Old, A =:= Ar -> + %% Must return a function of arity A here which calls the + %% lifted functions! Can access the imported variables. + Vars = new_vars(A), + lambda,Vars,New|Vars++Ivars; + true -> + Func + end; +trans_expr(function,_,_,_=Func, _, _, _, _) -> + Func; %Nothing to do here +%% Core closure special forms. +trans_expr(lambda,Args|Body0, Name, Ar, New, Ivars) -> + Body1 = trans_exprs(Body0, Name, Ar, New, Ivars), + lambda,Args|Body1; +trans_expr('match-lambda'|Cls0, Name, Ar, New, Ivars) -> + Cls1 = trans_cls(Cls0, Name, Ar, New, Ivars), + 'match-lambda'|Cls1; +trans_expr('let',Vbs|Body, Name, Ar, New, Ivars) -> + trans_let(Vbs, Body, Name, Ar, New, Ivars); +trans_expr('let-function',Fbs|Body, Name, Ar, New, Ivars) -> + trans_let_function(Fbs, Body, Name, Ar, New, Ivars); +trans_expr('letrec-function',Fbs|Body, Name, Ar, New, Ivars) -> + trans_letrec_function(Fbs, Body, Name, Ar, New, Ivars); +%% Core control special forms. +trans_expr(progn|Body, Name, Ar, New, Ivars) -> + progn|trans_exprs(Body, Name, Ar, New, Ivars); +trans_expr('if'|Body, Name, Ar, New, Ivars) -> + 'if'|trans_exprs(Body, Name, Ar, New, Ivars); +trans_expr('case',Expr|Cls, Name, Ar, New, Ivars) -> + trans_case(Expr, Cls, Name, Ar, New, Ivars); +trans_expr('receive'|Cls, Name, Ar, New, Ivars) -> + 'receive'|trans_cls(Cls, Name, Ar, New, Ivars); +trans_expr('catch'|Body, Name, Ar, New, Ivars) -> + 'catch'|trans_exprs(Body, Name, Ar, New, Ivars); +trans_expr('try'|Body, Name, Ar, New, Ivars) -> + trans_try(Body, Name, Ar, New, Ivars); +trans_expr(funcall|Body, Name, Ar, New, Ivars) -> + funcall|trans_exprs(Body, Name, Ar, New, Ivars); +%% List/binary comprehensions. +trans_expr('lc',Qs,E, Name, Ar, New, Ivars) -> + trans_comp('lc', Qs, E, Name, Ar, New, Ivars); +trans_expr('list-comp',Qs,E, Name, Ar, New, Ivars) -> + trans_comp('list-comp', Qs, E, Name, Ar, New, Ivars); +trans_expr('bc',Qs,E, Name, Ar, New, Ivars) -> + trans_comp('bc', Qs, E, Name, Ar, New, Ivars); +trans_expr('binary-comp',Qs,E, Name, Ar, New, Ivars) -> + trans_comp('binary-comp', Qs, E, Name, Ar, New, Ivars); +%% General cases. +trans_expr(call|Body, Name, Ar, New, Ivars) -> + call|trans_exprs(Body, Name, Ar, New, Ivars); +trans_expr(Fun|Args0, Name, Ar, New, Ivars) when is_atom(Fun) -> + %% Most of the core data special forms can be handled here as well. + Far = length(Args0), + Args1 = trans_exprs(Args0, Name, Ar, New, Ivars), + if Fun =:= Name, + Far =:= Ar -> New|Args1 ++ Ivars; + true -> Fun|Args1 + end; +trans_expr(Lit, _, _, _, _) -> Lit. + +trans_exprs(Exprs, Name, Ar, New, Ivars) -> + Fun = fun (E) -> trans_expr(E, Name, Ar, New, Ivars) end, + lists:map(Fun, Exprs). + +trans_bitsegs(Segs, Name, Ar, New, Ivars) -> + Fun = fun (Seg) -> trans_bitseg(Seg, Name, Ar, New, Ivars) end, + lists:map(Fun, Segs). + +trans_bitseg(Val0|Specs0, Name, Ar, New, Ivars) -> + Val1 = trans_expr(Val0, Name, Ar, New, Ivars), + Fun = fun (size,E) -> size,trans_expr(E, Name, Ar, New, Ivars) end, + Specs1 = lists:map(Fun, Specs0), + Val1|Specs1; +trans_bitseg(Seg, Name, Ar, New, Ivars) -> + trans_expr(Seg, Name, Ar, New, Ivars) . + +%% trans_rec_fields(Fields, Name, Arity, NewName, ImportedVars) -> Fields. +%% trans_rec_args(Args, Name, Arity, NewName, ImportedVars) -> Args. + +%% trans_rec_fields(F,V|Type|Fs, Name, Ar, New, Ivars) -> +%% Tv = trans_expr(V, Name, Ar, New, Ivars), +%% Tfs = trans_rec_fields(Fs, Name, Ar, New, Ivars), +%% F,Tv|Type|Tfs; +%% trans_rec_fields(F|Fs, Name, Ar, New, Ivars) -> +%% Tfs = trans_rec_fields(Fs, Name, Ar, New, Ivars), +%% F|Tfs; +%% trans_rec_fields(, _, _, _, _) -> . + +trans_rec_args(F,V|As, Name, Ar, New, Ivars) -> + Tv = trans_expr(V, Name, Ar, New, Ivars), + Tas = trans_rec_args(As, Name, Ar, New, Ivars), + F,Tv|Tas; +trans_rec_args(, _, _, _, _) -> . + +trans_cls(Cls, Name, Ar, New, Ivars) -> + Fun = fun (Cl) -> trans_cl(Cl, Name, Ar, New, Ivars) end, + lists:map(Fun, Cls). + +%% trans_cl(Clause, Name, Arity, NewName, ImportedVars) -> Clause. +%% We know that there are no interesting functions in the guard. + +trans_cl(Pat,'when'|_=G|Body, Name, Ar, New, Ivars) -> + Pat,G|trans_exprs(Body, Name, Ar, New, Ivars); +trans_cl(Pat|Body, Name, Ar, New, Ivars) -> + Pat|trans_exprs(Body, Name, Ar, New, Ivars). + +trans_let(Vbs0, Body0, Name, Ar, New, Ivars) -> + Fun = fun (Pat,'when'|_=G,Expr0) -> + Expr1 = trans_expr(Expr0, Name, Ar, New, Ivars), + Pat,G,Expr1; + (Pat,Expr0) -> + Expr1 = trans_expr(Expr0, Name, Ar, New, Ivars), + Pat,Expr1 + end, + Vbs1 = lists:map(Fun, Vbs0), + Body1 = trans_exprs(Body0, Name, Ar, New, Ivars), + 'let',Vbs1|Body1. + +trans_let_function(Fbs0, Body0, Name, Ar, New, Ivars) -> + Fbs1 = trans_let_fbs(Fbs0, Name, Ar, New, Ivars), + Body1 = trans_exprs(Body0, Name, Ar, New, Ivars), + 'let-function',Fbs1|Body1. + +trans_letrec_function(Fbs0, Body0, Name, Ar, New, Ivars) -> + Fbs1 = trans_let_fbs(Fbs0, Name, Ar, New, Ivars), + Body1 = trans_exprs(Body0, Name, Ar, New, Ivars), + 'letrec-function',Fbs1|Body1. + +trans_let_fbs(Fbs, Name, Ar, New, Ivars) -> + Fun = fun (F,Def) -> F,trans_expr(Def, Name, Ar, New, Ivars) end, + lists:map(Fun, Fbs). + +trans_case(Expr0, Cls0, Name, Ar, New, Ivars) -> + Expr1 = trans_expr(Expr0, Name, Ar, New, Ivars), + Cls1 = trans_cls(Cls0, Name, Ar, New, Ivars), + 'case',Expr1|Cls1. + +%% trans_try(TryBody, Name, Arity, NewName, ImportedVars) -> Try. +%% Step down the try body doing each section separately. + +trans_try(Try0, Name, Ar, New, Ivars) -> + Fun = fun (T) -> trans_try_1(T, Name, Ar, New, Ivars) end, + Try1 = lists:map(Fun, Try0), + 'try'|Try1. + +trans_try_1('case'|Case0, Name, Ar, New, Ivars) -> + Case1 = trans_cls(Case0, Name, Ar, New, Ivars), + 'case'|Case1; +trans_try_1('catch'|Catch0, Name, Ar, New, Ivars) -> + Catch1 = trans_cls(Catch0, Name, Ar, New, Ivars), + 'catch'|Catch1; +trans_try_1('after'|After0, Name, Ar, New, Ivars) -> + After1 = trans_exprs(After0, Name, Ar, New, Ivars), + 'after'|After1; +trans_try_1(E, Name, Ar, New, Ivars) -> %The try expression. + trans_expr(E, Name, Ar, New, Ivars). + +func_arity(lambda,Args|_) -> length(Args); +func_arity('match-lambda',Pats|_|_) -> + length(Pats). + +%% trans_comp(Comprehension, Qualifiers, Expr, +%% OldName, Arity, NewName, ImportedVars) -> +%% Expr. +%% Translate a list/binary comprehenesion. + +trans_comp(Comp, Qs0, E0, Name, Ar, New, Ivars) -> + E1 = trans_expr(E0, Name, Ar, New, Ivars), + Qs1 = trans_comp_quals(Qs0, Name, Ar, New, Ivars), + Comp,Qs1,E1. + +trans_comp_quals(Qs, Name, Ar, New, Ivars) -> + lists:map(fun (Q) -> + trans_comp_qual(Q, Name, Ar, New, Ivars) + end, Qs). + +trans_comp_qual('<-',Pat,E0, Name, Ar, New, Ivars) -> + E1 = trans_expr(E0, Name, Ar, New, Ivars), + io:format("tcq ~p ~p\n", E0,E1), + '<-',Pat,E1; +trans_comp_qual('<-',Pat,Guard,E0, Name, Ar, New, Ivars) -> + E1 = trans_expr(E0, Name, Ar, New, Ivars), + '<-',Pat,Guard,E1; +trans_comp_qual('<=',Pat,E0, Name, Ar, New, Ivars) -> + E1 = trans_expr(E0, Name, Ar, New, Ivars), + '<=',Pat,E1; +trans_comp_qual('<=',Pat,Guard,E0, Name, Ar, New, Ivars) -> + E1 = trans_expr(E0, Name, Ar, New, Ivars), + '<=',Pat,Guard,E1; +trans_comp_qual(Test, Name, Ar, New, Ivars) -> + trans_expr(Test, Name, Ar, New, Ivars). + +%% new_local_fun_name(Name, Arity, State) -> {FunName,State}. +%% Create a name for a local function. The name has a similar basic +%% format as those created in Core Erlang, though not overlapping. + +new_local_fun_name(Local, Lar, #cl{func=Func,arity=Far,fc=C}=St) -> + Name = lists:concat("-lfe-",Func,"/",Far, + "-local-",Local,"/",Lar, + "-",C,"-"), + {list_to_atom(Name),St#cl{fc=C+1}}. + +new_vars(N) when N > 0 -> + Var = lists:concat("+var+",N,"+"), + list_to_atom(Var)|new_vars(N-1); +new_vars(0) -> . + +%% ivars_expr(CoreExpr) -> ImportedVars. +%% ivars_expr(CoreExpr, KnownVars, ImportedVars) -> ImportedVars. +%% Return the imported variables in a Core expression. + +ivars_expr(Core) -> + ivars_expr(Core, ordsets:new(), ordsets:new()). + +%% Core data special forms. +ivars_expr(?Q(_), _Kvars, Ivars) -> Ivars; +ivars_expr(binary|Segs, Kvars, Ivars) -> + ivars_bitsegs(Segs, Kvars, Ivars); +%% Record forms. +ivars_expr('record',_|Args, Kvars, Ivars) -> + ivars_record_args(Args, Kvars, Ivars); +%% make-record has been deprecated but we sill accept it for now. +ivars_expr('make-record',_|Args, Kvars, Ivars) -> + ivars_record_args(Args, Kvars, Ivars); +ivars_expr('is-record',E,_, Kvars, Ivars) -> + ivars_expr(E, Kvars, Ivars); +ivars_expr('record-index',_,_, _, Ivars) -> Ivars; +ivars_expr('record-field',E,_,_, Kvars, Ivars) -> + ivars_expr(E, Kvars, Ivars); +ivars_expr('record-update',E,_|Args, Kvars, Ivars0) -> + Ivars1 = ivars_expr(E, Kvars, Ivars0), + ivars_record_args(Args, Kvars, Ivars1); +%% Struct special forms. +ivars_expr('struct',_Name|Args, Kvars, Ivars) -> + ivars_struct_args(Args, Kvars, Ivars); +ivars_expr('is-struct',E, Kvars, Ivars) -> + ivars_expr(E, Kvars, Ivars); +ivars_expr('is-struct',E,_, Kvars, Ivars) -> + ivars_expr(E, Kvars, Ivars); +ivars_expr('struct-field',E,_Name,_Field, Kvars, Ivars) -> + ivars_expr(E, Kvars, Ivars); +ivars_expr('struct-update',E,_Name|Args, Kvars, Ivars0) -> + Ivars1 = ivars_expr(E, Kvars, Ivars0), + ivars_struct_args(Args, Kvars, Ivars1); +%% Function forms. +ivars_expr(function,_,_, _, Ivars) -> Ivars; +ivars_expr(function,_,_,_, _, Ivars) -> Ivars; +%% Core closure special forms. +ivars_expr(lambda,Args|Body, Kvars, Ivars) -> + ivars_fun_cl(Args|Body, Kvars, Ivars); +ivars_expr('match-lambda'|Cls, Kvars, Ivars) -> + ivars_fun_cls(Cls, Kvars, Ivars); +ivars_expr('let',Vbs|Body, Kvars, Ivars) -> + ivars_let(Vbs, Body, Kvars, Ivars); +ivars_expr('let-function',Fbs|Body, Kvars, Ivars) -> + ivars_let_function(Fbs, Body, Kvars, Ivars); +ivars_expr('letrec-function',Fbs|Body, Kvars, Ivars) -> + ivars_let_function(Fbs, Body, Kvars, Ivars); +%% Core control special forms. +ivars_expr(progn|Body, Kvars, Ivars) -> + ivars_exprs(Body, Kvars, Ivars); +ivars_expr('if'|Body, Kvars, Ivars) -> + ivars_exprs(Body, Kvars, Ivars); +ivars_expr('case',Expr|Cls, Kvars, Ivars0) -> + Ivars1 = ivars_expr(Expr, Kvars, Ivars0), + ivars_cls(Cls, Kvars, Ivars1); +ivars_expr('receive'|Cls, Kvars, Ivars) -> + ivars_receive_cls(Cls, Kvars, Ivars); +ivars_expr('catch'|Body, Kvars, Ivars) -> + ivars_exprs(Body, Kvars, Ivars); +ivars_expr('try'|Body, Kvars, Ivars) -> + ivars_try(Body, Kvars, Ivars); +ivars_expr(funcall|Args, Kvars, Ivars) -> + ivars_exprs(Args, Kvars, Ivars); +ivars_expr(call|Args, Kvars, Ivars) -> + ivars_exprs(Args, Kvars, Ivars); +%% List/binary comprehensions. +ivars_expr('lc',Qs,E, Kvars, Ivars) -> + ivars_comp(Qs, E, Kvars, Ivars); +ivars_expr('list-comp',Qs,E, Kvars, Ivars) -> + ivars_comp(Qs, E, Kvars, Ivars); +ivars_expr('bc',Qs,E, Kvars, Ivars) -> + ivars_comp(Qs, E, Kvars, Ivars); +ivars_expr('binary-comp',Qs,E, Kvars, Ivars) -> + ivars_comp(Qs, E, Kvars, Ivars); +%% General cases. +ivars_expr(Fun|Args, Kvars, Ivars) when is_atom(Fun) -> + ivars_exprs(Args, Kvars, Ivars); +ivars_expr(Var, Kvars, Ivars) when is_atom(Var) -> + case ordsets:is_element(Var, Kvars) of + true -> Ivars; + false -> ordsets:add_element(Var, Ivars) + end; +ivars_expr(_Lit, _Kvars, Ivars) -> Ivars. %All literals + +ivars_exprs(Exprs, Kvars, Ivars) -> + Fun = fun (E, Ivs) -> ivars_expr(E, Kvars, Ivs) end, + lists:foldl(Fun, Ivars, Exprs). + +ivars_bitsegs(Segs, Kvars, Ivars) -> + Fun = fun (Seg, Ivs) -> ivars_bitseg(Seg, Kvars, Ivs) end, + lists:foldl(Fun, Ivars, Segs). + +ivars_bitseg(Val|Specs, Kvars, Ivars0) -> + %% This works even if bitseg is a string. + Ivars1 = ivars_expr(Val, Kvars, Ivars0), + Fun = fun (size,S, Ivs) -> ivars_expr(S, Kvars, Ivs); + (_, Ivs) -> Ivs + end, + lists:foldl(Fun, Ivars1, Specs); +ivars_bitseg(Val, Kvars, Ivars) -> + ivars_expr(Val, Kvars, Ivars). + +%% ivars_record_args(Args, Kvars, Ivars) -> Ivars. +%% ivars_struct_args(Args, Kvars, Ivars) -> Ivars. +%% Get the Ivars form record/struct argument lists. + +ivars_record_args(_F,V|As, Kvars, Ivars0) -> + Ivars1 = ivars_expr(V, Kvars, Ivars0), + ivars_record_args(As, Kvars, Ivars1); +ivars_record_args(, _, Ivars) -> Ivars. + +ivars_struct_args(_F,V|As, Kvars, Ivars0) -> + Ivars1 = ivars_expr(V, Kvars, Ivars0), + ivars_struct_args(As, Kvars, Ivars1); +ivars_struct_args(, _, Ivars) -> Ivars. + +%% ivars_let(VariableBindings, Body, Kvars, Ivars) -> Ivars. +%% Get Ivars from a let form. + +ivars_let(Vbs, Body, Kvars0, Ivars0) -> + Fun = fun (Pat,'when'|G,Expr, {Kvs0,Ivs0}) -> + Pvs = ivars_pat(Pat), + Kvs1 = ordsets:union(Pvs, Kvs0), + Ivs1 = ivars_exprs(G, Kvs1, Ivs0), + {Kvs1,ivars_expr(Expr, Kvs1, Ivs1)}; + (Pat,Expr, {Kvs0,Ivs}) -> + Pvs = ivars_pat(Pat), + Kvs1 = ordsets:union(Pvs, Kvs0), + {Kvs1,ivars_expr(Expr, Kvs1, Ivs)} + end, + {Kvars1,Ivars1} = lists:foldl(Fun, {Kvars0,Ivars0}, Vbs), + ivars_exprs(Body, Kvars1, Ivars1). + +%% ivars_let_function(FunctionBindings, Body, Kvars, Ivars) -> Ivars. +%% Get the Ivars from a let-function/letrec-function form. + +ivars_let_function(Fbs, Body, Kvars, Ivars0) -> + Fun = fun (_,Def, Ivs) -> ivars_expr(Def, Kvars, Ivs) end, + Ivars1 = lists:foldl(Fun, Ivars0, Fbs), + ivars_exprs(Body, Kvars, Ivars1). + +ivars_fun_cls(Cls, Kvars, Ivars) -> + Fun = fun (Cl, Ivs) -> ivars_fun_cl(Cl, Kvars, Ivs) end, + lists:foldl(Fun, Ivars, Cls). + +ivars_fun_cl(Pats|Body, Kvars, Ivars) -> + ivars_clause(list|Pats|Body, Kvars, Ivars). + +ivars_cls(Cls, Kvars, Ivars) -> + Fun = fun (Cl, Ivs) -> ivars_clause(Cl, Kvars, Ivs) end, + lists:foldl(Fun, Ivars, Cls). + +ivars_receive_cls(Cls, Kvars, Ivars) -> + Fun = fun ('after'|Body, Ivs) -> ivars_exprs(Body, Kvars, Ivs); + (Cl, Ivs) -> ivars_clause(Cl, Kvars, Ivs) + end, + lists:foldl(Fun, Ivars, Cls). + +%% ivars_clause(Clause, Kvars, Ivars) -> Ivars. +%% Get the Ivars from a function/case/receive clause. + +ivars_clause(Pat,'when'|G|Body, Kvars0, Ivars0) -> + Pvs = ivars_pat(Pat), + Kvars1 = ordsets:union(Pvs, Kvars0), + Ivars1 = ivars_exprs(G, Kvars1, Ivars0), + ivars_exprs(Body, Kvars1, Ivars1); +ivars_clause(Pat|Body, Kvars0, Ivars) -> + Pvs = ivars_pat(Pat), + Kvars1 = ordsets:union(Pvs, Kvars0), + ivars_exprs(Body, Kvars1, Ivars). + +%% ivars_try(TryBody, KnownVars, ImportedVars) -> ImportedVars. +%% Get the Ivars from a try. Step down the try body doing each +%% section separately. + +ivars_try(Try, Kvars, Ivars) -> + lists:foldl(fun (T, Ivs) -> ivars_try_1(T, Kvars, Ivs) end, + Ivars, Try). + +ivars_try_1('case'|Case, Kvars, Ivars) -> + ivars_cls(Case, Kvars, Ivars); +ivars_try_1('catch'|Catch, Kvars, Ivars) -> + ivars_cls(Catch, Kvars, Ivars); +ivars_try_1('after'|After, Kvars, Ivars) -> + ivars_exprs(After, Kvars, Ivars); +ivars_try_1(E, Kvars, Ivars) -> %The try expression. + ivars_expr(E, Kvars, Ivars). + +%% ivars_comp(Qualifiers, Expr, KnownVars, ImportedVars) -> ImportedVars, +%% Get the Ivars from a list/binary comprehension. + +ivars_comp(Qs, E, Kvars0, Ivars0) -> + {Kvars1,Ivars1} = ivars_comp_quals(Qs, Kvars0, Ivars0), + ivars_expr(E, Kvars1, Ivars1). + +ivars_comp_quals(Qs, Kvars, Ivars) -> + lists:foldl(fun (Q, {Kvars0,Ivars0}) -> + {Kvars1,Ivars1} = ivars_comp_qual(Q, Kvars0, Ivars0), + {Kvars1,Ivars1} + end, {Kvars,Ivars}, Qs). + +ivars_comp_qual('<-',Pat,Gen, Kvars, Ivars) -> + ivars_comp_qual(Pat, , Gen, Kvars, Ivars); +ivars_comp_qual('<-',Pat,'when'|G,Gen, Kvars, Ivars) -> + ivars_comp_qual(Pat, G, Gen, Kvars, Ivars); +ivars_comp_qual('<=',Pat,Gen, Kvars, Ivars) -> + ivars_comp_qual(Pat, , Gen, Kvars, Ivars); +ivars_comp_qual('<=',Pat,'when'|G,Gen, Kvars, Ivars) -> + ivars_comp_qual(Pat, G, Gen, Kvars, Ivars); +ivars_comp_qual(Test, Kvars, Ivars) -> + {Kvars,ivars_expr(Test, Kvars, Ivars)}. + +ivars_comp_qual(Pat, G, Gen, Kvars0, Ivars0) -> + Pvs = ivars_pat(Pat), + Kvars1 = ordsets:union(Pvs, Kvars0), + Ivars1 = ivars_exprs(G, Kvars1, Ivars0), + Ivars2 = ivars_expr(Gen, Kvars1, Ivars1), + {Kvars1,Ivars2}. + +%% ivars_pat(Pattern) -> PatternVars. +%% ivars_pat(Pattern, PatternVars) -> PatternVars. + +ivars_pat(Pat) -> ivars_pat(Pat, ordsets:new()). + +ivars_pat(?Q(_), Pvars) -> Pvars; +ivars_pat(list|Es, Pvars) -> + ivars_pats(Es, Pvars); +ivars_pat(_Fun|Args, Pvars) -> + ivars_pats(Args, Pvars); +ivars_pat(Var, Pvars) when is_atom(Var) -> + ordsets:add_element(Var, Pvars); +ivars_pat(_List, Pvars) -> Pvars. %All literals + +ivars_pats(Pats, Pvars) -> + Fun = fun (P, Pvs) -> ivars_pat(P, Pvs) end, + lists:foldl(Fun, Pvars, Pats). + +%% mapfoldl2(Fun, Acc1, Acc2, List) -> {List,Acc1,Acc2}. + +mapfoldl2(Fun, A0, B0, E0|Es0) -> + {E1,A1,B1} = Fun(E0, A0, B0), + {Es1,A2,B2} = mapfoldl2(Fun, A1, B1, Es0), + {E1|Es1,A2,B2}; +mapfoldl2(_, A, B, ) -> {,A,B}. + +%% test(Which) -> Sexpr. + +test(1) -> + %% Straight forward with no func/arity clashes with macros. + 'let-function', + a,lambda,s,foo,s, + b,lambda,x,y,bar,a,x,y, + b,42,43; +test(2) -> + %% Importing variables. + 'let-function', + a,lambda,s,foo,s,'i-2', + b,'match-lambda',x,y,bar,a,x,y, + c,lambda,m,b,m,'i-1', + c,43; +test(3) -> + %% Have local function a/1 and also calling global a/2. + 'let-function', + a,lambda,s,foo,s, + b,lambda,x,y,bar,a,x,a,99,y, + b,42,43; +test(4) -> + %% Have a local function a/1 call a global a/1. + 'let-function', + a,lambda,s,a,s, + b,lambda,x,y,b,a,x,y, + b,42,43; +test(5) -> + %% Create a function to local a function. + lambda,x,y,z, + 'let-function', + foo,lambda,a,b,g1,a,b,z, + g2,function,foo,2,x,y,z; +%% Letrec tests. +test(11) -> + %% Straight forward with no func/arity clashes with macros. + 'letrec-function', + a,lambda,s,b,10,s, + b,lambda,x,y,bar,a,x,y, + b,42,43; +test(12) -> + %% Importing variables. + 'letrec-function', + a,lambda,s,b,s,'i-2', + b,'match-lambda',x,y,bar,a,x,y, + c,lambda,m,b,m,'i-1', + c,43; +test(13) -> + %% Have local function a/1 and also calling global a/2. + 'letrec-function', + a,lambda,s,foo,s, + b,lambda,x,y,bar,a,x,a,99,y, + b,42,43.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_comp.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_comp.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,8 +34,12 @@ -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). +-include("lfe.hrl"). -include("lfe_comp.hrl"). +%% Mightn't use all commands in do_passes yet. +-dialyzer({no_match,do_passes/2}). + %% The main compiler state. -record(comp, {base="", %Base name @@ -49,7 +53,8 @@ code=, %Code after last pass. return=, %What is returned Val | errors=, - warnings= + warnings=, + extra= %Pass specific options, plist }). %% default_options() -> Options. @@ -85,8 +90,7 @@ Ret = try internal(Input, Opts) catch - error:Reason -> - St = erlang:get_stacktrace(), + ?CATCH(error, Reason, St) {error,{Reason,St}} end, exit(Ret) @@ -114,10 +118,10 @@ end. do_forms(Fs0, Opts0) -> - Source = proplists:get_value(source, Opts0, "-no-file-"), + Source = lprop(source, Opts0, ""), Opts1 = lfe_comp_opts(Opts0), St0 = #comp{opts=binary|Opts1}, %Implicit binary option - St1 = filenames(Source, ".lfe", St0), + St1 = filenames(Source, "", 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), @@ -129,20 +133,29 @@ filenames(File, Suffix, St) -> %% Test for explicit outdir. - Odir = outdir(St#comp.opts), + Odir = outdir(St#comp.opts, "."), Ldir = filename:dirname(File), Base = filename:basename(File, Suffix), - Lfile = filename:join(Ldir, Base ++ Suffix), + Lfile = lfefile(Ldir, Base, Suffix), St#comp{base=Base, ldir=Ldir, lfile=Lfile, odir=Odir }. -outdir({outdir,Dir}|_) -> Dir; %Erlang way -outdir(outdir,Dir|_) -> Dir; %LFE way -outdir(_|Opts) -> outdir(Opts); -outdir() -> ".". +lfefile(".", Base, Suffix) -> Base ++ Suffix; +lfefile(Dir, Base, Suffix) -> + filename:join(Dir, Base ++ Suffix). + +outdir(Opts, Def) -> lprop(outdir, Opts, Def). + +%% lprop(Key, PropList, Default) -> Value. +%% Find Key, Val from PropList else Default. + +lprop(Key, {Key,Val}|_, _) -> Val; %Erlang way +lprop(Key, Key,Val|_, _) -> Val; %LFE way +lprop(Key, _|List, Def) -> lprop(Key, List, Def); +lprop(_, , Def) -> Def. %% include_path(State) -> State. %% Set the include path, we permit {i,Dir} and i,Dir. @@ -168,14 +181,15 @@ Fun = fun ('to-split') -> to_split; ('to-expmac') -> to_expmac; ('to-expand') -> to_expand; - ('to-exp') -> to_exp; %Backwards compatibility - ('to-pmod') -> to_pmod; ('to-lint') -> to_lint; ('no-docs') -> no_docs; + ('to-erlang') -> to_erlang; ('to-core0') -> to_core0; ('to-core') -> to_core; ('to-kernel') -> to_kernel; ('to-asm') -> to_asm; + ('to-ast') -> to_ast; %The output should be an AST + ('debug-info') -> debug_info; ('no-export-macros') -> no_export_macros; ('warnings-as-errors') -> warnings_as_errors; ('report-warnings') -> report_warnings; @@ -229,25 +243,25 @@ %% Now we expand and trim remaining macros. {do,fun do_expand_macros/1}, {when_flag,to_expand,{done,fun expand_pp/1}}, - {when_flag,to_exp,{done,fun expand_pp/1}}, %Backwards compatibility - {do,fun do_lfe_pmod/1}, - {when_flag,to_pmod,{done,fun pmod_pp/1}}, {do,fun do_lfe_lint/1}, {when_flag,to_lint,{done,fun lint_pp/1}}, {unless_flag,no_docs,{do,fun do_get_docs/1}}, {do,fun do_lfe_codegen/1}, - {when_flag,to_core0,{done,fun core_pp/1}}, + {when_flag,to_erlang,{done,fun erlang_pp/1}}, {do,fun do_erl_comp/1}, %% These options will have made erlang compiler return internal %% form after pass. + {when_flag,to_core0,{done,fun erl_core_pp/1}}, {when_flag,to_core,{done,fun erl_core_pp/1}}, {when_flag,to_kernel,{done,fun erl_kernel_pp/1}}, {when_flag,to_asm,{done,fun erl_asm_pp/1}}, - %% Write docs beam chunks. - {unless_flag,no_docs,{do,fun do_add_docs/1}}, + %% Stop at non-binary returns, either return or drop. + {unless_test,fun is_binary_module/1,done}, %% Now we just write the beam file unless warnings-as-errors is %% set and we have warnings. {when_test,fun is_werror/1,error}, + %% Write docs beam chunks. + {do,fun add_chunks/1}, {done,fun beam_write/1} %Should be last . @@ -280,8 +294,11 @@ %% top-level macros in forms so we can safelt detect the start of %% each module (with define-module form). -do_split_file(#comp{cinfo=Ci,code=Code}=St) -> - case collect_pre_forms(Code, Ci) of %Expand pre module forms +do_split_file(#comp{lfile=Lfile,cinfo=Ci,code=Code0}=St) -> + %% Add a FILE macro with the file name at the beginning. + Mac = {defmacro,'FILE',,?BQ(?Q(Lfile)),1}, + Code1 = Mac|Code0, + case collect_pre_forms(Code1, Ci) of %Expand pre module forms {Pfs,Fs,Env0,Mst0} -> %% Expand the modules using the pre forms and environment. case collect_modules(Fs, Pfs, Env0, Mst0) of @@ -305,53 +322,53 @@ collect_pre_forms(Fs, Ci) -> Env = lfe_env:new(), %% Don't deep expand, keep everything. - St = lfe_macro:expand_form_init(Ci, false, true), - collect_mod_forms(Fs, Env, St). + Mst = lfe_macro:expand_form_init(Ci, false, true), + collect_mod_forms(Fs, Env, Mst). -%% collect_modules(Forms, PreForms, PreEnv, State) -> -%% {Modules,State}. +%% collect_modules(Forms, PreForms, PreEnv, MacroState) -> +%% {Modules,MacroState}. %% Collect and expand modules upto the end. Each module initially has %% the pre environment and all pre forms are appended to it. -collect_modules(Fs, PreFs, PreEnv, St) -> - collect_modules(Fs, , PreFs, PreEnv, St). +collect_modules(Fs, PreFs, PreEnv, Mst) -> + collect_modules(Fs, , PreFs, PreEnv, Mst). -collect_modules({'define-module',Name|_,_}=Mdef|Fs0, Ms, PreFs, PreEnv, St0) -> +collect_modules({'define-module',Name|_,_}=Mdef|Fs0, Ms, PreFs, PreEnv, Mst0) -> %% Expand and collect all forms upto next define-module or end. - case collect_mod_forms(Fs0, PreEnv, St0) of - {Mfs0,Fs1,_,St1} -> + case collect_mod_forms(Fs0, PreEnv, Mst0) of + {Mfs0,Fs1,_,Mst1} -> M = #module{name=Name,code=Mdef ++ PreFs ++ Mfs0}, - collect_modules(Fs1, M|Ms, PreFs, PreEnv, St1); + collect_modules(Fs1, M|Ms, PreFs, PreEnv, Mst1); Error -> Error end; -collect_modules(, Ms, _PreFs, _PreEnv, St) -> - {ok,lists:reverse(Ms),St}. +collect_modules(, Ms, _PreFs, _PreEnv, Mst) -> + {ok,lists:reverse(Ms),Mst}. -%% collect_mod_forms(Forms, Env, State) -> -%% collect_mod_forms(Forms, Acc, Env, State) -> -%% {Modforms,RestForms,Env,State}. +%% collect_mod_forms(Forms, Env, MacroState) -> +%% collect_mod_forms(Forms, Acc, Env, MacroState) -> +%% {Modforms,RestForms,Env,MacroState}. %% Expand and collect forms upto the next define-module or end. We %% also flatten top-level nested progn code. -collect_mod_forms(Fs, Env0, St0) -> - case collect_mod_forms(Fs, , Env0, St0) of - {Acc,Rest,Env1,St1} -> - {lists:reverse(Acc),Rest,Env1,St1}; +collect_mod_forms(Fs, Env0, Mst0) -> + case collect_mod_forms(Fs, , Env0, Mst0) of + {Acc,Rest,Env1,Mst1} -> + {lists:reverse(Acc),Rest,Env1,Mst1}; {error,_,_}=Error -> Error end. -collect_mod_forms(F0|Fs0, Acc, Env0, St0) -> - case lfe_macro:expand_fileform(F0, Env0, St0) of - {ok,{'define-module'|_,_}=F1,Env1,St1} -> - {Acc,F1|Fs0,Env1,St1}; - {ok,{'progn'|Pfs,L},Env1,St1} -> %Flatten progn's +collect_mod_forms(F0|Fs0, Acc, Env0, Mst0) -> + case lfe_macro:expand_fileform(F0, Env0, Mst0) of + {ok,{'define-module'|_,_}=F1,Env1,Mst1} -> + {Acc,F1|Fs0,Env1,Mst1}; + {ok,{'progn'|Pfs,L},Env1,Mst1} -> %Flatten progn's Fs1 = {F,L} || F <- Pfs ++ Fs0, - collect_mod_forms(Fs1, Acc, Env1, St1); - {ok,F1,Env1,St1} -> - collect_mod_forms(Fs0, F1|Acc, Env1, St1); + collect_mod_forms(Fs1, Acc, Env1, Mst1); + {ok,F1,Env1,Mst1} -> + collect_mod_forms(Fs0, F1|Acc, Env1, Mst1); {error,Es,Ws,_} -> {error,Es,Ws} end; -collect_mod_forms(, Acc, Env, St) -> {Acc,,Env,St}. +collect_mod_forms(, Acc, Env, Mst) -> {Acc,,Env,Mst}. %% do_export_macros(State) -> {ok,State} | {error,State}. %% do_expand_macros(State) -> {ok,State} | {error,State}. @@ -408,21 +425,12 @@ throw:{expand_form,Error} -> Error end. -%% do_lfe_pmod(State) -> {ok,State} | {error,State}. %% do_lint(State) -> {ok,State} | {error,State}. -%% do_lfe_codegen(State) -> {ok,State} | {error,State}. %% do_get_docs(State) -> {ok,State} | {error,State}. +%% do_lfe_codegen(State) -> {ok,State} | {error,State}. %% do_erl_comp(State) -> {ok,State} | {error,State}. %% The actual compiler passes. -do_lfe_pmod(#comp{cinfo=Ci,code=Ms0}=St) -> - Pmod = fun (#module{code=Mfs0}=Mod) -> - {Name,Mfs1} = lfe_pmod:module(Mfs0, Ci), - Mod#module{name=Name,code=Mfs1} - end, - Ms1 = lists:map(Pmod, Ms0), - {ok,St#comp{code=Ms1}}. - do_lfe_lint(#comp{cinfo=Ci,code=Ms0}=St0) -> Lint = fun (#module{code=Mfs,warnings=Ws}=Mod) -> case lfe_lint:module(Mfs, Ci) of @@ -435,25 +443,26 @@ St1 = St0#comp{code=Ms1}, ?IF(all_module(Ms1), {ok,St1}, {error,St1}). -do_get_docs(#comp{cinfo=Ci,code=Ms0}=St0) -> - Doc = fun (#module{code=Mfs,warnings=Ws}=Mod) -> - case lfe_doc:extract_module_docs(Mfs, Ci) of - {ok,Docs} -> Mod#module{docs=Docs}; - {error,Des,Dws} -> {error,Des,Ws ++ Dws} - end +do_get_docs(#comp{code=Ms0,opts=Opts}=St) -> + Doc = fun (#module{code=Mfs,chunks=Chks}=Mod) -> + {ok,Chunk} = lfe_docs:make_chunk(Mfs, Opts), + Mod#module{chunks=Chunk|Chks} end, Ms1 = lists:map(Doc, Ms0), - St1 = St0#comp{code=Ms1}, - ?IF(all_module(Ms1), {ok,St1}, {error,St1}). + {ok,St#comp{code=Ms1}}. -do_lfe_codegen(#comp{cinfo=Ci,code=Ms0}=St) -> - Code = fun (#module{name=Name,code=Mfs}=Mod) -> - %% Name consistency check! - {Name,Core} = lfe_codegen:module(Mfs, Ci), - Mod#module{code=Core} +do_lfe_codegen(#comp{cinfo=Ci,code=Ms0}=St0) -> + Code = fun (#module{name=Name,code=Mfs,warnings=Ws}=Mod) -> + case lfe_codegen:module(Mfs, Ci) of + {ok,Name,AST,Gws} -> %Name consistency check! + Mod#module{code=AST,warnings=Ws ++ Gws}; + {error,Ges,Gws} -> + {error,Ges,Gws} + end end, Ms1 = lists:map(Code, Ms0), - {ok,St#comp{code=Ms1}}. + St1 = St0#comp{code=Ms1}, + ?IF(all_module(Ms1), {ok,St1}, {error,St1}). do_erl_comp(#comp{code=Ms0}=St0) -> ErlOpts = erl_comp_opts(St0), %Options to erlang compiler @@ -483,11 +492,6 @@ Filter = fun (report) -> false; %No reporting! (report_warnings) -> false; (report_errors) -> false; - ('S') -> false; %No stopping early - ('E') -> false; - ('P') -> false; - (dcore) -> false; - (to_core0) -> false; (warnings_as_errors) -> false; %We handle these ourselves ({source,_}) -> false; (_) -> true %Everything else @@ -495,19 +499,17 @@ Os1 = filter(Filter, Os0), %% Now build options for the erlang compiler. 'no_bopt' turns off %% an optimisation in the guard which crashes our code. - from_core, %We are compiling from core - {source,St#comp.lfile}, %Set the source file + {source,St#comp.lfile}, %Set the source file return, %Ensure we return something binary, %We want a binary - no_bopt|Os1. + nowarn_unused_vars| %Don't need to know here + Os1. %% split_pp(State) -> {ok,State} | {error,State}. %% expmac_pp(State) -> {ok,State} | {error,State}. %% expand_pp(State) -> {ok,State} | {error,State}. -%% pmod_pp(State) -> {ok,State} | {error,State}. %% lint_pp(State) -> {ok,State} | {error,State}. %% sexpr_pp(State) -> {ok,State} | {error,State}. -%% core_pp(State) -> {ok,State} | {error,State}. %% erl_core_pp(State) -> {ok,State} | {error,State}. %% erl_kernel_pp(State) -> {ok,State} | {error,State}. %% erl_asm_pp(State) -> {ok,State} | {error,State}. @@ -520,7 +522,6 @@ split_pp(St) -> sexpr_pp(St, "split"). expmac_pp(St) -> sexpr_pp(St, "expmac"). expand_pp(St) -> sexpr_pp(St, "expand"). -pmod_pp(St) -> sexpr_pp(St, "pmod"). lint_pp(St) -> sexpr_pp(St, "lint"). sexpr_pp(St, Ext) -> @@ -530,26 +531,38 @@ do_list_save_file(Save, Ext, St). %% These print a list of module structures. -core_pp(St) -> - Save = fun (File, #module{code=Core}) -> - io:put_chars(File, core_pp:format(Core),$\n) +erlang_pp(#comp{opts=Opts}=St) -> + Format = ?IF(member(to_ast, Opts), + fun (F) -> io_lib:format("~p.\n", F) end, + fun (F) -> erl_pp:form(F),$\n end), + Save = fun (File, #module{code=AST}) -> + Chars = Format(F) || F <- AST , + io:put_chars(File, Chars) end, - do_list_save_file(Save, "core", St). + do_list_save_file(Save, "erl", St). -erl_core_pp(St) -> +erl_core_pp(#comp{opts=Opts}=St) -> + Format = ?IF(member(to_ast, Opts), + fun (F) -> io_lib:format("~p.\n", F) end, + fun (F) -> core_pp:format(F),$\n end), Save = fun (File, #module{code=Core}) -> - io:put_chars(File, core_pp:format(Core),$\n) + io:put_chars(File, Format(Core)) end, do_list_save_file(Save, "core", St). -erl_kernel_pp(St) -> +erl_kernel_pp(#comp{opts=Opts}=St) -> + Format = ?IF(member(to_ast, Opts), + fun (F) -> io_lib:format("~p.\n", F) end, + fun (F) -> v3_kernel_pp:format(F),$\n end), Save = fun (File, #module{code=Kern}) -> - io:put_chars(File, v3_kernel_pp:format(Kern),$\n) end, + io:put_chars(File, Format(Kern)) + end, do_list_save_file(Save, "kernel", St). erl_asm_pp(St) -> Save = fun (File, #module{code=Asm}) -> - beam_listing:module(File, Asm), io:nl(File) end, + beam_listing:module(File, Asm), io:nl(File) + end, do_list_save_file(Save, "S", St). do_list_save_file(SaveOne, Ext, St) -> @@ -568,25 +581,25 @@ case Ret of ok -> {ok,St}; {error,_} -> - %% Just signal we couldn't write the file. - {error,St#comp{errors={lfe_comp,write_file}}} + %% Just signal we couldn't write the file. + {error,St#comp{errors={lfe_comp,write_file}}} end; {error,_} -> - %% Just signal we couldn't write the file. - {error,St#comp{errors={lfe_comp,write_file}}} + %% Just signal we couldn't write the file. + {error,St#comp{errors={lfe_comp,write_file}}} end. -do_add_docs(#comp{cinfo=Ci,code=Ms0}=St0) -> - Add = fun (#module{code=Beam0,docs=Docs}=Mod) -> - case lfe_doc:save_module_docs(Beam0, Docs, Ci) of - {ok,Beam1} -> Mod#module{code=Beam1}; - {error,Es} -> {error,Es,} +add_chunks(#comp{code=Ms0}=St) -> + Add = fun (#module{name=Name,code=Beam0,chunks=Chks}=Mod) -> + if Chks =:= -> Mod; %Nothing to do + true -> + {ok,Name,All} = beam_lib:all_chunks(Beam0), + {ok,Beam1} = beam_lib:build_module(Chks ++ All), + Mod#module{code=Beam1} end end, - %%Add = fun (Mod) -> lfe_doc:save_module_docs(Mod, Ci) end, Ms1 = lists:map(Add, Ms0), - St1 = St0#comp{code=Ms1}, - ?IF(all_module(Ms1), {ok,St1}, {error,St1}). + {ok,St#comp{code=Ms1}}. beam_write(St0) -> Ms1 = lists:map(fun (M) -> beam_write_module(M, St0) end, St0#comp.code), @@ -599,7 +612,7 @@ case file:write_file(Name, Beam) of ok -> Mod; {error,_} -> - %% Just signal we couldn't write the file. + %% Just signal we couldn't write the file. {error,{lfe_comp,write_file},} end. @@ -607,6 +620,16 @@ fix_erl_errors(Fes) -> flatmap(fun ({_,Es}) -> Es end, Fes). +%% is_binary_module(State) -> true | false. +%% Check whether the module code is a binary or not. + +is_binary_module(#comp{code=Mods}) -> + case Mods of + #module{code=Code}|_ when is_binary(Code) -> true; + _ -> false + %% _ -> io:format("ibr: ~p\n", Mods), false + end. + %% is_werror(State) -> true | false. %% Check if warnings_as_errors is set and we have warnings.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_comp.hrl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_comp.hrl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2014-2015 Robert Virding +%% Copyright (c) 2014-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,20 +26,17 @@ -record(module, {name=, %Module name code=none, %Module code - warnings=, %Module warnings - docs= %Module docs + chunks=, %Extra chunks + warnings= %Module warnings }). -%% Bloody useful --define(IF(Test,True,False), case Test of true -> True; false -> False end). - %% ?WHEN_OPT(Option, Options, Fun) -> ok. %% ?UNLESS_OPT(Option, Options, Fun) -> ok. %% Call Fun when Option is/is not a member of Options. --define(WHEN_OPT(Opt,Opts,Fun), ?IF(member(Opt, Opts), Fun(), ok)). +-define(WHEN_OPT(Opt,Opts,Fun), ?IF(lists:member(Opt, Opts), Fun(), ok)). -%% -define(UNLESS_OPT(Opt,Opts,Fun), ?IF(member(Opt, Opts), ok, Fun())). +%% -define(UNLESS_OPT(Opt,Opts,Fun), ?IF(lists:member(Opt, Opts), ok, Fun())). -define(DEBUG(Format,Args,Opts), ?WHEN_OPT(debug_print, Opts,
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_docs.erl
Added
@@ -0,0 +1,279 @@ +%% Copyright (c) 2022 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_docs.erl +%% Author : Robert Virding +%% Purpose : Lisp Flavoured Erlang documentation handling. + +%% This module takes a lot of input from an older module written by +%% Eric Bailey. +%% +%% The "Docs" format from EEP 48: Documentation storage and format +%% +%% {docs_v1, +%% Anno :: erl_anno:anno(), +%% BeamLanguage :: atom(), +%% Format :: mime_type(), +%% ModuleDoc :: #{DocLanguage := DocValue} | none | hidden, +%% Metadata :: map(), +%% Docs :: +%% {{Kind, Name, Arity}, +%% Anno :: erl_anno:anno(), +%% Signature :: binary(), +%% Doc :: #{DocLanguage := DocValue} | none | hidden, +%% Metadata :: map() +%% }} when DocLanguage :: binary(), +%% DocValue :: binary() | term() + +-module(lfe_docs). +-export(make_chunk/2,make_docs_info/2). + +-export(get_module_docs/1). + +-include("lfe_docs.hrl"). + +%% Internal lfe_doc records. +-record(docs, {copts=, + module=, + macs=, + funcs= + }). + +-record(module, {name=, %Name + anno=, %Annotations/line + docs=, %Documentation + meta=, %Metadata + atts=, %Attributes + fexps=, %Exported functions + mexps= %Exported macros + }). + +-record(function, {name=, %Name + arity=, %Arity + anno=, %Annotations/line + docs=, %Documentation + spec=none, %Spec + meta=, %Meta information + def= %Definition + }). + +-record(macro, {name=, %Name + arity=, %Arity, always 1 for macros + anno=, %Annotations/line + docs=, %Documentation + spec=none, %Spec + meta=, %Meta information + def= %Definition + }). + +make_chunk(Code, CompilerOpts) -> + {ok,DocInfo} = make_docs_info(Code, CompilerOpts), + Chunk = {"Docs",erlang:term_to_binary(DocInfo)}, + {ok,Chunk}. + +make_docs_info(Code, CompilerOpts) -> + DS0 = #docs{copts=CompilerOpts,module=#module{}}, + DS1 = collect_forms(Code, DS0), + #module{anno=Anno,docs=Mdocs} = DS1#docs.module, + Funcs = generate_functions(DS1), + Macros = generate_macros(DS1), + DocInfo = docs_v1(Anno, Mdocs, #{}, Funcs ++ Macros), + {ok,DocInfo}. + +%% collect_forms(Code, DocsState) -> DocsState. + +collect_forms(Code, DS) -> lists:foldl(fun collect_form/2, DS, Code). + +collect_form({'define-module',Name,Meta,Atts,Line}, #docs{module=M0}=DS) -> + M1 = M0#module{name=Name,anno=Line}, + M2 = collect_mod_attrs(Atts, M1), + M3 = collect_mod_metas(Meta, M2), + DS#docs{module=M3}; +collect_form({'extend-module',Meta,Atts,_Line}, #docs{module=M0}=DS) -> + M1 = collect_mod_attrs(Atts, M0), + M2 = collect_mod_metas(Meta, M1), + DS#docs{module=M2}; +collect_form({'define-function',Name,Meta,Def,Line}, #docs{funcs=Fs}=DS) -> + F = collect_function(Name, Meta, Def, Line), + DS#docs{funcs=Fs ++ F}; +collect_form({'define-macro',Name,Meta,Def,Line}, #docs{macs=Ms}=DS) -> + M = collect_macro(Name, Meta, Def, Line), + DS#docs{macs=Ms ++ M}; +collect_form(_, DS) -> DS. + +collect_mod_metas(Metas, Mod) -> + Collect = fun (doc|Ds, M) -> + M#module{docs=M#module.docs ++ Ds}; + (_, M) -> M + end, + lists:foldl(Collect, Mod, Metas). + +collect_mod_attrs(Attrs, Mod) -> + Collect = fun (doc|Ds, M) -> + M#module{docs=M#module.docs ++ Ds}; + (export|Es, #module{fexps=Fes}=M) -> + M#module{fexps=collect_mod_exports(Fes, Es)}; + ('export-macro'|Es, #module{mexps=Mes}=M) -> + M#module{mexps=collect_mod_exports(Mes, Es)}; + (_, M) -> M + end, + lists:foldl(Collect, Mod, Attrs). + +%% Must handle exporting all for functions and macros. +collect_mod_exports(_Exps, all) -> all; +collect_mod_exports(all, _Es) -> all; +collect_mod_exports(Exps, Es) -> Exps ++ Es. + +collect_function(Name, Meta, Def, Line) -> + F = #function{name=Name, + arity=function_arity(Def), + anno=Line, + meta=Meta, + def=Def}, + collect_fun_metas(Meta, F). + +collect_fun_metas(Metas, Fun) -> + Collect = fun (doc|Ds, F) -> + F#function{docs=F#function.docs ++ Ds}; + (spec|Ss, F) -> + F#function{spec=Ss}; + (_, F) -> F + end, + lists:foldl(Collect, Fun, Metas). + +function_arity(lambda,Args|_) -> length(Args); +function_arity('match-lambda',Pat|_|_) -> length(Pat). + +collect_macro(Name, Meta, Def, Line) -> + F = #macro{name=Name, + arity=1, %Default for all macros + anno=Line, + meta=Meta, + def=Def}, + collect_mac_metas(Meta, F). + +collect_mac_metas(Metas, Mac) -> + Collect = fun (doc|Ds, M) -> + M#macro{docs=M#macro.docs ++ Ds}; + (_, M) -> M + end, + lists:foldl(Collect, Mac, Metas). + +%% generate_functions(Docs) -> FunctionDoc. + +generate_functions(#docs{module=#module{fexps=Fexps},funcs=Funcs}) -> + Fdoc = fun (#function{name=Name,arity=Arity,anno=Anno,docs=Docs}=F) -> + Sig = generate_sig(F), + Spec = generate_spec(F), + docs_v1_entry(function, Name, Arity, Anno, Sig, Docs, Spec) + end, + Fdoc(F) || F <- Funcs, exported_function(F, Fexps). + +exported_function(_F, all) -> true; %All functions are exported. +exported_function(#function{name=N,arity=A}, Fexps) -> + lists:member(N,A, Fexps). + +%% generate_macros(Docs) -> MacroDoc. + +generate_macros(#docs{module=#module{mexps=Mexps},macs=Macros}) -> + Mdoc = fun (#macro{name=Name,arity=Arity,anno=Anno,docs=Docs}=M) -> + Sig = generate_sig(M), + Spec = generate_spec(M), + docs_v1_entry(macro, Name, Arity, Anno, Sig, Docs, Spec) + end, + Mdoc(M) || M <- Macros, exported_macro(M, Mexps) . + +exported_macro(_M, all) -> true; %All macros are exported. +exported_macro(#macro{name=N}, Mexps) -> + lists:member(N, Mexps). + +%% generate_sig(FunctionMacro) -> Signature. + +generate_sig(#function{name=Name,arity=Arity,def=Def}) -> + generate_sig(Name, Arity, Def); +generate_sig(#macro{name=Name,arity=Arity,def=Def}) -> + generate_sig(Name, Arity, Def). + +generate_sig(Name, Arity, _Def) -> + Sig = lists:concat(Name,"/",Arity), + iolist_to_binary(Sig). + +%% generate_spec(FunctionMacro) -> ErlangSpec. + +generate_spec(#function{name=Name,arity=Arity,anno=Line,spec=Spec}) -> + generate_spec(Name, Arity, Line, Spec); +generate_spec(#macro{name=Name,arity=Arity,anno=Line,spec=Spec}) -> + generate_spec(Name, Arity, Line, Spec). + +generate_spec(_Name, _Arity, _Line, none) -> + #{}; +generate_spec(Name, Arity, Line, Spec) -> + %% Translate the LFE spec to Erlang format. + Sdef = {{Name,Arity},lfe_types:to_func_spec_list(Spec, Line)}, + #{signature => {attribute,Line,spec,Sdef}}. + +%% docs_v1(Anno, ModuleDocs, MetaData, Docs) -> #docs_v1{}. +%% docs_v1_entry(Kind, Name, Arity, Anno, Signature, Doc, MetaData) -> +%% Docs_V1_Entry. + +docs_v1(Anno, ModDoc, Metadata, Docs) -> + Doc = docs_v1_doc(ModDoc), + Meta = maps:merge(Metadata, #{otp_doc_vsn => ?CURR_DOC_VERSION}), + #docs_v1{anno=Anno, + beam_language=lfe, + format= ?LFE_FORMAT, + module_doc=Doc, + metadata=Meta, + docs=Docs}. + +docs_v1_entry(Kind, Name, Arity, Anno, Sig, DocContent, Meta) -> + Doc = docs_v1_doc(DocContent), + {{Kind,Name,Arity}, Anno, Sig, Doc, Meta}. + +docs_v1_doc() -> + none; +docs_v1_doc(DocContent) -> + #{<<"en">> => iolist_to_binary(DocContent)}. + +%% get_module_doc(Module | Binary) -> {ok,Chunk} | {error,What}. +%% Get the module doc chunk. If EEP48 is defined we can use the code +%% module to do most of the work. + +-ifdef(EEP48). + +get_module_docs(Mod) when is_atom(Mod) -> + code:get_doc(Mod); +get_module_docs(Bin) when is_binary(Bin) -> + get_module_chunk(Bin). + +-else. + +get_module_docs(Mod) when is_atom(Mod) -> + case code:get_object_code(Mod) of + {Mod,Bin,_} -> + get_module_chunk(Bin); + error -> {error,non_existing} %Could not find the module + end; +get_module_docs(Bin) when is_binary(Bin) -> + get_module_chunk(Bin). + +-endif. + +get_module_chunk(Bin) -> + case beam_lib:chunks(Bin, "Docs", ) of + {ok,{_,{"Docs",Chunk}}} -> + {ok,binary_to_term(Chunk)}; + {error,beam_lib,Error} -> + {error,Error} + end.
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_docs.hrl
Added
@@ -0,0 +1,50 @@ +%% Copyright (c) 2020 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_docs.hrl +%% Author : Robert Virding +%% Purpose : Common documentation-related definitions. + +%% The "Docs" format from EEP 48: Documentation storage and format +%% +%% {docs_v1, +%% Anno :: erl_anno:anno(), +%% BeamLanguage :: atom(), +%% Format :: mime_type(), +%% ModuleDoc :: #{DocLanguage := DocValue} | none | hidden, +%% Metadata :: map(), +%% Docs :: +%% {{Kind, Name, Arity}, +%% Anno :: erl_anno:anno(), +%% Signature :: binary(), +%% Doc :: #{DocLanguage := DocValue} | none | hidden, +%% Metadata :: map() +%% }} when DocLanguage :: binary(), +%% DocValue :: binary() | term() + +-define(NATIVE_FORMAT,<<"application/erlang+html">>). +-define(LFE_FORMAT, <<"text/markdown">>). + +-define(CURR_DOC_VERSION, {1,0,0}). + +%% The Docs v1 record. +-record(docs_v1, {anno, + beam_language, + format, + module_doc, + metadata, + docs = + }). + +-type docs_v1() :: #docs_v1{}.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_edlin_expand.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_edlin_expand.erl
Changed
@@ -1,21 +1,16 @@ +%% Copyright (c) 2008-2022 Robert Virding %% -%% %CopyrightBegin% +%% 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 %% -%% 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% +%% 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. -module(lfe_edlin_expand). @@ -39,9 +34,9 @@ case Bef1 of $:|Bef2 -> %After a ':' {Bef3,S2,_} = over_symbol(Bef2, , 0), - need_lparen(Bef3, fun () -> expand_function_name(S2, S1) end); + need_lparen(Bef3, fun () -> expand_function_name(S2, S1, " ") end); Bef2 -> - need_lparen(Bef2, fun () -> expand_module_name(S1) end) + need_lparen(Bef2, fun () -> expand_module_name(S1, ":") end) end. need_lparen(Bef, Do) -> @@ -61,26 +56,35 @@ %% expand_module_name(Word) %% end. -expand_module_name(Prefix) -> - match(Prefix, code:all_loaded(), ":"). +expand_module_name("", _) -> + {no, , }; +expand_module_name(Prefix, CompleteChar) -> + ModPaths = {list_to_atom(M),P} || {M,P,_} <- code:all_available() , + match(Prefix, ModPaths, CompleteChar). -expand_function_name(ModStr, FuncPrefix) -> +expand_function_name(ModStr, FuncPrefix, CompleteChar) -> 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,,} + {ok, Mod} -> + Exports = + case erlang:module_loaded(Mod) of + true -> + Mod:module_info(exports); + false -> + case beam_lib:chunks(code:which(Mod), exports) of + {ok, {Mod, {exports,E}}} -> + E; + _ -> + {no, , } + end + end, + case Exports of + {no, , } -> + {no, , }; + Exports -> + match(FuncPrefix, Exports, CompleteChar) end; error -> - {no,,} + {no, , } end. %% If it's a quoted symbol, atom_to_list/1 will do the wrong thing.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_env.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_env.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 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,13 +21,18 @@ -export(new/0,add_env/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, + get_recs/1,clr_recs/1,set_recs/2,fold_recs/3). + +-export(add_vbinding/3,add_vbindings/2,is_vbound/2,get_vbinding/2, + fetch_vbinding/2,del_vbinding/2). + +-export(add_fbinding/4,add_fbindings/2, is_fbound/3,get_fbinding/3,add_ibinding/5, add_mbinding/3,add_mbindings/2, is_mbound/2,get_mbinding/2). +-export(add_record/3,get_record/2). + %% Define access macros depending on whether we have maps. -ifdef(HAS_MAPS). -define(NEW(), #{}). @@ -55,7 +60,7 @@ -endif. %% The environment structure. --record(env, {vars=null,funs=null}). +-record(env, {vars=null,funs=null,recs=null}). %% -compile(export_all). @@ -70,6 +75,10 @@ %% set_funs(Funs, Env) -> Env. %% fold_funs(Fun, Acc, Env) -> Acc. %% fold_macros(Fun, Acc, Env) -> Acc. +%% get_recs(Env) -> Recs. +%% clr_recs(Env) -> Env. +%% set_recs(Recs, Env) -> Env. +%% fold_recs(Fun, Acc, Env) -> Acc. %% add_vbinding(Name, Val, Env) -> Env. %% add_vbindings({Name,Val}, Env) -> Env. %% is_vbound(Symb, Env) -> bool(). @@ -99,17 +108,19 @@ %% orddict with the name as key and the value is either the macro %% definition or a dict of arity definition. -new() -> #env{vars=?NEW(),funs=?NEW()}. +new() -> #env{vars=?NEW(),funs=?NEW(),recs=?NEW()}. -ifdef(HAS_MAPS). -add_env(#env{vars=Vs1,funs=Fs1}, #env{vars=Vs2,funs=Fs2}) -> +add_env(#env{vars=Vs1,funs=Fs1,recs=Rs1}, #env{vars=Vs2,funs=Fs2,recs=Rs2}) -> #env{vars=maps:merge(Vs2, Vs1), %Always take left env - funs=maps:merge(Fs2, Fs1)}. + funs=maps:merge(Fs2, Fs1), + recs=maps:merge(Rs2, Rs1)}. -else. -add_env(#env{vars=Vs1,funs=Fs1}, #env{vars=Vs2,funs=Fs2}) -> +add_env(#env{vars=Vs1,funs=Fs1,recs=Rs1}, #env{vars=Vs2,funs=Fs2,recs=Rs2}) -> Merge = fun (_, V1, _) -> V1 end, %Always take left env #env{vars=orddict:merge(Merge, Vs1, Vs2), - funs=orddict:merge(Merge, Fs1, Fs2)}. + funs=orddict:merge(Merge, Fs1, Fs2), + recs=orddict:merge(Merge, Rs1, Rs2)}. -endif. %% Accessing the variable table. @@ -145,6 +156,14 @@ end, ?FOLD(Ofun, Acc, Env#env.funs). +%% Accessing the record table. + +get_recs(Env) -> Env#env.recs. +clr_recs(Env) -> Env#env{recs=?NEW()}. +set_recs(Recs, Env) -> Env#env{recs=Recs}. +fold_recs(Fun, Acc, Env) -> + ?FOLD(Fun, Acc, Env#env.recs). + %% Variables. add_vbinding(N, V, #env{vars=Vs}=Env) -> @@ -185,7 +204,7 @@ add_fbindings(Fbs, #env{funs=Fs0}=Env) -> Fs1 = lists:foldl(fun ({N,A,V}, Fs) -> add_fbinding_1(N, A, {A,V}, Fs) end, - Fs0, Fbs), + Fs0, Fbs), Env#env{funs=Fs1}. add_ibinding(M, R, A, L, #env{funs=Fs0}=Env) -> @@ -220,7 +239,7 @@ add_mbindings(Fbs, #env{funs=Fs0}=Env) -> Fs1 = lists:foldl(fun ({N,V}, Fs) -> ?PUT(N, {macro,V}, Fs) end, - Fs0, Fbs), + Fs0, Fbs), Env#env{funs=Fs1}. is_mbound(N, #env{funs=Fs}) -> @@ -234,3 +253,14 @@ {ok,{macro,V}} -> {yes,V}; _ -> no end. + +%% Records. + +add_record(R, Fs, #env{recs=Rs}=Env) -> + Env#env{recs=?PUT(R, Fs, Rs)}. + +get_record(R, #env{recs=Rs}) -> + case ?FIND(R, Rs) of + {ok,Fs} -> {yes,Fs}; + error -> no + end.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_eval.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_eval.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2017 Robert Virding +%% Copyright (c) 2008-2021 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -37,57 +37,75 @@ add_fbinding/4,add_fbindings/2, add_ibinding/5). --import(lists, reverse/1,all/2,map/2,foldl/3,foldr/3). -import(orddict, find/2,fetch/2,store/3,is_key/2). -compile({no_auto_import,apply/3}). %For our apply/3 function -deprecated(eval/1,eval/2,eval_list/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). +-include("lfe.hrl"). -%% 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. +-define(STACKTRACE, + element(2, erlang:process_info(self(), current_stacktrace))). + +-define(EVAL_ERROR(Error), erlang:raise(error, Error, ?STACKTRACE)). %% -compile(export_all). -%% Errors. +%% Errors which we generate. +%% Some of thse may also be generated by compiled code in which case +%% they will probably be caught in lfe_lib. + format_error(badarg) -> <<"bad argument">>; format_error({badmatch,Val}) -> - lfe_io:format1(<<"bad match: ~w">>, Val); -format_error({unbound_symb,S}) -> + lfe_io:format1(<<"no match of value ~w">>, Val); +format_error({unbound_symbol,S}) -> lfe_io:format1(<<"symbol ~w is unbound">>, S); -format_error({undefined_func,{F,A}}) -> - lfe_io:format1(<<"undefined function ~w/~w">>, F,A); +format_error({undefined_function,{F,A}}) -> + lfe_io:format1(<<"function ~w/~w undefined">>, F,A); format_error(if_expression) -> <<"non-boolean if test">>; format_error(function_clause) -> <<"no function clause matching">>; format_error({case_clause,Val}) -> - lfe_io:format1(<<"no case clause matching ~.P">>, Val,10); -format_error(illegal_guard) -> <<"illegal guard">>; -format_error(illegal_bitsize) -> <<"illegal bitsize">>; -format_error(illegal_bitseg) -> <<"illegal bitsegment">>; + format_value(Val, <<"no case clause matching ">>); +format_error(illegal_guard) -> <<"illegal guard expression">>; +format_error(illegal_bitsize) -> <<"illegal bit size">>; +format_error(illegal_bitseg) -> <<"illegal bit segment">>; format_error({illegal_pattern,Pat}) -> - lfe_io:format1(<<"illegal pattern ~w">>, Pat); + format_value(Pat, <<"illegal pattern ">>); format_error({illegal_literal,Lit}) -> - lfe_io:format1(<<"illegal literal value ~w">>, Lit); + format_value(Lit, <<"illegal literal value ">>); format_error({illegal_mapkey,Key}) -> lfe_io:format1(<<"illegal map key ~w">>, Key); -format_error(bad_arity) -> <<"arity mismatch">>; +format_error(bad_head_arity) -> <<"function head arity mismatch">>; format_error({argument_limit,Arity}) -> lfe_io:format1(<<"too many arguments ~w">>, Arity); format_error({bad_form,Form}) -> lfe_io:format1(<<"bad ~w form">>, Form); +%% Try-catches. +format_error({try_clause,V}) -> + format_value(V, <<"no try clause matching ">>); +format_error({illegal_exception,E}) -> + lfe_io:format1(<<"illegal exception ~w">>, E); +%% Records. +format_error({undefined_record,Name}) -> + lfe_io:format1(<<"record ~w undefined">>, Name); +format_error({undefined_record_field,Name,Field}) -> + lfe_io:format1(<<"field ~w undefined in record ~w">>, Field,Name); +format_error({missing_record_field_value,Field}) -> + lfe_io:format1(<<"missing value to field ~w in record">>, Field); +%% Structs. +format_error({undefined_struct,Name}) -> + lfe_io:format1(<<"struct ~w undefined">>, Name); +format_error({undefined_struct_field,Name,Field}) -> + lfe_io:format1(<<"field ~w undefined in struct ~w">>, Field,Name); +format_error({missing_struct_field_value,Field}) -> + lfe_io:format1(<<"missing value to field ~w in struct">>, Field); %% Everything we don't recognise or know about. format_error(Error) -> lfe_io:prettyprint1(Error). +format_value(Val, ErrStr) -> + lfe_io:format1(<<"~s~.P">>, ErrStr,Val,10). + %% eval(Sexpr) -> Value. %% eval(Sexpr, Env) -> Value. @@ -162,31 +180,98 @@ setelement(eval_expr(I, Env), eval_expr(Tup, Env), eval_expr(V, Env)); eval_expr(binary|Bs, Env) -> eval_binary(Bs, Env); eval_expr(map|As, Env) -> - Pairs = map_pairs(As, Env), - maps:from_list(Pairs); -eval_expr('mref',Map,K, Env) -> - Key = map_key(K, Env), - maps:get(Key, eval_expr(Map, Env)); -eval_expr('mset',M|As, Env) -> - Map = eval_expr(M, Env), - Pairs = map_pairs(As, Env), - foldl(fun maps_put/2, Map, Pairs); -eval_expr('mupd',M|As, Env) -> - Map = eval_expr(M, Env), - Pairs = map_pairs(As, Env), - foldl(fun maps_update/2, Map, Pairs); -eval_expr('map-get',Map,K, Env) -> - eval_expr(mref,Map,K, Env); -eval_expr('map-set',M|As, Env) -> - eval_expr(mset,M|As, Env); -eval_expr('map-update',M|As, Env) -> - eval_expr(mupd,M|As, Env); -eval_expr(function,Fun,Ar, Env) -> - %% Build a lambda which can be applied. - Vs = new_vars(Ar), - eval_lambda(lambda,Vs,Fun|Vs, Env); -eval_expr(function,M,F,Ar, _) -> - erlang:make_fun(M, F, Ar); + eval_map(As, Env); +eval_expr('msiz',Map, Env) -> + eval_map_size(msiz, Map, Env); +eval_expr('mref',Map,Key, Env) -> + eval_map_get(mref, Map, Key, Env); +eval_expr('mset',Map|As, Env) -> + eval_map_set(mset, Map, As, Env); +eval_expr('mupd',Map|As, Env) -> + eval_map_update(mupd, Map, As, Env); +eval_expr('mrem',Map|Ks, Env) -> + eval_map_remove(mrem, Map, Ks, Env); +eval_expr('map-size',Map, Env) -> + eval_map_size('map-size', Map, Env); +eval_expr('map-get',Map,Key, Env) -> + eval_map_get('map-get', Map, Key, Env); +eval_expr('map-set',Map|As, Env) -> + eval_map_set('map-set', Map, As, Env); +eval_expr('map-update',Map|As, Env) -> + eval_map_update('map-update', Map, As, Env); +eval_expr('map-remove',Map|Ks, Env) -> + eval_map_remove('map-remove', Map, Ks, Env); +%% Record special forms. +eval_expr('record',Name|Fs, Env) -> + make_record_tuple(Name, Fs, Env); +%% make-record has been deprecated but we sill accept it for now. +eval_expr('make-record',Name|As, Env) -> + eval_expr('record',Name|As, Env); +eval_expr('is-record',E,Name, Env) -> + Ev = eval_expr(E, Env), + case lfe_env:get_record(Name, Env) of + {yes,Fields} -> + is_valid_record(Ev, Name, Fields); + no -> undefined_record_error(Name) + end; +eval_expr('record-index',Name,F, Env) -> + case lfe_env:get_record(Name, Env) of + {yes,Fields} -> + get_field_index(Name, Fields, F); + no -> undefined_record_error(Name) + end; +eval_expr('record-field',E,Name,F, Env) -> + Ev = eval_expr(E, Env), + case lfe_env:get_record(Name, Env) of + {yes,Fields} -> + case is_valid_record(Ev, Name, Fields) of + true -> + Index = get_field_index(Name, Fields, F), + element(Index, Ev); + false -> + eval_error({badrecord,Name,Ev}) + end; + no -> undefined_record_error(Name) + end; +eval_expr('record-update',E,Name|Args, Env) -> + Ev = eval_expr(E, Env), + update_record_tuple(Ev, Name, Args, Env); +%% Struct special forms. +eval_expr('struct',Name|Fs, Env) -> + make_struct_map(Name, Fs, Env); +eval_expr('is-struct',E, Env) -> + Ev = eval_expr(E, Env), + test_is_struct(Ev); +eval_expr('is-struct',E,Name, Env) -> + Ev = eval_expr(E, Env), + test_is_struct(Ev, Name); +eval_expr('struct-field',E,Name,F, Env) -> + Ev = eval_expr(E, Env), + get_struct_field(Ev, Name, F); +eval_expr('struct-update',E,Name|Args, Env) -> + Ev = eval_expr(E, Env), + update_struct_map(Ev, Name, Args, Env); +%% Function forms. +eval_expr(function,Mod,Name,Arity, _Env) -> + %% Don't evaluate the arguments here. + erlang:make_fun(Mod, Name, Arity); +eval_expr(function,Name,Arity, Env) -> + %% Only works for local functions and BIFs without an erlang:. + Vs = new_vars(Arity), + eval_lambda(lambda,Vs,Name|Vs, Env); +%% Special known data type operations. +eval_expr('andalso'|Es, Env) -> + Fun = fun (E, true) -> eval_expr(E, Env); + (_, false) -> false; + (_, _Other) -> badarg_error() + end, + lists:foldl(Fun, true, Es); +eval_expr('orelse'|Es, Env) -> + Fun = fun (_, true) -> true; + (E, false) -> eval_expr(E, Env); + (_, _Other) -> badarg_error() + end, + lists:foldl(Fun, false, Es); %% Handle the Core closure special forms. eval_expr(lambda|_=Lambda, Env) -> eval_lambda(Lambda, Env); @@ -222,21 +307,147 @@ case get_fbinding(Fun, Ar, Env) of {yes,M,F} -> erlang:apply(M, F, eval_list(Es, Env)); {yes,F} -> eval_apply(F, eval_list(Es, Env), Env); - no -> undefined_func_error(Fun, Ar) + no -> undefined_function_error(Fun, Ar) end; eval_expr(_|_=S, _) -> %Test if string literal - case is_posint_list(S) of - true -> S; %It an "atomic" type + case lfe_lib:is_posint_list(S) of + true -> S; %It is an "atomic" type false -> %It is a bad application form bad_form_error(application) end; eval_expr(Symb, Env) when is_atom(Symb) -> case get_vbinding(Symb, Env) of {yes,Val} -> Val; - no -> unbound_symb_error(Symb) + no -> unbound_symbol_error(Symb) end; eval_expr(E, _) -> E. %Atomic evaluate to themselves +%% is_valid_record(Value, Name, Fields) -> boolean(). +%% Check if Value is a valid record tuple. + +is_valid_record(Value, Name, Fields) -> + RecSize = length(Fields) + 1, + is_tuple(Value) + andalso (tuple_size(Value) =:= RecSize) + andalso (element(1, Value) =:= Name). + +%% make_record_tuple(Name, Args, Env) -> Record. +%% We have to macro expand and evaluate the default values here as +%% well. Make sure to build the tuple in the right order. + +make_record_tuple(Name, Args, Env) -> + case lfe_env:get_record(Name, Env) of + {yes,Fields} -> + Es = make_record_elements(Fields, Args, Env), + list_to_tuple(Name|Es); + no -> undefined_record_error(Name) + end. + +make_record_elements(Fields, Args, Env) -> + Mfun = fun (F,Def|_) -> make_field_val(F, Args, Def, Env); + (F) -> make_field_val(F, Args, ?Q(undefined), Env); + (F) -> make_field_val(F, Args, ?Q(undefined), Env) + end, + lists:map(Mfun, Fields). + +make_field_val(F, F,V|_, _Def, Env) -> eval_expr(V, Env); +make_field_val(F, _,_|Args, Def, Env) -> + make_field_val(F, Args, Def, Env); +make_field_val(_F, ArgF, _Def, _Env) -> + eval_error({missing_record_field_value,ArgF}); +make_field_val(_, , Def, Env) -> expr(Def, Env). + +%% get_field_index(Name, Fields, Field) -> Index. + +get_field_index(Name, Fields, F) -> + get_field_index(Name, Fields, F, 2). %First element record name + +get_field_index(_Name, F|_|_Fields, F, I) -> I; +get_field_index(_Name, F|_Fields, F, I) -> I; %Field can be just name +get_field_index(Name, _|Fields, F, I) -> + get_field_index(Name, Fields, F, I+1); +get_field_index(Name, , F, _I) -> + undefined_record_field_error(Name, F). + +%% update_record_tuple(Record, Name, Args, Env) -> Record. +%% Update the Record with the Args. + +update_record_tuple(Rec, Name, Args, Env) -> + case lfe_env:get_record(Name, Env) of + {yes,Fields} -> + case is_valid_record(Rec, Name, Fields) of + true -> + Es0 = tl(tuple_to_list(Rec)), + Es1 = update_record_elements(Fields, Es0, Args, Env), + list_to_tuple(Name|Es1); + false -> + eval_error({badrecord,Name,Rec}) + end; + no -> undefined_record_error(Name) + end. + +update_record_elements(Fields, Recvs, Args, Env) -> + Ufun = fun (F|_, Rv) -> update_field_val(F, Args, Rv, Env); + (F, Rv) -> update_field_val(F, Args, Rv, Env) + end, + lists:zipwith(Ufun, Fields, Recvs). + +update_field_val(F, F,V|_, _Recv, Env) -> eval_expr(V, Env); +update_field_val(F, _,_|Args, Recv, Env) -> + update_field_val(F, Args, Recv, Env); +update_field_val(_, , Recv, _Env) -> Recv. + +%% make_struct_map(Name, Fields, Env) -> Struct. +%% We have to macro expand and evaluate the values in the fields. Use +%% the __struct__/1 check and build the new struct. + +make_struct_map(Name, Fields, Env) -> + Efs = make_struct_fields(Fields, Env), + try + Name:'__struct__'(Efs) + catch + _:_ -> + eval_error({undefined_struct,Name}) + end. + +make_struct_fields(Key,Val|Kvs, Env) -> + {Key,eval_expr(Val, Env)}|make_struct_fields(Kvs, Env); +make_struct_fields(Key, _Env) -> + eval_error({missing_struct_field_value,Key}); +make_struct_fields(, _Env) -> . + +%% test_is_struct(Struct) -> boolean(). +%% test_is_struct(Struct, Name) -> boolean(). +%% Test whether term is a struct. + +test_is_struct(#{'__struct__' := StrName}) when is_atom(StrName) -> true; +test_is_struct(_Other) -> false. + +test_is_struct(#{'__struct__' := StrName}, Name) when is_atom(StrName) -> + StrName =:= Name; +test_is_struct(_Other, _Name) -> false. + +%% get_struct_field(Struct, Name, Field) -> Value. + +get_struct_field(Str, Name, Field) -> + case Str of + #{'__struct__' := Name, Field := Val} -> Val; + _ -> + eval_error({badstruct,Name,Str}) + end. + +%% update_struct_map(Struct, Name, Fields) -> Struct. +%% Update the Record with the Args. + +update_struct_map(Str, Name, Fields, Env) -> + case Str of + #{'__struct__' := Name} -> + Assocs = make_struct_fields(Fields, Env), + lists:foldl(fun maps_update/2, Str, Assocs); + _ -> + eval_error({badstruct,Name,Str}) + end. + %% get_fbinding(NAme, Arity, Env) -> %% {yes,Module,Fun} | {yes,Binding} | no. %% Get the function binding. Locally bound function takes precedence @@ -259,149 +470,88 @@ end. eval_list(Es, Env) -> - map(fun (E) -> eval_expr(E, Env) end, Es). + lists:map(fun (E) -> eval_expr(E, Env) end, Es). + +%% eval_body(Body, Env) -> Value. +%% Evaluate the list of expressions and return value of the last one. eval_body(E, Env) -> eval_expr(E, Env); eval_body(E|Es, Env) -> eval_expr(E, Env), eval_body(Es, Env); -eval_body(, _) -> . %Empty body +eval_body(, _) -> ; %Empty body +eval_body(_, _) -> ?EVAL_ERROR({bad_form,body}).%Not a list of expressions %% eval_binary(Bitsegs, Env) -> Binary. -%% Construct a binary from Bitsegs. This code is taken from -%% eval_bits.erl. Pass in an evaluator function to be used when -%% evaluating vale and size expression. +%% Construct a binary from Bitsegs. Pass in an evaluator function to +%% be used when evaluating value and size expression. eval_binary(Segs, Env) -> - Vsps = get_bitsegs(Segs), - Eval = fun (S) -> eval_expr(S, Env) end, - eval_bitsegs(Vsps, Eval). - -get_bitsegs(Segs) -> - 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. - -get_bitseg(Val|Specs=Seg, Vsps) -> - case is_posint_list(Seg) of %Is bitseg a string? - true -> %A string - {Sz,Ty} = get_bitspecs(), - foldr(fun (V, Vs) -> {V,Sz,Ty}|Vs end, Vsps, Seg); - false -> %A value and spec - {Sz,Ty} = get_bitspecs(Specs), - case is_posint_list(Val) of %Is Val a string? - true -> foldr(fun (V, Vs) -> {V,Sz,Ty}|Vs end, Vsps, Val); - false -> {Val,Sz,Ty}|Vsps %The default - end - end; -get_bitseg(Val, Vsps) -> - {Sz,Ty} = get_bitspecs(), - {Val,Sz,Ty}|Vsps. - -%% get_bitspec(Specs) -> {Size,Type}. -%% Get the error handling as we want it. - -get_bitspecs(Ss) -> - case lfe_bits:get_bitspecs(Ss) of - {ok,Sz,Ty} -> {Sz,Ty}; - {error,Error} -> eval_error(Error) - end. - -is_posint_list(I|Is) when is_integer(I), I >= 0 -> - is_posint_list(Is); -is_posint_list() -> true; -is_posint_list(_) -> false. - -%% eval_bitsegs(VSTys, Evaluator) -> Binary. -%% The evaluator function is use to evaluate the value and size -%% fields. - -eval_bitsegs(Vsps, Eval) -> - foldl(fun ({Val,Sz,Ty}, Acc) -> - Bin = eval_bitseg(Val, Sz, Ty, Eval), - <<Acc/bitstring,Bin/bitstring>> - end, <<>>, Vsps). - -eval_bitseg(Val, Sz, Ty, Eval) -> - V = Eval(Val), - eval_exp_bitseg(V, Sz, Eval, Ty). - -%% eval_exp_bitseg(Value, Size, EvalSize, {Type,Unit,Sign,Endian}) -> Binary. - -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>>; - _ -> badarg_error() - end; - true -> - Sz = Eval(Size), - <<Val:(Sz*Unit)/bitstring>> - end - end. - -eval_int_bitseg(Val, Sz, signed, big) -> <<Val:Sz/signed>>; -eval_int_bitseg(Val, Sz, unsigned, big) -> <<Val:Sz>>; -eval_int_bitseg(Val, Sz, signed, little) -> <<Val:Sz/little-signed>>; -eval_int_bitseg(Val, Sz, unsigned, little) -> <<Val:Sz/little>>; -eval_int_bitseg(Val, Sz, signed, native) -> <<Val:Sz/native-signed>>; -eval_int_bitseg(Val, Sz, unsigned, native) -> <<Val:Sz/native>>. - -eval_utf16_bitseg(Val, big) -> <<Val/utf16-big>>; -eval_utf16_bitseg(Val, little) -> <<Val/utf16-little>>; -eval_utf16_bitseg(Val, native) -> <<Val/utf16-native>>. - -eval_utf32_bitseg(Val, big) -> <<Val/utf32-big>>; -eval_utf32_bitseg(Val, little) -> <<Val/utf32-little>>; -eval_utf32_bitseg(Val, native) -> <<Val/utf32-native>>. - -eval_float_bitseg(Val, Sz, big) -> <<Val:Sz/float>>; -eval_float_bitseg(Val, Sz, little) -> <<Val:Sz/float-little>>; -eval_float_bitseg(Val, Sz, native) -> <<Val:Sz/float-native>>. - -%% map_pairs(Args, Env) -> {K,V}. - -map_pairs(K,V|As, Env) -> - P = {map_key(K, Env),eval_expr(V, Env)}, - P|map_pairs(As, Env); -map_pairs(, _) -> ; -map_pairs(_, _) -> badarg_error(). - -%% map_key(Key, Env) -> Value. + Eval = fun (E) -> eval_expr(E, Env) end, + lfe_eval_bits:expr_bitsegs(Segs, Eval). + +%% eval_map(Args, Env) -> Map. +%% eval_map_size(Form, Map, Env) -> Value. +%% eval_map_get(Form, Map, Key, Env) -> Value. +%% eval_map_set(Form, Map, Args, Env) -> Map. +%% eval_map_update(Form, Map, Args, Env) -> Map. +%% eval_map_remove(Form, Map, Keys, Env) -> Map. + +eval_map(Args, Env) -> + Pairs = eval_map_pairs(map, Args, Env), + maps:from_list(Pairs). + +eval_map_size(_Form, Map, Env) -> + erlang:map_size(eval_expr(Map, Env)). %Use the BIF + +eval_map_get(_Form, Map, K, Env) -> + Key = eval_map_key(K, Env), + erlang:map_get(Key, eval_expr(Map, Env)). %Use the BIF + +eval_map_set(Form, M, Args, Env) -> + Map = eval_expr(M, Env), + Pairs = eval_map_pairs(Form, Args, Env), + lists:foldl(fun maps_put/2, Map, Pairs). + +eval_map_update(Form, M, Args, Env) -> + Map = eval_expr(M, Env), + Pairs = eval_map_pairs(Form, Args, Env), + lists:foldl(fun maps_update/2, Map, Pairs). + +eval_map_remove(_Form, M, Keys, Env) -> + Map = eval_expr(M, Env), + lists:foldl(fun maps_remove/2, Map, eval_list(Keys, Env)). + +%% eval_map_pairs(Form, Args, Env) -> {K,V}. + +eval_map_pairs(Form, K,V|As, Env) -> + P = {eval_map_key(K, Env),eval_expr(V, Env)}, + P|eval_map_pairs(Form, As, Env); +eval_map_pairs(_Form, , _) -> ; +eval_map_pairs(Form, _, _) -> bad_form_error(Form). + +%% eval_map_key(Key, Env) -> Value. %% A map key can only be a literal in 17 but can be anything in 18.. + -ifdef(HAS_FULL_KEYS). -map_key(Key, Env) -> +eval_map_key(Key, Env) -> eval_expr(Key, Env). -else. -map_key(?Q(E), _) -> E; -map_key(_|_=L, _) -> - case is_posint_list(L) of +eval_map_key(?Q(E), _) -> E; +eval_map_key(_|_=L, _) -> + case lfe_lib:is_posint_list(L) of true -> L; %Literal strings only false -> illegal_mapkey_error(L) end; -map_key(E, _) when not is_atom(E) -> E; %Everything else -map_key(E, _) -> illegal_mapkey_error(E). +eval_map_key(E, _) when not is_atom(E) -> E; %Everything else +eval_map_key(E, _) -> illegal_mapkey_error(E). -endif. +maps_put({K,V}, M) -> maps:put(K, V, M). +maps_update({K,V}, M) -> maps:update(K, V, M). +maps_remove(K, M) -> maps:remove(K, M). + %% new_vars(N) -> Vars. new_vars(N) when N > 0 -> @@ -416,7 +566,7 @@ eval_lambda(lambda,Args|Body, Env) -> Apply = fun (Vals) -> apply_lambda(Args, Body, Vals, Env) end, - make_lambda(length(Args), Apply); + make_lambda(lambda_arity(Args), Apply); eval_lambda(_, _) -> bad_form_error(lambda). @@ -447,9 +597,25 @@ 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; + 16 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> + Apply(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) end; + 17 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> + Apply(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) end; + 18 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> + Apply(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) end; + 19 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> + Apply(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) end; + 20 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> + Apply(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) end; _ -> eval_error({argument_limit,Arity}) end. +lambda_arity(Args) -> + case lfe_lib:is_symb_list(Args) of + true -> length(Args); + false -> bad_form_error(lambda) + end. + apply_lambda(Args, Body, Vals, Env0) -> Env1 = bind_args(Args, Vals, Env0), eval_body(Body, Env1). @@ -458,9 +624,23 @@ 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. +bind_args(, , Env) -> Env; +bind_args(_As, _Vs, _Env) -> + eval_error(bad_head_arity). + +match_lambda_arity(Pats|_|Cls) -> + case lfe_lib:is_proper_list(Pats) of + true -> match_lambda_arity(Cls, length(Pats)); + false -> bad_form_error('match-lambda') + end. -match_lambda_arity(Pats|_|_) -> length(Pats). +match_lambda_arity(Pats|_|Cls, Ar) -> + case lfe_lib:is_proper_list(Pats) andalso (length(Pats) =:= Ar) of + true -> match_lambda_arity(Cls, Ar); + false -> bad_form_error('match-lambda') + end; +match_lambda_arity(, Ar) -> Ar; +match_lambda_arity(_, _) -> bad_form_error('match-lambda'). apply_match_lambda(Pats|B0|Cls, Vals, Env) -> if length(Vals) == length(Pats) -> @@ -471,29 +651,30 @@ {yes,B1,Vbs} -> eval_body(B1, add_vbindings(Vbs, Env)); no -> apply_match_lambda(Cls, Vals, Env) end; - true -> eval_error(bad_arity) + true -> eval_error(bad_head_arity) end; -apply_match_lambda(, Vals, _) -> eval_error({function_clause,Vals}); +apply_match_lambda(, _Vals, _) -> eval_error(function_clause); apply_match_lambda(_, _, _) -> bad_form_error('match-lambda'). %% eval_let(PatBindings|Body, Env) -> Value. eval_let(Vbs|Body, Env0) -> %% Make sure we use the right environment. - Env1 = foldl(fun (Pat,E, Env) -> - Val = eval_expr(E, Env0), - case match(Pat, Val, Env0) of - {yes,Bs} -> add_vbindings(Bs, Env); - no -> eval_error({badmatch,Val}) - end; - (Pat,'when'|_=G,E, Env) -> - Val = eval_expr(E, Env0), - case match_when(Pat, Val, G, Env0) of - {yes,,Bs} -> add_vbindings(Bs, Env); - no -> eval_error({badmatch,Val}) - end; - (_, _) -> bad_form_error('let') - end, Env0, Vbs), + Fun = fun (Pat,E, Env) -> + Val = eval_expr(E, Env0), + case match(Pat, Val, Env0) of + {yes,Bs} -> add_vbindings(Bs, Env); + no -> eval_error({badmatch,Val}) + end; + (Pat,'when'|_=G,E, Env) -> + Val = eval_expr(E, Env0), + case match_when(Pat, Val, G, Env0) of + {yes,,Bs} -> add_vbindings(Bs, Env); + no -> eval_error({badmatch,Val}) + end; + (_, _) -> bad_form_error('let') + end, + Env1 = lists:foldl(Fun, Env0, Vbs), eval_body(Body, Env1). %% eval_let_function(FuncBindings|Body, Env) -> Value. @@ -502,13 +683,14 @@ Add = fun (F, Ar, Def, Lenv, Env) -> add_lexical_func(F, Ar, Def, Lenv, Env) end, - Env1 = foldl(fun (V,lambda,Args|_=Lambda, E) when is_atom(V) -> - Add(V, length(Args), Lambda, Env0, E); - (V,'match-lambda',Pats|_|_=Match, E) - when is_atom(V) -> - Add(V, length(Pats), Match, Env0, E); - (_, _) -> bad_form_error('let-function') - end, Env0, Fbs), + Fun = fun (V,lambda,Args|_=Lambda, E) when is_atom(V) -> + Add(V, length(Args), Lambda, Env0, E); + (V,'match-lambda',Pats|_|_=Match, E) + when is_atom(V) -> + Add(V, length(Pats), Match, Env0, E); + (_, _) -> bad_form_error('let-function') + end, + Env1 = lists:foldl(Fun, Env0, Fbs), %% io:fwrite("elf: ~p\n", {Body,Env1}), eval_body(Body, Env1). @@ -518,12 +700,13 @@ eval_letrec_function(Fbs0|Body, Env0) -> %% Check and abstract out function bindings. - Fbs1 = map(fun (V,lambda,Args|_=Lambda) when is_atom(V) -> - {V,length(Args),Lambda}; - (V,'match-lambda',Pats|_|_=Match) when is_atom(V) -> - {V,length(Pats),Match}; - (_) -> bad_form_error('letrec-function') - end, Fbs0), + Fun = fun (V,lambda,Args|_=Lambda) when is_atom(V) -> + {V,length(Args),Lambda}; + (V,'match-lambda',Pats|_|_=Match) when is_atom(V) -> + {V,length(Pats),Match}; + (_) -> bad_form_error('letrec-function') + end, + Fbs1 = lists:map(Fun, Fbs0), Env1 = make_letrec_env(Fbs1, Env0), %% io:fwrite("elrf: ~p\n", {Env0,Env1}), eval_body(Body, Env1). @@ -544,7 +727,8 @@ %% init_letrec_env(Env) -> {,Env}. make_letrec_env(Fbs0, Env) -> - Fbs1 = map(fun ({V,Ar,Body}) -> {V,Ar,{letrec,Body,Fbs0,Env}} end, Fbs0), + Fbs1 = lists:map(fun ({V,Ar,Body}) -> {V,Ar,{letrec,Body,Fbs0,Env}} end, + Fbs0), add_fbindings(Fbs1, Env). %% extend_letrec_env(Lete0, Fbs0, Env0) -> @@ -577,9 +761,10 @@ eval_apply_expr(Func, Es, Env); eval_apply({letrec,Body,Fbs,Env}, Es, _) -> %% A function created by/for letrec-function. - NewEnv = foldl(fun ({V,Ar,Lambda}, E) -> - add_fbinding(V, Ar, {letrec,Lambda,Fbs,Env}, E) - end, Env, Fbs), + Fun = fun ({V,Ar,Lambda}, E) -> + add_fbinding(V, Ar, {letrec,Lambda,Fbs,Env}, E) + end, + NewEnv = lists:foldl(Fun, Env, Fbs), %% io:fwrite("la: ~p\n", {Body,NewEnv}), eval_apply_expr(Body, Es, NewEnv). @@ -589,9 +774,14 @@ eval_apply_expr(Func, Es, Env) -> case lfe_macro:expand_expr_all(Func, Env) of - lambda,Args|Body -> apply_lambda(Args, Body, Es, Env); - 'match-lambda'|Cls -> apply_match_lambda(Cls, Es, Env); - Fun when erlang:is_function(Fun) -> erlang:apply(Fun, Es) + lambda|_=Lambda -> + Fun = eval_lambda(Lambda, Env), + erlang:apply(Fun, Es); + 'match-lambda'|_=Mlambda -> + Fun = eval_match_lambda(Mlambda, Env), + erlang:apply(Fun, Es); + Fun when erlang:is_function(Fun) -> + erlang:apply(Fun, Es) end. %% eval_if(IfBody, Env) -> Value. @@ -613,12 +803,16 @@ eval_case(E|Cls, Env) -> eval_case_clauses(eval_expr(E, Env), Cls, Env). +%% eval_case_clauses(Value, Clauses, Env) -> Value. + eval_case_clauses(V, Cls, Env) -> case match_clause(V, Cls, Env) of {yes,B,Vbs} -> eval_body(B, add_vbindings(Vbs, Env)); no -> eval_error({case_clause,V}) end. +%% match_clause(Value, Clauses, Env) -> {yes,Body,Bindings} | no. + match_clause(V, Pat|B0|Cls, Env) -> case match_when(Pat, V, B0, Env) of {yes,_,_}=Yes -> Yes; @@ -637,11 +831,11 @@ end. split_receive('after',T|B, Rcls) -> - {reverse(Rcls),T,B}; + {lists:reverse(Rcls),T,B}; split_receive(Cl|Cls, Rcls) -> split_receive(Cls, Cl|Rcls); split_receive(, Rcls) -> - {reverse(Rcls),?Q(infinity),}. %No timeout, return 'infinity. + {lists:reverse(Rcls),?Q(infinity),}. %No timeout, return 'infinity. %% receive_clauses(Clauses, Env) -> Value. %% Recurse down message queue. We are only called with timeout value @@ -697,7 +891,7 @@ receive X -> recv_all(X|Xs) after 0 -> - reverse(Xs) + lists:reverse(Xs) end. send_all(X|Xs, Self) -> @@ -708,57 +902,62 @@ %% eval_try(TryBody, Env) -> Value. %% Complicated by checking legal combinations of options. -eval_try(E,'case'|Cls|Catch, Env) -> - eval_try_catch(Catch, E, {yes,Cls}, Env); +eval_try(E,'case'|Case|Catch, Env) -> + eval_try_catch(Catch, E, Case, Env); eval_try(E|Catch, Env) -> - eval_try_catch(Catch, E, no, Env); + eval_try_catch(Catch, E, , Env); eval_try(_, _) -> bad_form_error('try'). -eval_try_catch('catch'|Cls, E, Case, Env) -> - eval_try(E, Case, {yes,Cls}, no, Env); -eval_try_catch('catch'|Cls,'after'|B, E, Case, Env) -> - eval_try(E, Case, {yes,Cls}, {yes,B}, Env); -eval_try_catch('after'|B, E, Case, Env) -> - eval_try(E, Case, no, {yes,B}, Env); +eval_try_catch('catch'|Catch, E, Case, Env) -> + eval_try(E, Case, Catch, , Env); +eval_try_catch('catch'|Catch,'after'|After, E, Case, Env) -> + eval_try(E, Case, Catch, After, Env); +eval_try_catch('after'|After, E, Case, Env) -> + eval_try(E, Case, , After, Env); eval_try_catch(_, _, _, _) -> bad_form_error('try'). %% We do it all in one, not so efficient but easier. eval_try(E, Case, Catch, After, Env) -> + check_exceptions(Catch), %Check for legal exceptions try eval_expr(E, Env) of - Ret -> - case Case of - {yes,Cls} -> eval_case_clauses(Ret, Cls, Env); - no -> Ret + Value when Case =:= -> Value; + Value -> + case match_clause(Value, Case, Env) of + {yes,Body,Vbs} -> + eval_body(Body, add_vbindings(Vbs, Env)); + no -> + ?EVAL_ERROR({try_clause,Value}) end catch - Class:Error -> - %% Try does return the stacktrace here but we can't hit it - %% so we have to explicitly get it. - Stack = erlang:get_stacktrace(), - case Catch of - {yes,Cls} -> - eval_catch_clauses({Class,Error,Stack}, Cls, Env); + ?CATCH(Class, Error, Stack) + %% Try returns the stacktrace here so we have to + %% explicitly get it here just in case. + case match_clause({Class,Error,Stack}, Catch, Env) of + {yes,Body,Vbs} -> + eval_body(Body, add_vbindings(Vbs, Env)); no -> erlang:raise(Class, Error, Stack) end after - case After of - {yes,B} -> eval_body(B, Env); - no -> - end + eval_body(After, Env) end. -eval_catch_clauses(V, Pat|B0|Cls, Env) -> - case match_when(Pat, V, B0, Env) of - {yes,B1,Vbs} -> eval_body(B1, add_vbindings(Vbs, Env)); - no -> eval_catch_clauses(V, Cls, Env) - end; -eval_catch_clauses({Class,Error,Stack}, , _) -> - erlang:raise(Class, Error, Stack). +check_exceptions(Cl|Cls) -> + case Cl of + tuple,_,_,St|_ when is_atom(St) -> ok; + '_'|_ -> ok; + Other|_ -> ?EVAL_ERROR({illegal_exception,Other}) + end, + check_exceptions(Cls); +check_exceptions() -> ok. + + +%% eval_call(Mod,Func|Args, Env) -> Value. +%% Evaluate the module, function and args and then apply the function. eval_call(M0,F0|As0, Env) -> M1 = eval_expr(M0, Env), @@ -794,9 +993,8 @@ true -> true; _Other -> false %Fail guard catch - error:illegal_guard -> %Handle illegal guard - St = erlang:get_stacktrace(), - erlang:raise(error, illegal_guard, St); + ?CATCH(error, illegal_guard, Stack) %Handle illegal guard + erlang:raise(error, illegal_guard, Stack); _:_ -> false %Fail guard end. @@ -804,7 +1002,7 @@ %% A body is a sequence of tests which must all succeed. eval_gbody(Gts, Env) -> - all(fun (Gt) -> eval_gexpr(Gt, Env) end, Gts). + lists:all(fun (Gt) -> eval_gexpr(Gt, Env) end, Gts). %% eval_gexpr(Sexpr, Environment) -> Value. %% Evaluate a guard sexpr in the current environment. @@ -820,7 +1018,35 @@ eval_gexpr(tref,Tup,I, Env) -> element(eval_gexpr(I, Env), eval_gexpr(Tup, Env)); eval_gexpr(binary|Bs, Env) -> eval_gbinary(Bs, Env); -%% Map operations are not allowed in guards. +%% Check map special forms which translate into legal guard expressions. +eval_gexpr(map|As, Env) -> + eval_gmap(As, Env); +eval_gexpr(msiz,Map, Env) -> + eval_gmap_size(msiz, Map, Env); +eval_gexpr(mref,Map,Key, Env) -> + eval_gmap_get(mref, Map, Key, Env); +eval_gexpr(mset,Map|As, Env) -> + eval_gmap_set(mset, Map, As, Env); +eval_gexpr(mupd,Map|As, Env) -> + eval_gmap_update(mupd, Map, As, Env); +eval_gexpr('map-size',Map, Env) -> + eval_gmap_size('map-size', Map, Env); +eval_gexpr('map-get',Map,Key, Env) -> + eval_gmap_get('map-get', Map, Key, Env); +eval_gexpr('map-set',Map|As, Env) -> + eval_gmap_set('map-set', Map, As, Env); +eval_gexpr('map-update',Map|As, Env) -> + eval_gmap_update('map-update', Map, As, Env); +%% Struct special forms. +eval_gexpr('is-struct',E0, Env) -> + Ev = eval_gexpr(E0, Env), + test_is_struct(Ev); +eval_gexpr('is-struct',E0,Name, Env) -> + Ev = eval_gexpr(E0, Env), + test_is_struct(Ev, Name); +eval_gexpr('struct-field',E,Name,F, Env) -> + Ev = eval_gexpr(E, Env), + get_struct_field(Ev, Name, F); %% Handle the Core closure special forms. %% Handle the control special forms. eval_gexpr('progn'|Body, Env) -> eval_gbody(Body, Env); @@ -837,11 +1063,15 @@ {yes,M,F} -> erlang:apply(M, F, eval_glist(Es, Env)); no -> illegal_guard_error() end; -eval_gexpr(_|_, _) -> illegal_guard_error(); +eval_gexpr(_|_=S, _) -> %Test is literal string + case lfe_lib:is_posint_list(S) of + true -> S; %It is an "atomic" type + false -> illegal_guard_error() %It is a bad application form + end; eval_gexpr(Symb, Env) when is_atom(Symb) -> case get_vbinding(Symb, Env) of {yes,Val} -> Val; - no -> unbound_symb_error(Symb) + no -> unbound_symbol_error(Symb) end; eval_gexpr(E, _) -> E. %Atoms evaluate to themselves. @@ -860,15 +1090,67 @@ end. eval_glist(Es, Env) -> - map(fun (E) -> eval_gexpr(E, Env) end, Es). + lists:map(fun (E) -> eval_gexpr(E, Env) end, Es). + +%% eval_gmap(Args, Env) -> Map. +%% eval_gmap_size(Form, Map, Env) -> Value. +%% eval_gmap_get(Form, Map, Key, Env) -> Value. +%% eval_gmap_set(Form, Map, Args, Env) -> Map. +%% eval_gmap_update(Form, Map, Args, Env) -> Map. + +eval_gmap(Args, Env) -> + Pairs = eval_gmap_pairs(map, Args, Env), + maps:from_list(Pairs). + +eval_gmap_size(_Form, Map, Env) -> + erlang:map_size(eval_gexpr(Map, Env)). %Use the BIF + +eval_gmap_get(_Form, Map, K, Env) -> + Key = eval_gmap_key(K, Env), + erlang:map_get(Key, eval_gexpr(Map, Env)). %Use the BIF + +eval_gmap_set(Form, M, Args, Env) -> + Map = eval_gexpr(M, Env), + Pairs = eval_gmap_pairs(Form, Args, Env), + lists:foldl(fun maps_put/2, Map, Pairs). + +eval_gmap_update(Form, M, Args, Env) -> + Map = eval_gexpr(M, Env), + Pairs = eval_gmap_pairs(Form, Args, Env), + lists:foldl(fun maps_update/2, Map, Pairs). + +%% eval_gmap_pairs(Form, Args, Env) -> {K,V}. + +eval_gmap_pairs(Form, K,V|As, Env) -> + P = {eval_gmap_key(K, Env),eval_gexpr(V, Env)}, + P|eval_gmap_pairs(Form, As, Env); +eval_gmap_pairs(_Form, , _) -> ; +eval_gmap_pairs(Form, _, _) -> bad_form_error(Form). + +%% eval_map_key(Key, Env) -> Value. +%% A map key can only be a literal in 17 but can be anything in 18.. + + +-ifdef(HAS_FULL_KEYS). +eval_gmap_key(Key, Env) -> + eval_gexpr(Key, Env). +-else. +eval_gmap_key(?Q(E), _) -> E; +eval_gmap_key(_|_=L, _) -> + case lfe_lib:is_posint_list(L) of + true -> L; %Literal strings only + false -> illegal_mapkey_error(L) + end; +eval_gmap_key(E, _) when not is_atom(E) -> E; %Everything else +eval_gmap_key(E, _) -> illegal_mapkey_error(E). +-endif. %% eval_gbinary(Bitsegs, Env) -> Binary. %% Construct a binary from Bitsegs. This code is taken from eval_bits.erl. eval_gbinary(Segs, Env) -> - Vsps = get_bitsegs(Segs), - Eval = fun(S) -> eval_gexpr(S, Env) end, - eval_bitsegs(Vsps, Eval). + Eval = fun (E) -> eval_gexpr(E, Env) end, + lfe_eval_bits:expr_bitsegs(Segs, Eval). %% eval_gif(IfBody, Env) -> Val. @@ -918,8 +1200,29 @@ true -> match_map(Ps, Val, Pbs, Env); false -> no end; +%% Record patterns. +match('record',Name|Fs, Val, Pbs, Env) -> + case lfe_env:get_record(Name, Env) of + {yes,Fields} -> + match_record_tuple(Name, Fields, Fs, Val, Pbs, Env); + no -> undefined_record_error(Name) + end; +%% make-record has been deprecated but we sill accept it for now. +match('make-record',Name|Fs, Val, Pbs, Env) -> + match('record',Name|Fs, Val, Pbs, Env); +match('record-index',Name,F, Val, Pbs, Env) -> + case lfe_env:get_record(Name, Env) of + {yes,Fields} -> + Index = get_field_index(Name, Fields, F), + match(Index, Val, Pbs, Env); + no -> undefined_record_error(Name) + end; +%% Struct patterns. +match('struct',Name|Fs, Val, Pbs, Env) -> + match_struct_map(Name, Fs, Val, Pbs, Env); +%% No constructor list forms. match(_|_=List, Val, Pbs, _) -> %No constructor - case is_posint_list(List) of %Accept strings + case lfe_lib:is_posint_list(List) of %Accept strings true -> if List =:= Val -> {yes,Pbs}; true -> no @@ -956,149 +1259,39 @@ error -> {yes,store(S, Val, Pbs)} %Not yet bound end. -%% match_binary(Bitsegs, Binary, PatBindings, Env) -> {yes,PatBindings} | no. -%% Match Bitsegs against Binary. This code is taken from -%% eval_bits.erl. Bitspec errors generate an error. Bad matches -%% result in an error, we use catch to trap it. +%% match_record_tuple(Name, Fields, Pats, Val, Pbs, Env) -> {yes,Pbs} | no. -match_binary(Segs, Bin, Pbs0, Env) -> - Psps = get_bitsegs(Segs), - match_bitsegs(Psps, Bin, , Pbs0, Env). +match_record_tuple(Name, Fields, Pats, Val, Pbs, Env) -> + Ps = match_record_patterns(Fields, Pats), + match(tuple,Name|Ps, Val, Pbs, Env). -match_bitsegs({Pat,Sz,Ty}|Psps, Bin0, Bbs0, Pbs0, Env) -> - case match_bitseg(Pat, Sz, Ty, Bin0, Bbs0, Pbs0, Env) of - {yes,Bin1,Bbs1,Pbs1} -> - match_bitsegs(Psps, Bin1, Bbs1, Pbs1, Env); - no -> no - end; -match_bitsegs(, <<>>, _, Pbs, _) -> {yes,Pbs}; %Reached the end of both -match_bitsegs(, _, _, _, _) -> no. %More to go - -match_bitseg(Pat, Size, Type, Bin0, Bbs0, Pbs0, Env) -> - Sz = get_pat_bitsize(Size, Type, Bbs0, Pbs0, Env), - case catch {ok,get_pat_bitseg(Bin0, Sz, Type)} of - {ok,{Val,Bin1}} -> - case match_bitexpr(Pat, Val, Bbs0, Pbs0, Env) of - {yes,Bbs1,Pbs1} -> {yes,Bin1,Bbs1,Pbs1}; - no -> no - end; - _ -> no - end. +match_record_patterns(Fields, Pats) -> + Mfun = fun (F|_) -> make_field_pat(F, Pats); + (F) -> make_field_pat(F, Pats) + end, + lists:map(Mfun, Fields). -get_pat_bitsize(all, {Ty,_,_,_}, _, _, _) -> - if Ty =:= binary -> all; - true -> eval_error(illegal_bitsize) - end; -get_pat_bitsize(undefined, {Ty,_,_,_}, _, _, _) -> - if Ty =:= utf8; Ty =:= utf16; Ty =:= utf32 -> undefined; - true -> eval_error(illegal_bitsize) - end; -get_pat_bitsize(S, _, _, _, _) when is_integer(S) -> S; -get_pat_bitsize(S, _, Bbs, _, Env) when is_atom(S) -> - %% Variable either in environment or bound in binary. - case get_vbinding(S, Env) of - {yes,V} -> V; - no -> - case find(S, Bbs) of - {ok,V} -> V; - error -> unbound_symb_error(S) - end - end. +make_field_pat(F, F,P|_) -> P; +make_field_pat(F, _,_|Pats) -> make_field_pat(F, Pats); +make_field_pat(_, ) -> '_'. %Underscore matches anything -match_bitexpr(N, Val, Bbs, Pbs, _) when is_number(N) -> - if N =:= Val -> {yes,Bbs,Pbs}; - true -> no - end; -match_bitexpr('_', _, Bbs, Pbs, _) -> {yes,Bbs,Pbs}; -match_bitexpr(S, Val, Bbs, Pbs, _) when is_atom(S) -> - %% We know that if variable is in Pbs it will also be in Bbs! - case find(S, Pbs) of - {ok,Val} -> {yes,Bbs,Pbs}; %Bound to the same value - {ok,_} -> no; %Bound to a different value - error -> %Not yet bound - {yes,store(S, Val, Bbs),store(S, Val, Pbs)} - end; -match_bitexpr(_, _, _, _, _) -> eval_error(illegal_bitseg). - -%% get_pat_bitseg(Binary, Size, {Type,Unit,Sign,Endian}) -> {Value,RestBinary}. -%% This function can signal error if impossible to get specified bit -%% segment. - -get_pat_bitseg(Bin, Size, Type) -> - case Type of - %% Integer types. - {integer,Un,Si,En} -> - get_int_bitseg(Bin, Size*Un, Si, En); - %% Unicode types, ignore unused bitsegs. - {utf8,_,_,_} -> get_utf8_bitseg(Bin); - {utf16,_,_,En} -> get_utf16_bitseg(Bin, En); - {utf32,_,_,En} -> get_utf32_bitseg(Bin, En); - %% Float types. - {float,Un,_,En} -> get_float_bitseg(Bin, Size*Un, En); - %% Binary types. - {binary,Un,_,_} -> - if Size == all -> - 0 = (bit_size(Bin) rem Un), - {Bin,<<>>}; - true -> - TotSize = Size * Un, - <<Val:TotSize/bitstring,Rest/bitstring>> = Bin, - {Val,Rest} - end - end. +%% match_struct_map(Name, Pats, Val, Pbs, Env) -> {yes,Pbs} | no. + +match_struct_map(Name, Pats, Val, Pbs, Env) -> + Str = map,?Q('__struct__'),?Q(Name)|match_struct_fields(Pats), + match(Str, Val, Pbs, Env). -get_int_bitseg(Bin, Sz, signed, big) -> - <<Val:Sz/big-signed,Rest/bitstring>> = Bin, - {Val,Rest}; -get_int_bitseg(Bin, Sz, unsigned, big) -> - <<Val:Sz/big-unsigned,Rest/bitstring>> = Bin, - {Val,Rest}; -get_int_bitseg(Bin, Sz, signed, little) -> - <<Val:Sz/little-signed,Rest/bitstring>> = Bin, - {Val,Rest}; -get_int_bitseg(Bin, Sz, unsigned, little) -> - <<Val:Sz/little-unsigned,Rest/bitstring>> = Bin, - {Val,Rest}; -get_int_bitseg(Bin, Sz, signed, native) -> - <<Val:Sz/native-signed,Rest/bitstring>> = Bin, - {Val,Rest}; -get_int_bitseg(Bin, Sz, unsigned, native) -> - <<Val:Sz/native-unsigned,Rest/bitstring>> = Bin, - {Val,Rest}. - -get_utf8_bitseg(Bin) -> - <<Val/utf8,Rest/bitstring>> = Bin, - {Val,Rest}. - -get_utf16_bitseg(Bin, big) -> - <<Val/utf16-big,Rest/bitstring>> = Bin, - {Val,Rest}; -get_utf16_bitseg(Bin, little) -> - <<Val/utf16-little,Rest/bitstring>> = Bin, - {Val,Rest}; -get_utf16_bitseg(Bin, native) -> - <<Val/utf16-native,Rest/bitstring>> = Bin, - {Val,Rest}. - -get_utf32_bitseg(Bin, big) -> - <<Val/utf32-big,Rest/bitstring>> = Bin, - {Val,Rest}; -get_utf32_bitseg(Bin, little) -> - <<Val/utf32-little,Rest/bitstring>> = Bin, - {Val,Rest}; -get_utf32_bitseg(Bin, native) -> - <<Val/utf32-native,Rest/bitstring>> = Bin, - {Val,Rest}. - -get_float_bitseg(Bin, Sz, big) -> - <<Val:Sz/float,Rest/bitstring>> = Bin, - {Val,Rest}; -get_float_bitseg(Bin, Sz, little) -> - <<Val:Sz/float-little,Rest/bitstring>> = Bin, - {Val,Rest}; -get_float_bitseg(Bin, Sz, native) -> - <<Val:Sz/float-native,Rest/bitstring>> = Bin, - {Val,Rest}. +match_struct_fields(Key,Val|Kvs) -> + ?Q(Key),Val|match_struct_fields(Kvs); +match_struct_fields(Key) -> eval_error({missing_struct_field_value,Key}); +match_struct_fields() -> . + +%% match_binary(Bitsegs, Binary, PatBindings, Env) -> {yes,PatBindings} | no. +%% Match Bitsegs against Binary. Bad matches result in an error, we +%% use catch to trap it. + +match_binary(Segs, Bin, Pbs0, Env) -> + lfe_eval_bits:match_bitsegs(Segs, Bin, Pbs0, Env). %% match_map(Pairs, Map, PatBindings, Env) -> {yes,PatBindings} | no. @@ -1117,7 +1310,7 @@ pat_map_key(?Q(E)) -> E; pat_map_key(_|_=L) -> - case is_posint_list(L) of + case lfe_lib:is_posint_list(L) of true -> L; %Literal strings only false -> illegal_mapkey_error(L) end; @@ -1144,7 +1337,7 @@ eval_lit(Symb, Env) when is_atom(Symb) -> case get_vbinding(Symb, Env) of {yes,Val} -> Val; - no -> unbound_symb_error(Symb) + no -> unbound_symbol_error(Symb) end; eval_lit(Key, _) -> Key. %Literal values @@ -1152,23 +1345,22 @@ eval_lit(E, Env) || E <- Es . eval_lit_binary(Segs, Env) -> - Vsps = get_bitsegs(Segs), Eval = fun (S) -> eval_lit(S, Env) end, - eval_bitsegs(Vsps, Eval). + lfe_eval_bits:expr_bitsegs(Segs, Eval). eval_lit_map(K,V|As, Env) -> {eval_lit(K, Env),eval_lit(V, Env)}|eval_lit_map(As, Env); eval_lit_map(, _) -> . -%% Error functions. {?MODULE,eval_expr,2} is the stacktrace. +%% Error functions. badarg_error() -> eval_error(badarg). -unbound_symb_error(Sym) -> - eval_error({unbound_symb,Sym}). +unbound_symbol_error(Sym) -> + eval_error({unbound_symbol,Sym}). -undefined_func_error(Func, Ar) -> - eval_error({undefined_func,{Func,Ar}}). +undefined_function_error(Func, Ar) -> + eval_error({undefined_function,{Func,Ar}}). bad_form_error(Form) -> eval_error({bad_form,Form}). @@ -1179,13 +1371,13 @@ illegal_mapkey_error(Key) -> eval_error({illegal_mapkey,Key}). -eval_error(Error) -> - erlang:raise(error, Error, stacktrace()). - -stacktrace() -> {?MODULE,eval_expr,2}. +undefined_record_error(Rec) -> + eval_error({undefined_record,Rec}). -%%% Helper functions +undefined_record_field_error(Rec, F) -> + eval_error({undefined_record_field,Rec,F}). -maps_put({K,V}, M) -> maps:put(K, V, M). +eval_error(Error) -> + erlang:raise(error, Error, ?STACKTRACE). -maps_update({K,V}, M) -> maps:update(K, V, M). +%%% Helper functions
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_eval_bits.erl
Added
@@ -0,0 +1,299 @@ +%% Copyright (c) 2021 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_eval_bits.erl +%% Author : Robert Virding +%% Purpose : Lisp Flavoured Erlang interpreter functions for binaries. + +%%% We follow Erlang here in many cases even though it is sometimes a +%%% bit strange. In a fun argument where when matching a binary we +%%% import the size of bitseg as a variable from the environment not +%%% just from earlier segments. No other argument variables are +%%% imported. + +-module(lfe_eval_bits). + +-export(expr_bitsegs/2,match_bitsegs/4). + +-import(lists, foldl/3,foldr/3). + +-import(lfe_env, add_vbinding/3,add_vbindings/2,get_vbinding/2, + add_fbinding/4,add_fbindings/2, + add_ibinding/5). +-import(orddict, find/2,fetch/2,store/3,is_key/2). + +-include("lfe.hrl"). + +-define(STACKTRACE, + element(2, erlang:process_info(self(), current_stacktrace))). + +-define(EVAL_ERROR(Error), erlang:raise(error, Error, ?STACKTRACE)). + +%% expr_bitsegs(Bitsegs, EvalFun) -> Binary. +%% Construct a binary from Bitsegs. This code is taken from +%% eval_bits.erl. Pass in an evaluator function to be used when +%% evaluating vale and size expression. + +expr_bitsegs(Segs, Eval) -> + Vsps = get_bitsegs(Segs), + eval_bitsegs(Vsps, Eval). + +get_bitsegs(Segs) -> + 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. + +get_bitseg(Val|Specs=Seg, Vsps) -> + case lfe_lib:is_posint_list(Seg) of %Is bitseg a string? + true -> %A string + {Sz,Ty} = get_bitspecs(), + foldr(fun (V, Vs) -> {V,Sz,Ty}|Vs end, Vsps, Seg); + false -> %A value and spec + {Sz,Ty} = get_bitspecs(Specs), + case lfe_lib:is_posint_list(Val) of %Is Val a string? + true -> foldr(fun (V, Vs) -> {V,Sz,Ty}|Vs end, Vsps, Val); + false -> {Val,Sz,Ty}|Vsps %The default + end + end; +get_bitseg(Val, Vsps) -> + {Sz,Ty} = get_bitspecs(), + {Val,Sz,Ty}|Vsps. + +%% get_bitspec(Specs) -> {Size,Type}. +%% Get the error handling as we want it. + +get_bitspecs(Ss) -> + case lfe_bits:get_bitspecs(Ss) of + {ok,Sz,Ty} -> {Sz,Ty}; + {error,Error} -> eval_error(Error) + end. + +%% eval_bitsegs(VSTys, EvalFun) -> Binary. +%% The evaluator function is use to evaluate the value and size +%% fields. + +eval_bitsegs(Vsps, Eval) -> + foldl(fun ({Val,Sz,Ty}, Acc) -> + Bin = eval_bitseg(Val, Sz, Ty, Eval), + <<Acc/bitstring,Bin/bitstring>> + end, <<>>, Vsps). + +eval_bitseg(Val, Sz, Ty, Eval) -> + V = Eval(Val), + eval_exp_bitseg(V, Sz, Eval, Ty). + +%% eval_exp_bitseg(Value, Size, EvalSize, {Type,Unit,Sign,Endian}) -> Binary. + +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>>; + _ -> badarg_error() + end; + true -> + Sz = Eval(Size), + <<Val:(Sz*Unit)/bitstring>> + end + end. + +eval_int_bitseg(Val, Sz, signed, big) -> <<Val:Sz/signed>>; +eval_int_bitseg(Val, Sz, unsigned, big) -> <<Val:Sz>>; +eval_int_bitseg(Val, Sz, signed, little) -> <<Val:Sz/little-signed>>; +eval_int_bitseg(Val, Sz, unsigned, little) -> <<Val:Sz/little>>; +eval_int_bitseg(Val, Sz, signed, native) -> <<Val:Sz/native-signed>>; +eval_int_bitseg(Val, Sz, unsigned, native) -> <<Val:Sz/native>>. + +eval_utf16_bitseg(Val, big) -> <<Val/utf16-big>>; +eval_utf16_bitseg(Val, little) -> <<Val/utf16-little>>; +eval_utf16_bitseg(Val, native) -> <<Val/utf16-native>>. + +eval_utf32_bitseg(Val, big) -> <<Val/utf32-big>>; +eval_utf32_bitseg(Val, little) -> <<Val/utf32-little>>; +eval_utf32_bitseg(Val, native) -> <<Val/utf32-native>>. + +eval_float_bitseg(Val, Sz, big) -> <<Val:Sz/float>>; +eval_float_bitseg(Val, Sz, little) -> <<Val:Sz/float-little>>; +eval_float_bitseg(Val, Sz, native) -> <<Val:Sz/float-native>>. + +%% match_bitsegs(BitSegs, Binary PatBindings, Env) -> {yes,PatBindings} | no. +%% Match Bitsegs against Binary. This code is taken from +%% eval_bits.erl. Bitspec errors generate an error. Bad matches +%% result in an error, we use catch to trap it. + +match_bitsegs(Segs, Bin, Pbs0, Env) -> + Psps = get_bitsegs(Segs), + match_bitsegs(Psps, Bin, , Pbs0, Env). + +match_bitsegs({Pat,Sz,Ty}|Psps, Bin0, Bbs0, Pbs0, Env) -> + case match_bitseg(Pat, Sz, Ty, Bin0, Bbs0, Pbs0, Env) of + {yes,Bin1,Bbs1,Pbs1} -> + match_bitsegs(Psps, Bin1, Bbs1, Pbs1, Env); + no -> no + end; +match_bitsegs(, <<>>, _, Pbs, _) -> {yes,Pbs}; %Reached the end of both +match_bitsegs(, _, _, _, _) -> no. %More to go + +match_bitseg(Pat, Size, Type, Bin0, Bbs0, Pbs0, Env) -> + Sz = get_pat_bitsize(Size, Type, Bbs0, Pbs0, Env), + case catch {ok,get_pat_bitseg(Bin0, Sz, Type)} of + {ok,{Val,Bin1}} -> + case match_bitexpr(Pat, Val, Bbs0, Pbs0, Env) of + {yes,Bbs1,Pbs1} -> {yes,Bin1,Bbs1,Pbs1}; + no -> no + end; + _ -> no + end. + +get_pat_bitsize(all, {Ty,_,_,_}, _, _, _) -> + if Ty =:= binary -> all; + true -> eval_error(illegal_bitsize) + end; +get_pat_bitsize(undefined, {Ty,_,_,_}, _, _, _) -> + if Ty =:= utf8; Ty =:= utf16; Ty =:= utf32 -> undefined; + true -> eval_error(illegal_bitsize) + end; +get_pat_bitsize(S, _, _, _, _) when is_integer(S) -> S; +get_pat_bitsize(S, _, Bbs, _, Env) when is_atom(S) -> + %% Variable either in environment or bound in binary. + case get_vbinding(S, Env) of + {yes,V} -> V; + no -> + case find(S, Bbs) of + {ok,V} -> V; + error -> unbound_symb_error(S) + end + end. + +match_bitexpr(N, Val, Bbs, Pbs, _) when is_number(N) -> + if N =:= Val -> {yes,Bbs,Pbs}; + true -> no + end; +match_bitexpr('_', _, Bbs, Pbs, _) -> {yes,Bbs,Pbs}; +match_bitexpr(S, Val, Bbs, Pbs, _) when is_atom(S) -> + %% We know that if variable is in Pbs it will also be in Bbs! + case find(S, Pbs) of + {ok,Val} -> {yes,Bbs,Pbs}; %Bound to the same value + {ok,_} -> no; %Bound to a different value + error -> %Not yet bound + {yes,store(S, Val, Bbs),store(S, Val, Pbs)} + end; +match_bitexpr(_, _, _, _, _) -> eval_error(illegal_bitseg). + +%% get_pat_bitseg(Binary, Size, {Type,Unit,Sign,Endian}) -> {Value,RestBinary}. +%% This function can signal error if impossible to get specified bit +%% segment. + +get_pat_bitseg(Bin, Size, Type) -> + case Type of + %% Integer types. + {integer,Un,Si,En} -> + get_int_bitseg(Bin, Size*Un, Si, En); + %% Unicode types, ignore unused bitsegs. + {utf8,_,_,_} -> get_utf8_bitseg(Bin); + {utf16,_,_,En} -> get_utf16_bitseg(Bin, En); + {utf32,_,_,En} -> get_utf32_bitseg(Bin, En); + %% Float types. + {float,Un,_,En} -> get_float_bitseg(Bin, Size*Un, En); + %% Binary types. + {binary,Un,_,_} -> + if Size == all -> + 0 = (bit_size(Bin) rem Un), + {Bin,<<>>}; + true -> + TotSize = Size * Un, + <<Val:TotSize/bitstring,Rest/bitstring>> = Bin, + {Val,Rest} + end + end. + +get_int_bitseg(Bin, Sz, signed, big) -> + <<Val:Sz/big-signed,Rest/bitstring>> = Bin, + {Val,Rest}; +get_int_bitseg(Bin, Sz, unsigned, big) -> + <<Val:Sz/big-unsigned,Rest/bitstring>> = Bin, + {Val,Rest}; +get_int_bitseg(Bin, Sz, signed, little) -> + <<Val:Sz/little-signed,Rest/bitstring>> = Bin, + {Val,Rest}; +get_int_bitseg(Bin, Sz, unsigned, little) -> + <<Val:Sz/little-unsigned,Rest/bitstring>> = Bin, + {Val,Rest}; +get_int_bitseg(Bin, Sz, signed, native) -> + <<Val:Sz/native-signed,Rest/bitstring>> = Bin, + {Val,Rest}; +get_int_bitseg(Bin, Sz, unsigned, native) -> + <<Val:Sz/native-unsigned,Rest/bitstring>> = Bin, + {Val,Rest}. + +get_utf8_bitseg(Bin) -> + <<Val/utf8,Rest/bitstring>> = Bin, + {Val,Rest}. + +get_utf16_bitseg(Bin, big) -> + <<Val/utf16-big,Rest/bitstring>> = Bin, + {Val,Rest}; +get_utf16_bitseg(Bin, little) -> + <<Val/utf16-little,Rest/bitstring>> = Bin, + {Val,Rest}; +get_utf16_bitseg(Bin, native) -> + <<Val/utf16-native,Rest/bitstring>> = Bin, + {Val,Rest}. + +get_utf32_bitseg(Bin, big) -> + <<Val/utf32-big,Rest/bitstring>> = Bin, + {Val,Rest}; +get_utf32_bitseg(Bin, little) -> + <<Val/utf32-little,Rest/bitstring>> = Bin, + {Val,Rest}; +get_utf32_bitseg(Bin, native) -> + <<Val/utf32-native,Rest/bitstring>> = Bin, + {Val,Rest}. + +get_float_bitseg(Bin, Sz, big) -> + <<Val:Sz/float,Rest/bitstring>> = Bin, + {Val,Rest}; +get_float_bitseg(Bin, Sz, little) -> + <<Val:Sz/float-little,Rest/bitstring>> = Bin, + {Val,Rest}; +get_float_bitseg(Bin, Sz, native) -> + <<Val:Sz/float-native,Rest/bitstring>> = Bin, + {Val,Rest}. + +%% Error functions. + +badarg_error() -> eval_error(badarg). + +unbound_symb_error(Sym) -> + eval_error({unbound_symb,Sym}). + +eval_error(Error) -> + erlang:raise(error, Error, ?STACKTRACE).
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_gen.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_gen.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_init.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_init.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2014 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,49 +29,62 @@ -export(start/0). +-include("lfe.hrl"). + -define(OK_STATUS, 0). -define(ERROR_STATUS, 127). %% Start LFE running a script or the shell depending on arguments. start() -> - case init:get_plain_arguments() of - "-lfe_eval"|As -> %Run a command string - user:start(), %Start user for io - run_string(As); - S|As -> %Run a script - user:start(), %Start user for io - run_file(S|As); - -> %Run a shell - user_drv:start('tty_sl -c -e',{lfe_shell,start,}) + case collect_args(init:get_plain_arguments()) of + {,} -> %Run a shell + user_drv:start('tty_sl -c -e',{lfe_shell,start,}); + {Es,Script} -> + user:start(), + %% io:format("es: ~p\n", {Es,Script}), + run_evals_script(Es, Script) end. -run_file(S|As) -> - Script = fun () -> lfe_shell:run_script(S, As) end, - spawn_link(fun () -> run_script(Script) end). +collect_args(E,S|As) when E == "-lfe_eval" ; E == "-eval" ; E == "-e" -> + {Es,Script} = collect_args(As), + {S ++ Es,Script}; +collect_args(E) when E == "-lfe_eval" ; E == "-eval" ; E == "-e" -> + {,}; +collect_args(As) -> {,As}. %Remaining become script + +%% run_evals_script(Evals, Script) -> Pid. +%% Firat evaluate all the eval strings if any then the script if +%% there is one. The state from the string is past into the +%% script. We can handle no strings and no script. -run_string() -> run_string(, ); %No command -run_string("--") -> run_string(, ); %No command -run_string(S,"--"|As) -> run_string(S, As); -run_string(S|As) -> run_string(S, As). +run_evals_script(Evals, Script) -> + S = fun () -> + St = lfe_shell:run_strings(Evals), + case Script of + F|As -> + lfe_shell:run_script(F, As, St); + -> {,St} + end + end, + spawn_link(fun () -> run_script(S) end). -run_string(, _) -> %No command - io:put_chars(user, "eval: missing command\n"), - halt(?ERROR_STATUS); -run_string(S, As) -> - Script = fun () -> lfe_shell:run_string(S, As) end, - spawn_link(fun () -> run_script(Script) end). +%% run_script(Script) +%% Run a script and terminate the erlang process afterwards. run_script(Script) -> try - Script(), + Script(), %Evaluate the script + %% For some reason we need to wait a bit before stopping. + timer:sleep(1), init:stop(?OK_STATUS) catch - Class:Error -> - St = erlang:get_stacktrace(), %Need to get this first - Sf = fun (_) -> false end, + ?CATCH(Class, Error, Stack) + Sf = fun ({M,_F,_A,_L}) -> + M /= lfe_eval + end, Ff = fun (T, I) -> lfe_io:prettyprint1(T, 15, I, 80) end, - Cs = lfe_lib:format_exception(Class, Error, St, Sf, Ff, 1), + Cs = lfe_lib:format_exception(Class, Error, Stack, Sf, Ff, 1), io:put_chars(Cs), halt(?ERROR_STATUS) end.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_internal.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_internal.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2016 Robert Virding +%% Copyright (c) 2016-2021 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -14,13 +14,16 @@ %% File : lfe_internal.erl %% Author : Robert Virding -%% Purpose : Define Lisp Flavoured Erlang internal bifs, guards. +%% Purpose : Define Lisp Flavoured Erlang internals. + +%%% Define LFE internal bifs, guards and other internal stuff. -module(lfe_internal). %% General library functions. -export(is_bif/2,is_guard_bif/2,is_erl_bif/2,is_lfe_bif/2). -export(is_core_form/1,is_core_func/2). +-export(is_type/2). %% -compile(export_all). @@ -62,12 +65,30 @@ is_core_form(tset) -> true; is_core_form(binary) -> true; is_core_form(map) -> true; +is_core_form(msiz) -> true; is_core_form(mref) -> true; is_core_form(mset) -> true; is_core_form(mupd) -> true; +is_core_form(mrem) -> true; +is_core_form('map-size') -> true; is_core_form('map-get') -> true; is_core_form('map-set') -> true; is_core_form('map-update') -> true; +is_core_form('map-remove') -> true; +%% Core record special forms. +is_core_form('record') -> true; +%% make-record has been deprecated but we sill accept it for now. +is_core_form('make-record') -> true; +is_core_form('is-record') -> true; +is_core_form('record-index') -> true; +is_core_form('record-field') -> true; +is_core_form('record-update') -> true; +%% Core struct special forms. +is_core_form('struct') -> true; +is_core_form('is-struct') -> true; +is_core_form('struct-field') -> true; +is_core_form('struct-update') -> true; +%% Function forms. is_core_form(function) -> true; %% Core closure special forms. is_core_form(lambda) -> true; @@ -85,6 +106,11 @@ is_core_form('try') -> true; is_core_form('funcall') -> true; is_core_form(call) -> true; +%% List/binary comprehensions. +is_core_form('lc') -> true; +is_core_form('list-comp') -> true; +is_core_form('bc') -> true; +is_core_form('binary-comp') -> true; %% Core definition special forms. is_core_form('eval-when-compile') -> true; is_core_form('define-module') -> true; @@ -94,6 +120,8 @@ is_core_form('define-function-spec') -> true; is_core_form('define-function') -> true; is_core_form('define-macro') -> true; +is_core_form('define-record') -> true; +is_core_form('define-struct') -> true; %% And don't forget when. is_core_form('when') -> true; %% Everything else is not a core form. @@ -113,12 +141,35 @@ is_core_func(tset, 3) -> true; is_core_func(binary, Ar) when Ar >= 0 -> true; is_core_func(map, Ar) when Ar >= 0, (Ar rem 2) =:= 0 -> true; +is_core_func(msiz, 1) -> true; is_core_func(mref, 2) -> true; -is_core_func(mset, Ar) when Ar >= 0, (Ar rem 2) =:= 1 -> true; -is_core_func(mupd, Ar) when Ar >= 0, (Ar rem 2) =:= 1 -> true; +is_core_func(mset, Ar) when Ar >= 1, (Ar rem 2) =:= 1 -> true; +is_core_func(mupd, Ar) when Ar >= 1, (Ar rem 2) =:= 1 -> true; +is_core_func(mrem, Ar) when Ar >= 1 -> true; +is_core_func('map-size', 1) -> true; is_core_func('map-get', 2) -> true; -is_core_func('map-set', Ar) when Ar >= 0, (Ar rem 2) =:= 1 -> true; -is_core_func('map-upd', Ar) when Ar >= 0, (Ar rem 2) =:= 1 -> true; +is_core_func('map-set', Ar) when Ar >= 1, (Ar rem 2) =:= 1 -> true; +is_core_func('map-update', Ar) when Ar >= 1, (Ar rem 2) =:= 1 -> true; +is_core_func('map-remove', Ar) when Ar >= 1 -> true; +%% Core record special functions. +is_core_func('record', Ar) when Ar >= 1, (Ar rem 2) =:= 1 -> true; +%% make-record has been deprecated but we sill accept it for now. +is_core_func('make-record', Ar) when Ar >= 1, (Ar rem 2) =:= 1 -> true; +is_core_func('is-record', 2) -> true; +is_core_func('record-index', 2) -> true; +is_core_func('record-field', 3) -> true; +is_core_func('record-update', Ar) when Ar >= 2, (Ar rem 2) =:= 0 -> true; +%% Core struct special functions. +is_core_func('struct', Ar) when Ar >= 1, (Ar rem 2) =:= 1 -> true; +is_core_func('is-struct', Ar) when Ar =:= 1; Ar =:= 2 -> true; +is_core_func('struct-field', 3) -> true; +is_core_func('struct-update', Ar) when Ar >= 2, (Ar rem 2) =:= 0 -> true; +%% List/binary comprehensions. +is_core_func('lc', 2) -> true; +is_core_func('list-comp', 2) -> true; +is_core_func('bc', 2) -> true; +is_core_func('binary-comp', 2) -> true; +%% Core control special functions. is_core_func(funcall, Ar) when Ar >= 1 -> true; is_core_func(call, Ar) when Ar >= 2 -> true; is_core_func(_, _) -> false. @@ -138,3 +189,16 @@ is_lfe_bif('macroexpand-all', 1) -> true; is_lfe_bif('macroexpand-all', 2) -> true; is_lfe_bif(_, _) -> false. + +%% is_type(NAme, Arity) -> bool(). +%% Return true if Name/Arity is a predefined type. + +is_type('UNION', Ar) -> is_integer(Ar) and (Ar >= 0); +is_type(call, Ar) -> is_integer(Ar) and (Ar >= 0); +is_type(lambda, Ar) -> is_integer(Ar) and (Ar >= 0); +is_type(map, Ar) -> is_integer(Ar) and (Ar >= 0); +is_type(range, 2) -> true; +is_type(bitstring, 2) -> true; +is_type(tuple, Ar) -> is_integer(Ar) and (Ar >= 0); +is_type(Name, Arity) -> + erl_internal:is_type(Name, Arity).
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_io.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_io.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,7 +24,7 @@ -module(lfe_io). --export(parse_file/1,read_file/1). +-export(parse_file/1,parse_file/2,read_file/1,read_file/2). -export(read/0,read/1,read/2,read_line/0,read_line/1,read_line/2). -export(read_string/1). -export(scan_sexpr/2,scan_sexpr/3). @@ -38,68 +38,79 @@ -import(lists, flatten/1,reverse/1,reverse/2,map/2,mapfoldl/3,all/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. +-include("lfe.hrl"). -%% parse_file(FileName) -> {ok,{Sexpr,Line}} | {error,Error}. +%% parse_file(FileName|Fd, Line) -> {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_file(Name) -> - with_token_file(Name, fun (Ts) -> parse_file1(Ts, , ) end). +parse_file(Name) -> parse_file(Name, 1). -parse_file1(_|_=Ts0, Pc0, Ss) -> +parse_file(Name, Line) -> + with_token_file(Name, + fun (Ts, Lline) -> parse_file1(Ts, Lline, , ) end, + Line). + +parse_file1(_|_=Ts0, Lline, Pc0, Ss) -> case lfe_parse:sexpr(Pc0, Ts0) of - {ok,L,S,Ts1} -> parse_file1(Ts1, , {S,L}|Ss); + {ok,L,S,Ts1} -> parse_file1(Ts1, Lline, , {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,_} = lfe_parse:sexpr(Pc1, {eof,Lline}), {error,E}; {error,E,_} -> {error,E} end; -parse_file1(, _, Ss) -> {ok,reverse(Ss)}. +parse_file1(, _, _, Ss) -> {ok,reverse(Ss)}. -%% read_file(FileName) -> {ok,Sexpr} | {error,Error}. +%% read_file(FileName|Fd, Line) -> {ok,Sexpr} | {error,Error}. %% 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_file(Name) -> read_file(Name, 1). + +read_file(Name, Line) -> + with_token_file(Name, + fun (Ts, Lline) -> read_file1(Ts, Lline, ) end, + Line). -read_file1(_|_=Ts0, Ss) -> +read_file1(_|_=Ts0, Lline, Ss) -> case lfe_parse:sexpr(Ts0) of - {ok,_,S,Ts1} -> read_file1(Ts1, S|Ss); + {ok,_,S,Ts1} -> read_file1(Ts1, Lline, 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,_} = lfe_parse:sexpr(Pc1, {eof,Lline}), {error,E}; {error,E,_} -> {error,E} end; -read_file1(, Ss) -> {ok,reverse(Ss)}. +read_file1(, _, Ss) -> {ok,reverse(Ss)}. -%% with_token_file(FileName, DoFunc) -%% Open the file, scan all LFE tokens and apply DoFunc on them. +%% with_token_file(FileName|Fd, DoFunc, Line) +%% Open the file, scan all LFE tokens and apply DoFunc on them. If +%% file:open fails with badarg then try assuming it is a fd. Note +%% that a new file starts at line 1. -with_token_file(Name, Do) -> +with_token_file(Name, Do, Line) -> case file:open(Name, read) of - {ok,F} -> - Ret = case io:request(F, {get_until,unicode,'',lfe_scan,tokens,1}) of - {ok,Ts,_} -> Do(Ts); - {error,Error,_} -> {error,Error} - end, - file:close(F), %Close the file - Ret; % and return value + {ok,Fd} -> + with_token_file_fd(Fd, Do, 1); %Start at line 1 + {error,badarg} -> + %% Could be a fd so use it as it is one. + with_token_file_fd(Name, Do, Line); {error,Error} -> {error,{none,file,Error}} end. -%% read() -> {ok,Sexpr} | {error,Error}. -%% read(Prompt) -> {ok,Sexpr} | {error,Error}. -%% read(IoDevice, Prompt) -> {ok,Sexpr} | {error,Error}. +with_token_file_fd(Fd, Do, Line) -> %Called with a file descriptor + Ret = case io:request(Fd, {get_until,unicode,'',lfe_scan,tokens,Line}) of + {ok,Ts,Lline} -> Do(Ts, Lline); + {error,Error,_} -> {error,Error} + end, + file:close(Fd), %Close the file + Ret. % and return value + +%% read() -> {ok,Sexpr} | {error,Error} | eof. +%% read(Prompt) -> {ok,Sexpr} | {error,Error} | eof. +%% read(IoDevice, Prompt) -> {ok,Sexpr} | {error,Error} | eof. %% A simple read function. It is not line oriented and stops as soon %% as it has consumed enough. @@ -113,9 +124,9 @@ {eof,_} -> eof end. -%% read_line() -> {ok,Sexpr} | {error,Error}. -%% read_line(Prompt) -> {ok,Sexpr} | {error,Error}. -%% read_line(IoDevice, Prompt) -> {ok,Sexpr} | {error,Error}. +%% read_line() -> {ok,Sexpr} | {error,Error} | eof. +%% read_line(Prompt) -> {ok,Sexpr} | {error,Error} | eof. +%% read_line(IoDevice, Prompt) -> {ok,Sexpr} | {error,Error} | eof. %% A simple read function. It is line oriented and reads whole lines %% until it has consumed enough characters. Left-over characters in %% the last line are discarded. @@ -133,6 +144,7 @@ case scan_sexpr(C0, Cs0, L0) of {done,{ok,Ret,_L1},_Cs1} -> {ok,Ret}; {done,{error,Error,_},_Cs1} -> {error,Error}; + {done,{eof,_},_} -> eof; {more,C1} -> read_line_1(Io, P, C1, L0) end
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_io_format.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_io_format.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,91 +26,104 @@ -import(lists, reverse/1,foldl/3). +-record(cstruct, {cchar, %Control character + args, %Control arguments + width, %Field width + adjust, %Adjust left/right + prec, %Precision + pad %Pad character + }). + %% -compile(export_all). fwrite1(Format, Data) -> - Cs = scan(Format, Data), - Pc = pcount(Cs), - build(Cs, Pc, 0). - -%% scan(Format, Args) -> FormatList. - -scan(Format, Args) when is_binary(Format) -> - scan(binary_to_list(Format), Args); -scan(Format, Args) -> - collect(Format, Args). - -%% collect(Format, Args) -> FormatList. - -collect($~|Fmt0, As0) -> - {C,Fmt1,As1} = collect_cseq(Fmt0, As0), - C|collect(Fmt1, As1); -collect(C|Fmt, Args) -> - C|collect(Fmt, Args); + Cstructs = scan(Format, Data), + Pc = pcount(Cstructs), + build(Cstructs, Pc, 0). + +%% scan(Format, Data) -> OutputChars. + +scan(Format, Data) when is_binary(Format) -> + scan(binary_to_list(Format), Data); +scan(Format, Data) -> + collect(Format, Data). + +%% collect(Format, Data) -> ControlStruct. +%% Collect all the control structures and characters built from the +%% format and the data. + +collect($~|Fmt0, Data0) -> + {Cstruct,Fmt1,Data1} = collect_cseq(Fmt0, Data0), + Cstruct|collect(Fmt1, Data1); +collect(C|Fmt, Data) -> + %% Just return the character in format. + C|collect(Fmt, Data); collect(, ) -> . -%% collect_cseq(Format, Args) -> -%% {{Control,ControlArgs,Field,Adjust,Precision,Pad},Format,Args}. +%% collect_cseq(Format, Data) -> +%% {ControlStruct,Format,Data}. -collect_cseq(Fmt0, As0) -> - {F,Ad,Fmt1,As1} = field_width(Fmt0, As0), - {P,Fmt2,As2} = precision(Fmt1, As1), - {Pad,Fmt3,As3} = pad_char(Fmt2, As2), - {C,As,Fmt4,As4} = collect_cc(Fmt3, As3), - {{C,As,F,Ad,P,Pad},Fmt4,As4}. +collect_cseq(Fmt0, Data0) -> + {Width,Ad,Fmt1,Data1} = field_width(Fmt0, Data0), + {P,Fmt2,Data2} = precision(Fmt1, Data1), + {Pad,Fmt3,Data3} = pad_char(Fmt2, Data2), + {C,Args,Fmt4,Data4} = collect_cc(Fmt3, Data3), + {#cstruct{cchar=C,args=Args,width=Width,adjust=Ad,prec=P,pad=Pad}, + Fmt4,Data4}. -%% field_width(Format, Args) -> {Field,Adjust,Format,Args}. -%% precision(Format, Args) -> {Precision,Format,Args}. -%% pad_char(Format, Args) -> {Field,Adjust,Format,Args}. +%% field_width(Format, Data) -> {Field,Adjust,Format,Data}. +%% precision(Format, Data) -> {Precision,Format,Data}. +%% pad_char(Format, Data) -> {Field,Adjust,Format,Data}. %% Extract the field width/precision/pad char from the format -field_width($-|Fmt0, Args0) -> - {F,Fmt,Args} = field_value(Fmt0, Args0), - field_width(-F, Fmt, Args); -field_width(Fmt0, Args0) -> - {F,Fmt,Args} = field_value(Fmt0, Args0), - field_width(F, Fmt, Args). - -field_width(F, Fmt, Args) when F < 0 -> - {-F,left,Fmt,Args}; -field_width(F, Fmt, Args) when F >= 0 -> - {F,right,Fmt,Args}. - -precision($.|Fmt, Args) -> field_value(Fmt, Args); -precision(Fmt, Args) -> {none,Fmt,Args}. - -field_value($*|Fmt, A|Args) when is_integer(A) -> - {A,Fmt,Args}; -field_value(C|Fmt, Args) when is_integer(C), C >= $0, C =< $9 -> - field_value(C|Fmt, Args, 0); -field_value(Fmt, Args) -> - {none,Fmt,Args}. - -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 - {F,Fmt,Args}. - -pad_char($.,$*|Fmt, Pad|Args) -> {Pad,Fmt,Args}; -pad_char($.,Pad|Fmt, Args) -> {Pad,Fmt,Args}; -pad_char(Fmt, Args) -> {$\s,Fmt,Args}. - -%% pcount(ControlC) -> Count. +field_width($-|Fmt0, Data0) -> + {F,Fmt,Data1} = field_value(Fmt0, Data0), + field_width(-F, Fmt, Data1); +field_width(Fmt0, Data0) -> + {F,Fmt,Data1} = field_value(Fmt0, Data0), + field_width(F, Fmt, Data1). + +field_width(F, Fmt, Data) when F < 0 -> + {-F,left,Fmt,Data}; +field_width(F, Fmt, Data) when F >= 0 -> + {F,right,Fmt,Data}. + +precision($.|Fmt, Data) -> field_value(Fmt, Data); +precision(Fmt, Data) -> {none,Fmt,Data}. + +field_value($*|Fmt, D|Data) when is_integer(D) -> + {D,Fmt,Data}; +field_value(C|Fmt, Data) when is_integer(C), C >= $0, C =< $9 -> + field_value(C|Fmt, Data, 0); +field_value(Fmt, Data) -> + {none,Fmt,Data}. + +field_value(C|Fmt, Data, F) when is_integer(C), C >= $0, C =< $9 -> + field_value(Fmt, Data, 10*F + (C - $0)); +field_value(Fmt, Data, F) -> %Default case + {F,Fmt,Data}. + +pad_char($.,$*|Fmt, Pad|Data) -> {Pad,Fmt,Data}; +pad_char($.,Pad|Fmt, Data) -> {Pad,Fmt,Data}; +pad_char(Fmt, Data) -> {$\s,Fmt,Data}. + +%% pcount(ControlStructs) -> Count. %% Count the number of print requests. pcount(Cs) -> - foldl(fun ({$p,_,_,_,_,_}, Acc) -> Acc+1; - ({$P,_,_,_,_,_}, Acc) -> Acc+1; + foldl(fun (#cstruct{cchar=$p}, Acc) -> Acc+1; + (#cstruct{cchar=$P}, Acc) -> Acc+1; (_, Acc) -> Acc end, 0, Cs). -%% build(FormatList, Pc, Indentation) -> Char. +%% build(ControlStruct, PrintRequestCount, Indentation) -> Char. %% Interpret the control structures. Count the number of print %% remaining and only calculate indentation when necessary. Must also %% be smart when calculating indentation for characters in format. -build({C,As,F,Ad,P,Pad}|Cs, Pc0, I) -> - S = control(C, As, F, Ad, P, Pad, I), +build(#cstruct{}=Cstruct|Cs, Pc0, I) -> + #cstruct{cchar=C,args=As,width=Width,adjust=Ad,prec=P,pad=Pad} = Cstruct, + S = control(C, As, Width, Ad, P, Pad, I), Pc1 = decr_pc(C, Pc0), if Pc1 > 0 -> S|build(Cs, Pc1, indentation(S, I)); @@ -137,29 +150,29 @@ indentation(Cs, indentation(C, I)); indentation(, I) -> I. -%% collect_cc(FormatChar, Argument) -> -%% {Control,ControlArg,FormatChar,Arg}. +%% collect_cc(Format, Data) -> +%% {Control,ControlArg,Format,Data}. %% Here we collect the argments for each control character. %% Be explicit to cause failure early. -collect_cc($w|Fmt, A|Args) -> {$w,A,Fmt,Args}; -collect_cc($p|Fmt, A|Args) -> {$p,A,Fmt,Args}; -collect_cc($W|Fmt, A,Depth|Args) -> {$W,A,Depth,Fmt,Args}; -collect_cc($P|Fmt, A,Depth|Args) -> {$P,A,Depth,Fmt,Args}; -collect_cc($s|Fmt, A|Args) -> {$s,A,Fmt,Args}; -collect_cc($e|Fmt, A|Args) -> {$e,A,Fmt,Args}; -collect_cc($f|Fmt, A|Args) -> {$f,A,Fmt,Args}; -collect_cc($g|Fmt, A|Args) -> {$g,A,Fmt,Args}; -collect_cc($b|Fmt, A|Args) -> {$b,A,Fmt,Args}; -collect_cc($B|Fmt, A|Args) -> {$B,A,Fmt,Args}; -collect_cc($x|Fmt, A,Prefix|Args) -> {$x,A,Prefix,Fmt,Args}; -collect_cc($X|Fmt, A,Prefix|Args) -> {$X,A,Prefix,Fmt,Args}; -collect_cc($+|Fmt, A|Args) -> {$+,A,Fmt,Args}; -collect_cc($#|Fmt, A|Args) -> {$#,A,Fmt,Args}; -collect_cc($c|Fmt, A|Args) -> {$c,A,Fmt,Args}; -collect_cc($~|Fmt, Args) when is_list(Args) -> {$~,,Fmt,Args}; -collect_cc($n|Fmt, Args) when is_list(Args) -> {$n,,Fmt,Args}; -collect_cc($i|Fmt, A|Args) -> {$i,A,Fmt,Args}. +collect_cc($w|Fmt, D|Data) -> {$w,D,Fmt,Data}; +collect_cc($p|Fmt, D|Data) -> {$p,D,Fmt,Data}; +collect_cc($W|Fmt, D,Depth|Data) -> {$W,D,Depth,Fmt,Data}; +collect_cc($P|Fmt, D,Depth|Data) -> {$P,D,Depth,Fmt,Data}; +collect_cc($s|Fmt, D|Data) -> {$s,D,Fmt,Data}; +collect_cc($e|Fmt, D|Data) -> {$e,D,Fmt,Data}; +collect_cc($f|Fmt, D|Data) -> {$f,D,Fmt,Data}; +collect_cc($g|Fmt, D|Data) -> {$g,D,Fmt,Data}; +collect_cc($b|Fmt, D|Data) -> {$b,D,Fmt,Data}; +collect_cc($B|Fmt, D|Data) -> {$B,D,Fmt,Data}; +collect_cc($x|Fmt, D,Prefix|Data) -> {$x,D,Prefix,Fmt,Data}; +collect_cc($X|Fmt, D,Prefix|Data) -> {$X,D,Prefix,Fmt,Data}; +collect_cc($+|Fmt, D|Data) -> {$+,D,Fmt,Data}; +collect_cc($#|Fmt, D|Data) -> {$#,D,Fmt,Data}; +collect_cc($c|Fmt, D|Data) -> {$c,D,Fmt,Data}; +collect_cc($~|Fmt, Data) when is_list(Data) -> {$~,,Fmt,Data}; +collect_cc($n|Fmt, Data) when is_list(Data) -> {$n,,Fmt,Data}; +collect_cc($i|Fmt, D|Data) -> {$i,D,Fmt,Data}. %% control(FormatChar, Argument, FieldWidth, Adjust, Precision, PadChar, %% Indentation) -> @@ -167,7 +180,7 @@ %% This is the main dispatch function for the various formatting commands. %% Field widths and precisions have already been calculated. -control($w, A, F, Adj, P, Pad, _) -> +control($w, A, F, Adj, P, Pad, _I) -> write(lfe_io:print1(A, -1), F, Adj, P, Pad); control($W, A,Depth, F, Adj, P, Pad, _I) when is_integer(Depth) -> write(lfe_io:print1(A, Depth), F, Adj, P, Pad); @@ -177,93 +190,91 @@ print(A, Depth, F, Adj, P, Pad, I); control($s, A, F, Adj, P, Pad, _I) when is_atom(A) -> string(atom_to_list(A), F, Adj, P, Pad); -%% control($s, L0, F, Adj, P, Pad, _) -> +%% control($s, L0, F, Adj, P, Pad, _I) -> %% L = iolist_to_chars(L0), %% string(L, F, Adj, P, Pad); -control($s, L0, F, Adj, P, Pad, _) -> +control($s, L0, F, Adj, P, Pad, _I) -> L = unicode:characters_to_list(L0), string(L, F, Adj, P, Pad); -control($e, A, F, Adj, P, Pad, _) when is_float(A) -> +control($e, A, F, Adj, P, Pad, _I) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); -control($f, A, F, Adj, P, Pad, _) when is_float(A) -> +control($f, A, F, Adj, P, Pad, _I) when is_float(A) -> fwrite_f(A, F, Adj, P, Pad); -control($g, A, F, Adj, P, Pad, _) when is_float(A) -> +control($g, A, F, Adj, P, Pad, _I) when is_float(A) -> fwrite_g(A, F, Adj, P, Pad); -control($b, A, F, Adj, P, Pad, _) when is_integer(A) -> +control($b, A, F, Adj, P, Pad, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, true); -control($B, A, F, Adj, P, Pad, _) when is_integer(A) -> +control($B, A, F, Adj, P, Pad, _I) 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), +control($x, A,Prefix, F, Adj, P, Pad, _I) when is_integer(A), 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) -> +control($x, A,Prefix, F, Adj, P, Pad, _I) 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), +control($X, A,Prefix, F, Adj, P, Pad, _I) when is_integer(A), 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) -> +control($X, A,Prefix, F, Adj, P, Pad, _I) 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, false); -control($+, A, F, Adj, P, Pad, _) when is_integer(A) -> +control($+, A, F, Adj, P, Pad, _I) when is_integer(A) -> Base = base(P), Prefix = base_prefix(Base, true), prefixed_integer(A, F, Adj, Base, Pad, Prefix, true); -control($#, A, F, Adj, P, Pad, _) when is_integer(A) -> +control($#, A, F, Adj, P, Pad, _I) when is_integer(A) -> Base = base(P), Prefix = base_prefix(Base, false), prefixed_integer(A, F, Adj, Base, Pad, Prefix, false); -control($c, A, F, Adj, P, Pad, _) when is_integer(A) -> +control($c, A, F, Adj, P, Pad, _I) when is_integer(A) -> char(A, F, Adj, P, Pad); -%% control($c, A, F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> -%% char(A band 255, F, Adj, P, Pad); -control($~, , F, Adj, P, Pad, _) -> char($~, F, Adj, P, Pad); -control($n, , F, Adj, P, Pad, _) -> newline(F, Adj, P, Pad); -control($i, _, _, _, _, _, _) -> . +control($~, , F, Adj, P, Pad, _I) -> char($~, F, Adj, P, Pad); +control($n, , F, Adj, P, Pad, _I) -> newline(F, Adj, P, Pad); +control($i, _, _F, _Adj, _P, _Pad, _I) -> . %% Default integer base base(none) -> 10; base(B) when is_integer(B) -> B. -%% write(CharList, Field, Adjust, Precision, PadChar) +%% write(CharList, FieldWidth, 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. -write(T, none, _, none, _) -> T; -write(T, F, Adj, P, Pad) -> +write(T, none, _Adj, none, _Pad) -> T; +write(T, W, Adj, P, Pad) -> N = lists:flatlength(T), - 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) + if P =:= none -> write1(T, W, Adj, N, Pad); + P >= N -> write1(T, W, Adj, N, Pad); + true -> write1(flat_trunc(T, P), W, Adj, P, Pad) end. -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) +write1(T, none, _Adj, _P, _Pad) -> T; +write1(T, W, Adj, N, Pad) -> + if W < N -> chars($*, W); + W == N -> T; + true -> adjust(T, chars(Pad, W-N), Adj) end. -%% print(CharList, Depth, Field, Adjust, Precision, PadChar, Indentation) +%% print(CharList, Depth, FieldWidth, 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:term(T, D, P, F). +print(T, D, W, Adj, none, Pad, I) -> print(T, D, W, Adj, I, Pad, I); +print(T, D, FW, right, P, _Pad, _I) -> + lfe_io_pretty:term(T, D, P, FW). -%% fwrite_e(Float, Field, Adjust, Precision, PadChar) +%% fwrite_e(Float, FieldWidth, Adjust, Precision, PadChar) 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 -> - write(float_e(Fl, float_data(Fl), P), F, Adj, F, Pad). +fwrite_e(Fl, W, Adj, none, Pad) -> + fwrite_e(Fl, W, Adj, 6, Pad); +fwrite_e(Fl, W, Adj, P, Pad) when P >= 2 -> + write(float_e(Fl, float_data(Fl), P), W, Adj, W, Pad). float_e(Fl, Fd, P) when Fl < 0.0 -> %Negative numbers $-|float_e(-Fl, Fd, P); @@ -308,16 +319,16 @@ float_exp(E) -> $e|integer_to_list(E). -%% fwrite_f(FloatData, Field, Adjust, Precision, PadChar) +%% fwrite_f(FloatData, FieldWidth, Adjust, Precision, PadChar) 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 -> - write(float_f(Fl, float_data(Fl), P), F, Adj, F, Pad). +fwrite_f(Fl, W, Adj, none, Pad) -> + fwrite_f(Fl, W, Adj, 6, Pad); +fwrite_f(Fl, W, Adj, P, Pad) when P >= 1 -> + write(float_f(Fl, float_data(Fl), P), W, Adj, W, Pad). float_f(Fl, Fd, P) when Fl < 0.0 -> $-|float_f(-Fl, Fd, P); @@ -340,14 +351,14 @@ float_data(_|Cs, Ds) -> float_data(Cs, Ds). -%% fwrite_g(Float, Field, Adjust, Precision, PadChar) +%% fwrite_g(Float, FieldWidth, Adjust, Precision, PadChar) %% Use the f form if Float is >= 0.1 and < 1.0e4, %% and the prints correctly in the f form, else the e form. %% Precision always means the # of significant digits. -fwrite_g(Fl, F, Adj, none, Pad) -> - fwrite_g(Fl, F, Adj, 6, Pad); -fwrite_g(Fl, F, Adj, P, Pad) when P >= 1 -> +fwrite_g(Fl, W, Adj, none, Pad) -> + fwrite_g(Fl, W, Adj, 6, Pad); +fwrite_g(Fl, W, Adj, P, Pad) when P >= 1 -> A = abs(Fl), E = if A < 1.0e-1 -> -2; A < 1.0e0 -> -1; @@ -359,55 +370,55 @@ end, if P =< 1, E =:= -1; P-1 > E, E >= -1 -> - fwrite_f(Fl, F, Adj, P-1-E, Pad); + fwrite_f(Fl, W, Adj, P-1-E, Pad); P =< 1 -> - fwrite_e(Fl, F, Adj, 2, Pad); + fwrite_e(Fl, W, Adj, 2, Pad); true -> - fwrite_e(Fl, F, Adj, P, Pad) + fwrite_e(Fl, W, Adj, P, Pad) end. -%% string(StringList, Field, Adjust, Precision, PadChar) +%% string(StringList, FieldWidth, Adjust, Precision, PadChar) %% Output a string adjusted with PadChar. string(S, none, _, none, _) -> S; -string(S, F, Adj, P, Pad) -> +string(S, W, Adj, P, Pad) -> N = lists:flatlength(S), - if P =:= none -> string1(S, F, Adj, N, Pad); - P >= N -> string1(S, F, Adj, N, Pad); - true -> string1(flat_trunc(S, P), F, Adj, P, Pad) + if P =:= none -> string1(S, W, Adj, N, Pad); + P >= N -> string1(S, W, Adj, N, Pad); + true -> string1(flat_trunc(S, P), W, Adj, P, Pad) end. -string1(S, none, _, _, _) -> S; -string1(S, F, Adj, N, Pad) -> - if F < N -> flat_trunc(S, F); - F == N -> S; - true -> adjust(S, chars(Pad, F-N), Adj) +string1(S, none, _Adj, _N, _Pad) -> S; +string1(S, W, Adj, N, Pad) -> + if W < N -> flat_trunc(S, W); + W == N -> S; + true -> adjust(S, chars(Pad, W-N), Adj) end. %% unprefixed_integer(Int, Field, Adjust, Base, PadChar, Lowercase) -> %% Char. -unprefixed_integer(Int, F, Adj, Base, Pad, Lowercase) +unprefixed_integer(Int, W, Adj, Base, Pad, Lowercase) when Base >= 2, Base =< 1+$Z-$A+10 -> if Int < 0 -> S = cond_lowercase(erlang:integer_to_list(-Int, Base), Lowercase), - write($-|S, F, Adj, none, Pad); + write($-|S, W, Adj, none, Pad); true -> S = cond_lowercase(erlang:integer_to_list(Int, Base), Lowercase), - write(S, F, Adj, none, Pad) + write(S, W, Adj, none, Pad) end. -%% prefixed_integer(Int, Field, Adjust, Base, PadChar, Prefix, Lowercase) -> +%% prefixed_integer(Int, FieldWidth, Adjust, Base, PadChar, Prefix, Lowercase) -> %% Char. -prefixed_integer(Int, F, Adj, Base, Pad, Prefix, Lowercase) +prefixed_integer(Int, W, Adj, Base, Pad, Prefix, Lowercase) when Base >= 2, Base =< 1+$Z-$A+10 -> if Int < 0 -> S = cond_lowercase(erlang:integer_to_list(-Int, Base), Lowercase), - write($-,Prefix|S, F, Adj, none, Pad); + write($-,Prefix|S, W, Adj, none, Pad); true -> S = cond_lowercase(erlang:integer_to_list(Int, Base), Lowercase), - write(Prefix|S, F, Adj, none, Pad) + write(Prefix|S, W, Adj, none, Pad) end. %% base_prefix(Base, Lowercase) -> Char. @@ -424,24 +435,24 @@ base_prefix(Base, true) -> $#,integer_to_list(Base),$r; base_prefix(Base, false) -> $#,integer_to_list(Base),$R. -%% char(Char, Field, Adjust, Precision, PadChar) -> Char. +%% char(Char, FieldWidth, Adjust, Precision, PadChar) -> Char. char(C, none, _Adj, none, _Pad) -> C; -char(C, F, _Adj, none, _Pad) -> chars(C, F); +char(C, W, _Adj, none, _Pad) -> chars(C, W); char(C, none, _Adj, P, _Pad) -> chars(C, P); -char(C, F, Adj, P, Pad) when F >= P -> - adjust(chars(C, P), chars(Pad, F - P), Adj). +char(C, W, Adj, P, Pad) when W >= P -> + adjust(chars(C, P), chars(Pad, W - P), Adj). -%% newline(Field, Adjust, Precision, PadChar) -> Char. +%% newline(FieldWidth, Adjust, Precision, PadChar) -> Char. -newline(none, _, _, _) -> "\n"; -newline(F, _, _, _) -> chars($\n, F). +newline(none, _Adj, _P, _Pad) -> "\n"; +newline(W, _Adj, _P, _Pad) -> chars($\n, W). %% %% Utilities %% -adjust(Data, , _) -> Data; +adjust(Data, , _Adj) -> Data; adjust(Data, Pad, left) -> Data,Pad; adjust(Data, Pad, right) -> Pad,Data.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_io_pretty.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_io_pretty.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2021 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,18 +18,18 @@ -module(lfe_io_pretty). +%% The basic API. -export(term/1,term/2,term/3,term/4). +%% These might be useful somewhere else. +-export(newline/1,newline/2,last_length/1,last_length/2). --compile(export_all). +%% -compile(export_all). -import(lists, reverse/1,reverse/2,flatlength/1). -%% 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. +-include("lfe.hrl"). + +-define(MAPVIND, 2). %Extra indentation of map value %% term(Sexpr , Depth , Indentation , LineLength) -> char(). %% A relatively simple pretty print function, but with some @@ -52,9 +52,6 @@ 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) -> %Special case map form - Mcs = map_body(MapBody, D, I+5, L), - "(map ",Mcs,$); term(Car|_=List, D, I, L) -> %% Handle printable lists specially. case io_lib:printable_unicode_list(List) of @@ -85,14 +82,27 @@ term(Bit, D, _, _) when is_bitstring(Bit) -> bitstring(Bit, D); %First D bytes term(Map, D, I, L) when ?IS_MAP(Map) -> - %% This will return kv pairs in reverse order to from_list, but - %% this dooesn't really matter here. - Fun = fun (K, V, Acc) -> K,V|Acc end, - Mcs = map_body(maps:fold(Fun, , Map), D, I+3, L), - "#M(",Mcs,$); + %% Preserve kv pair ordering, the extra copying is trivial here. + map(Map, D, I, L); term(Other, _, _, _) -> lfe_io_write:term(Other). %Use standard LFE for rest +%% map(Map, Depth, Indentation, LineLength) -> string(). +%% Print a map butt specially handle structs. + +map(Map, D, I, L) -> + %% Preserve kv pair ordering, the extra copying is trivial here. + Mkvs = maps:to_list(Map), + case lists:keyfind('__struct__', 1, Mkvs) of + {'__struct__',Struct} -> + Skvs = lists:keydelete('__struct__', 1, Mkvs), + Scs = map_body(Skvs, D, I+3, L), + "#S(",lfe_io_write:symbol(Struct),newline(I+3),Scs,$); + false -> + Mcs = map_body(Mkvs, D, I+3, L), + "#M(",Mcs,$) + end. + %% 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. @@ -307,7 +317,7 @@ indent_type('match-spec') -> 0; indent_type(_) -> none. -%% map(KVs, Depth, Indentation, LineLength). +%% map_body(KVs, Depth, Indentation, LineLength). %% map_body(KVs, CurrentLineIndent, Depth, Indentation, LineLength) %% Don't include the start and end of the map as this is called from %% differenct functions. @@ -315,44 +325,35 @@ map_body(KVs, D, I, L) -> map_body(KVs, I, D, I, L-1). -map_body(K,V|KVs, CurL, D, I, L) -> - case map_assoc(K, V, CurL, D, I, L) of +map_body(KV|KVs, CurL, D, I, L) -> + case map_assoc(KV, CurL, D, I, L) of {curr_line,KVcs,KVl} -> %Both fit on current line KVcs,map_rest(KVs, CurL+KVl, D-1, I, L); {one_line,KVcs,KVl} -> %Both fit on one line KVcs,map_rest(KVs, I+KVl, D-1, I, L); {sep_lines,Kcs,Vcs} -> %On separate lines %% Force a break after K/V split. - Kcs,newline(I, Vcs),map_rest(KVs, L, D-1, I, L) + Kcs,newline(I+?MAPVIND, Vcs),map_rest(KVs, L, D-1, I, L) end; -map_body(E, CurL, D, I, L) -> - map_last(E, CurL, D, I, L). +map_body(, _CurL, _D, _I, _L) -> . -%% map_rest(KVs, Depth, Indentation, LineLength) %% map_rest(KVs, CurrentLineIndent, Depth, Indentation, LineLength) -map_rest(KVs, D, I, L) -> - map_rest(KVs, I, D, I, L-1). - map_rest(_, _, 0, _, _) -> " ..."; %Reached our depth -map_rest(K,V|KVs, CurL, D, I, L) -> - case map_assoc(K, V, CurL+1, D, I, L) of +map_rest(KV|KVs, CurL, D, I, L) -> + case map_assoc(KV, CurL+1, D, I, L) of {curr_line,KVcs,KVl} -> %Both fit on current line $\s,KVcs,map_rest(KVs, CurL+KVl+1, D-1, I, L); {one_line,KVcs,KVl} -> %Both fit on one line newline(I, KVcs),map_rest(KVs, I+KVl, D-1, I, L); {sep_lines,Kcs,Vcs} -> %On separate lines %% Force a break after K/V split. - newline(I, Kcs),newline(I, Vcs),map_rest(KVs, L, D-1, I, L) + newline(I, Kcs),newline(I+?MAPVIND, Vcs), + map_rest(KVs, L, D-1, I, L) end; -map_rest(E, CurL, D, I, L) -> - map_last(E, CurL, D, I, L). - -%% Print any remaining element as list element. -map_last(Tail, CurL, D, I, L) -> - list_tail(Tail, CurL, D, I, L). +map_rest(, _CurL, _D, _I, _L) -> . -map_assoc(K, V, CurL, D, I, L) -> +map_assoc({K,V}, CurL, D, I, L) -> Kcs = term(K, D, 0, 99999), %Never break the line Kl = flatlength(Kcs), Vcs = term(V, D, 0, 99999), %Never break the line @@ -367,7 +368,7 @@ true -> term(K, D, I, L) end, Vs = if I+Vl < L-10 -> Vcs; - true -> term(V, D, I, L) + true -> term(V, D, I+?MAPVIND, L) end, {sep_lines,Ks,Vs} end.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_io_write.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_io_write.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2015 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,12 +22,7 @@ %% -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. +-include("lfe.hrl"). %% print(IoDevice, Sexpr) -> ok. %% print1(Sexpr) -> char(). @@ -48,7 +43,11 @@ "#(",list(Es, D-1),")"; term(Bit, _) when is_bitstring(Bit) -> bitstring(Bit); +term(Fun, D) when is_function(Fun) -> + function(Fun, D); term(Map, D) when ?IS_MAP(Map) -> map(Map, D); +term(Pid, D) when is_pid(Pid) -> + "#Pid" ++ io_lib:write(Pid, D); term(Other, D) -> %Use standard Erlang for rest io_lib:write(Other, D). @@ -81,6 +80,22 @@ <<B:N>> = Bits, io_lib:format("(~w (size ~w))", B,N). +%% function(Function, Depth) -> Chars +%% We want it all so give it lots of depth! + +function(Fun, _) -> + {module,M} = erlang:fun_info(Fun, module), + {name,F} = erlang:fun_info(Fun, name), + {arity,A} = erlang:fun_info(Fun, arity), + case erlang:fun_info(Fun, type) of + {type,external} -> + term(function,M,F,A, -1); + _ -> + %% Having a little bit of fun. + lists:droplast(erlang:fun_to_list(Fun)), + "/",integer_to_list(A),">" + end. + %% list(List, Depth) -> Chars. %% Print the elements in a list. We handle the empty list and depth=0.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_lib.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_lib.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 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_lib). %% General library functions. --export(is_symb/1,is_symb_list/1,is_proper_list/1,is_doc_string/1). +-export(is_symb/1,is_symb_list/1,is_posint_list/1, + is_proper_list/1,is_doc_string/1). -export(proc_forms/3,proc_forms/4). @@ -42,6 +43,11 @@ is_symb_list() -> true; is_symb_list(_) -> false. %Might not be a proper list +is_posint_list(I|Is) when is_integer(I), I >= 0 -> + is_posint_list(Is); +is_posint_list() -> true; +is_posint_list(_) -> false. + is_proper_list(_|Ss) -> is_proper_list(Ss); is_proper_list() -> true; is_proper_list(_) -> false. @@ -139,32 +145,68 @@ format_stacktrace(St1, Skip, Format). %% format_reason(Error, Indentation) -> DeepCharList. -%% Format an error giving a little better information. - -format_reason(badarg, _I) -> <<"bad argument">>; -format_reason(badarith, _I) -> <<"error in arithmetic expression">>; +%% Format an error giving a little better information. Explicitly +%% handle errors known from ERTS here, anything is assumed to come +%% from lfe_eval. + +%% The ERTS exit codes. +format_reason(badarg, _I) -> + <<"bad argument">>; +format_reason({badarg,V}, I) -> + format_value(V, <<"bad argument ">>, I); +format_reason(badarith, _I) -> + <<"error in arithmetic expression">>; +format_reason({badarity,{Fun,As}}, _I) + when is_function(Fun) -> + %% Only the arity is displayed, not the arguments As. + lfe_io:format1(<<"~s called with ~s">>, + format_fun(Fun),argss(length(As))); +format_reason({badfun,Term}, I) -> + format_value(Term, <<"bad function ">>, I); format_reason({badmatch,V}, I) -> - lfe_io:format1(<<"no match of value ~.*P">>, I+18,V,10); -format_reason(function_clause, _I) -> <<"no function clause matching">>; + format_value(V, <<"no match of value ">>, I); format_reason({case_clause,V}, I) -> - lfe_io:format1(<<"no case clause matching ~.*P">>, I+24,V,10); -format_reason(if_clause, _I) -> <<"no if clause matching">>; -format_reason(undef, _I) -> <<"undefined function">>; -%% Some LFE eval specific errors. -format_reason({unbound_symb,S}, _I) -> - lfe_io:format1(<<"symbol ~w is unbound">>, S); -format_reason(illegal_guard, _I) -> <<"illegal guard">>; -format_reason({undefined_func,{F,A}}, _I) -> - lfe_io:format1(<<"undefined function ~w/~w">>, F,A); -format_reason(if_expression, _I) -> <<"non-boolean if test">>; -format_reason({illegal_pattern,Pat}, _I) -> - lfe_io:format1(<<"illegal pattern ~w">>, Pat); -format_reason({illegal_literal,Lit}, I) -> - lfe_io:format1(<<"illegal literal value ~.*P">>, I+22,Lit,10); -format_reason(bad_arity, _I) -> <<"arity mismatch">>; -%% Default catch-all -format_reason(Error, I) -> %Default catch-all - lfe_io:prettyprint1(Error, 10, I). + %% "there is no case clause with a true guard sequence and a + %% pattern matching..." + format_value(V, <<"no case clause matching ">>, I); +format_reason(function_clause, _I) -> + <<"no function clause matching">>; +format_reason(if_clause, _I) -> + <<"no if clause matching">>; +format_reason(noproc, _I) -> <<"no such process or port">>; +format_reason(notalive, _I) -> + <<"the node cannot be part of a distributed system">>; +format_reason(system_limit, _I) -> + <<"a system limit has been reached">>; +format_reason(timeout_value, _I) -> + <<"bad receive timeout value">>; +format_reason({try_clause,V}, I) -> + %% "there is no try clause with a true guard sequence and a + %% pattern matching..." + format_value(V, <<"no try clause matching ">>, I); +format_reason(undef, _I) -> + <<"undefined function">>; +%% We now pass the buck to lfe_eval. +format_reason(Error, _) -> + lfe_eval:format_error(Error). + +argss(0) -> <<"no arguments">>; +argss(1) -> <<"one argument">>; +argss(N) -> lfe_io:format1(<<"~w arguments">>, N). + +format_fun(Fun) when is_function(Fun) -> + {module,M} = erlang:fun_info(Fun, module), + %% {name,F} = erlang:fun_info(Fun, name), + {arity,A} = erlang:fun_info(Fun, arity), + case erlang:fun_info(Fun, type) of + {type,local} when M =:= lfe_eval -> + lfe_io:format1(<<"interpreted function with arity ~w">>, A); + _ -> lfe_io:print1(Fun) + end. + +format_value(Val, ErrStr, I) -> + Sz = I + iolist_size(ErrStr), + lfe_io:format1(<<"~s~.*P">>, ErrStr,Sz,Val,10). %% format_stacktrace(Stacktrace, SkipFun, FormatFun) -> DeepCharList. %% Format a stacktrace. SkipFun is used to trim the end of stack;
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_lint.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_lint.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2017 Robert Virding +%% Copyright (c) 2008-2021 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,6 +16,11 @@ %% Author : Robert Virding %% Purpose : Lisp Flavoured Erlang syntax checker. +%%% We get a lot help here from the Erlang linter as our code is +%%% passed on into it when the erlng code is compiled. This means that +%%% if we miss anything it will catch it. How much do we really needt +%%% to do here? + %%% In a fun argument where when matching a binary we import the size %%% of bitseg as a variable from the environment not just from earlier %%% segments. No other argument variables are imported. @@ -27,120 +32,169 @@ %% -compile(export_all). --import(lists, member/2,sort/1,all/2,foldl/3,foldr/3,foreach/2,mapfoldl/3). --import(ordsets, add_element/2,from_list/1,is_element/2, - union/1,union/2,intersection/2,subtract/2). - -include("lfe_comp.hrl"). - -%% 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(lint, {module=, %Module name - mline=0, %Module definition line - exps=orddict:new(), %Exports - imps=, %Imports - pref=, %Prefixes - funcs=, %Defined functions - types=, %Known types - specs=, %Known func specs - env=, %Top-level environment - func=, %Current function - file="nofile", %File name - opts=, %Compiler options - errors=, %Errors - warnings= %Warnings - }). +-include("lfe.hrl"). + +-record(lfe_lint, {module=, %Module name + mline=0, %Module definition line + exports=orddict:new(), %Exported function-line + imports=orddict:new(), %Imported function-{module,func} + aliases=orddict:new(), %Module-alias + onload=, %Onload + funcs=orddict:new(), %Defined function-line + types=, %Known types + texps=orddict:new(), %Exported types + specs=, %Known func specs + records=orddict:new(), %Known record definitions + struct=undefined, %Struct definition + env=, %Top-level environment + func=, %Current function + file="no file", %File name + opts=, %Compiler options + errors=, %Errors + warnings= %Warnings + }). %% Errors. -format_error({bad_mdef,D}) -> - lfe_io:format1("bad module definition: ~w", D); -format_error(bad_extends) -> "bad extends"; -format_error(bad_funcs) -> "bad function list"; -format_error(bad_body) -> "bad body"; -format_error(bad_clause) -> "bad clause"; -format_error(bad_guard) -> "bad guard"; +%% Module definition. +format_error({bad_module_def,D}) -> + %% This can handle both atom and string error value. + lfe_io:format1(<<"bad ~s in module definition">>, D); +format_error({bad_attribute,A}) -> + lfe_io:format1(<<"bad ~w attribute">>, A); +format_error({bad_meta_def,M}) -> + lfe_io:format1(<<"bad ~w metadata definition">>, M); +%% Forms and code. +format_error({bad_body_def,Form}) -> + lfe_io:format1(<<"bad body in ~w">>, Form); +format_error(bad_guard_def) -> "bad guard definition"; format_error(bad_args) -> "bad argument list"; format_error(bad_gargs) -> "bad guard argument list"; -format_error(bad_alias) -> "bad pattern alias"; -format_error(bad_arity) -> "head arity mismatch"; -format_error({bad_attribute,A}) -> - lfe_io:format1("bad attribute: ~w", A); -format_error({bad_meta,M}) -> - lfe_io:format1("bad metadata: ~w", M); -format_error({bad_form,Type}) -> - lfe_io:format1("bad ~w form", Type); -format_error({bad_gform,Type}) -> - lfe_io:format1("bad ~w guard form", Type); -format_error({bad_pat,Type}) -> - lfe_io:format1("bad ~w pattern", Type); -format_error({unbound_symb,S}) -> - lfe_io:format1("symbol ~w unbound", S); -format_error({undefined_func,F}) -> - lfe_io:format1("function ~w undefined", F); +format_error(bad_pat_alias) -> "bad pattern alias"; +format_error(bad_head_arity) -> "function head arity mismatch"; +format_error({bad_form,Form}) -> + lfe_io:format1(<<"bad ~w form">>, Form); +format_error({bad_guard_form,Form}) -> + lfe_io:format1(<<"bad ~w guard form">>, Form); +format_error({bad_pattern,Pat}) -> + lfe_io:format1(<<"bad ~w pattern">>, Pat); +format_error({unbound_symbol,S}) -> + lfe_io:format1(<<"symbol ~w is unbound">>, S); +format_error({undefined_function,{F,Ar}}) -> + lfe_io:format1("function ~w/~w undefined", F,Ar); format_error({multi_var,S}) -> lfe_io:format1("variable ~w multiply defined", S); -format_error({redef_fun,F}) -> - lfe_io:format1("redefining function ~w", F); +%% Functions, imports, exports, on_loads and aliases. +format_error({redefine_function,{F,Ar}}) -> + lfe_io:format1("function ~w/~w already defined", F,Ar); format_error({bad_fdef,F}) -> lfe_io:format1("bad definition of function ~w", F); +format_error({reimport_function,{F,Ar},M1,M2}) -> + lfe_io:format1(<<"importing ~w/~w from ~w, already imported from ~w">>, + F,Ar,M1,M2); +format_error({define_imported_function,{F,Ar}}) -> + lfe_io:format1(<<"defining imported function ~w/~w">>, F,Ar); +format_error({undefined_onload_function,{F,Ar}}) -> + lfe_io:format1("on_load function ~w/~w undefined", F,Ar); +format_error({redefine_module_alias,A}) -> + lfe_io:format1(<<"redefining ~w module alias">>, A); +format_error({circular_module_alias,A}) -> + lfe_io:format1(<<"circular module alias for ~w">>, A); +%% Others format_error({illegal_literal,Lit}) -> - lfe_io:format1("illegal literal value ~w", Lit); + lfe_io:format1(<<"illegal literal value ~w">>, Lit); format_error({illegal_pattern,Pat}) -> - lfe_io:format1("illegal pattern ~w", Pat); -format_error(illegal_guard) -> "illegal guard"; + lfe_io:format1(<<"illegal pattern ~w">>, Pat); +format_error(illegal_guard) -> <<"illegal guard expression">>; format_error({illegal_mapkey,Key}) -> - lfe_io:format1("illegal map key ~w", Key); -format_error({undefined_bittype,S}) -> - lfe_io:format1("bit type ~w undefined", S); -format_error(bittype_unit) -> - "bit unit size can only be specified together with size"; + lfe_io:format1(<<"illegal map key ~w">>, Key); format_error(illegal_bitseg) -> "illegal bit segment"; format_error(illegal_bitsize) -> "illegal bit size"; format_error({deprecated,What}) -> - lfe_io:format1("deprecated: ~s", What); + lfe_io:format1("~s is deprecated", What); format_error(unknown_form) -> "unknown form"; -format_error({bad_record,R}) -> - lfe_io:format1("bad record definition: ~w", R); +%% Try-catches. +format_error({illegal_stacktrace,S}) -> + lfe_io:format1(<<"stacktrace ~w must be unbound variable">>, S); +format_error({illegal_exception,E}) -> + lfe_io:format1(<<"illegal exception ~w">>, E); +%% Records. +format_error({bad_record_def,Name}) -> + lfe_io:format1(<<"bad definition of record ~w">>, Name); +format_error({bad_record_name,Name}) -> + lfe_io:format1(<<"bad record name ~w">>, Name); +format_error({bad_record_field,Name,Field}) -> + lfe_io:format1(<<"bad field ~w in record ~w">>, Field,Name); +format_error({redefine_record,Name}) -> + lfe_io:format1(<<"record ~w already defined">>, Name); +format_error({missing_record_field_value,Name,Field}) -> + lfe_io:format1(<<"missing value to field ~w in record ~w">>,Field,Name); +%% Structs. +format_error(redefine_struct) -> + <<"struct already defined">>; +format_error(bad_struct_def) -> + <<"bad definition of struct">>; +format_error({bad_struct_def,Name}) -> + lfe_io:format1(<<"bad definition of struct ~w">>, Name); +format_error({bad_struct_field,Field}) -> + lfe_io:format1(<<"bad field ~w in struct">>, Field); +%% format_error({bad_struct_field,Name,Field}) -> +%% lfe_io:format1(<<"bad field ~w in struct ~w">>, Field,Name); +format_error({missing_struct_field_value,Name,Field}) -> + lfe_io:format1(<<"missing value to field ~w in struct ~w">>,Field,Name); +%% These are also used in lfe_eval. +format_error({undefined_record,Name}) -> + lfe_io:format1(<<"record ~w undefined">>, Name); +format_error({undefined_record_field,Name,Field}) -> + lfe_io:format1(<<"field ~w undefined in record ~w">>, Field,Name); +format_error({undefined_struct,Name}) -> + lfe_io:format1(<<"struct ~w undefined">>, Name); +format_error({undefined_struct_field,Name,Field}) -> + lfe_io:format1(<<"field ~w undefined in struct ~w">>, Field,Name); %% Type and spec errors. -format_error({singleton_typevar,V}) -> - lfe_io:format1("type variable ~w is only used once", V); +format_error({undefined_type,{T,A}}) -> + lfe_io:format1("type ~w/~w undefined", T,A); format_error({builtin_type,{T,A}}) -> lfe_io:format1("type ~w/~w is a builtin type", T,A); format_error({redefine_type,{T,A}}) -> lfe_io:format1("type ~w/~w already defined", T,A); format_error({redefine_spec,{F,A}}) -> lfe_io:format1("spec for ~w/~w is already defined", F,A); +format_error({singleton_typevar,V}) -> + lfe_io:format1("type variable ~w is only used once", V); %% Type and spec errors. These are also returned from lfe_types. -format_error({bad_type,T}) -> +format_error({bad_type_def,T}) -> lfe_io:format1("bad ~w type definition", T); -format_error({type_syntax,T}) -> - lfe_io:format1("bad ~w type", T); -format_error({undefined_type,{T,A}}) -> - lfe_io:format1("type ~w/~w undefined", T,A); -format_error({bad_spec,S}) -> - lfe_io:format1("bad function spec: ~w", S). +format_error({bad_type_syntax,T}) -> + lfe_io:format1("bad ~w type syntax", T); +format_error({bad_function_spec,S}) -> + lfe_io:format1("bad function specification: ~w", S); +%% These are signaled from lfe_bits. +format_error({undefined_bittype,S}) -> + lfe_io:format1("bit type ~w undefined", S); +format_error(bittype_unit) -> + <<"bit unit size can only be specified together with size">>; +format_error(Error) -> + lfe_io:format1("Unknown error ~p", Error). + %% expr(Expr) -> {ok,Warning} | {error,Error,Warning}. %% expr(Expr, Env) -> {ok,Warning} | {error,Error,Warning}. -expr(E) -> expr(E, lfe_env:new()). +expr(E) -> expr(E, le_new()). expr(E, Env) -> - St0 = #lint{}, + St0 = #lfe_lint{}, St1 = check_expr(E, Env, 1, St0), return_status(St1). %% pattern(Pattern) -> {ok,Warning} | {error,Error,Warning}. %% pattern(Pattern, Env) -> {ok,Warning} | {error,Error,Warning}. -pattern(P) -> pattern(P, lfe_env:new()). +pattern(P) -> pattern(P, le_new()). pattern(P, Env) -> - St0 = #lint{}, + St0 = #lfe_lint{}, {_,St1} = pattern(P, Env, 1, St0), return_status(St1). @@ -159,15 +213,15 @@ module(Ms) -> module(Ms, #cinfo{file="nofile",opts=}). module(Ms, #cinfo{file=F,opts=Os}) -> - St0 = #lint{file=F,opts=Os}, %Initialise the lint record + St0 = #lfe_lint{file=F,opts=Os}, %Initialise the lint record St1 = check_module(Ms, St0), - ?DEBUG("#lint: ~s\n", io_lib:format("~p",St1), Os), + ?DEBUG("#lfe_lint: ~s\n", io_lib:format("~p",St1), Os), return_status(St1). -return_status(#lint{module=M,errors=}=St) -> - {ok,M,St#lint.warnings}; +return_status(#lfe_lint{module=M,errors=}=St) -> + {ok,M,St#lfe_lint.warnings}; return_status(St) -> - {error,St#lint.errors,St#lint.warnings}. + {error,St#lfe_lint.errors,St#lfe_lint.warnings}. %% check_module(ModuleForms, State) -> State. %% Do all the actual work checking a module. @@ -176,195 +230,302 @@ {Fbs0,St1} = collect_module(Mfs, St0), %% Make an initial environment and set up state. {Predefs,Env0,St2} = init_state(St1), + %% io:format("~p\n", Env0), Fbs1 = Predefs ++ Fbs0, %% Now check definitions. - {Fs,Env1,St3} = check_functions(Fbs1, Env0, St2), - %% Save functions and environment and test exports. - St4 = St3#lint{funcs=Fs,env=Env1}, - check_exports(St4#lint.exps, Fs, St4). + {Funcs,Env1,St3} = check_functions(Fbs1, Env0, St2), + %% io:format("~p\n", Env1), + %% Save functions and environment and post check. + St4 = St3#lfe_lint{funcs=Funcs,env=Env1}, + post_check_module(St4). + +%% post_check_module(State) -> State. +%% Ru checks which can only be done when everything has been collected. + +post_check_module(St0) -> + St1 = check_valid_exports(St0), + St2 = check_valid_imports(St1), + St3 = check_valid_onload(St2), + check_valid_type_exports(St3). %% 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. +%% not first. We use lfe_proc_forms to automatically handle nested +%% progn forms for us. -collect_module(Mfs, St0) -> - {Fbs,St1} = lists:foldl(fun collect_form/2, {,St0}, Mfs), - {lists:reverse(Fbs),St1}. +collect_module(Mfs, St) -> + lfe_lib:proc_forms(fun collect_form/3, Mfs, St). + %% Fun = fun (F, L, S) -> + %% io:format("~p ~w\n", F,L), + %% collect_form(F, L, S) + %% end, + %% lfe_lib:proc_forms(Fun, Mfs, St). -collect_form({'define-module',Mod,Meta,Atts,L}, {Fbs,St0}) -> - St1 = check_mdef(Meta, Atts, L, St0#lint{module=Mod,mline=L}), +%% collect_form(Form, Line, State) -> {Fbs,State}. + +collect_form('define-module',Mod,Meta,Atts, L, St0) -> + St1 = check_mod_def(Meta, Atts, L, St0#lfe_lint{module=Mod,mline=L}), if is_atom(Mod) -> %Normal module - {Fbs,St1}; + {,St1}; true -> %Bad module name - {Fbs,bad_mdef_error(L, name, St1)} + {,bad_module_def_error(L, name, St1)} end; -collect_form({_,L}, {Fbs,#lint{module=}=St}) -> +collect_form(_, L, #lfe_lint{module=}=St) -> %% Set module name so this only triggers once. - {Fbs,bad_mdef_error(L, name, St#lint{module='-no-module-'})}; -collect_form({'extend-module',Metas,Atts,L}, {Fbs,St}) -> - {Fbs,check_mdef(Metas, Atts, L, St)}; -collect_form({'define-type',Type,Def,L}, {Fbs,St}) -> - {Fbs,check_type_def(Type, Def, L, St)}; -collect_form({'define-opaque-type',Type,Def,L}, {Fbs,St}) -> - {Fbs,check_type_def(Type, Def, L, St)}; -collect_form({'define-function-spec',Func,Spec,L}, {Fbs,St}) -> - {Fbs,check_func_spec(Func, Spec, L, St)}; -collect_form({'define-function',Func,Meta,Def,L}, {Fbs,St}) -> - collect_function(Func, Meta, Def, L, Fbs, St); + {,bad_module_def_error(L, name, St#lfe_lint{module='-no-module-'})}; +collect_form('extend-module',Metas,Atts, L, St) -> + {,check_mod_def(Metas, Atts, L, St)}; +collect_form('define-type',Type,Def, L, St) -> + {,check_type_def(Type, Def, L, St)}; +collect_form('define-opaque-type',Type,Def, L, St) -> + {,check_type_def(Type, Def, L, St)}; +collect_form('define-function-spec',Func,Specs, L, St) -> + {,check_func_spec(Func, Specs, L, St)}; +collect_form('define-record',Name,Fields, L, St) -> + {,check_record_def(Name, Fields, L, St)}; +collect_form('define-struct',Fields, L, St) -> + {,check_struct_def(Fields, L, St)}; +collect_form('define-function',Func,Meta,Def, L, St) -> + collect_function(Func, Meta, Def, L, , St); +%% lfe_lib:proc_forms handles nested progn. %% Ignore macro definitions and eval-when-compile forms. -collect_form({'define-macro'|_,_}, {Fbs,St}) -> {Fbs,St}; -collect_form({'eval-when-compile'|_,_}, {Fbs,St}) -> {Fbs,St}; -collect_form({_,L}, {Fbs,St}) -> - {Fbs,add_error(L, unknown_form, St)}. +collect_form('define-macro'|_, _, St) -> {,St}; +collect_form('eval-when-compile'|_, _, St) -> {,St}; +collect_form(_, L, St) -> + {,add_error(L, unknown_form, St)}. -%% check_mdef(Metadata, Attributes, Line, State) -> State. +%% check_mod_def(Metadata, Attributes, Line, State) -> State. +%% Check a module definition, its metasdata and attributes. -check_mdef(Metas, Atts, L, St0) -> - St1 = check_mmetas(Metas, L, St0), - check_attrs(Atts, L, St1). +check_mod_def(Metas, Atts, L, St0) -> + St1 = check_mod_metas(Metas, L, St0), + check_mod_attrs(Atts, L, St1). -%% check_mmetas(Metas, Line, State) -> State. +%% check_mod_metas(Metas, Line, State) -> State. %% Only allow docs and type definitions. -check_mmetas(Ms, L, St) -> - check_foreach(fun (M, S) -> check_mmeta(M, L, S) end, - fun (S) -> bad_mdef_error(L, form, S) end, +check_mod_metas(Ms, L, St) -> + check_foreach(fun (M, S) -> check_mod_meta(M, L, S) end, + fun (S) -> bad_module_def_error(L, <<"meta form">>, S) end, St, Ms). -check_mmeta(doc|Docs, L, St) -> - ?IF(check_docs(Docs), St, bad_meta_error(L, doc, St)); -check_mmeta(type|Tds, L, St) -> +check_mod_meta(doc|Docs, L, St) -> + ?IF(is_docs_list(Docs), St, bad_meta_def_error(L, doc, St)); +check_mod_meta(type|Tds, L, St) -> check_type_defs(Tds, L, St); -check_mmeta(opaque|Tds, L, St) -> +check_mod_meta(opaque|Tds, L, St) -> check_type_defs(Tds, L, St); -check_mmeta(spec|Sps, L, St) -> +check_mod_meta(spec|Sps, L, St) -> check_func_specs(Sps, L, St); -check_mmeta(record|Rds, L, St) -> - check_record_defs(Rds, L, St); -check_mmeta(M|Vals, L, St) -> - %% Other metadata, must be list and have symbol name. - ?IF(is_atom(M) and lfe_lib:is_proper_list(Vals), - St, bad_meta_error(L, M, St)); -check_mmeta(_, L, St) -> bad_mdef_error(L, meta, St). +check_mod_meta(record|Rdefs, L, St) -> + %% deprecated_error(L, <<"module record definition">>, St); + check_record_defs(Rdefs, L, St); +check_mod_meta(_, L, St) -> bad_module_def_error(L, meta, St). -%% check_attrs(Attributes, Line, State) -> State. +%% check_mod_attrs(Attributes, Line, State) -> State. +%% Check the attributes of the module. -check_attrs(As, L, St) -> - check_foreach(fun (A, S) -> check_attr(A, L, S) end, - fun (S) -> bad_mdef_error(L, form, S) end, +check_mod_attrs(As, L, St) -> + check_foreach(fun (A, S) -> check_mod_attr(A, L, S) end, + fun (S) -> bad_module_def_error(L, <<"attribute form">>, S) end, St, As). -check_attr(export,all, _, St) -> St; %Ignore 'all' here -check_attr(export|Es, L, St) -> - case is_flist(Es) of - {yes,Fs} -> - Exps = add_exports(Fs, L, St#lint.exps), - St#lint{exps=Exps}; - no -> bad_mdef_error(L, export, St) - end; -check_attr(import|Is, L, St) -> - check_imports(Is, L, St); -check_attr(doc|Docs, L, St0) -> - St1 = depr_warning(L, "documentation string attribute", St0), +check_mod_attr(export,all, _, St) -> St; %Ignore 'all' here +check_mod_attr(export|Es, L, St) -> + check_export_attr(Es, L, St); +check_mod_attr(import|Is, L, St) -> + check_import_attr(Is, L, St); +check_mod_attr('module-alias'|As, L, St) -> + check_alias_attr(As, L, St); +check_mod_attr('export-type'|Ts, L, St) -> + check_export_types(Ts, L, St); +check_mod_attr(doc|Docs, L, St0) -> + St1 = deprecated_warning(L, <<"module documentation attribute">>, St0), check_doc_attr(Docs, L, St1); -%% Note we handle type and spec as normal attributes here. -check_attr(A|Vals, L, St) -> - %% Other attributes, must be list and have symbol name. - ?IF(is_atom(A) and lfe_lib:is_proper_list(Vals), - St, bad_attr_error(L, A, St)); -check_attr(_, L, St) -> bad_mdef_error(L, attribute, St). +check_mod_attr(record|_Rds, L, St) -> + deprecated_error(L, <<"module record definition">>, St); +check_mod_attr(on_load|Onload, L, St) -> + check_onload_attr(Onload, L, St); +%% Note we don't allow type and spec as normal attributes here. +check_mod_attr(A|Vals, L, St) -> + %% Meta tags are not allowed in attributes. + ?IF(is_meta_tag(A), bad_attr_error(L, A, St), + %% Other attributes, must be list and have symbol name. + ?IF(is_atom(A) and lfe_lib:is_proper_list(Vals), + St, bad_attr_error(L, A, St))); +check_mod_attr(_, L, St) -> bad_module_def_error(L, <<"attribute form">>, St). + +is_meta_tag(doc) -> true; +is_meta_tag(spec) -> true; +is_meta_tag(Tag) -> lfe_types:is_type_decl(Tag). + +%% check_doc_attr(Doc, Line, State) -> State. +%% Check the format of the docimentation. check_doc_attr(Docs, L, St) -> - ?IF(check_docs(Docs), St, bad_attr_error(L, doc, St)). + ?IF(is_docs_list(Docs), St, bad_attr_error(L, doc, St)). -check_imports(Is, L, St) -> - check_foreach(fun (I, S) -> check_import(I, L, S) end, - fun (S) -> import_error(L, S) end, St, Is). +%% check_export_attr(Exports, Line, State) -> State. -check_import(from,Mod|Fs, L, St) when is_atom(Mod) -> - Check = fun (F,A, Imps, S) when is_atom(F), is_integer(A) -> - {orddict:store({F,A}, F, Imps),S}; - (_, Imps, S) -> {Imps,bad_mdef_error(L, from, S)} - end, - check_import(Check, Mod, L, St, Fs); -check_import(rename,Mod|Rs, L, St) when is_atom(Mod) -> - Check = fun (F,A,R, Imps, S) when is_atom(F), - is_integer(A), - is_atom(R) -> - {orddict:store({F,A}, R, Imps),S}; - (_, Imps, S) -> {Imps,bad_mdef_error(L, rename, S)} - end, - check_import(Check, Mod, L, St, Rs); -check_import(prefix,Mod,Pre, L, St) when is_atom(Mod), is_atom(Pre) -> - Pstr = atom_to_list(Pre), - case orddict:find(Pstr, St#lint.pref) of - {ok,_} -> bad_mdef_error(L, prefix, St); - error -> - Pref = orddict:store(Pstr, Mod, St#lint.pref), - St#lint{pref=Pref} - end; -check_import(_, L, St) -> import_error(L, St). +check_export_attr(Es, L, St) -> + case is_func_list(Es) of + {yes,Fs} -> + Exps = add_exports(Fs, L, St#lfe_lint.exports), + St#lfe_lint{exports=Exps}; + no -> bad_module_def_error(L, export, St) + end. -check_import(Check, Mod, L, St0, Fs) -> - Imps0 = safe_fetch(Mod, St0#lint.imps, ), - {Imps1,St1} = foldl_form(Check, import, L, Imps0, St0, Fs), - St1#lint{imps=orddict:store(Mod, Imps1, St1#lint.imps)}. +%% check_import_attr(Imports, Line, State) -> State. -import_error(L, St) -> bad_mdef_error(L, import, St). +check_import_attr(Imports, L, St) -> + check_foreach(fun (Import, S) -> check_imports(Import, L, S) end, + fun (S) -> import_error(L, S) end, St, Imports). -is_flist(Fs) -> is_flist(Fs, ). +check_imports(from,Mod|Fs, L, St0) when is_atom(Mod) -> + Add = fun (F,Ar, Is, S) when is_atom(F), + is_integer(Ar), Ar >= 0 -> + check_import(F, Ar, Mod, F, Is, L, S); + (_, Is, S) -> + {Is,bad_module_def_error(L, <<"import from">>, S)} + end, + {Imps,St1} = check_foldl(Add, fun (S) -> S end, + St0#lfe_lint.imports, St0, Fs), + St1#lfe_lint{imports=Imps}; +check_imports(rename,Mod|Fs, L, St0) when is_atom(Mod) -> + Add = fun (F,Ar,R, Is, S) when is_atom(F), + is_integer(Ar), Ar >= 0, + is_atom(R) -> + check_import(R, Ar, Mod, F, Is, L, S); + (_, Is, S) -> + {Is,bad_module_def_error(L, <<"import rename">>, S)} + end, + {Imps,St1} = check_foldl(Add, fun (S) -> S end, + St0#lfe_lint.imports, St0, Fs), + St1#lfe_lint{imports=Imps}; +check_imports(prefix,Mod,Pre, L, St0) when is_atom(Mod), is_atom(Pre) -> + deprecated_error(L, <<"import prefix">>, St0); +check_imports(_, L, St) -> + import_error(L, St). + +%% check_import(LocalName, Arity, Module, RemoteName, Imports, Line, State) -> +%% {Imports,State}. + +check_import(F, Ar, Mod, Rem, Imps, L, St) -> + case orddict:find({F,Ar}, Imps) of + {ok,{M,_}} when M =/= Mod -> + {Imps,add_error(L, {reimport_function,{F,Ar},Mod,M}, St)}; + _Other -> + {orddict:store({F,Ar}, {Mod,Rem}, Imps),St} + end. + +import_error(L, St) -> bad_module_def_error(L, import, St). + +%% check_alias_attr(ModAliases, Line, State) -> State. + +check_alias_attr(Aliases, L, St) -> + check_foreach(fun (Alias, S) -> check_alias(Alias, L, S) end, + fun (S) -> bad_module_def_error(L, 'module-alias', S) end, + St, Aliases). + +check_alias(Mod,Alias, L, #lfe_lint{aliases=As0}=St0) when is_atom(Mod), + is_atom(Alias) -> + %% Test if we redefine alias or get circular aliases. + St1 = case orddict:is_key(Alias, As0) of + true -> add_error(L, {redefine_module_alias,Alias}, St0); + false -> St0 + end, + St2 = case orddict:is_key(Mod, As0) of + true -> add_error(L, {circular_module_alias,Alias}, St1); + false -> St1 + end, + As1 = orddict:store(Alias, Mod, As0), %Add the alias + St2#lfe_lint{aliases=As1}; +check_alias(_, L, St) -> + bad_module_def_error(L, 'module-alias', St). + +%% check_export_types(Types, Line, State) -> State. + +check_export_types(Ts, L, St) -> + case is_func_list(Ts) of + {yes,Fs} -> + Texps = add_exports(Fs, L, St#lfe_lint.texps), + St#lfe_lint{texps=Texps}; + no -> + bad_module_def_error(L, 'export-type', St) + end. + +%% is_func_ref(Name,Arity) -> +%% is_atom(Name) and is_integer(Arity) and Arity >= 0; +%% is_func_ref(_Other) -> false. + +is_func_list(Fs) -> is_func_list(Fs, ordsets:new()). + +is_func_list(F,Ar|Fs, Funcs) when is_atom(F), is_integer(Ar), Ar >= 0 -> + is_func_list(Fs, ordsets:add_element({F,Ar}, Funcs)); +is_func_list(, Funcs) -> {yes,Funcs}; +is_func_list(_, _) -> no. -is_flist(F,Ar|Fs, Funcs) when is_atom(F), is_integer(Ar), Ar >= 0 -> - is_flist(Fs, add_element({F,Ar}, Funcs)); -is_flist(, Funcs) -> {yes,Funcs}; -is_flist(_, _) -> no. +%% check_onload_attr(Onload, Line, State) -> State. +%% Check the onl_load attribute that it is a valid function reference +%% and that there is only one. -%% check_type_defs(TypeDefs, Def, Line, State) -> State. -%% check_type_def(TypeDef, Def, Line, State) -> State. +check_onload_attr(F,Ar=LoadF, L, St) when is_atom(F), is_integer(Ar) -> + Onload = St#lfe_lint.onload, + if (Onload =:= ) or (Onload =:= LoadF) -> + St#lfe_lint{onload=LoadF}; + true -> + bad_attr_error(L, on_load, St) + end; +check_onload_attr(_Onload, L, St) -> + bad_attr_error(L, on_load, St). + +%% check_type_defs(TypeDefs, Line, State) -> State. +%% check_type_def(TypeDef, Line, State) -> State. %% check_type_def(Type, Def, Line, State) -> State. %% Check a type definition. check_type_defs(Tds, L, St) -> check_foreach(fun (Td, S) -> check_type_def(Td, L, S) end, - fun (S) -> bad_meta_error(L, type, S) end, + fun (S) -> bad_meta_def_error(L, type, S) end, St, Tds). check_type_def(Type,Def, L, St) -> check_type_def(Type, Def, L, St); check_type_def(_, L, St) -> - bad_meta_error(L, type, St). + bad_meta_def_error(L, type, St). check_type_def(Type, Def, L, St0) -> {Tvs0,St1} = check_type_name(Type, L, St0), - case lfe_types:check_type_def(Def, St1#lint.types, Tvs0) of + %% case lfe_types:check_type_def(Def, St1#lfe_lint.types, Tvs0) of + case lfe_types:check_type_def(Def, St1#lfe_lint.records, Tvs0) of {ok,Tvs1} -> check_type_vars(Tvs1, L, St1); {error,Error,Tvs1} -> St2 = add_error(L, Error, St1), check_type_vars(Tvs1, L, St2) end. -check_type_name(T|Args, L, #lint{types=Kts}=St) when is_atom(T) -> +check_type_name(T|Args, L, #lfe_lint{types=Kts}=St) when is_atom(T) -> case lfe_lib:is_symb_list(Args) of true -> Arity = length(Args), Kt = {T,Arity}, - Ts = lists:foldl(fun (V, S) -> orddict:update_counter(V, 1, S) end, - , Args), + Tvs = lists:foldl(fun (V, S) -> orddict:update_counter(V, 1, S) end, + , Args), case lists:member(Kt, Kts) of - true -> {Ts,add_error(L, {redefine_type,{T,Arity}}, St)}; + true -> {Tvs,add_error(L, {redefine_type,{T,Arity}}, St)}; false -> - case lfe_types:is_predefined_type(T, Arity) of + case lfe_internal:is_type(T, Arity) of true -> - {Ts,add_error(L, {builtin_type,{T,Arity}}, St)}; + {Tvs,add_error(L, {builtin_type,{T,Arity}}, St)}; false -> - {Ts,St#lint{types=Kt|Kts}} + {Tvs,St#lfe_lint{types=Kt|Kts}} end end; - false -> {,add_error(L, {bad_type,T}, St)} + false -> {,bad_type_def_error(L, T, St)} end; check_type_name(T, L, St) -> %Type name wrong format - {,add_error(L, {bad_type,T}, St)}. + {,bad_type_def_error(L, T, St)}. %% check_type_vars(TypeVars, Line, State) -> State. %% Check for singleton type variables except for _ which we allow. @@ -378,126 +539,186 @@ %% check_func_specs(FuncSpecs, Line, State) -> State. %% check_func_spec(FuncSpec, Line, State) -> State. -%% check_func_spec(Func, Spec, Line, State) -> State. +%% check_func_spec(Func, Specs, Line, State) -> State. %% Check a function specification. check_func_specs(Sps, L, St) -> check_foreach(fun (Sp, S) -> check_func_spec(Sp, L, S) end, - fun (S) -> bad_meta_error(L, spec, S) end, + fun (S) -> bad_meta_def_error(L, spec, S) end, St, Sps). -check_func_spec(Func,Spec, L, St) -> - check_func_spec(Func, Spec, L, St); +check_func_spec(Func|Specs, L, St) -> + check_func_spec(Func, Specs, L, St); check_func_spec(_, L, St) -> - bad_meta_error(L, spec, St). + bad_meta_def_error(L, spec, St). -check_func_spec(Func, Spec, L, St0) -> +check_func_spec(Func, Specs, L, St0) -> {Ar,St1} = check_func_name(Func, L, St0), - case lfe_types:check_func_spec_list(Spec, Ar, St1#lint.types) of - {ok,Tvss} -> check_type_vars_list(Tvss, L, St1); + case lfe_types:check_func_spec_list(Specs, Ar, St1#lfe_lint.records) of + {ok,Tvss} -> + check_type_vars_list(Tvss, L, St1); {error,Error,Tvss} -> St2 = add_error(L, Error, St1), check_type_vars_list(Tvss, L, St2) end. -check_func_name(F,Ar, L, #lint{specs=Kss}=St) +check_func_name(F,Ar, L, #lfe_lint{specs=Kss}=St) when is_atom(F), is_integer(Ar), Ar >= 0 -> Ks = {F,Ar}, case lists:member(Ks, Kss) of true -> {Ar,add_error(L, {redefine_spec,{F,Ar}}, St)}; - false -> {Ar,St#lint{specs=Ks|Kss}} + false -> {Ar,St#lfe_lint{specs=Ks|Kss}} end; check_func_name(F, L, St) -> - {0,add_error(L, {bad_spec,F}, St)}. + {0,add_error(L, {bad_function_spec,F}, St)}. check_type_vars_list(Tvss, L, St) -> lists:foldl(fun (Tvs, S) -> check_type_vars(Tvs, L, S) end, St, Tvss). -%% check_record_defs(RecordDefs, Line, State) -> State. - -check_record_defs(Rds, L, St) -> - check_foreach(fun (Rd, S) -> check_record_def(Rd, L, S) end, - fun (S) -> bad_meta_error(L, record, S) end, - St, Rds). - -check_record_def(Name|Fields, L, St) -> - check_record_def(Name, Fields, L, St); -check_record_def(_, L, St) -> - bad_meta_error(L, record, St). - -check_record_def(Name, Fds, L, St) when is_atom(Name) -> - check_foreach(fun (Fd, S) -> check_record_field(Fd, L, S) end, - fun (S) -> bad_record_error(L, Name, S) end, - St, Fds); -check_record_def(Name, _, L, St) -> - bad_record_error(L, Name, St). - -check_record_field(F,D,T, L, St0) -> - St1 = check_record_field(F,D, L, St0), - case lfe_types:check_type_def(T, St1#lint.types, ) of - {ok,Tvs} -> check_type_vars(Tvs, L, St1); - {error,Error,Tvs} -> - St2 = add_error(L, Error, St1), - check_type_vars(Tvs, L, St2) - end; -check_record_field(F,_D, L, St) -> %No need to check default value - check_record_field(F, L, St); -check_record_field(F, L, St) -> - if is_atom(F) -> St; - true -> bad_record_error(L, F, St) - end. - %% collect_function(Name, Meta, Def, Line, Fbs, State) -> {Fbs,State}. %% Collect function and do some basic checks. collect_function(Name, Meta, Def, L, Fbs, St0) -> - St1 = check_fmetas(Name, Meta, L, St0), + St1 = check_func_metas(Name, Meta, L, St0), {{Name,Def,L}|Fbs,St1}. -%% check_fmetas(Name, Metas, Line, State) -> State. +%% check_func_metas(Name, Metas, Line, State) -> State. -check_fmetas(N, Ms, L, St) -> - check_foreach(fun (M, S) -> check_fmeta(N, M, L, S) end, +check_func_metas(N, Ms, L, St) -> + check_foreach(fun (M, S) -> check_func_meta(N, M, L, S) end, fun (S) -> bad_form_error(L, 'define-function', S) end, St, Ms). -check_fmeta(N, doc|Docs, L, St) -> - ?IF(check_docs(Docs), St, bad_meta_error(L, N, St)); +check_func_meta(N, doc|Docs, L, St) -> + ?IF(is_docs_list(Docs), St, bad_meta_def_error(L, N, St)); %% Need to get arity in here. -%% check_fmeta(N, spec|Specs, L, St) -> -%% case lfe_types:check_func_spec_list(Specs, Ar, St#lint.types) of -%% ok -> St1; -%% {error,Error} -> add_error(L, Error, St) +%% check_func_meta(N, spec|Specs, L, St0) -> +%% case lfe_types:check_func_spec_list(Specs, Ar, St#lfe_lint.records) of +%% {ok,Tvss} -> +%% check_type_vars_list(Tvss, L, St0); +%% {error,Error,Tvss} -> +%% St1 = add_error(L, Error, St0), +%% check_type_vars_list(Tvss, L, St1) %% end; -check_fmeta(N, M|Vals, L, St) -> +check_func_meta(N, M|Vals, L, St) -> ?IF(is_atom(M) and lfe_lib:is_proper_list(Vals), - St, bad_meta_error(L, N, St)); -check_fmeta(N, _, L, St) -> bad_meta_error(L, N, St). + St, bad_meta_def_error(L, N, St)); +check_func_meta(N, _, L, St) -> bad_meta_def_error(L, N, St). -%% check_docs(Docs) -> boolean(). +%% is_docs_list(Docs) -> boolean(). -check_docs(Docs) -> +is_docs_list(Docs) -> Fun = fun (D) -> lfe_lib:is_doc_string(D) end, - lfe_lib:is_proper_list(Docs) andalso all(Fun, Docs). + lfe_lib:is_proper_list(Docs) andalso lists:all(Fun, Docs). + +%% check_record_defs(RecordDefs, Line, State) -> State. +%% check_record_def(RecordDef, Line, State) -> State. +%% check_record_def(RecordName, Fields, Line, State) -> State. +%% Check a record definition. + +check_record_defs(Rdefs, L, St) -> + check_foreach(fun (Rdef, S) -> check_record_def(Rdef, L, S) end, + fun (S) -> bad_meta_def_error(L, record, S) end, + St, Rdefs). + +check_record_def(Name,Fields, L, St) -> + check_record_def(Name, Fields, L, St); +check_record_def(_, L, St) -> + bad_meta_def_error(L, record, St). + +check_record_def(Name, Fds, L, #lfe_lint{records=Recs}=St0) + when is_atom(Name) -> + case orddict:is_key(Name, Recs) of + true -> + add_error(L, {redefine_record,Name}, St0); + false -> + %% Insert the record with no fields yet. + St1 = St0#lfe_lint{records=orddict:store(Name, , Recs)}, + check_foreach(fun (Fd, S) -> + check_record_field_def(Name, Fd, L, S) end, + fun (S) -> bad_record_def_error(L, Name, S) end, + St1, Fds) + end; +check_record_def(Name, _, L, St) -> + bad_record_def_error(L, Name, St). + +check_record_field_def(Name, Field,D,Type, L, St0) -> + St1 = check_record_field_def(Name, Field,D, L, St0), + case lfe_types:check_type_def(Type, St1#lfe_lint.records, ) of + {ok,Tvs} -> check_type_vars(Tvs, L, St1); + {error,Error,Tvs} -> + St2 = add_error(L, Error, St1), + check_type_vars(Tvs, L, St2) + end; +check_record_field_def(Name, Field,_D, L, St) -> + %% Default value checked when record is made. + check_record_field_def(Name, Field, L, St); +check_record_field_def(Name, Field, L, St) -> + check_record_field_def_1(Name, Field, L, St); +check_record_field_def(Name, Field, L, St) -> + check_record_field_def_1(Name, Field, L, St). + +check_record_field_def_1(Name, Field, L, #lfe_lint{records=Recs}=St) -> + if is_atom(Field) -> + St#lfe_lint{records=orddict:append(Name, Field, Recs)}; + true -> + bad_record_field_error(L, Name, Field, St) + end. + +%% check_struct_def(StructDef, Line, State) -> State. +%% Check a struct definition. + +check_struct_def(Fields, L, St) -> + case St#lfe_lint.struct of + undefined -> + check_foreach(fun (Fd, S) -> + check_struct_field_def(Fd, L, S) end, + fun (S) -> bad_struct_def_error(L, S) end, + St#lfe_lint{struct=}, Fields); + _Fs -> + add_error(L, redefine_struct, St) + end. + +check_struct_field_def(Field,D,Type, L, St0) -> + St1 = check_struct_field_def(Field,D, L, St0), + case lfe_types:check_type_def(Type, St1#lfe_lint.records, ) of + {ok,Tvs} -> check_type_vars(Tvs, L, St1); + {error,Error,Tvs} -> + St2 = add_error(L, Error, St1), + check_type_vars(Tvs, L, St2) + end; +check_struct_field_def(Field,_D, L, St) -> + %% Default value a literal here so no checking. + check_struct_field_def(Field, L, St); +check_struct_field_def(Field, L, St) -> + check_struct_field_def_1(Field, L, St); +check_struct_field_def(Field, L, St) -> + check_struct_field_def_1(Field, L, St). + +check_struct_field_def_1(Field, L, #lfe_lint{struct=Fs}=St) -> + if is_atom(Field) -> + St#lfe_lint{struct=Field|Fs}; + true -> + bad_struct_field_error(L, Field, St) + end. %% init_state(State) -> {Predefs,Env,State}. %% Setup the initial predefines and state. Build dummies for -%% predefined module_info and parameteried module functions, which -%% makes it easier to later check redefines. +%% predefined module_info which makes it easier to later check +%% redefines. init_state(St) -> - %% Add the imports. - Env0 = foldl(fun ({M,Fs}, Env) -> - foldl(fun ({{F,A},R}, E) -> - lfe_env:add_ibinding(M, F, A, R, E) - end, Env, Fs) - end, lfe_env:new(), St#lint.imps), + Env0 = le_new(), + %% Add original import name to the environment. + Env1 = orddict:fold(fun ({F,Ar}, {_Mod,_Ren}, E) -> + le_addf(F, Ar, E) + end, Env0, St#lfe_lint.imports), %% Basic predefines Predefs0 = {module_info,lambda,,?Q(dummy),1}, {module_info,lambda,x,?Q(dummy),1}, Exps0 = {module_info,0},{module_info,1}, - {Predefs0,Env0, - St#lint{exps=add_exports(Exps0, St#lint.mline, St#lint.exps)}}. + Exps1 = add_exports(Exps0, St#lfe_lint.mline, St#lfe_lint.exports), + {Predefs0,Env1,St#lfe_lint{exports=Exps1}}. %% check_functions(FuncBindings, Env, State) -> {Funcs,Env,State}. %% Check the top-level functions definitions. These have the format @@ -507,37 +728,70 @@ check_functions(Fbs, Env0, St0) -> {Fs,St1} = check_fbindings(Fbs, St0), %% Add to the environment. - Env1 = foldl(fun ({F,A}, Env) -> add_fbinding(F, A, Env) end, Env0, Fs), + Env1 = lists:foldl(fun ({{F,A},_L}, Env) -> le_addf(F, A, Env) end, + Env0, Fs), %% Now check function definitions. - St2 = foldl(fun ({_,lambda|Lambda,L}, St) -> - check_lambda(Lambda, Env1, L, St); - ({_,'match-lambda'|Match,L}, St) -> - check_match_lambda(Match, Env1, L, St); - ({F,_,L}, St) -> %Flag error here - bad_fdef_error(L, F, St) + St2 = lists:foldl(fun ({_,lambda|Lambda,L}, St) -> + check_lambda(Lambda, Env1, L, St); + ({_,'match-lambda'|Match,L}, St) -> + check_match_lambda(Match, Env1, L, St); + ({F,_,L}, St) -> %Flag error here + bad_fdef_error(L, F, St) end, St1, Fbs), {Fs,Env1,St2}. -%% check_exports(Exports, Funcs, State) -> State. +%% check_valid_exports(State) -> State. +%% Check that all the exports are defined functions. -check_exports(Exps, Fs, St) -> - Fun = fun (E, L, S) -> - case is_element(E, Fs) of - true -> S; - false -> undefined_func_error(L, E, S) - end +check_valid_exports(#lfe_lint{exports=Exps,funcs=Funcs}=St) -> + Fun = fun (FAr, L, S) -> + ?IF(orddict:is_key(FAr, Funcs), + S, + undefined_function_error(L, FAr, S)) end, orddict:fold(Fun, St, Exps). +%% check_valid_imports(State) -> State. + +check_valid_imports(#lfe_lint{imports=Imps,funcs=Funcs}=St) -> + Fun = fun (FAr, {_Mod,_R}, S) -> + ?IF(orddict:is_key(FAr, Funcs), + add_error(orddict:fetch(FAr, Funcs), + {define_imported_function,FAr}, S), + S) + end, + orddict:fold(Fun, St, Imps). + %% add_exports(More, Line, Exports) -> New. %% Add exports preserving line number of earliest entry. add_exports(More, L, Exps) -> - Fun = fun (F, Es) -> - orddict:update(F, fun (Old) -> Old end, L, Es) + Fun = fun (FAr, Es) -> + orddict:update(FAr, fun (Old) -> Old end, L, Es) end, lists:foldl(Fun, Exps, More). +%% check_valid_onload(State) -> State. +%% Check that the on_load function is a defined function. + +check_valid_onload(#lfe_lint{mline=L,onload=F,Ar,env=Env}=St) -> + case le_hasf(F, Ar, Env) of + true -> St; + false -> + add_error(L, {undefined_onload_function,{F,Ar}}, St) + end; +check_valid_onload(#lfe_lint{onload=}=St) -> + St. + +%% check_valid_type_exports(State) -> State. + +check_valid_type_exports(#lfe_lint{types=Types,texps=Texps}=St) -> + Fun = fun (E, L, S) -> + ?IF(lists:member(E, Types), S, + add_error(L, {undefined_type,E}, S)) + end, + orddict:fold(Fun, St, Texps). + %% check_expr(Expr, Env, Line, State) -> State. %% Check an expression. @@ -551,19 +805,28 @@ check_expr(tref|_,_=As, Env, L, St) -> check_args(As, Env, L, St); check_expr(tset|_,_,_=As, Env, L, St) -> check_args(As, Env, L, St); check_expr(binary|Segs, Env, L, St) -> expr_bitsegs(Segs, Env, L, St); -check_expr(map|As, Env, L, St) -> expr_map(As, Env, L, St); -check_expr('mref',Map,K, Env, L, St) -> - expr_get_map(Map, K, Env, L, St); +check_expr(map|As, Env, L, St) -> + check_map(As, Env, L, St); +check_expr('msiz',Map, Env, L, St) -> + check_map_size(msiz, Map, Env, L, St); +check_expr('mref',Map,Key, Env, L, St) -> + check_map_get(mref, Map, Key, Env, L, St); check_expr('mset',Map|As, Env, L, St) -> - expr_set_map(Map, As, Env, L, St); + check_map_set(mset, Map, As, Env, L, St); check_expr('mupd',Map|As, Env, L, St) -> - expr_update_map(Map, As, Env, L, St); -check_expr('map-get',Map,K, Env, L, St) -> - check_expr('mref',Map,K, Env, L, St); + check_map_update(mupd, Map, As, Env, L, St); +check_expr('mrem',Map|Ks, Env, L, St) -> + check_map_remove(mrem, Map, Ks, Env, L, St); +check_expr('map-size',Map, Env, L, St) -> + check_map_size('map-size', Map, Env, L, St); +check_expr('map-get',Map,Key, Env, L, St) -> + check_map_get('map-get', Map, Key, Env, L, St); check_expr('map-set',Map|As, Env, L, St) -> - check_expr('mset',Map|As, Env, L, St); + check_map_set('map-set', Map, As, Env, L, St); check_expr('map-update',Map|As, Env, L, St) -> - check_expr('mupd',Map|As, Env, L, St); + check_map_update('map-update', Map, As, Env, L, St); +check_expr('map-remove',Map|Ks, Env, L, St) -> + check_map_remove('map-remove', Map, Ks, Env, L, St); check_expr(function,F,Ar, Env, L, St) -> %% Check for the right types. if is_atom(F) and is_integer(Ar) and (Ar >= 0) -> @@ -575,6 +838,42 @@ if is_atom(M) and is_atom(F) and is_integer(Ar) and (Ar >= 0) -> St; true -> bad_form_error(L, function, St) end; +%% Check record special forms. +check_expr('record',Name|Fs, Env, L, St) -> + check_record(Name, Fs, Env, L, St); +%% make-record has been deprecated but we sill accept it for now. +check_expr('make-record',Name|Fs, Env, L, St) -> + check_record(Name, Fs, Env, L, St); +check_expr('is-record',E,Name, Env, L, St0) -> + St1 = check_expr(E, Env, L, St0), + check_record(Name, L, St1); +check_expr('record-index',Name,F, _Env, L, St) -> + check_record_field(Name, F, L, St); +check_expr('record-field',E,Name,F, Env, L, St0) -> + St1 = check_expr(E, Env, L, St0), + check_record_field(Name, F, L, St1); +check_expr('record-update',E,Name|Fs, Env, L, St0) -> + St1 = check_expr(E, Env, L, St0), + check_record(Name, Fs, Env, L, St1); +%% Check struct special forms. +check_expr('struct',Name|Fs, Env, L, St) -> + check_struct(Name, Fs, Env, L, St); +check_expr('is-struct',E, Env, L, St) -> + check_expr(E, Env, L, St); +check_expr('is-struct',E,Name, Env, L, St0) -> + St1 = check_expr(E, Env, L, St0), + check_struct(Name, L, St1); +check_expr('struct-field',E,Name,F, Env, L, St0) -> + St1 = check_expr(E, Env, L, St0), + check_struct_field(Name, F, L, St1); +check_expr('struct-update',E,Name|Fs, Env, L, St0) -> + St1 = check_expr(E, Env, L, St0), + check_struct(Name, Fs, Env, L, St1); +%% Special known data type operations. +check_expr('andalso'|Es, Env, L, St) -> + check_args(Es, Env, L, St); +check_expr('orelse'|Es, Env, L, St) -> + check_args(Es, Env, L, St); %% Check the Core closure special forms. check_expr('lambda'|Lambda, Env, L, St) -> check_lambda(Lambda, Env, L, St); @@ -591,7 +890,7 @@ bad_form_error(L, 'let-macro', St); %% Check the Core control special forms. check_expr('progn'|B, Env, L, St) -> - check_body(B, Env, L, St); + check_body(progn, B, Env, L, St); check_expr('if'|B, Env, L, St) -> check_if(B, Env, L, St); check_expr('case'|B, Env, L, St) -> @@ -599,19 +898,28 @@ check_expr('receive'|Cls, Env, L, St) -> check_rec_clauses(Cls, Env, L, St); check_expr('catch'|B, Env, L, St) -> - check_body(B, Env, L, St); + check_body('catch', B, Env, L, St); check_expr('try'|B, Env, L, St) -> check_try(B, Env, L, St); check_expr('funcall'|As, Env, L, St) -> check_args(As, Env, L, St); +%% List/binary comprehensions. +check_expr('lc',Qs,E, Env, L, St) -> + check_comp(Qs, E, Env, L, St); +check_expr('list-comp',Qs,E, Env, L, St) -> + check_comp(Qs, E, Env, L, St); +check_expr('bc',Qs,BS, Env, L, St) -> + check_comp(Qs, BS, Env, L, St); +check_expr('binary-comp',Qs,BS, Env, L, St) -> + check_comp(Qs, BS, Env, L, St); +%% Finally the general cases. check_expr('call'|As, Env, L, St) -> check_args(As, Env, L, St); -%% Finally the general cases. check_expr(Fun|As, Env, L, St0) when is_atom(Fun) -> St1 = check_args(As, Env, L, St0), %Check arguments first check_func(Fun, safe_length(As), Env, L, St1); check_expr(_|As=S, Env, L, St0) -> %Test if literal string - case is_posint_list(S) of + case lfe_lib:is_posint_list(S) of true -> St0; false -> %% Function here is an expression, report error and check args. @@ -627,38 +935,33 @@ %% Check if Symbol is bound. check_symb(Symb, Env, L, St) -> - case lfe_env:is_vbound(Symb, Env) of + %% case lfe_env:is_vbound(Symb, Env) of + case le_hasv(Symb, Env) of true -> St; - false -> add_error(L, {unbound_symb,Symb}, St) + false -> add_error(L, {unbound_symbol,Symb}, St) end. %% check_func(Func, Arity, Env, Line, State) -> State. %% Check if Func/Arity is bound or an auto-imported BIF. check_func(F, Ar, Env, L, St) -> - case lfe_env:is_fbound(F, Ar, Env) orelse + %% case lfe_env:is_fbound(F, Ar, Env) orelse + case le_hasf(F, Ar, Env) orelse lfe_internal:is_lfe_bif(F, Ar) orelse lfe_internal:is_erl_bif(F, Ar) of true -> St; - false -> undefined_func_error(L, {F,Ar}, St) + false -> undefined_function_error(L, {F,Ar}, St) end. -%% check_body(Body, Env, Line, State) -> State. +%% check_body(Form, Body, Env, Line, State) -> State. %% Check the calls in a body. A body is a proper list of calls. Env is %% the set of known bound variables. -check_body(Body, Env, L, St) -> +check_body(Form, Body, Env, L, St) -> check_foreach(fun (E, S) -> check_expr(E, Env, L, S) end, - fun (S) -> add_error(L, bad_body, S) end, + fun (S) -> add_error(L, {bad_body_def,Form}, S) end, St, Body). -%% check_body(Body, Env, L, St) -> -%% %% check_body(fun check_exprs/4, Env, L, St, Body). -%% case lfe_lib:is_proper_list(Body) of -%% true -> check_exprs(Body, Env, L, St); -%% false -> add_error(L, bad_body, St) -%% end. - %% check_args(Args, Env, Line, State) -> State. %% Check the expressions in an argument list. @@ -667,97 +970,96 @@ fun (S) -> add_error(L, bad_args, S) end, St, Args). -%% check_args(Args, Env, L, St) -> -%% case lfe_lib:is_proper_list(Args) of -%% true -> check_exprs(Args, Env, L, St); -%% false -> add_error(L, bad_args, St) -%% end. - %% check_exprs(Exprs, Env, Line, State) -> State. %% Check a list of expressions. We know it's a proper list. check_exprs(Es, Env, L, St) -> - foldl(fun (E, S) -> check_expr(E, Env, L, S) end, St, Es). + lists:foldl(fun (E, S) -> check_expr(E, Env, L, S) end, St, Es). %% expr_bitsegs(BitSegs, Env, Line, State) -> State. expr_bitsegs(Segs, Env, L, St0) -> - foreach_form(fun (S, St) -> bitseg(S, Env, L, St, fun check_expr/4) end, - binary, L, St0, Segs). + BitSeg = fun (S, St) -> check_bitseg(fun check_expr/4, S, Env, L, St) end, + foreach_form(BitSeg, binary, L, St0, Segs). -%% bitseg(BitSeg, Env, Line, State) -> State. -%% bitspecs(BitSpecs, Env, Line, State) -> State. -%% bit_size(Size, Type, Env, Line, State) -> State. -%% Functions for checking expression bitsegments. +%% check_bitseg(CheckFun, BitSeg, Env, Line, State) -> State. +%% bitspecs(CheckFun, BitSpecs, Env, Line, State) -> State. +%% bit_size(CheckFun, Size, Type, Env, Line, State) -> State. +%% Functions for checking expression bitsegments. -bitseg(Val|Specs=Seg, Env, L, St0, Check) -> - case is_posint_list(Seg) of %Is bitseg a string? +check_bitseg(Check, Val|Specs=Seg, Env, L, St0) -> + %% io:format("cb ~p\n", Seg), + case lfe_lib:is_posint_list(Seg) of %Is bitseg a string? true -> St0; %A string false -> %A value and spec - St1 = bitspecs(Specs, Env, L, St0, Check), - case is_posint_list(Val) of %Is Val a string? + St1 = bitspecs(Check, Specs, Env, L, St0), + case lfe_lib:is_posint_list(Val) of %Is Val a string? true -> St1; false -> Check(Val, Env, L, St1) end end; -bitseg(Val, Env, L, St, Check) -> +check_bitseg(Check, Val, Env, L, St) -> Check(Val, Env, L, St). -bitspecs(Specs, Env, L, St, Check) -> +bitspecs(Check, Specs, Env, L, St) -> case lfe_bits:get_bitspecs(Specs) of - {ok,Sz,Ty} -> bit_size(Sz, Ty, Env, L, St, Check); + {ok,Sz,Ty} -> bit_size(Check, Sz, Ty, Env, L, St); {error,E} -> add_error(L, E, St) end. %% Catch the case where size was explicitly given as 'undefined' or %% 'all' for the wrong type. -bit_size(all, {Ty,_,_,_}, _, L, St, _) -> +bit_size(_Check, all, {Ty,_,_,_}, _, L, St) -> if Ty =:= binary -> St; true -> illegal_bitsize_error(L, St) end; -bit_size(undefined, {Ty,_,_,_}, _, L, St, _) -> +bit_size(_Check, undefined, {Ty,_,_,_}, _, L, St) -> if Ty =:= utf8; Ty =:= utf16; Ty =:= utf32 -> St; true -> illegal_bitsize_error(L, St) end; -bit_size(Sz, _, Env, L, St, Check) -> Check(Sz, Env, L, St). - -is_posint_list(I|Is) when is_integer(I), I >= 0 -> - is_posint_list(Is); -is_posint_list() -> true; -is_posint_list(_) -> false. - -%% expr_map(Pairs, Env, Line, State) -> State. -%% expr_get_map(Map, Key, Env, Line, State) -> State. -%% expr_set_map(Map, Pairs, Line, State) -> State. -%% expr_update_map(Args, Pairs, Line, State) -> State. +bit_size(Check, Sz, _, Env, L, St) -> Check(Sz, Env, L, St). + +%% check_map(Pairs, Env, Line, State) -> State. +%% check_map_size(Form, Map, Env, Line, State) -> State. +%% check_map_get(Form, Map, Key, Env, Line, State) -> State. +%% check_map_set(Form, Map, Pairs, Line, State) -> State. +%% check_map_update(Form, Args, Pairs, Line, State) -> State. +%% check_map_remove(Form, Args, Keys, Line, State) -> State. %% Functions for checking maps, these always return errors if system %% does not support maps. -ifdef(HAS_MAPS). -expr_map(Pairs, Env, L, St) -> - expr_map_pairs(Pairs, Env, L, St). +check_map(Pairs, Env, L, St) -> + check_map_pairs(map, Pairs, Env, L, St). + +check_map_size(_Form, Map, Env, L, St) -> + check_expr(Map, Env, L, St). -expr_get_map(Map, Key, Env, L, St0) -> +check_map_get(_Form, Map, Key, Env, L, St0) -> St1 = check_expr(Map, Env, L, St0), map_key(Key, Env, L, St1). -expr_set_map(Map, Pairs, Env, L, St0) -> +check_map_set(Form, Map, Pairs, Env, L, St0) -> + St1 = check_expr(Map, Env, L, St0), + check_map_pairs(Form, Pairs, Env, L, St1). + +check_map_update(Form, Map, Pairs, Env, L, St0) -> St1 = check_expr(Map, Env, L, St0), - expr_map_pairs(Pairs, Env, L, St1). + check_map_pairs(Form, Pairs, Env, L, St1). -expr_update_map(Map, Pairs, Env, L, St0) -> +check_map_remove(_Form, Map, Keys, Env, L, St0) -> St1 = check_expr(Map, Env, L, St0), - expr_map_pairs(Pairs, Env, L, St1). + check_exprs(Keys, Env, L, St1). -expr_map_pairs(K,V|As, Env, L, St0) -> - St1 = expr_map_assoc(K, V, Env, L, St0), - expr_map_pairs(As, Env, L, St1); -expr_map_pairs(, _, _, St) -> St; -expr_map_pairs(_, _, L, St) -> - bad_form_error(L, map, St). +check_map_pairs(Form, K,V|As, Env, L, St0) -> + St1 = check_map_assoc(K, V, Env, L, St0), + check_map_pairs(Form, As, Env, L, St1); +check_map_pairs(_, , _, _, St) -> St; +check_map_pairs(Form, _, _, L, St) -> + bad_form_error(L, Form, St). -expr_map_assoc(K, V, Env, L, St0) -> +check_map_assoc(K, V, Env, L, St0) -> St1 = map_key(K, Env, L, St0), check_expr(V, Env, L, St1). @@ -775,31 +1077,165 @@ end. is_map_key(?Q(Lit)) -> is_literal(Lit); -is_map_key(_|_=L) -> is_posint_list(L); %Literal strings only +is_map_key(_|_=L) -> + lfe_lib:is_posint_list(L); %Literal strings only is_map_key(E) when is_atom(E) -> false; is_map_key(Lit) -> is_literal(Lit). -endif. -else. -expr_map(Ps, _, L, St) -> - undefined_func_error(L, {map,safe_length(Ps)}, St). +check_map(Ps, _, L, St) -> + undefined_function_error(L, {map,safe_length(Ps)}, St). -expr_get_map(_, _, _, L, St) -> - undefined_func_error(L, {'map-get',2}, St). +check_map_size(Form, _, _, L, St) -> + undefined_function_error(L, {Form,1}, St). -expr_set_map(_, Ps, _, L, St) -> - undefined_func_error(L, {'map-set',safe_length(Ps)+1}, St). +check_map_get(Form, _, _, _, L, St) -> + undefined_function_error(L, {Form,2}, St). -expr_update_map(_, Ps, _, L, St) -> - undefined_func_error(L, {'map-update',safe_length(Ps)+1}, St). +check_map_set(Form, _, Ps, _, L, St) -> + undefined_function_error(L, {Form,safe_length(Ps)+1}, St). + +check_map_update(Form, _, Ps, _, L, St) -> + undefined_function_error(L, {Form,safe_length(Ps)+1}, St). + +check_map_remove(Form, _, Ks, _, L, St) -> + undefined_function_error(L, {Form,safe_length(Ks)+1}, St). -endif. +%% check_record(RecordName, Line, State) -> State. +%% check_record(RecordName, Fields, Env, Line, State) -> State. +%% Check record usage against its definition. + +check_record(Name, L, #lfe_lint{records=Recs}=St) when is_atom(Name) -> + case orddict:is_key(Name, Recs) of + true -> St; + false -> + undefined_record_error(L, Name, St) + end; +check_record(Name, L, St) -> + bad_record_name_error(L, Name, St). + +check_record(Name, Fields, Env, L, #lfe_lint{records=Recs}=St) + when is_atom(Name) -> + case orddict:find(Name, Recs) of + {ok,Rfields} -> + check_record_fields(Name, Rfields, Fields, Env, L, St); + error -> + undefined_record_error(L, Name, St) + end; +check_record(Name, _, _, L, St) -> + bad_record_name_error(L, Name, St). + +%% check_record_fields(RecordName, RecordFields, Fields, Env, Line, State) -> +%% State. + +check_record_fields(Name, Rfs, '_',_Val|Fs, Env, L, St) -> + %% The _ field is special! + check_record_fields(Name, Rfs, Fs, Env, L, St); +check_record_fields(Name, Rfs, F,Val|Fs, Env, L, St0) -> + St1 = case lists:member(F, Rfs) of + true -> + check_expr(Val, Env, L, St0); + false -> + undefined_record_field_error(L, Name, F, St0) + end, + check_record_fields(Name, Rfs, Fs, Env, L, St1); +check_record_fields(Name, _Rfs, F, _Env, L, St) -> + missing_record_field_value_error(L, Name, F, St); +check_record_fields(_Name, _Rfs, , _Env, _L, St) -> St; +check_record_fields(Name, _Rfs, Pat, _Env, L, St) -> + bad_record_field_error(L, Name, Pat, St). + +%% check_record_field(RecordName, Field, Line, State) -> State. +%% Check whether record has beeen defined and has a field. + +check_record_field(Name, F, L, #lfe_lint{records=Recs}=St) + when is_atom(Name) -> + case orddict:find(Name, Recs) of + {ok,Rfields} -> + case lists:member(F, Rfields) of + true -> St; + false -> + undefined_record_field_error(L, Name, F, St) + end; + error -> + undefined_record_error(L, Name, St) + end; +check_record_field(Name, _F, L, St) -> + bad_record_name_error(L, Name, St). + +%% check_struct(StructName, Line, State) -> State. +%% check_struct(StructName, Fields, Env, Line, State) -> State. +%% Check struct usage against its definition. + +check_struct(Name, L, St0) -> + case get_struct_fields(Name, L, St0) of + {ok,_Sfields} -> St0; + {error,St1} -> St1 + end. + +check_struct(Name, Fields, Env, L, St0) -> + case get_struct_fields(Name, L, St0) of + {ok,Sfields} -> + check_struct_fields(Name, Sfields, Fields, Env, L, St0); + {error,St1} -> St1 + end. + +%% check_struct_field(StructName, Field, Line, State) -> State. + +check_struct_field(Name, Field, L, St0) -> + case get_struct_fields(Name, L, St0) of + {ok,Sfields} -> + case lists:member(Field, Sfields) of + true -> St0; + false -> + undefined_struct_field_error(L, Name, Field, St0) + end; + {error,St1} -> St1 + end. + +%% get_struct_fields(StructName, Line, State) -> {ok,Fields} | {error,State}. +%% Check if struct exists either in this module or in another module +%% and if so return the fields + +get_struct_fields(Name, L, #lfe_lint{module=Mod}=St) when Name =:= Mod -> + case St#lfe_lint.struct of + undefined -> + {error,undefined_struct_error(L, Name, St)}; + Sfields -> {ok,Sfields} + end; +get_struct_fields(Name, L, St) -> + try + Sfields = maps:keys(Name:'__struct__'()), + {ok,Sfields} + catch + _:_ -> {error,undefined_struct_error(L, Name, St)} + end. + +%% check_struct_fields(StructName, StructFields, Fields, Env, Line, State) -> +%% State. + +check_struct_fields(Name, Sfs, F,Val|Fs, Env, L, St0) -> + St1 = case lists:member(F, Sfs) of + true -> + check_expr(Val, Env, L, St0); + false -> + undefined_struct_field_error(L, Name, F, St0) + end, + check_struct_fields(Name, Sfs, Fs, Env, L, St1); +check_struct_fields(Name, _Sfs, F, _Env, L, St) -> + missing_struct_field_value_error(L, Name, F, St); +check_struct_fields(_Name, _Sfs, , _Env, _L, St) -> St; +check_struct_fields(Name, _Sfs, _Field, _Env, L, St) -> + bad_struct_def_error(L, Name, St). + %% check_lambda(LambdaBody, Env, Line, State) -> State. %% Check form (lambda Args ...). check_lambda(Args|Body, Env, L, St0) -> {Vs,St1} = check_lambda_args(Args, L, St0), - check_body(Body, add_vbindings(Vs, Env), L, St1); + check_body(lambda, Body, le_addvs(Vs, Env), L, St1); check_lambda(_, _, L, St) -> bad_form_error(L, lambda, St). check_lambda_args(Args, L, St) -> @@ -807,7 +1243,7 @@ %% same rules as for pattern symbols. Check = fun (A, {As,S}) -> pat_symb(A, As, L, S) end, case lfe_lib:is_symb_list(Args) of - true -> foldl(Check, {,St}, Args); + true -> lists:foldl(Check, {,St}, Args); false -> {,bad_form_error(L, lambda, St)} end. @@ -829,9 +1265,9 @@ check_ml_clause(Pat|Rest=C, Ar, Env0, L, St0) -> St1 = case ml_arity(C) =:= Ar of true -> St0; - false -> add_error(L, bad_arity, St0) + false -> add_error(L, bad_head_arity, St0) end, - check_clause(list|Pat|Rest, Env0, L, St1); + check_clause('match-lambda', list|Pat|Rest, Env0, L, St1); check_ml_clause(_, _, _, L, St) -> bad_form_error(L, clause, St). @@ -846,14 +1282,14 @@ check_let(Vbs|Body, Env, L, St0) -> Check = fun (Vb, Pvs, Sta) -> {Pv,Stb} = check_let_vb(Vb, Env, L, Sta), - Stc = case intersection(Pv, Pvs) of + Stc = case ordsets:intersection(Pv, Pvs) of -> Stb; Ivs -> multi_var_error(L, Ivs, Stb) end, - {union(Pv, Pvs), Stc} + {ordsets:union(Pv, Pvs), Stc} end, {Pvs,St1} = foldl_form(Check, 'let', L, , St0, Vbs), - check_body(Body, add_vbindings(Pvs, Env), L, St1); + check_body('let', Body, le_addvs(Pvs, Env), L, St1); check_let(_, _, L, St) -> bad_form_error(L, 'let', St). @@ -877,7 +1313,7 @@ %% Collect correct function definitions. {Fbs1,St1} = collect_let_funcs(Fbs0, 'let-function', L, St0), {_,Env1,St2} = check_let_bindings(Fbs1, Env0, St1), - check_body(Body, Env1, L, St2). + check_body('let-function', Body, Env1, L, St2). %% check_letrec_function(FletrecBody, Env, Line, State) -> {Env,State}. %% Check a letrec-function form (letrec-function FuncBindings ... ). @@ -886,7 +1322,7 @@ %% Collect correct function definitions. {Fbs1,St1} = collect_let_funcs(Fbs0, 'letrec-function', L, St0), {_,Env1,St2} = check_letrec_bindings(Fbs1, Env0, St1), - check_body(Body, Env1, L, St2). + check_body('letrec-function', Body, Env1, L, St2). %% collect_let_funcs(FuncDefs, Type, Line, State) -> {Funcbindings,State}. %% Collect the function definitions for a let/letrec-function @@ -907,16 +1343,17 @@ %% already be reported. Use explicit line number in element. check_let_bindings(Fbs, Env0, St0) -> - {Fs,St1} = check_fbindings(Fbs, St0), + {Funcs,St1} = check_fbindings(Fbs, St0), %% Now check function definitions. - St2 = foldl(fun ({_,lambda|Lambda,L}, St) -> - check_lambda(Lambda, Env0, L, St); - ({_,'match-lambda'|Match,L}, St) -> - check_match_lambda(Match, Env0, L, St) - end, St1, Fbs), + St2 = lists:foldl(fun ({_,lambda|Lambda,L}, St) -> + check_lambda(Lambda, Env0, L, St); + ({_,'match-lambda'|Match,L}, St) -> + check_match_lambda(Match, Env0, L, St) + end, St1, Fbs), %% Add to environment - Env1 = foldl(fun ({F,A}, Env) -> add_fbinding(F, A, Env) end, Env0, Fs), - {Fs,Env1,St2}. + Env1 = lists:foldl(fun ({{F,A},_L}, Env) -> le_addf(F, A, Env) end, + Env0, Funcs), + {Funcs,Env1,St2}. %% check_letrec_bindings(FuncBindings, Env, State) -> {Funcs,Env,State}. %% Check the function bindings and return new environment. We only @@ -924,41 +1361,43 @@ %% already be reported. Use explicit line number in element. check_letrec_bindings(Fbs, Env0, St0) -> - {Fs,St1} = check_fbindings(Fbs, St0), + {Funcs,St1} = check_fbindings(Fbs, St0), %% Add to the environment. - Env1 = foldl(fun ({F,A}, Env) -> add_fbinding(F, A, Env) end, Env0, Fs), + Env1 = lists:foldl(fun ({{F,A},_L}, Env) -> le_addf(F, A, Env) end, + Env0, Funcs), %% Now check function definitions. - St2 = foldl(fun ({_,lambda|Lambda,L}, St) -> - check_lambda(Lambda, Env1, L, St); - ({_,'match-lambda'|Match,L}, St) -> - check_match_lambda(Match, Env1, L, St) - end, St1, Fbs), - {Fs,Env1,St2}. + St2 = lists:foldl(fun ({_,lambda|Lambda,L}, St) -> + check_lambda(Lambda, Env1, L, St); + ({_,'match-lambda'|Match,L}, St) -> + check_match_lambda(Match, Env1, L, St) + end, St1, Fbs), + {Funcs,Env1,St2}. %% check_fbindings(FuncBindings, State) -> {Funcs,State}. %% Check function bindings for format and for multiple fucntion %% definitions. check_fbindings(Fbs0, St0) -> - AddFb = fun(F, Fs, L, St) -> - case member(F, Fs) of - true -> {Fs,add_error(L, {redef_fun,F}, St)}; - false -> {add_element(F, Fs),St} + AddFb = fun(FAr, Funcs, L, St) -> + case orddict:is_key(FAr, Funcs) of + true -> + {Funcs,add_error(L, {redefine_function,FAr}, St)}; + false -> {orddict:store(FAr, L, Funcs),St} end end, - Check = fun ({V,lambda,Args|_,L}, {Fs,St}) -> + Check = fun ({V,lambda,Args|_,L}, {Funcs,St}) -> case lfe_lib:is_symb_list(Args) of - true -> AddFb({V,length(Args)}, Fs, L, St); - false -> {Fs,bad_form_error(L, lambda, St)} + true -> AddFb({V,length(Args)}, Funcs, L, St); + false -> {Funcs,bad_form_error(L, lambda, St)} end; - ({V,'match-lambda',Pats|_|_,L}, {Fs,St}) -> + ({V,'match-lambda',Pats|_|_,L}, {Funcs,St}) -> case lfe_lib:is_proper_list(Pats) of - true -> AddFb({V,length(Pats)}, Fs, L, St); - false -> {Fs,bad_form_error(L, 'match-lambda', St)} + true -> AddFb({V,length(Pats)}, Funcs, L, St); + false -> {Funcs,bad_form_error(L, 'match-lambda', St)} end; (_, Acc) -> Acc %Error here flagged elsewhere end, - foldl(Check, {,St0}, Fbs0). + lists:foldl(Check, {orddict:new(),St0}, Fbs0). %% check_if(IfBody, Env, Line, State) -> State. %% Check form (if Test True False). @@ -980,24 +1419,24 @@ bad_form_error(L, 'case', St). check_case_clauses(Cls, Env, L, St) -> - foreach_form(fun (Cl, S) -> check_clause(Cl, Env, L, S) end, + foreach_form(fun (Cl, S) -> check_clause('case', Cl, Env, L, S) end, 'case', L, St, Cls). check_rec_clauses('after',T|B, Env, L, St0) -> St1 = check_expr(T, Env, L, St0), - check_body(B, Env, L, St1); + check_body('receive', B, Env, L, St1); check_rec_clauses('after'|_|Cls, Env, L, St) -> %% Only allow after last and with timeout. check_rec_clauses(Cls, Env, L, bad_form_error(L, 'receive', St)); check_rec_clauses(Cl|Cls, Env, L, St) -> - check_rec_clauses(Cls, Env, L, check_clause(Cl, Env, L, St)); + check_rec_clauses(Cls, Env, L, check_clause('receive', Cl, Env, L, St)); check_rec_clauses(, _, _, St) -> St; check_rec_clauses(_, _, L, St) -> bad_form_error(L, 'receive', St). -check_clause(_|_=Cl, Env0, L, St0) -> +check_clause(Form, _|_=Cl, Env0, L, St0) -> {B,_,Env1,St1} = pattern_guard(Cl, Env0, L, St0), - check_body(B, Env1, L, St1); -check_clause(_, _, L, St) -> bad_form_error(L, clause, St). + check_body(Form, B, Env1, L, St1); +check_clause(Form, _, _, L, St) -> bad_form_error(L, Form, St). %% check_try(TryBody, Env, Line, State) -> State. %% Check a (try ...) form making sure that the right combination of @@ -1013,27 +1452,89 @@ check_try_catch(Catch, Env, L, St1); check_try(_, _, L, St) -> bad_form_error(L, 'try', St). -check_try_catch('catch'|Cls, Env, L, St) -> - check_case_clauses(Cls, Env, L, St); -check_try_catch('catch'|Cls,'after'|B, Env, L, St0) -> - St1 = check_case_clauses(Cls, Env, L, St0), - check_body(B, Env, L, St1); -check_try_catch('after'|B, Env, L, St) -> - check_body(B, Env, L, St); +check_try_catch('catch'|Catch, Env, L, St) -> + check_catch_clauses(Catch, Env, L, St); +check_try_catch('catch'|Catch,'after'|After, Env, L, St0) -> + St1 = check_catch_clauses(Catch, Env, L, St0), + check_body('try', After, Env, L, St1); +check_try_catch('after'|After, Env, L, St) -> + check_body('try', After, Env, L, St); check_try_catch(_, _, L, St) -> bad_form_error(L, 'try', St). +check_catch_clauses(Cls, Env, L, St) -> + foreach_form(fun (C, S) -> check_catch_clause(C, Env, L, S) end, + 'try', L, St, Cls). + +check_catch_clause('_'|_=Cl, Env, L, St) -> + check_clause('catch', Cl, Env, L, St); +check_catch_clause(tuple,_,_,Stack|_=Cl, Env, L, St0) -> + %% Stack must be an unbound variable. + %% St1 = case is_atom(Stack) and not lfe_env:is_vbound(Stack, Env) of + St1 = case is_atom(Stack) and not le_hasv(Stack, Env) of + true -> St0; + false -> add_error(L, {illegal_stacktrace,Stack}, St0) + end, + check_clause('catch', Cl, Env, L, St1); +check_catch_clause(Other|_, _Env, L, St) -> + add_error(L, {illegal_exception,Other}, St). + +%% check_comp(Qualifiers, Expr, Env, LineNumber, State) -> State. +%% Check a comprehension. We can use the same function for both list +%% and binary comprehensions here and push any extra tests to the +%% Erlang compiler. + +check_comp(Qs, Expr, Env0, L, St0) -> + %% io:format("~p ~p ~p\n", L,Qs,BitExpr), + {Env1,St1} = check_comp_quals(Qs, Env0, L, St0), + check_expr(Expr, Env1, L, St1). + +%% check_comp_quals(Qualifiers, Env, LineNumber, State) -> +%% {Env,State}. + +check_comp_quals('<-',Pat,E|Qs, Env0, L, St0) -> + {Pvs,St1} = pattern(Pat, Env0, L, St0), + Env1 = le_addvs(Pvs, Env0), + St2 = check_expr(E, Env1, L, St1), + check_comp_quals(Qs, Env1, L, St2); +check_comp_quals('<-',Pat,'when'|G,E|Qs, Env, L, St) -> + %% Move guards to qualifiers as tests. + check_comp_quals('<-',Pat,E|G ++ Qs, Env, L, St); +check_comp_quals('<=',Pat,E|Qs, Env0, L, St0) -> + {Pvs,St1} = check_bitstring_pattern(Pat, Env0, L, St0), + Env1 = le_addvs(Pvs, Env0), + St2 = check_expr(E, Env1, L, St1), + check_comp_quals(Qs, Env1, L, St2); +check_comp_quals('<=',Pat,'when'|G,E|Qs, Env, L, St) -> + %% Move guards to qualifiers as tests. + check_comp_quals('<=',Pat,E|G ++ Qs, Env, L, St); +check_comp_quals(Test|Qs, Env, L, St0) -> + St1 = check_expr(Test, Env, L, St0), + check_comp_quals(Qs, Env, L, St1); +check_comp_quals(, Env, _L, St) -> + {Env,St}. + +%% check_bitstring_pattern(Pattern, Env, LineNumber, State) -> {PatVars,State}. +%% The bitstring pattern must be a binary. + +check_bitstring_pattern(Pat, Env, L, St) -> + pattern(Pat, Env, L, St). +%% check_bitstring_pattern(binary|Segs, Env, L, St) -> +%% pat_binary(Segs, , Env, L, St); +%% check_bitstring_pattern(Pat, _Env, L, St) -> +%% {,illegal_pattern_error(L, Pat, St)}. + %% pattern_guard(Pat{,Guard}|Body, Env, L, State) -> %% {Body,PatVars,Env,State}. %% Check pattern and guard in a clause. We know there is at least pattern! pattern_guard(Pat,'when'|G|Body, Env0, L, St0) -> {Pvs,St1} = pattern(Pat, Env0, L, St0), - Env1 = add_vbindings(Pvs, Env0), + Env1 = le_addvs(Pvs, Env0), St2 = check_guard(G, Env1, L, St1), {Body,Pvs,Env1,St2}; pattern_guard(Pat|Body, Env0, L, St0) -> {Pvs,St1} = pattern(Pat, Env0, L, St0), - Env1 = add_vbindings(Pvs, Env0), + Env1 = le_addvs(Pvs, Env0), {Body,Pvs,Env1,St1}. %% check_guard(GuardTests, Env, Line, State) -> State. @@ -1044,11 +1545,10 @@ %% check_gbody(Body, Env, Line, State) -> State. %% Check guard expressions in a body -check_gbody(E|Es, Env, L, St0) -> - St1 = check_gexpr(E, Env, L, St0), - check_gbody(Es, Env, L, St1); -check_gbody(, _, _, St) -> St; -check_gbody(_, _, L, St) -> add_error(L, bad_guard, St). +check_gbody(Exprs, Env, L, St) -> + check_foreach(fun (E, S) -> check_gexpr(E, Env, L, S) end, + fun (S) -> add_error(L, bad_guard_def, S) end, + St, Exprs). %% check_gexpr(Call, Env, Line, State) -> State. %% Check a guard expression. This is a restricted body expression. @@ -1062,11 +1562,48 @@ check_gexpr(tuple|As, Env, L, St) -> check_gargs(As, Env, L, St); check_gexpr(tref|_,_=As, Env, L, St) -> check_gargs(As, Env, L, St); check_gexpr(binary|Segs, Env, L, St) -> gexpr_bitsegs(Segs, Env, L, St); -%% Map operations are not allowed in guards. -%% Check the Core closure special forms. -%% Check the Core control special forms. -check_gexpr('progn'|B, Env, L, St) -> check_gbody(B, Env, L, St); -check_gexpr('if'|B, Env, L, St) -> check_gif(B, Env, L, St); +%% Check map special forms which translate into legal guard expressions. +check_gexpr(map|As, Env, L, St) -> + check_gmap(As, Env, L, St); +check_gexpr(msiz,Map, Env, L, St) -> + check_gmap_size(msiz, Map, Env, L, St); +check_gexpr(mref,Map,Key, Env, L, St) -> + check_gmap_get(mref, Map, Key, Env, L, St); +check_gexpr(mset,Map|As, Env, L, St) -> + check_gmap_set(mset, Map, As, Env, L, St); +check_gexpr(mupd,Map|As, Env, L, St) -> + check_gmap_update(mupd, Map, As, Env, L, St); +check_gexpr('map-size',Map, Env, L, St) -> + check_gmap_size('map-size', Map, Env, L, St); +check_gexpr('map-get',Map,Key, Env, L, St) -> + check_gmap_get('map-get', Map, Key, Env, L, St); +check_gexpr('map-set',Map|As, Env, L, St) -> + check_gmap_set('map-set', Map, As, Env, L, St); +check_gexpr('map-update',Map|As, Env, L, St) -> + check_gmap_update('map-update', Map, As, Env, L, St); +%% Check record special forms. +check_gexpr('is-record',E,Name, Env, L, St0) -> + St1 = check_gexpr(E, Env, L, St0), + check_record(Name, L, St1); +check_gexpr('record-index',Name,F, _Env, L, St) -> + check_record_field(Name, F, L, St); +check_gexpr('record-field',E,Name,F, Env, L, St0) -> + St1 = check_gexpr(E, Env, L, St0), + check_record_field(Name, F, L, St1); +%% Check struct special forms. +check_gexpr('is-struct',E, Env, L, St) -> + check_gexpr(E, Env, L, St); +check_gexpr('is-struct',E,Name, Env, L, St0) -> + St1 = check_gexpr(E, Env, L, St0), + check_struct(Name, L, St1); +check_gexpr('struct-field',E,Name,F, Env, L, St0) -> + St1 = check_gexpr(E, Env, L, St0), + check_struct_field(Name, F, L, St1); +%% Special known data type operations. +check_gexpr('andalso'|Es, Env, L, St) -> + check_gargs(Es, Env, L, St); +check_gexpr('orelse'|Es, Env, L, St) -> + check_gargs(Es, Env, L, St); check_gexpr(call,?Q(erlang),?Q(Fun)|As, Env, L, St0) -> St1 = check_gargs(As, Env, L, St0), %% It must be a legal guard bif here. @@ -1074,18 +1611,18 @@ true -> St1; false -> illegal_guard_error(L, St1) end; +%% Finally the general case. check_gexpr(call|_, _, L, St) -> %Other calls not allowed illegal_guard_error(L, St); -%% Finally the general case. check_gexpr(Fun|As, Env, L, St0) when is_atom(Fun) -> St1 = check_gargs(As, Env, L, St0), check_gfunc(Fun, safe_length(As), Env, L, St1); check_gexpr(_|As=S, Env, L, St0) -> %Test if literal string - case is_posint_list(S) of + case lfe_lib:is_posint_list(S) of true -> St0; false -> %% Function here is an expression, report error and check args. - St1 = bad_gform_error(L, application, St0), + St1 = bad_guard_form_error(L, application, St0), check_gargs(As, Env, L, St1) end; check_gexpr(Symb, Env, L, St) when is_atom(Symb) -> @@ -1097,7 +1634,8 @@ %% Check if Func/Arity is not bound and an auto-imported guard BIF. check_gfunc(F, Ar, Env, L, St) -> - case (not lfe_env:is_fbound(F, Ar, Env)) andalso + %% case (not lfe_env:is_fbound(F, Ar, Env)) andalso + case (not le_hasf(F, Ar, Env)) andalso lfe_internal:is_guard_bif(F, Ar) of true -> St; false -> illegal_guard_error(L, St) @@ -1112,24 +1650,90 @@ fun (S) -> add_error(L, bad_gargs, S) end, St, Args). -check_gexprs(Es, Env, L, St) -> - foldl(fun (E, S) -> check_gexpr(E, Env, L, S) end, St, Es). - -%% check_gif(IfBody, Env, Line, State) -> State. -%% Check guard form (if Test True False). - -check_gif(Test,True,False, Env, L, St) -> - check_gexprs(Test,True,False, Env, L, St); -check_gif(Test,True, Env, L, St) -> - check_gexprs(Test,True, Env, L, St); -check_gif(_, _, L, St) -> - bad_gform_error(L, 'if', St). %Signal as guard error. +%% check_gexprs(Es, Env, L, St) -> +%% foldl(fun (E, S) -> check_gexpr(E, Env, L, S) end, St, Es). %% gexpr_bitsegs(BitSegs, Env, Line, State) -> State. gexpr_bitsegs(Segs, Env, L, St0) -> - check_foreach(fun (S, St) -> bitseg(S, Env, L, St, fun check_gexpr/4) end, - fun (St) -> bad_gform_error(L, binary, St) end, St0, Segs). + BitSeg = fun (S, St) -> check_bitseg(fun check_gexpr/4, S, Env, L, St) end, + check_foreach(BitSeg, + fun (St) -> bad_guard_form_error(L, binary, St) end, + St0, Segs). + +%% check_gmap_size(Form, Map, Env, Line, State) -> State. +%% check_gmap_get(Form, Map, Key, Env, Line, State) -> State. +%% check_gmap_set(Form, Map, Pairs, Line, State) -> State. +%% check_gmap_update(Form, Args, Pairs, Line, State) -> State. +%% Functions for checking maps, these always return errors if system +%% does not support maps. Note the special check if map-get is +%% guardable. + +-ifdef(HAS_MAPS). +check_gmap(Pairs, Env, L, St) -> + check_gmap_pairs(map, Pairs, Env, L, St). + +check_gmap_size(_Form, Map, Env, L, St) -> + check_gexpr(Map, Env, L, St). + +check_gmap_get(Form, Map, Key, Env, L, St0) -> + case lfe_internal:is_guard_bif(map_get, 2) of + true -> + St1 = check_gexpr(Map, Env, L, St0), + gmap_key(Key, Env, L, St1); + false -> + undefined_function_error(L, {Form,2}, St0) + end. + +check_gmap_set(Form, Map, Pairs, Env, L, St0) -> + St1 = check_expr(Map, Env, L, St0), + check_gmap_pairs(Form, Pairs, Env, L, St1). + +check_gmap_update(Form, Map, Pairs, Env, L, St0) -> + St1 = check_gexpr(Map, Env, L, St0), + check_gmap_pairs(Form, Pairs, Env, L, St1). + +check_gmap_pairs(Form, K,V|As, Env, L, St0) -> + St1 = check_gmap_assoc(K, V, Env, L, St0), + check_gmap_pairs(Form, As, Env, L, St1); +check_gmap_pairs(_, , _, _, St) -> St; +check_gmap_pairs(Form, _, _, L, St) -> + bad_form_error(L, Form, St). + +check_gmap_assoc(K, V, Env, L, St0) -> + St1 = gmap_key(K, Env, L, St0), + check_gexpr(V, Env, L, St1). + +%% gmap_key(Key, Env, L, State) -> State. +%% A map key can only be a literal in 17 but can be anything in 18. + +-ifdef(HAS_FULL_KEYS). +gmap_key(Key, Env, L, St) -> + check_gexpr(Key, Env, L, St). +-else. +gmap_key(Key, _, L, St) -> + case is_map_key(Key) of + true -> St; + false -> illegal_mapkey_error(L, Key, St) + end. +-endif. + +-else. +check_gmap(Ps, _, L, St) -> + undefined_function_error(L, {map,safe_length(Ps)}, St). + +check_gmap_size(Form, _, _, L, St) -> + undefined_function_error(L, {Form,1}, St). + +check_gmap_get(Form, _, _, _, L, St) -> + undefined_function_error(L, {Form,2}, St). + +check_gmap_set(Form, _, Ps, _, L, St) -> + undefined_function_error(L, {Form,safe_length(Ps)+1}, St). + +check_gmap_update(Form, _, Ps, _, L, St) -> + undefined_function_error(L, {Form,safe_length(Ps)+1}, St). +-endif. %% pattern(Pattern, Env, L, State) -> {PatVars,State}. %% pattern(Pattern, PatVars, Env, L, State) -> {PatVars,State}. @@ -1143,11 +1747,11 @@ %% io:fwrite("pat: ~p\n", Pat), %% pattern/5 should never fail! pattern(Pat, , Env, L, St). -%% try +%% try %% pattern(Pat, , Env, L, St) -%% catch +%% catch %% _:_ -> {,illegal_pattern_error(L, Pat, St)} -%% end. +%% end. pattern(?Q(Lit), Pvs, Env, L, St) -> {Pvs,literal(Lit, Env, L, St)}; @@ -1158,7 +1762,7 @@ {Pvs2,St2} = pattern(P2, Pvs1, Env, L, St1), St3 = case is_pat_alias(P1, P2) of true -> St2; %Union of variables now visible - false -> add_error(L, bad_alias, St2) + false -> add_error(L, bad_pat_alias, St2) end, {Pvs2,St3}; pattern(cons,H,T, Pvs0, Env, L, St0) -> %Explicit cons constructor @@ -1172,12 +1776,23 @@ pat_binary(Segs, Pvs, Env, L, St); pattern(map|Ps, Pvs, Env, L, St) -> pat_map(Ps, Pvs, Env, L, St); +%% Check record patterns. +pattern('record',Name|Fs, Pvs, Env, L, St) -> + check_record_pat(Name, Fs, Pvs, Env, L, St); +%% make-record has been deprecated but we sill accept it for now. +pattern('make-record',Name|Fs, Pvs, Env, L, St) -> + check_record_pat(Name, Fs, Pvs, Env, L, St); +pattern('record-index',Name,F, _Pvs, _Env, L, St) -> + check_record_field(Name, F, L, St); +%% Check struct patterns. +pattern('struct',Name|Fs, Pvs, Env, L, St) -> + check_struct_pat(Name, Fs, Pvs, Env, L, St); %% Check old no contructor list forms. -pattern(_|_=List, Pvs0, _, L, St0) -> - case is_posint_list(List) of - true -> {Pvs0,St0}; %A string +pattern(_|_=List, Pvs, _, L, St) -> + case lfe_lib:is_posint_list(List) of + true -> {Pvs,St}; %A string false -> %Illegal pattern - {Pvs0,illegal_pattern_error(L, List, St0)} + {Pvs,illegal_pattern_error(L, List, St)} end; pattern(, Pvs, _, _, St) -> {Pvs,St}; pattern(Symb, Pvs, _, L, St) when is_atom(Symb) -> @@ -1194,11 +1809,11 @@ pat_symb('_', Pvs, _, St) -> {Pvs,St}; %Don't care variable pat_symb(Symb, Pvs, _, St) -> - {add_element(Symb, Pvs),St}. %Add that to pattern vars + {ordsets:add_element(Symb, Pvs),St}. %Add that to pattern vars %% is_pat_alias(Pattern, Pattern) -> true | false. -%% Check if two aliases are compatible. Note that binaries can never -%% be aliased, this is from erlang. +%% Check if two pattern aliases are compatible. Note that binaries +%% can never be aliased, this is from erlang. is_pat_alias(?Q(P1), ?Q(P2)) -> P1 =:= P2; is_pat_alias(tuple|Ps1, tuple|Ps2) -> @@ -1239,17 +1854,18 @@ %% pat_binary(BitSegs, PatVars, Env, Line, State) -> {PatVars,State}. %% pat_bitsegs(BitSegs, BitVars, PatVars, Env, Line, State) -> -%% {BitVars,PatVars,State}. +%% {PatVars,State}. %% pat_bitseg(BitSeg, BitVars, PatVars, Env, Line, State) -> -%% {BitVars,PatVars,State}. +%% {BitVars,State}. %% pat_bitspecs(BitSpecs, BitVars, PatVars, Env, Line, State) -> State. %% pat_bit_size(Size, Type, BitVars, PatVars, Env, Line, State) -> State. %% pat_bit_expr(BitElement, BitVars, PatVars, Env, Line, State) -> -%% {BitVars,PatVars,State}. +%% {BitVars,State}. %% Functions for checking pattern bitsegments. This gets a bit -%% complex as we allow using values from left but only as sizes, no -%% implicit equality checks so multiple pattern variables are an -%% error. We only update BitVars during the match. +%% complex as we allow using values from left to right within the +%% binary pattern but only as sizes, no implicit equality checks so +%% multiple pattern variables are an error. We only update BitVars +%% during the match. pat_binary(Segs, Pvs, Env, L, St) -> pat_bitsegs(Segs, , Pvs, Env, L, St). @@ -1259,16 +1875,16 @@ check_foldl(fun (Seg, Bvs, St) -> pat_bitseg(Seg, Bvs, Pvs, Env, L, St) end, - fun (St) -> bad_pat_error(L, binary, St) end, + fun (St) -> bad_pattern_error(L, binary, St) end, Bvs0, St0, Segs), - {union(Bvs1, Pvs),St1}. %Add bitvars to patvars + {ordsets:union(Bvs1, Pvs),St1}. %Add bitvars to patvars pat_bitseg(Pat|Specs=Seg, Bvs, Pvs, Env, L, St0) -> - case is_posint_list(Seg) of %Is bitseg a string? + case lfe_lib:is_posint_list(Seg) of %Is bitseg a string? true -> {Bvs,St0}; %A string false -> %A pattern and spec St1 = pat_bitspecs(Specs, Bvs, Pvs, Env, L, St0), - case is_posint_list(Pat) of %Is Pat a string? + case lfe_lib:is_posint_list(Pat) of %Is Pat a string? true -> {Bvs,St1}; false -> pat_bit_expr(Pat, Bvs, Pvs, Env, L, St1) end @@ -1296,16 +1912,17 @@ pat_bit_size(N, _, _, _, _, _, St) when is_integer(N), N > 0 -> St; pat_bit_size(S, _, Bvs, _, Env, L, St) when is_atom(S) -> %% Size must be bound here or occur earlier in binary pattern. - case is_element(S, Bvs) or lfe_env:is_vbound(S, Env) of + %% case is_element(S, Bvs) or lfe_env:is_vbound(S, Env) of + case ordsets:is_element(S, Bvs) or le_hasv(S, Env) of true -> St; - false -> add_error(L, {unbound_symb,S}, St) + false -> add_error(L, {unbound_symbol,S}, St) end; pat_bit_size(_, _, _, _, _, L, St) -> illegal_bitsize_error(L, St). pat_bit_expr(N, Bvs, _, _, _, St) when is_number(N) -> {Bvs,St}; pat_bit_expr('_', Bvs, _, _, _, St) -> {Bvs,St}; pat_bit_expr(S, Bvs, _, _, _, St) when is_atom(S) -> - {add_element(S, Bvs),St}; + {ordsets:add_element(S, Bvs),St}; pat_bit_expr(_, Bvs, _, _, L, St) -> {Bvs,add_error(L, illegal_bitseg, St)}. @@ -1333,7 +1950,8 @@ end. is_pat_map_key(?Q(Lit)) -> is_literal(Lit); -is_pat_map_key(_|_=L) -> is_posint_list(L); %Literal strings only +is_pat_map_key(_|_=L) -> + lfe_lib:is_posint_list(L); %Literal strings only is_pat_map_key(E) when is_atom(E) -> false; is_pat_map_key(Lit) -> is_literal(Lit). -else. @@ -1341,6 +1959,52 @@ {Pvs,illegal_pattern_error(L, Ps, St)}. -endif. +%% check_record_pat(Name, Fields, PatVars, Env, Line State) -> {PatVars,State}. + +check_record_pat(Name, Fields, Pvs, Env, L, #lfe_lint{records=Recs}=St) + when is_atom(Name) -> + case orddict:find(Name, Recs) of + {ok,Rfields} -> + check_record_pat_fields(Name, Fields, Rfields, Pvs, Env, L, St); + error -> + {Pvs,undefined_record_error(L, Name, St)} + end; +check_record_pat(Name, _, Pvs, _, L, St) -> + {Pvs,bad_record_def_error(L, Name, St)}. + +check_record_pat_fields(Name, F,Pat|Fs, Rfs, Pvs0, Env, L, St0) -> + {Pvs1,St1} = case lists:member(F, Rfs) of + true -> + pattern(Pat, Pvs0, Env, L, St0); + false -> + {Pvs0,undefined_record_field_error(L, Name, F, St0)} + end, + check_record_pat_fields(Name, Fs, Rfs, Pvs1, Env, L, St1); +check_record_pat_fields(_Name, , _, Pvs, _, _, St) -> {Pvs,St}; +check_record_pat_fields(Name, _, _, Pvs, _, L, St) -> + {Pvs,bad_record_def_error(L, Name, St)}. + +%% check_struct_pat(Name, Fields, PatVars, Env, Line, State) -> {PatVars,State}. + +check_struct_pat(Name, Fields, Pvs, Env, L, St0) -> + case get_struct_fields(Name, L, St0) of + {ok,Sfields} -> + check_struct_pat_fields(Name, Fields, Sfields, Pvs, Env, L, St0); + {error,St1} -> {Pvs,St1} + end. + +check_struct_pat_fields(Name, F,Pat|Fs, Sfs, Pvs0, Env, L, St0) -> + {Pvs1,St1} = case lists:member(F, Sfs) of + true -> + pattern(Pat, Pvs0, Env, L, St0); + false -> + {Pvs0,undefined_struct_field_error(L, Name, F, St0)} + end, + check_struct_pat_fields(Name, Fs, Sfs, Pvs1, Env, L, St1); +check_struct_pat_fields(_Name, , _, Pvs, _, _, St) -> {Pvs,St}; +check_struct_pat_fields(Name, _Field, _, Pvs, _, L, St) -> + {Pvs,bad_struct_def_error(L, Name, St)}. + %% is_literal(Literal) -> true | false. %% literal(Literal, Env, Line, State) -> State. %% Check for legal literals. We have to be extra careful here as the @@ -1401,20 +2065,12 @@ %% proper top list. Could easily and clearly be done with a Lisp %% macro. -%% Versions which only check for proper top list. check_foreach(Check, Err, St0, F|Fs) -> St1 = Check(F, St0), check_foreach(Check, Err, St1, Fs); check_foreach(_, _, St, ) -> St; check_foreach(_, Err, St, _) -> Err(St). -%% check_map(Check, Err, St0, F|Fs) -> -%% {R,St1} = Check(F, St0), -%% {Rs,St2} = check_map(Check, Err, St1, Fs), -%% {R|Rs,St2}; -%% check_map(_, _, St, ) -> {,St}; -%% check_map(_, Err, St, _) -> {,Err(St)}. - check_foldl(Check, Err, Acc0, St0, F|Fs) -> {Acc1,St1} = Check(F, Acc0, St0), check_foldl(Check, Err, Acc1, St1, Fs); @@ -1427,33 +2083,60 @@ check_foldr(_, _, Acc, St, ) -> {Acc,St}; check_foldr(_, Err, Acc, St, _) -> {Acc,Err(St)}. +%% Versions which only check for proper top list. +%% check_foreach(Check, Err, St, Fs) -> +%% case lfe_lib:is_proper_list(Fs) of +%% true -> lists:foldl(Check, St, Fs); +%% false -> Err(St) +%% end. + +%% check_map(Check, Err, St, Fs) -> +%% case lfe_lib:is_proper_list(Fs) of +%% true -> lists:foldl(Check, St, Fs); +%% false -> {,Err(St)} +%% end. + +%% check_foldl(Check, Err, Acc, St, Fs) -> +%% case lfe_lib:is_proper_list(Fs) of +%% true -> +%% lists:foldl(fun (F, {A,S}) -> Check(F, A, S) end, {Acc,St}, F); +%% false -> {Acc,Err(St)} +%% end. + +%% check_foldr(Check, Err, Acc, St, Fs) -> +%% case lfe_lib:is_proper_list(Fs) of +%% true -> +%% lists:foldl(fun (F, {A,S}) -> Check(F, A, S) end, {Acc,St}, F); +%% false -> {Acc,Err(St)} +%% end. + %% Versions which completely wrap with a try. These may catch too much! %% check_foreach(Fun, Err, St, Fs) -> %% try -%% foldl(Fun, St, Fs) +%% foldl(Fun, St, Fs) %% catch -%% _:_ -> Err(St) +%% _:_ -> Err(St) %% end. %% check_map(Fun, Err, St, Fs) -> %% try -%% mapfoldl(Fun, St, Fs) +%% mapfoldl(Fun, St, Fs) %% catch -%% _:_ -> {,Err(St)} +%% _:_ -> {,Err(St)} %% end. %% check_foldl(Fun, Err, Acc, St, Fs) -> %% try -%% foldl(fun (F, {A,S}) -> Fun(F, A, S) end, {Acc,St}, Fs) +%% foldl(fun (F, {A,S}) -> Fun(F, A, S) end, {Acc,St}, Fs) %% catch -%% _:_ -> {Acc,Err(St)} +%% _:_ -> {Acc,Err(St)} %% end. %% check_foldr(Fun, Err, St, Acc, Fs) -> %% try -%% foldr(fun (F, {A,S}) -> Fun(F, A, S) end, {Acc,St}, Fs) +%% foldr(fun (F, {A,S}) -> Fun(F, A, S) end, {Acc,St}, Fs) %% catch -%% _:_ -> {Acc,Err(St)} +%% _:_ -> {Acc,Err(St)} %% end. %% safe_length(List) -> Length. @@ -1464,48 +2147,96 @@ safe_length(_|L, Acc) -> safe_length(L, Acc+1); safe_length(_, Acc) -> Acc. +%% safe_fetch(Key, Dict, Default) -> Value. +%% Fetch a value with a default if it doesn't exist. + +%% safe_fetch(Key, D, Def) -> +%% case orddict:find(Key, D) of +%% {ok,Val} -> Val; +%% error -> Def +%% end. + %% add_error(Line, Error, State) -> State. %% add_warning(Line, Warning, State) -> State. %% add_errors(Line, Errors, State) -> State. -add_error(L, E, #lint{errors=Errs}=St) -> - St#lint{errors=Errs ++ {L,?MODULE,E}}. +add_error(L, E, #lfe_lint{errors=Errs}=St) -> + St#lfe_lint{errors=Errs ++ {L,?MODULE,E}}. + +add_warning(L, W, #lfe_lint{warnings=Warns}=St) -> + St#lfe_lint{warnings=Warns ++ {L,?MODULE,W}}. + +%% add_errors(L, Es, #lfe_lint{errors=Errs}=St) -> +%% St#lfe_lint{errors=Errs ++ {L,?MODULE,E} || E <- Es }. -add_warning(L, W, #lint{warnings=Warns}=St) -> - St#lint{warnings=Warns ++ {L,?MODULE,W}}. +bad_attr_error(L, A, St) -> + add_error(L, {bad_attribute,A}, St). -add_errors(L, Es, #lint{errors=Errs}=St) -> - St#lint{errors=Errs ++ {L,?MODULE,E} || E <- Es }. +bad_meta_def_error(L, A, St) -> + add_error(L, {bad_meta_def,A}, St). bad_form_error(L, F, St) -> add_error(L, {bad_form,F}, St). -bad_gform_error(L, F, St) -> - add_error(L, {bad_gform,F}, St). +bad_guard_form_error(L, F, St) -> + add_error(L, {bad_guard_form,F}, St). +-ifdef(HAS_MAPS). illegal_mapkey_error(L, K, St) -> add_error(L, {illegal_mapkey,K}, St). +-endif. illegal_bitsize_error(L, St) -> add_error(L, illegal_bitsize, St). -bad_pat_error(L, F, St) -> - add_error(L, {bad_pat,F}, St). +bad_pattern_error(L, F, St) -> + add_error(L, {bad_pattern,F}, St). illegal_pattern_error(L, P, St) -> add_error(L, {illegal_pattern,P}, St). -bad_mdef_error(L, D, St) -> - add_error(L, {bad_mdef,D}, St). +bad_module_def_error(L, D, St) -> + add_error(L, {bad_module_def,D}, St). -bad_attr_error(L, A, St) -> - add_error(L, {bad_attribute,A}, St). +%% Record errors. + +bad_record_def_error(L, R, St) -> + add_error(L, {bad_record_def,R}, St). + +bad_record_name_error(L, R, St) -> + add_error(L, {bad_record_name,R}, St). -bad_meta_error(L, A, St) -> - add_error(L, {bad_meta,A}, St). +bad_record_field_error(L, R, F, St) -> + add_error(L, {bad_record_field,R,F}, St). -bad_record_error(L, R, St) -> - add_error(L, {bad_record,R}, St). +undefined_record_error(L, R, St) -> + add_error(L, {undefined_record,R}, St). + +undefined_record_field_error(L, R, F, St) -> + add_error(L, {undefined_record_field,R,F}, St). + +missing_record_field_value_error(L, R, F, St) -> + add_error(L, {missing_record_field_value,R,F}, St). + +%% Struct errors. + +bad_struct_def_error(L, St) -> + add_error(L, bad_struct_def, St). + +bad_struct_def_error(L, Name, St) -> + add_error(L, {bad_struct_def,Name}, St). + +bad_struct_field_error(L, F, St) -> + add_error(L, {bad_struct_field,F}, St). + +undefined_struct_error(L, Name, St) -> + add_error(L, {undefined_struct,Name}, St). + +undefined_struct_field_error(L, Name, F, St) -> + add_error(L, {undefined_struct_field,Name,F}, St). + +missing_struct_field_value_error(L, Name, F, St) -> + add_error(L, {missing_struct_field_value,Name,F}, St). bad_fdef_error(L, D, St) -> add_error(L, {bad_fdef,D}, St). @@ -1513,28 +2244,39 @@ multi_var_error(L, V, St) -> add_error(L, {multi_var,V}, St). -undefined_func_error(L, F, St) -> - add_error(L, {undefined_func,F}, St). +undefined_function_error(L, F, St) -> + add_error(L, {undefined_function,F}, St). illegal_guard_error(L, St) -> add_error(L, illegal_guard, St). -depr_warning(L, D, St) -> +bad_type_def_error(L, T, St) -> + add_error(L, {bad_type_def,T}, St). + +%% Deprecated errors. + +deprecated_error(L, D, St) -> + add_error(L, {deprecated,D}, St). + +deprecated_warning(L, D, St) -> add_warning(L, {deprecated,D}, St). -%% Interface to the binding functions in lfe_lib. -%% These just add arity as a dummy values as we are not interested in -%% value but it might be useful. +%% Accessing our local environment of functions and variables. We just +%% need to know their existence here here so we use ordsets. -add_fbinding(N, A, Env) -> lfe_env:add_fbinding(N, A, A, Env). +le_new() -> #{funs => ordsets:new(), vars => ordsets:new()}. -add_vbindings(Vs, Env) -> - foldl(fun (V, E) -> lfe_env:add_vbinding(V, dummy, E) end, Env, Vs). +le_addv(V, #{vars := Vars} = LE) -> + LE#{vars := ordsets:add_element(V, Vars)}. -%% safe_fetch(Key, Dict, Default) -> Value. +le_addvs(Vs, Env) -> + lists:foldl(fun (V, E) -> le_addv(V, E) end, Env, Vs). -safe_fetch(Key, D, Def) -> - case orddict:find(Key, D) of - {ok,Val} -> Val; - error -> Def - end. +le_hasv(V, #{vars := Vars}) -> + ordsets:is_element(V, Vars). + +le_addf(F, Ar, #{funs := Funs} = LE) -> + LE#{funs := ordsets:add_element({F,Ar}, Funs)}. + +le_hasf(F, Ar, #{funs := Funs}) -> + ordsets:is_element({F,Ar}, Funs).
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_macro.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_macro.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2021 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,18 +27,15 @@ -export(expand_expr/2,expand_expr_1/2,expand_expr_all/2). %% These work on list of forms in "file format". --export(expand_forms/4). -export(expand_form_init/2,expand_form_init/3, expand_form/4,expand_fileform/3). +-export(expand_fileforms/3,expand_fileforms/4). %% For creating the macro expansion state. -export(default_state/2,default_state/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). - %% -compile(export_all). -import(lfe_env, new/0,add_vbinding/3,is_vbound/2, @@ -48,24 +45,20 @@ -import(lists, any/2,all/2,map/2,foldl/3,foldr/3,mapfoldl/3, reverse/1,reverse/2,member/2,concat/1). +-include("lfe.hrl"). -include("lfe_comp.hrl"). -include("lfe_macro.hrl"). -%% 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 +%% Errors we get, generally in the predefined macros. format_error({bad_form,Type}) -> - lfe_io:format1("bad form: ~w", Type); + lfe_io:format1(<<"bad form: ~w">>, Type); format_error({bad_env_form,Type}) -> - lfe_io:format1("bad environment form: ~w", Type); + lfe_io:format1(<<"bad environment form: ~w">>, Type); format_error({expand_macro,Call,Error}) -> %% Can be very big so only print limited depth. - lfe_io:format1("error expanding ~P: ~P", Call,10,Error,10). + lfe_io:format1(<<"error expanding ~P:\n ~P">>, Call,10,Error,10); +format_error(Error) -> + lfe_io:format1(<<"macro expansion error: ~P\n">>, Error,10). %% expand_expr(Form, Env) -> {yes,Exp} | no. %% expand_expr_1(Form, Env) -> {yes,Exp} | no. @@ -104,21 +97,14 @@ {Ef,_} = exp_form(F, Env, default_state(true, false)), Ef. -%% expand_forms(FileForms, Env, Deep, Keep) -> -%% {ok,FileForms,Env,Warnings} | {error,Errors,Warnings}. -%% Collect macro definitions in file forms, completely expand all -%% macros and only keep all functions. +%% expand_form_init(Deep, Keep) -> State. +%% expand_form_init(CompInfo, Deep, Keep) -> State. -expand_forms(Fs, Env, Deep, Keep) -> - St = default_state(Deep, Keep), - do_forms(Fs, Env, St). +expand_form_init(Deep, Keep) -> + default_state(Deep, Keep). -do_forms(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. +expand_form_init(Ci, Deep, Keep) -> + default_state(Ci, Deep, Keep). default_state(Deep, Keep) -> #mac{deep=Deep,keep=Keep,line=1,file="-no-file-",opts=,ipath="."}. @@ -126,19 +112,11 @@ default_state(#cinfo{file=File,opts=Os,ipath=Is}, Deep, Keep) -> #mac{deep=Deep,keep=Keep,line=1,file=File,opts=Os,ipath=Is}. -%% expand_form_init(Deep, Keep) -> State. -%% expand_form_init(CompInfo, Deep, Keep) -> State. -%% expand_form(Form, Line, Env, State) -> {Form,Env,State}. -%% expand_fileform(Form, Env, State) -> {Form,Env,State}. +%% expand_form(Form, Line, Env, MacState) -> {Form,Env,MacState}. +%% expand_fileform(FileForm, Env, MacState) -> {FileForm,Env,MacState}. %% Collect macro definitions in a (file)form, completely expand all %% macros and only keep all functions. -expand_form_init(Deep, Keep) -> - default_state(Deep, Keep). - -expand_form_init(Ci, Deep, Keep) -> - default_state(Ci, Deep, Keep). - expand_form(F0, L, E0, St0) -> {F1,E1,St1} = pass_form(F0, E0, St0#mac{line=L}), return_status(F1, E1, St1). @@ -152,6 +130,27 @@ return_status(_, _, #mac{errors=Es,warnings=Ws}=St) -> {error,Es,Ws,St}. +%% expand_fileforms(FileForms, Env, MacState) -> +%% expand_fileforms(FileForms, Env, Deep, Keep) -> +%% {ok,FileForms,Env,Warnings} | {error,Errors,Warnings}. +%% Collect macro definitions in file forms, completely expand all +%% macros and only keep all functions. This is intended to process a +%% whole file so the end macro state is not returned. + +expand_fileforms(Fs, Env, St) -> + do_forms(Fs, Env, St). + +expand_fileforms(Fs, Env, Deep, Keep) -> + St = default_state(Deep, Keep), + do_forms(Fs, Env, St). + +do_forms(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. + %% pass_fileforms(FileForms, Env, State) -> {FileForms,Env,State}. %% pass_forms(Forms, Env, State) -> {Forms,Env,State}. %% Pass over a list of fileforms/forms collecting and removing all macro @@ -179,6 +178,18 @@ pass_form('eval-when-compile'|Efs0, Env0, St0) -> {Efs1,Env1,St1} = pass_ewc(Efs0, Env0, St0), {'eval-when-compile'|Efs1,Env1,St1}; +pass_form('include-file',File, Env, St0) -> + case lfe_macro_include:file(File, Env, St0) of + {yes,Exp,St1} -> pass_form(Exp, Env, St1); + {error,St1} -> + {'progn',Env,St1} + end; +pass_form('include-lib',Lib, Env, St0) -> + case lfe_macro_include:lib(Lib, Env, St0) of + {yes,Exp,St1} -> pass_form(Exp, Env, St1); + {error,St1} -> + {'progn',Env,St1} + end; pass_form('define-macro'|Def=M, Env0, St0) -> case pass_define_macro(Def, Env0, St0) of {yes,Env1,St1} -> @@ -359,18 +370,72 @@ exp_normal_core(binary, As, Env, St); exp_form(map|As, Env, St) -> exp_normal_core(map, As, Env, St); +exp_form(msiz|As, Env, St) -> + exp_normal_core(msiz, As, Env, St); exp_form(mref|As, Env, St) -> exp_normal_core(mref, As, Env, St); exp_form(mset|As, Env, St) -> exp_normal_core(mset, As, Env, St); exp_form(mupd|As, Env, St) -> exp_normal_core(mupd, As, Env, St); +exp_form(mrem|As, Env, St) -> + exp_normal_core(mrem, As, Env, St); +exp_form('map-size'|As, Env, St) -> + exp_normal_core('map-size', As, Env, St); exp_form('map-get'|As, Env, St) -> exp_normal_core('map-get', As, Env, St); exp_form('map-set'|As, Env, St) -> exp_normal_core('map-set', As, Env, St); exp_form('map-update'|As, Env, St) -> exp_normal_core('map-update', As, Env, St); +exp_form('map-remove'|As, Env, St) -> + exp_normal_core('map-remove', As, Env, St); +%% Record special forms. Note that these are used for both the +%% compiler as well as the evaluator so we can't do too much here. +exp_form('define-record',Name,Fds, Env, St0) -> + {Efds,St1} = exp_rec_fields(Name, Fds, Env, St0), + {'define-record',Name,Efds,St1}; +exp_form('record',Name|Args, Env, St0) -> + {Eas,St1} = exp_tail(Args, Env, St0), + {'record',Name|Eas,St1}; +%% make-record has been deprecated but we sill accept it for now. +exp_form('make-record',Name|Args, Env, St0) -> + {Eas,St1} = exp_tail(Args, Env, St0), + {'make-record',Name|Eas,St1}; +exp_form('is-record',E,Name, Env, St0) -> + {Ee,St1} = exp_form(E, Env, St0), + {'is-record',Ee,Name,St1}; +exp_form('record-index',Name,F, _, St) -> + {'record-index',Name,F,St}; +exp_form('record-field',E,Name,F, Env, St0) -> + {Ee,St1} = exp_form(E, Env, St0), + {'record-field',Ee,Name,F,St1}; +exp_form('record-update',E,Name|Args, Env, St0) -> + {Ee,St1} = exp_form(E, Env, St0), + {Eas,St2} = exp_tail(Args, Env, St1), + {'record-update',Ee,Name|Eas,St2}; +%% Struct special forms. Note that these are used for both the +%% compiler as well as the evaluator so we can't do too much here. +exp_form('define-struct',Fds, Env, St0) -> + {Efds,St1} = exp_struct_fields(Fds, Env, St0), + {'define-struct',Efds,St1}; +exp_form('struct',Name|Args, Env, St0) -> + {Eas,St1} = exp_tail(Args, Env, St0), + {'struct',Name|Eas,St1}; +exp_form('is-struct',E, Env, St0) -> + {Ee,St1} = exp_form(E, Env, St0), + {'is-struct',Ee,St1}; +exp_form('is-struct',E,Name, Env, St0) -> + {Ee,St1} = exp_form(E, Env, St0), + {'is-struct',Ee,Name,St1}; +exp_form('struct-field',E,Name,F, Env, St0) -> + {Ee,St1} = exp_form(E, Env, St0), + {'struct-field',Ee,Name,F,St1}; +exp_form('struct-update',E,Name|Args, Env, St0) -> + {Ee,St1} = exp_form(E, Env, St0), + {Eas,St2} = exp_tail(Args, Env, St1), + {'struct-update',Ee,Name|Eas,St2}; +%% Function forms. exp_form(function|_=F, _, St) -> {F,St}; %% Core closure special forms. exp_form(lambda,Head|B, Env, St) -> @@ -407,16 +472,31 @@ exp_normal_core(funcall, As, Env, St); exp_form(call|As, Env, St) -> exp_normal_core(call, As, Env, St); +%% List/binary comprehensions. +exp_form(lc,Qs,Exp, Env, St0) -> + exp_list_comp('lc', Qs, Exp, Env, St0); +exp_form('list-comp',Qs,Exp, Env, St) -> + exp_list_comp('list-comp', Qs, Exp, Env, St); +exp_form(bc,Qs,Exp, Env, St) -> + exp_binary_comp('bc', Qs, Exp, Env, St); +exp_form('binary-comp',Qs,Exp, Env, St) -> + exp_binary_comp('binary-comp', Qs, Exp, Env, St); %% Core definition special forms. exp_form('eval-when-compile'|B, Env, St) -> exp_normal_core('eval-when-compile', B, Env, St); -exp_form('define-function',Head|B, Env, St) -> - exp_head_tail('define-function', Head, B, Env, St); +exp_form('define-function',Name,Meta,Def, Env, St) -> + exp_define_function(Name, Meta, Def, Env, St); exp_form('define-macro',Head|B, Env, St) -> exp_head_tail('define-macro', Head, B, Env, St); -%% These don't expand at all as name clashes are allowed. +%% Only worry about the module forms off the right size to expand and +%% don't touch the rest. +exp_form('define-module',Mod,Metas,Attrs, Env, St) -> + exp_define_module(Mod, Metas, Attrs, Env, St); +exp_form('extend-module',Metas,Attrs, Env, St) -> + exp_extend_module(Metas, Attrs, Env, St); exp_form('define-module',_Mod|_=Form, _, St) -> {Form,St}; exp_form('extend-module'|_=Form, _, St) -> {Form,St}; +%% These aren't expanded at all and just passed on as is. exp_form('define-type',_Type|_=Form, _, St) -> {Form,St}; exp_form('define-opaque-type',_Type|_=Form, _, St) -> {Form,St}; exp_form('define-function-spec',_Func|_=Form, _, St) -> {Form,St}; @@ -465,6 +545,28 @@ exp_tail(_, , _, St) -> {,St}; exp_tail(Fun, E, Env, St) -> Fun(E, Env, St). %Same on improper tail. +%% exp_rec_fields(Name, Fields, Env, State) -> {ExpArgs,State}. +%% Expand the field definitions for the record. + +exp_rec_fields(_, Fields, Env, St) -> + lists:mapfoldl(fun (F, S) -> exp_rec_field(F, Env, S) end, St, Fields). + +exp_rec_field(_|_=Fdef, Env, St) -> + exp_list(Fdef, Env, St); +exp_rec_field(Fdef, Env, St) -> + exp_form(Fdef, Env, St). + +%% exp_struct_fields(Fields, Env, State) -> {ExpArgs,State}. +%% Expand the field definitions for the struct. + +exp_struct_fields(Fields, Env, St) -> + lists:mapfoldl(fun (F, S) -> exp_struct_field(F, Env, S) end, St, Fields). + +exp_struct_field(_|_=Fdef, Env, St) -> + exp_list(Fdef, Env, St); +exp_struct_field(Fdef, Env, St) -> + exp_form(Fdef, Env, St). + %% exp_clauses(Clauses, Env, State) -> {ExpCls,State}. %% exp_ml_clauses(Clauses, Env, State) -> {ExpCls,State}. %% Expand macros in clause patterns, guards and body. Must handle @@ -553,6 +655,9 @@ {B1,St1} = exp_tail(B0, Env1, St0), %Expand the body {'progn'|B1,St1}. +%% exp_try(Expression, Body, Env, State) -> {Expansion,State}. +%% Expand a try. + exp_try(E0, B0, Env, St0) -> {E1,St1} = exp_form(E0, Env, St0), {B1,St2} = exp_tail(fun ('case'|Cls0, E, Sta) -> @@ -568,6 +673,79 @@ end, B0, Env, St1), {'try',E1|B1,St2}. +%% exp_list_comp(Comp, Qualifiers, Expr, Env, State) -> {Qualifiers,Exp,State}. +%% exp_binary_comp(Comp, Qualifiers, BitStringExpr, Env, State) -> +%% {Qualifiers,BitStringExpr,State}. +%% Don't do much yet. + +exp_list_comp(Comp, Qs0, Expr0, Env, St0) -> + {Expr1,St1} = exp_form(Expr0, Env, St0), + %% io:format("lml ~p\n ~p\n", Expr0,Expr1), + {Qs1,St2} = exp_comp_quals(Qs0, Env, St1), + {Comp,Qs1,Expr1,St2}. + +exp_binary_comp(Comp, Qs0, BitExpr0, Env, St0) -> + {BitExpr1,St1} = exp_form(BitExpr0, Env, St0), + %% io:format("lmb ~p\n ~p\n", BitExpr0,BitExpr1), + {Qs1,St2} = exp_comp_quals(Qs0, Env, St1), + {Comp,Qs1,BitExpr1,St2}. + +%% exp_comp_quals(Qualifiers, Env, State) -> {Qualifiers,State}. +%% We accept improper qualifier list here as the tail might expand +%% into a proper list. We will let the linter catch any errors. + +exp_comp_quals('<-',Pat0,Exp0|Qs0, Env, St0) -> + {Pat1,St1} = exp_form(Pat0, Env, St0), + {Exp1,St2} = exp_form(Exp0, Env, St1), + {Qs1,St3} = exp_comp_quals(Qs0, Env, St2), + {'<-',Pat1,Exp1|Qs1,St3}; +exp_comp_quals('<-',Pat0,'when'|G0,Exp0|Qs0, Env, St0) -> + {Pat1,St1} = exp_form(Pat0, Env, St0), + {G1,St2} = exp_tail(G0, Env, St1), + {Exp1,St3} = exp_form(Exp0, Env, St2), + {Qs1,St4} = exp_comp_quals(Qs0, Env, St3), + {'<-',Pat1,'when'|G1,Exp1|Qs1,St4}; +exp_comp_quals('<=',Pat0,Exp0|Qs0, Env, St0) -> + {Pat1,St1} = exp_form(Pat0, Env, St0), + {Exp1,St2} = exp_form(Exp0, Env, St1), + {Qs1,St3} = exp_comp_quals(Qs0, Env, St2), + {'<=',Pat1,Exp1|Qs1,St3}; +exp_comp_quals('<=',Pat0,'when'|G0,Exp0|Qs0, Env, St0) -> + {Pat1,St1} = exp_form(Pat0, Env, St0), + {G1,St2} = exp_tail(G0, Env, St1), + {Exp1,St3} = exp_form(Exp0, Env, St2), + {Qs1,St4} = exp_comp_quals(Qs0, Env, St3), + {'<=',Pat1,'when'|G1,Exp1|Qs1,St4}; +exp_comp_quals(Test0|Qs0, Env, St0) -> + {Test1,St1} = exp_form(Test0, Env, St0), + {Qs1,St2} = exp_comp_quals(Qs0, Env, St1), + {Test1|Qs1,St2}; +exp_comp_quals(Other0, Env, St0) -> + %% This also catches . + {Other1,St1} = exp_form(Other0, Env, St0), + {Other1,St1}. + +%% exp_define_function(Name, Metq, Def, Env, State) -> {Expansion,State}. +%% Expand a function definition adding the function local macros: +%% (defmacro FUNCTION_NAME () `'name) +%% (defmacro FUNCTION_ARITY () arity) + +exp_define_function(Name, Meta0, Def0, Env0, St0) -> + %% Just get an arity, a bad def will crash later anyway. + Arity = case function_arity(Def0) of + {yes,A} -> A; + no -> 0 + end, + {Meta1,St1} = exp_form(Meta0, Env0, St0), + Fun = fun (Mname|Rest, E) -> + {_,Mdef} = exp_defmacro(Rest), + add_mbinding(Mname, Mdef, E) + end, + Env1 = foldl(Fun, Env0, 'FUNCTION_NAME',,?BQ(?Q(Name)), + 'FUNCTION_ARITY',,Arity), + {Def1,St2} = exp_form(Def0, Env1, St1), + {'define-function',Name,Meta1,Def1,St2}. + %% exp_macro(Call, Env, State) -> {yes,Exp,State} | no. %% Expand the macro in top call, but not if it is a core form. @@ -599,14 +777,10 @@ {yes,Exp,St1} catch %% error:no_Error -> boom - %% error:Error -> - %% Stack = erlang:get_stacktrace(), - %% erlang:error({expand_macro,Mac|Args,{Error,Stack}}) - error:Error -> - Stack = erlang:get_stacktrace(), + ?CATCH(error, Error, Stack) + %% io:format("Userdef stack ~p\n", Stack), erlang:raise(error, {expand_macro,Mac|Args,Error}, Stack) - %% error:Error -> - %% Stack0 = erlang:get_stacktrace(), + %% ?CATCH(error, Error, Stack0) %% Stack1 = trim_stacktrace(Stack0), %% erlang:error({expand_macro,Mac|Args,{Error,Stack1}}) end. @@ -619,18 +793,46 @@ try exp_predef(Call, Env, St) catch - %% error:Error -> - %% Stack = erlang:get_stacktrace(), - %% erlang:raise({expand_macro,Call,{Error,Stack}}) - error:Error -> - Stack = erlang:get_stacktrace(), + ?CATCH(error, Error, Stack) + %% io:format("Predef stack ~p\n", Stack), erlang:raise(error, {expand_macro,Call,Error}, Stack) - %% error:Error -> - %% Stack0 = erlang:get_stacktrace(), + %% ?CATCH(error, Error, Stack0) %% Stack1 = trim_stacktrace(Stack0), %% erlang:error({expand_macro,Call,{Error,Stack1}}) end. +%% exp_define_module(Name, Metas, Attrs, Env, State) -> {Expansion,State}. +%% exp_extend_module(Rest, Env, State) -> {Expansion,State}. +%% As record definitions are allowed inmodule definitions in the meta +%% data and the defualt values contain code these must be +%% macroexpanded. We try and be lenient and pass syntactic errors on +%% to the linter. + +exp_define_module(Name, Metas, Attrs, Env, St0) -> + Fun = fun (Meta, S) -> exp_module_meta(Meta, Env, S) end, + {Emetas,St1} = lists:mapfoldl(Fun, St0, Metas), + {'define-module',Name,Emetas,Attrs,St1}. + +exp_extend_module(Metas, Attrs, Env, St0) -> + Fun = fun (Meta, S) -> exp_module_meta(Meta, Env, S) end, + {Emetas,St1} = lists:mapfoldl(Fun, St0, Metas), + {'extend-module',Emetas,Attrs,St1}. + +exp_module_meta(record|Recs, Env, St0) -> + {Erecs,St1} = lists:mapfoldl(fun (R, S) -> exp_module_rec(R, Env, S) end, + St0, Recs), + {record|Erecs,St1}; +exp_module_meta(struct|Fds, Env, St0) -> + {Efds,St1} = exp_struct_fields(Fds, Env, St0), + {struct|Efds,St1}; +exp_module_meta(Meta, _Env, St) -> + {Meta,St}. + +exp_module_rec(Name,Fds, Env, St0) -> + {Efds,St1} = exp_rec_fields(Name, Fds, Env, St0), + {Name,Efds,St1}; +exp_module_rec(Other, _Env, St) -> {Other,St}. + %% trim_stacktrace({lfe_macro,_,_,_}=S|_) -> S; %R15 and later %% trim_stacktrace({lfe_macro,_,_}|_=S) -> S; %Pre R15 %% trim_stacktrace(S|Stk) -> S|trim_stacktrace(Stk); @@ -675,36 +877,19 @@ exp_predef(cddddr,E, _, St) -> {yes,cdr,cdr,cdr,cdr,E,St}; %% Arithmetic operations and comparison operations. -%% Be careful to make these behave as if they were a function and -%% strictly evalated all their arguments. -exp_predef('+'|Es, _, St0) -> - case Es of - -> {yes,0,St0}; %Identity - _ -> - {Exp,St1} = exp_arith(Es, '+', St0), - {yes,Exp,St1} - end; -exp_predef('-'|Es, _, St0) -> - case Es of - _|_ -> %Non-empty argument list - {Exp,St1} = exp_arith(Es, '-', St0), - {yes,Exp,St1} - end; -exp_predef('*'|Es, _, St0) -> - case Es of - -> {yes,1,St0}; %Identity - _ -> {yes,exp_bif('*', 1|Es),St0}; %Check if number - _ -> - {Exp,St1} = exp_arith(Es, '*', St0), - {yes,Exp,St1} - end; -exp_predef('/'|Es, _, St0) -> - case Es of - _ -> {yes,exp_bif('/', 1|Es),St0}; %According to definition - _ -> - {Exp,St1} = exp_arith(Es, '/', St0), - {yes,Exp,St1} - end; +%% Don't allow having no arguments and check type with one argument. +exp_predef('+'|Es, _, St) -> + Exp = exp_arith(Es, '+', 0), + {yes,Exp,St}; +exp_predef('-'|Es, _, St) -> + Exp = exp_arith(Es, '-', 0), + {yes,Exp,St}; +exp_predef('*'|Es, _, St) -> + Exp = exp_arith(Es, '*', 1), + {yes,Exp,St}; +exp_predef('/'|Es, _, St) -> + Exp = exp_arith(Es, '/', 1), + {yes,Exp,St}; %% Logical operators. exp_predef(Op|Es, _, St0) when Op =:= 'and'; Op =:= 'or'; Op =:= 'xor' -> @@ -727,14 +912,14 @@ end; exp_predef(backquote,Bq, _, St) -> %We do this here. {yes,exp_backquote(Bq),St}; -exp_predef('++'|Abody, _, St) -> +exp_predef('++'|Abody, _, St) -> %List append Exp = exp_append(Abody), {yes,Exp,St}; -exp_predef('++*'|Abody, _, St) -> - Exp = exp_prefix(Abody), +exp_predef('--'|Args, _, St) -> %List subtract + Exp = exp_right_assoc(Args, '--'), {yes,Exp,St}; exp_predef('?'|As, _, St) -> - Omega = omega,omega, + Omega = omega,omega, %Match anything and return it Exp = case As of To,Def -> 'receive',Omega,'after',To,Def; To -> 'receive',Omega,'after',To,exit,?Q(timeout); @@ -756,32 +941,12 @@ exp_predef('do'|Dbody, _, St0) -> {Exp,St1} = exp_do(Dbody, St0), {yes,Exp,St1}; -exp_predef(lc|Lbody, _, St0) -> - %% (lc (qual ...) e ...) - Qs|Es = Lbody, - {Exp,St1} = lc_te(Es, Qs, St0), - {yes,Exp,St1}; -%% Add an alias for lc. -exp_predef('list-comp'|Lbody, _, St0) -> - Qs|Es = Lbody, - {Exp,St1} = lc_te(Es, Qs, St0), - {yes,Exp,St1}; -exp_predef(bc|Bbody, _, St0) -> - %% (bc (qual ...) e ...) - Qs|Es = Bbody, - {Exp,St1} = bc_te(Es, Qs, St0), - {yes,Exp,St1}; -%% Add an alias for bc. -exp_predef('binary-comp'|Bbody, _, St0) -> - Qs|Es = Bbody, - {Exp,St1} = bc_te(Es, Qs, St0), - {yes,Exp,St1}; -exp_predef('andalso'|Abody, _, St) -> - Exp = exp_andalso(Abody), - {yes,Exp,St}; -exp_predef('orelse'|Obody, _, St) -> - Exp = exp_orelse(Obody), - {yes,Exp,St}; +%% exp_predef('andalso'|Abody, _, St) -> +%% Exp = exp_andalso(Abody), +%% {yes,Exp,St}; +%% exp_predef('orelse'|Obody, _, St) -> +%% Exp = exp_orelse(Obody), +%% {yes,Exp,St}; %% The fun forms assume M, F and Ar are atoms and integer. We leave %% them as before for backwards compatibility. exp_predef('fun',F,Ar, _, St0) -> @@ -792,45 +957,14 @@ {yes,'lambda',Vs,'call',?Q(M),?Q(F)|Vs,St1}; exp_predef('defrecord'|Def, Env, St) -> lfe_macro_record:define(Def, Env, St); -%% Include-XXX as macros for now. Move to top-level forms? -exp_predef('include-file'|Ibody, Env, St) -> - lfe_macro_include:file(Ibody, Env, St); -exp_predef('include-lib'|Ibody, Env, St) -> - lfe_macro_include:lib(Ibody, Env, St); -%% Compatibility macros for the older Scheme like syntax. -exp_predef('begin'|Body, _, St) -> - {yes,'progn'|Body,St}; -exp_predef('define',Head|Body, _, St) -> - %% Let the lint catch errors here. - Exp = case lfe_lib:is_symb_list(Head) of - true -> - 'define-function',hd(Head),,lambda,tl(Head)|Body; - false -> - 'define-function',Head,,Body - end, - {yes,Exp,St}; -exp_predef('define-record'|Def, _, St) -> - {yes,defrecord|Def,St}; -exp_predef('define-syntax',Name,Def, _, St) -> - {Meta,Mdef} = exp_syntax(Name, Def), - {yes,'define-macro',Name,Meta,Mdef,St}; -exp_predef('let-syntax',Defs|Body, _, St) -> - Fun = fun (Name,Def) -> - {_,Def} = exp_syntax(Name, Def), - Name,Def - end, - Mdefs = map(Fun, Defs), - {yes,'let-macro',Mdefs|Body,St}; +exp_predef('defstruct'|Def, Env, St) -> + lfe_macro_struct:define(Def, Env, St); %% Common Lisp inspired macros. exp_predef(defmodule,Name|Rest, _, St) -> - %% Need to handle parametrised module defs here. Limited checking. - Mname = case Name of - Mod|_ -> Mod; %Parametrised module - Mod -> Mod %Normal module - end, - MODULE = defmacro,'MODULE',,?BQ(?Q(Mname)), + %% Define the MODULE macro. + MODULE = defmacro,'MODULE',,?BQ(?Q(Name)), {Meta,Atts} = exp_defmodule(Rest), - {yes,progn,'define-module',Name,Meta,Atts,MODULE,St#mac{module=Mname}}; + {yes,progn,'define-module',Name,Meta,Atts,MODULE,St#mac{module=Name}}; exp_predef(deftype,Type0|Def0, _, St) -> {Type1,Def1} = exp_deftype(Type0, Def0), {yes,'define-type',Type1,Def1,St}; @@ -850,9 +984,6 @@ %% or matching (defmacro name (patlist1 ...) (patlist2 ...)) {Meta,Def} = exp_defmacro(Rest), {yes,'define-macro',Name,Meta,Def,St}; -exp_predef(defsyntax,Name|Rules, _, St) -> - {Meta,Def} = exp_rules(Name, , Rules), - {yes,'define-macro',Name,Meta,Def,St}; exp_predef(flet,Defs|Body, _, St) -> Fun = fun (Name|Rest) -> {_,Def} = exp_defun(Rest), %Ignore meta data @@ -874,13 +1005,6 @@ end, Mdefs = map(Fun, Defs), {yes,'let-macro',Mdefs|Body,St}; -exp_predef(syntaxlet,Defs|Body, _, St) -> - Fun = fun (Name|Rest) -> - {_,Def} = exp_rules(Name, , Rest), - Name,Def - end, - Mdefs = map(Fun, Defs), - {yes,'let-macro',Mdefs|Body,St}; exp_predef(prog1|Body, _, St0) -> %% We do a simple optimisation here. case Body of %Catch bad form here @@ -892,13 +1016,22 @@ exp_predef(prog2|Body, _, St) -> First|Rest = Body, %Catch bad form here {yes,progn,First,prog1|Rest,St}; -%% This has to go here for the time being so as to be able to macro -%% expand body. -exp_predef('match-spec'|Body, Env, St0) -> - %% Expand it like a match-lambda. +%% Handle match specifications both ets and tracing (dbg). +%% This has to go here so as to be able to macro expand body. +exp_predef('match-spec'|Cls, Env, St) -> %The old interface. + exp_predef('ets-ms'|Cls, Env, St); +exp_predef('table-ms'|Body, Env, St0) -> + {Exp,St1} = exp_ml_clauses(Body, Env, St0), + MS = lfe_ms:expand(table, Exp), + {yes,MS,St1}; +exp_predef('trace-ms'|Body, Env, St0) -> {Exp,St1} = exp_ml_clauses(Body, Env, St0), - MS = lfe_ms:expand(Exp), + MS = lfe_ms:expand(trace, Exp), {yes,MS,St1}; +exp_predef('ets-ms'|Body, Env, St) -> + exp_predef('table-ms'|Body, Env, St); +exp_predef('dbg-ms'|Body, Env, St) -> %Just a synonym + exp_predef('trace-ms'|Body, Env, St); %% (qlc (lc (qual ...) e ...) opts) exp_predef(qlc,LC, Env, St) -> exp_qlc(LC, , Env, St); exp_predef(qlc,LC,Opts, Env, St) -> exp_qlc(LC, Opts, Env, St); @@ -974,13 +1107,13 @@ %% Now translate to vanilla AST, call qlc expand and then convert %% back to LFE. lfe_qlc:expand/2 wants a list of conversions not %% a conversion of a list. - Vlc = lfe_trans:to_expr(lc,Eqs|Ees, 42), + Vlc = lfe_translate:to_expr(lc,Eqs|Ees, 42), %% lfe_io:format("~w\n", Vlc), - Vos = map(fun (O) -> lfe_trans:to_expr(O, 42) end, Opts), + Vos = map(fun (O) -> lfe_translate:to_expr(O, 42) end, Opts), %% io:put_chars("E0 = ",erl_pp:expr(Vlc, 5, ),"\n"), {ok,Vexp} = lfe_qlc:expand(Vlc, Vos), %% io:put_chars(erl_pp:expr(Vexp),"\n"), - Exp = lfe_trans:from_expr(Vexp), + Exp = lfe_translate:from_expr(Vexp), %% lfe_io:format("Q1 = ~p\n", Exp), {yes,Exp,St2}. @@ -1009,29 +1142,24 @@ exp_args(As, St) -> mapfoldl(fun (A, St0) -> {V,St1} = new_symb(St0), {V,A,St1} end, St, As). -%% exp_arith(Args, Op, State) -> {Exp,State}. -%% Expand arithmetic call strictly forcing evaluation of all -%% arguments. Note that single argument version may need special -%% casing. +%% exp_arith(Args, Op, Identity) -> {Exp,State}. +%% Expand arithmetic operation using Identity to type check single +%% argument. -exp_arith(A, Op, St) -> {exp_bif(Op, A),St}; -exp_arith(A,B, Op, St) -> {exp_bif(Op, A,B),St}; -exp_arith(As, Op, St0) -> - {Ls,St1} = exp_args(As, St0), - B = foldl(fun (V,_, Acc) -> exp_bif(Op, Acc,V) end, hd(hd(Ls)), tl(Ls)), - {exp_let_star(Ls,B),St1}. +exp_arith(A, Op, Id) -> %Test type + exp_left_assoc(Id,A, Op); +exp_arith(As, Op, _Id) -> exp_left_assoc(As, Op). + +%% {foldl(fun (A, Acc) -> exp_bif(Op, Acc,A) end, hd(As), tl(As)),St}. %% exp_logical(Args, Op State) -> {Exp,State}. -%% Expand logical call forcing evaluation of all arguments but not -%% strictly; this guarantees expansion is hygenic. Note that single -%% argument version may need special casing. +%% Expand logical call strictly forcing evaluation of all arguments. +%% Note that single argument version may need special casing. exp_logical(A, Op, St) -> {exp_bif(Op, A,?Q(true)),St}; exp_logical(A,B, Op, St) -> {exp_bif(Op, A,B),St}; -exp_logical(As, Op, St0) -> - {Ls,St1} = exp_args(As, St0), - B = foldl(fun (V,_, Acc) -> exp_bif(Op, Acc,V) end, hd(hd(Ls)), tl(Ls)), - {'let',Ls,B,St1}. +exp_logical(As, Op, St) -> + {foldl(fun (A, Acc) -> exp_bif(Op, Acc,A) end, hd(As), tl(As)),St}. %% exp_comp(Args, Op, State) -> {Exp,State}. %% Expand comparison test strictly forcing evaluation of all @@ -1041,14 +1169,8 @@ exp_comp(A, _, St) -> %Force evaluation {progn,A,?Q(true),St}; exp_comp(A,B, Op, St) -> {exp_bif(Op, A,B),St}; -exp_comp(As, Op, St0) -> - {Ls,St1} = exp_args(As, St0), - Ts = op_pairs(Ls, Op), - {exp_let_star(Ls,exp_andalso(Ts)),St1}. - -op_pairs(V0,_|Ls, Op) -> - element(1, mapfoldl(fun (V1,_, Acc) -> {exp_bif(Op, Acc,V1),V1} end, - V0, Ls)). +exp_comp(As, Op, St) -> + {foldl(fun (A, Acc) -> exp_bif(Op, Acc,A) end, hd(As), tl(As)),St}. %% exp_nequal(Args, Op, State) -> {Exp,State}. %% Expand not equal test strictly forcing evaluation of all @@ -1066,44 +1188,48 @@ op_all_pairs(V,_|Ls, Op) -> exp_bif(Op, V,V1) || V1,_ <- Ls ++ op_all_pairs(Ls, Op). +%% exp_left_assoc(List, Op) -> Expansion. +%% Expand the left associated operator into sequence of calls. + +exp_left_assoc(E1,E2|Es, Op) -> + exp_left_assoc(exp_bif(Op, E1,E2)|Es, Op); +exp_left_assoc(E, _Op) -> E. + +%% exp_right_assoc(List, Op) -> Expansion. +%% Expand the right associated operator into sequence of calls. + +exp_right_assoc(E, _Op) -> E; +exp_right_assoc(E|Es, Op) -> + exp_bif(Op, E,exp_right_assoc(Es, Op)). + %% exp_append(Args) -> Expansion. %% Expand ++ in such a way as to allow its use in patterns. There are %% a lot of interesting cases here. Only be smart with proper forms. exp_append(Args) -> + ConsList = fun (E, Cs) -> cons,E,Cs end, case Args of %% Cases with quoted lists. - ?Q(A|As)|Es -> cons,?Q(A),exp_append(?Q(As)|Es); - ?Q()|Es -> exp_append(Es); + ?Q(A|Qas)|As -> cons,?Q(A),exp_append(?Q(Qas)|As); + ?Q()|As -> exp_append(As); %% Cases with explicit cons/list/list*. - 'list*',A|Es -> exp_append(A|Es); - 'list*',A|As|Es -> cons,A,exp_append('list*'|As|Es); - list,A|As|Es -> cons,A,exp_append(list|As|Es); - list|Es -> exp_append(Es); - cons,H,T|Es -> cons,H,exp_append(T|Es); - |Es -> exp_append(Es); - %% Cases with lists of numbers (strings). - %% N|Ns|Es when is_number(N) -> cons,N,exp_append(Ns|Es); - %% Default cases with unquoted arg. - E -> E; %Last arg not checked - E|Es -> exp_bif('++', E,exp_append(Es)); + 'list*',A|As -> exp_append(A|As); + 'list*',A|Las|As -> cons,A,exp_append('list*'|Las|As); + list|Las|As -> lists:foldr(ConsList, exp_append(As), Las); + cons,H,T|As -> cons,H,exp_append(T|As); + |As -> exp_append(As); + A|As -> + case lfe_lib:is_posint_list(A) of + true -> + lists:foldr(ConsList, exp_append(As), A); + false -> + if As =:= -> A; + true -> exp_bif('++', A,exp_append(As)) + end + end; -> end. -%% exp_prefix(Args) -> Expansion. -%% Expand ++* in such a way as to allow its use in patterns. -%% Handle lists of numbers (strings) explicitly, otherwise -%% default to exp_append/1. - -exp_prefix('list*',A|Es) -> exp_prefix(A|Es); -exp_prefix('list*',A|As|Es) -> cons,A,exp_prefix('list*'|As|Es); -exp_prefix(list,A|As|Es) -> cons,A,exp_prefix(list|As|Es); -exp_prefix(list|Es) -> exp_prefix(Es); -exp_prefix(cons,H,T|Es) -> cons,H,exp_prefix(T|Es); -exp_prefix(N|Ns|Es) when is_number(N) -> cons,N,exp_prefix(Ns|Es); -exp_prefix(|Es) -> exp_prefix(Es); -exp_prefix(Args) -> exp_append(Args). - %% exp_list_star(ListBody) -> Cons. exp_list_star(E) -> E; @@ -1151,10 +1277,10 @@ Exp = 'letrec-function', Fun,lambda,Vs, 'if',Test,Ret, - 'let','do-state', - 'progn' ++ Body, - Fun|Cs, - Fun|Is, + 'let','do-state', + 'progn' ++ Body, + Fun|Cs, + Fun|Is, {Exp,St1}. %% exp_andalso(AndAlsoBody) -> Ifs. @@ -1165,17 +1291,30 @@ 'if',E,exp_andalso(Es),?Q(false); exp_andalso() -> ?Q(true). -exp_orelse(E) -> E; %Let user check last call -exp_orelse(E|Es) -> 'if',E,?Q(true),exp_orelse(Es); -exp_orelse() -> ?Q(false). +%% exp_orelse(E) -> E; %Let user check last call +%% exp_orelse(E|Es) -> 'if',E,?Q(true),exp_orelse(Es); +%% exp_orelse() -> ?Q(false). %% exp_defmodule(Rest) -> {Meta,Attributes}. -%% Extract the comment string either if it is first. Ignore 'doc' -%% attributes. Allow empty module definition. +%% Extract the comment string if it is first, then split the rest +%% into meta data or attributes deepending on the tag. The order is +%% preserved in both cases. + +exp_defmodule(Doc|Rest) -> + {Meta,Attr} = ?IF(lfe_lib:is_doc_string(Doc), {doc,Doc,}, {,Doc}), + Fun = fun (Tag|_=R, {Me,As}) -> + case is_meta_tag(Tag) of + true -> {Me ++ R,As}; + false -> {Me,As ++ R} + end + end, + lists:foldl(Fun, {Meta,Attr}, Rest); +exp_defmodule() -> {,}. -exp_defmodule() -> {,}; -exp_defmodule(Doc|Atts=Rest) -> - ?IF(lfe_lib:is_doc_string(Doc), {doc,Doc,Atts}, {,Rest}). +is_meta_tag(doc) -> true; +is_meta_tag(spec) -> true; +is_meta_tag(record) -> true; +is_meta_tag(Tag) -> lfe_types:is_type_decl(Tag). %% exp_deftype(Type, Def) -> {Type,Def}. %% Paramterless types to be written as just type name and default @@ -1260,30 +1399,6 @@ {Meta,Cls} = exp_meta(Rest, ), {Meta,map(fun (Head|Body) -> Head,'$ENV'|Body end, Cls)}. -%% exp_syntax(Name, Def) -> {Meta,Lambda | MatchLambda}. -%% N.B. New macro definition is function of 2 arguments, the whole -%% argument list of macro call, and the current macro environment. - -exp_syntax(Name, Def) -> - case Def of - macro|Cls -> - Mcls = map(fun (Pat|Body) -> Pat,'$ENV'|Body end, Cls), - {,'match-lambda'|Mcls}; - 'syntax-rules'|Rules -> - exp_rules(Name, , Rules) - end. - -%% exp_rules(Name, Keywords, Rules) -> {Meta,Lambda}. -%% Expand into call function which expands macro an invocation time, -%% this saves much space and costs us nothing. -%% N.B. New macro definition is function of 2 arguments, the whole -%% argument list of macro call, and the current macro environment. - -exp_rules(Name, Keywords, Rules) -> - {,lambda,args,'$ENV', - ':',lfe_macro,mbe_syntax_rules_proc, - quote,Name,quote,Keywords,quote,Rules,args}. - %% By Andr� van Tonder %% Unoptimized. See Dybvig source for optimized version. %% Resembles one by Richard Kelsey and Jonathan Rees. @@ -1401,291 +1516,6 @@ C = St#mac.fc, {list_to_atom(Pre ++ "$^" ++ integer_to_list(C)),St#mac{fc=C+1}}. -%% Macro by Example -%% Proper syntax-rules which can handle ... ellipsis by Dorai Sitaram. -%% -%% While we extend patterns to include tuples and binaries as in -%% normal LFE we leave the keyword handling in even though it is -%% subsumed by quotes and not really used. - -%% To make it more lispy! --define(car(L), hd(L)). --define(cdr(L), tl(L)). --define(cadr(L), hd(tl(L))). --define(cddr(L), tl(tl(L))). - --define(mbe_ellipsis(Car, Cddr), Car,'...'|Cddr). - -is_mbe_symbol(S) -> - is_atom(S) andalso not is_boolean(S). - -%% Tests if ellipsis pattern, (p ... . rest) -%% is_mbe_ellipsis(?mbe_ellipsis(_, _)) -> true; -%% is_mbe_ellipsis(_) -> false. - -mbe_match_pat(quote,P, E, _) -> P =:= E; -mbe_match_pat(tuple|Ps, tuple|Es, Ks) -> %Match tuple constructor - mbe_match_pat(Ps, Es, Ks); -mbe_match_pat(tuple|Ps, E, Ks) -> %Match literal tuple - case is_tuple(E) of - true -> mbe_match_pat(Ps, tuple_to_list(E), Ks); - false -> false - end; -mbe_match_pat(?mbe_ellipsis(Pcar, _), E, Ks) -> - case lfe_lib:is_proper_list(E) of - true -> - all(fun (X) -> mbe_match_pat(Pcar, X, Ks) end, E); - false -> false - end; -mbe_match_pat(Pcar|Pcdr, E, Ks) -> - case E of - Ecar|Ecdr -> - mbe_match_pat(Pcar, Ecar, Ks) andalso - mbe_match_pat(Pcdr, Ecdr, Ks); - _ -> false - end; -mbe_match_pat(Pat, E, Ks) -> - case is_mbe_symbol(Pat) of - true -> - case member(Pat, Ks) of - true -> Pat =:= E; - false -> true - end; - false -> Pat =:= E - end. - -mbe_get_ellipsis_nestings(Pat, Ks) -> - m_g_e_n(Pat, Ks). - -m_g_e_n(quote,_, _) -> ; -m_g_e_n(tuple|Ps, Ks) -> m_g_e_n(Ps, Ks); -m_g_e_n(?mbe_ellipsis(Pcar, Pcddr), Ks) -> - m_g_e_n(Pcar, Ks)|m_g_e_n(Pcddr, Ks); -m_g_e_n(Pcar|Pcdr, Ks) -> - m_g_e_n(Pcar, Ks) ++ m_g_e_n(Pcdr, Ks); -m_g_e_n(Pat, Ks) -> - case is_mbe_symbol(Pat) of - true -> - case member(Pat, Ks) of - true -> ; - false -> Pat - end; - false -> - end. - -mbe_ellipsis_sub_envs(Nestings, R) -> - ormap(fun (C) -> - case mbe_intersect(Nestings, ?car(C)) of - true -> ?cdr(C); - false -> false - end end, R). - -%% Return first value of F applied to elements in list which is not false. -ormap(F, H|T) -> - case F(H) of - false -> ormap(F, T); - V -> V - end; -ormap(_, ) -> false. - -mbe_intersect(V, Y) -> - case is_mbe_symbol(V) orelse is_mbe_symbol(Y) of - true -> V =:= Y; - false -> - any(fun (V0) -> - any(fun (Y0) -> mbe_intersect(V0, Y0) end, Y) - end, V) - end. - -%% mbe_get_bindings(Pattern, Expression, Keywords) -> Bindings. - -mbe_get_bindings(quote,_, _, _) -> ; -mbe_get_bindings(tuple|Ps, tuple|Es, Ks) -> %Tuple constructor - mbe_get_bindings(Ps, Es, Ks); -mbe_get_bindings(tuple|Ps, E, Ks) -> %Literal tuple - mbe_get_bindings(Ps, tuple_to_list(E), Ks); -mbe_get_bindings(?mbe_ellipsis(Pcar, _), E, Ks) -> - mbe_get_ellipsis_nestings(Pcar, Ks) | - map(fun (X) -> mbe_get_bindings(Pcar, X, Ks) end, E); -mbe_get_bindings(Pcar|Pcdr, Ecar|Ecdr, Ks) -> - mbe_get_bindings(Pcar, Ecar, Ks) ++ - mbe_get_bindings(Pcdr, Ecdr, Ks); -mbe_get_bindings(Pat, E, Ks) -> - case is_mbe_symbol(Pat) of - true -> - case member(Pat, Ks) of - true -> ; - false -> Pat|E - end; - false -> - end. - -%% mbe_expand_pattern(Pattern, Bindings, Keywords) -> Form. - -mbe_expand_pattern(quote,P, R, Ks) -> - quote,mbe_expand_pattern(P, R, Ks); -mbe_expand_pattern(tuple|Ps, R, Ks) -> - tuple|mbe_expand_pattern(Ps, R, Ks); -mbe_expand_pattern(?mbe_ellipsis(Pcar, Pcddr), R, Ks) -> - Nestings = mbe_get_ellipsis_nestings(Pcar, Ks), - Rr = mbe_ellipsis_sub_envs(Nestings, R), - map(fun (R0) -> mbe_expand_pattern(Pcar, R0 ++ R, Ks) end, Rr) ++ - mbe_expand_pattern(Pcddr, R, Ks); -mbe_expand_pattern(Pcar|Pcdr, R, Ks) -> - mbe_expand_pattern(Pcar, R, Ks)| - mbe_expand_pattern(Pcdr, R, Ks); -mbe_expand_pattern(Pat, R, Ks) -> - case is_mbe_symbol(Pat) of - true -> - case member(Pat, Ks) of - true -> Pat; - false -> - case lfe:assoc(Pat, R) of - _|Cdr -> Cdr; - -> Pat - end - end; - false -> Pat - end. - -%% mbe_syntax_rules_proc(Name, Keywords, Rules, Argsym, Keywordsym) -> -%% Sexpr. -%% Generate the sexpr to evaluate in a macro from Name and -%% Rules. When the sexpr is applied to arguments (in Argsym) and -%% evaluated then expansion is returned. - -%% Return sexpr to evaluate. -mbe_syntax_rules_proc(Name, Ks0, Cls, Argsym, Ksym) -> - Ks = Name|Ks0, - %% Don't prepend the macro name to the arguments! - 'let',Ksym,quote,Ks, - 'cond' ++ - map(fun (C) -> - Inpat = hd(C), - Outpat = hd(tl(C)), - ':',lfe_macro,mbe_match_pat,quote,Inpat, Argsym, Ksym, - 'let', - r,':',lfe_macro,mbe_get_bindings, - quote,Inpat,Argsym,Ksym, - ':',lfe_macro,mbe_expand_pattern, - quote,Outpat,r,Ksym - end, Cls) ++ - quote,true,':',erlang,error, - tuple, - quote,expand_macro, - cons,quote,Name,Argsym, %??? Must check this - quote,macro_clause. - -%% Do it all directly. -mbe_syntax_rules_proc(Name, Ks0, Cls, Args) -> - Ks = Name|Ks0, - case ormap(fun (Pat,Exp) -> - case mbe_match_pat(Pat, Args, Ks) of - true -> - R = mbe_get_bindings(Pat, Args, Ks), - mbe_expand_pattern(Exp, R, Ks); - false -> false - end - end, Cls) of - Res -> Res; - false -> erlang:error({expand_macro,Name|Args,macro_clause}) - end. - -%% lc_te(Exprs, Qualifiers, State) -> {Exp,State}. -%% bc_te(Exprs, Qualifiers, State) -> {Exp,State}. -%% Expand a list/binary comprehension. Algorithm straight out of -%% Simon PJs book. - -%% lc_te(Es, Qs, St) -> lc_tq(Es, Qs, , St). -lc_te(Es, Qs, St) -> lc_te(Es, Qs, , St). - -lc_te(Es, Qs, End, St) -> - c_tq(fun (E, S) -> {cons,'progn'|Es,E,S} end, Qs, End, St). - -%%bc_te(Es, Qs, St) -> bc_tq(Es, Qs, <<>>, St). -bc_te(Es, Qs, St) -> - c_tq(fun (E, S) -> - %% Separate last form to be binary segment. - case reverse(Es) of - R -> {binary,R,E,bitstring,S}; - R|Rs -> {'progn'|reverse(Rs) ++ - binary,R,E,bitstring,S}; - -> {E,S} - end - end, Qs, <<>>, St). - -%% c_tq(BuildExp, Qualifiers, End, State) -> {Exp,State}. - -c_tq(Exp, '<-',P,Gen|Qs, End, St) -> %List generator - c_l_tq(Exp, P, , Gen, Qs, End, St); -c_tq(Exp, '<-',P,'when'|G,Gen|Qs, End, St) -> %List generator - c_l_tq(Exp, P, G, Gen, Qs, End, St); -c_tq(Exp, '<=',P,Gen|Qs, End, St) -> %Bits generator - c_b_tq(Exp, P, , Gen, Qs, End, St); -c_tq(Exp, '<=',P,'when'|G,Gen|Qs, End, St) -> %Bits generator - c_b_tq(Exp, P, G, Gen, Qs, End, St); -c_tq(Exp, '?=',P,E|Qs, End, St0) -> %Test match - {Rest,St1} = c_tq(Exp, Qs, End, St0), - {'case',E,P,Rest,'_',End,St1}; -c_tq(Exp, '?=',P,'when'|_=G,E|Qs, End, St0) -> %Test match - {Rest,St1} = c_tq(Exp, Qs, End, St0), - {'case',E,P,G,Rest,'_',End,St1}; -c_tq(Exp, T|Qs, End, St0) -> %Test - {Rest,St1} = c_tq(Exp, Qs, End, St0), - {'if',T,Rest,End,St1}; -c_tq(Exp, , End, St) -> %End of qualifiers - Exp(End, St). - -c_l_tq(Exp, P, G, Gen, Qs, End, St0) -> - {H,St1} = new_fun_name("lc", St0), %Function name - {Us,St2} = new_symb(St1), %Tail variable - {Rest,St3} = c_tq(Exp, Qs, H,Us, St2), %Do rest of qualifiers - %% Build the match, no match and end clauses, no nomatch clause if - %% pattern and guard guaranteed to match. Keeps compiler quiet. - Cs0 = ,End , %End of list - Cs1 = case is_atom(P) and (G == ) of %No match, skip - true -> Cs0; - false -> cons,'_',Us,H,Us |Cs0 - end, - Cs2 = cons,P,Us,'when'|G,Rest |Cs1, %Matches pattern and guard - {'letrec-function', - H,'match-lambda'|Cs2, - H,Gen,St3}. - -c_b_tq(Exp, P, G, Gen, Qs, End, St0) -> - {H,St1} = new_fun_name("bc", St0), %Function name - {B,St2} = new_symb(St1), %Bin variable - {Rest,St3} = c_tq(Exp, Qs, H,B, St2), %Do rest of qualifiers - Brest = B,bitstring,'big-endian',unsigned,unit,1, %,size,all - %% Build the match and nomatch/end clauses. - MatchC = binary,P,Brest,'when'|G,Rest, %Matches pattern and guard - EndC = binary,Brest,End, %No match - {'letrec-function', - H,'match-lambda',MatchC,EndC, - H,Gen,St3}. - -%% c_tq(Exp, '<-',P,Gen|Qs, End, St0) -> %List generator -%% {H,St1} = new_fun_name("lc", St0), %Function name -%% {Us,St2} = new_symb(St1), %Tail variable -%% {Rest,St3} = c_tq(Exp, Qs, H,Us, St2), %Do rest of qualifiers -%% {'letrec-function', -%% H,'match-lambda', -%% P|Us,Rest, %Matches pattern -%% '_'|Us,H,Us, %No match -%% ,End, %End of list -%% H,Gen,St3}; - -%% c_tq(Exp, '<=',P,Gen|Qs, End, St0) -> %Bits generator -%% {H,St1} = new_fun_name("bc", St0), %Function name -%% {B,St2} = new_symb(St1), %Bin variable -%% {Rest,St3} = c_tq(Exp, Qs, H,B, St2), %Do rest of qualifiers -%% Brest = B,bitstring,'big-endian',unsigned,unit,1, %,size,all -%% {'letrec-function', -%% H,'match-lambda', -%% binary,P,Brest,Rest, %Matches pattern -%% binary,Brest,End, %No match -%% H,Gen,St3}; - %% mapfoldl2(Fun, Acc1, Acc2, List) -> {List,Acc1,Acc2}. %% Like normal mapfoldl but with 2 accumulators.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_macro.hrl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_macro.hrl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2013-2016 Robert Virding +%% Copyright (c) 2013-2020 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,12 +16,6 @@ %% Author : Robert Virding %% Purpose : Lisp Flavoured Erlang macro expander. -%% 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). - %% Macro expander state. -record(mac, {deep=true, %Deep expand everything keep=true, %Keep all forms
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_macro_export.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_macro_export.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2016 Robert Virding +%% Copyright (c) 2016-2022 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 @@ %% also enter all the functions and variables defined inside ewc so %% they can be reached from these macros when the L-E-E-M function is %% compiled. We do NOT need to save the ewc macros as they will -%% accessible when he module is compiled. +%% accessible when the module is compiled. %% %% The macros will be expanded in the context of the module when it is %% later compiled and not in the context of the calling module. This @@ -57,18 +57,12 @@ %%-compile(export_all). --include("lfe_comp.hrl"). +-include("lfe.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). - -define(NOMETA, ). %Empty documentation %% We need these variables to have a funny name. @@ -76,8 +70,10 @@ -define(ARGSVAR, '|- CALL ARGS -|'). %% Define the macro data. --record(umac, {mline=,expm=,env=, - leem=false,huf=false %Do we have leem and huf? +-record(umac, {mline=, %expand-macro on line + expm=, %Macros to export + env=, %LFE env to store macros + uleem=false %Do we have user defined LEEM? }). %% module(ModuleForms, CompState) -> {ModuleForms,CompState}. @@ -86,18 +82,17 @@ 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,Meta,Atts,L}, Fs0, Mst0, Cst) -> +module({'define-module',Name,Meta,Atts,L}, Fs, Mst0, Cst) -> Mst1 = collect_attrs(Atts, Mst0#umac{mline=L}), - Fs1 = add_huf(L, Fs0), - Umac = build_user_macro(Mst1), + Emac = build_exported_macro(Mst1), %% We need to export the expansion function but leave the rest. - Exp = export,'LFE-EXPAND-EXPORTED-MACRO',3, - '$handle_undefined_function',2, + Exp = export,'LFE-EXPAND-EXPORTED-MACRO',3, Md1 = {'define-module',Name,Meta,Exp|Atts,L}, - {Md1|Fs1 ++ Umac,Cst}. + %% io:format("m: ~p\n", {Md1,Fs,Emac}), + %% Put export-macro last so it can find all macros. + {Md1|Fs ++ Emac,Cst}. collect_macros(Fs, Mst) -> lists:foldl(fun collect_macro/2, Mst, Fs). @@ -110,12 +105,10 @@ collect_macro({'extend-module',_,Atts,_}, Mst) -> collect_attrs(Atts, Mst); collect_macro({'define-function',Name,_,Def,_}, Mst) -> - %% Check for LFE-EXPAND-EXPORTED-MACRO and $handle_undefined_function. + %% Check for user defined LFE-EXPAND-EXPORTED-MACRO. case {Name,function_arity(Def)} of {'LFE-EXPAND-EXPORTED-MACRO',3} -> - Mst#umac{leem=true}; - {'$handle_undefined_function',2} -> - Mst#umac{huf=true}; + Mst#umac{uleem=true}; _ -> Mst %Ignore other functions end; collect_macro(_, Mst) -> Mst. %Ignore everything else @@ -157,7 +150,7 @@ %% exported_macro(Name, State) -> true | false. add_exports(all, _) -> all; -add_exports(_, all) -> all; +add_exports(_, all) -> all; %Note we get a list of macros! add_exports(Old, More) -> ordsets:union(Old, lists:usort(More)). @@ -165,15 +158,15 @@ exported_macro(Name, #umac{expm=Expm}) -> member(Name, Expm). -%% build_user_macro(MacroState) -> UserMacFunc. +%% build_exported_macro(MacroState) -> ExportedMacFunc. %% 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{leem=true}) -> ; %Already have LEEM -build_user_macro(#umac{mline=L,expm=}) -> %No macros to export - {empty_leum(),L}; -build_user_macro(#umac{mline=ModLine,env=Env}=Mst) -> +build_exported_macro(#umac{uleem=true}) -> ; %Already have user defined LEEM +build_exported_macro(#umac{mline=L,expm=}) -> %No macros to export + {empty_leem(),L}; +build_exported_macro(#umac{mline=ModLine,env=Env}=Mst) -> Vfun = fun (N, V, Acc) -> N,V|Acc end, Sets = lfe_env:fold_vars(Vfun, , Env), %% Collect the local functions. @@ -193,7 +186,7 @@ end, %% Get the macros to export as case clauses. LEEM = case lfe_env:fold_macros(Mfun, , Env) of - -> empty_leum(); %No macros to export + -> empty_leem(); %No macros to export Macs -> %% Build case, flet and let. Case = 'case',?NAMEVAR|Macs ++ '_',?Q(no), @@ -204,7 +197,7 @@ end, {LEEM,ModLine}. -empty_leum() -> +empty_leem() -> 'define-function','LFE-EXPAND-EXPORTED-MACRO',?NOMETA, lambda,'_','_','_',?Q(no). @@ -231,30 +224,3 @@ Args,W,tuple,?Q(yes),progn|Body; macro_clause(Args, Body) -> Args,tuple,?Q(yes),progn|Body. - -%% 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',Meta,Def,Lf}=F|Fs) -> - case function_arity(Def) of - 2 -> {make_huf(Meta, Def),Lf}|Fs; %Found the right $huf - _ -> F|add_huf(L, Fs) %Keep going - 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, - {make_huf(, Excep),L}. - -make_huf(Meta, Huf) -> - 'define-function','$handle_undefined_function',Meta, - lambda,f,as, - 'case','LFE-EXPAND-EXPORTED-MACRO',f,as,':',lfe_env,new, - tuple,?Q(yes),exp,':',lfe_eval,expr,exp, - ?Q(no),funcall,Huf,f,as.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_macro_include.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_macro_include.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2013-2017 Robert Virding +%% Copyright (c) 2013-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,6 +29,7 @@ %%-compile(export_all). +-include("lfe.hrl"). -include("lfe_macro.hrl"). %% Test function to inspect output of parsing functions. @@ -44,102 +45,139 @@ end. %% Errors. +format_error({bad_form,Type}) -> + lfe_io:format1(<<"bad ~w form">>, Type); +format_error({no_include,T,F}) -> + io_lib:format(<<"can't find include ~w ~ts">>, T,F); format_error({notrans_function,F,A}) -> - io_lib:format("unable to translate function ~w/~w", F,A); + lfe_io:format1(<<"unable to translate function ~w/~w">>, F,A); format_error({notrans_record,R}) -> - io_lib:format("unable to translate record ~w", R); + lfe_io:format1(<<"unable to translate record ~w">>, R); format_error({notrans_type,T}) -> - io_lib:format("unable to translate type ~w", T); + lfe_io:format1(<<"unable to translate type ~w">>, T); format_error({notrans_macro,M}) -> - io_lib:format("unable to translate macro ~w", M). + lfe_io:format1(<<"unable to translate macro ~w">>, M); +%% File errors are passed on. +format_error({file_error,E}) -> + file:format_error(E). +%% add_error(Error, State) -> State. +%% add_error(Line, Error, State) -> State. %% add_warning(Warning, State) -> State. %% add_warning(Line, Warning, State) -> State. +%% Add errors and warnings to the state + +add_error(E, St) -> add_error(St#mac.line, E, St). + +add_error(L, E, St) -> + St#mac{errors=St#mac.errors ++ {L,?MODULE,E}}. add_warning(W, St) -> add_warning(St#mac.line, W, St). add_warning(L, W, St) -> St#mac{warnings=St#mac.warnings ++ {L,?MODULE,W}}. -%% file(FileName, Env, MacState) -> -%% {yes,(progn ...),MacState} | {error,Error}. +%% file(FileName, Env, MacState) -> +%% {yes,(progn ...),MacState} | {error,MacState}. %% Expand the (include-file ...) macro. This is a VERY simple %% include file macro! We just signal errors. -file(Body, _, #mac{ipath=Path}=St0) -> - case include_name(Body) of +file(IncFile, _, #mac{ipath=Path}=St0) -> + case include_name(IncFile) of {ok,Name} -> case path_read_file(Path, Name, St0) of - {ok,Fs,St1} -> {yes,'progn'|Fs,St1}; - {error,E} -> error(E); - not_found -> error(enoent) + {ok,Forms,St1} -> {yes,'progn'|Forms,St1}; + {error,St1} -> {error,St1}; + not_found -> + {error,add_error({no_include,file,Name}, St0)} end; - {error,E} -> error(E) + {error,_} -> + {error,add_error({bad_form,'include-file'}, St0)} end. -%% lib(FileName, Env, MacState) -> -%% {yes,(progn ...),MacState} | {error,Error}. -%% Expand the (include-lib ...) macro. This is a VERY simple include -%% lib macro! First try to include the file directly else assume -%% first directory name is a library name. We just signal errors. +%% lib(FileName, Env, MacState) -> +%% {yes,(progn ...),MacState} | {error,MacState}. +%% Expand the (include-lib ...) macro. We do the same as epp so we +%% first test if we can find the file through the normal search path, +%% if not we assume that the first directory name is a library name, +%% find its true directory and try with that. -lib(Body, _, St0) -> - case include_name(Body) of +lib(IncFile, _, #mac{ipath=Path}=St0) -> + case include_name(IncFile) of {ok,Name} -> - case path_read_file(St0#mac.ipath, Name, St0) of - {ok,Fs,St1} -> {yes,'progn'|Fs,St1}; - {error,E} -> error(E); %Found contained error - not_found -> %File not found - case lib_file_name(Name) of - {ok,Lfile} -> - case read_file(Lfile, St0) of - {ok,Fs,St1} -> {yes,'progn'|Fs,St1}; - {error,E} -> error(E) - end; - {error,_} -> error(badarg) + case path_read_file(Path, Name, St0) of + {ok,Forms,St1} -> + {yes,'progn'|Forms,St1}; + {error,St1} -> {error,St1}; + not_found -> + case lib_read_file(Name, St0) of + {ok,Forms,St1} -> {yes,'progn'|Forms,St1}; + {error,St1} -> {error,St1}; + not_found -> + {error,add_error({no_include,lib,Name}, St0)} end end; - {error,E} -> error(E) + {error,_} -> + {error,add_error({bad_form,'include-lib'}, St0)} end. -%% path_read_file(Path, Name, State) -> {ok,Forms,State} | {error,E} | error. -%% Step down the path trying to read the file. We first test if we -%% can open it, if so then this the file we use, if not we go on. +%% include_name(FileName) -> bool(). +%% Gets the file name from the include-XXX FileName. -path_read_file(P|Ps, Name, St) -> - File = filename:join(P, Name), - case file:open(File, read,raw) of %Test if we can open the file - {ok,F} -> - file:close(F), %Close it again - read_file(File, St); - {error,_} -> - path_read_file(Ps, Name, St) - end; -path_read_file(, _, _) -> %Couldn't find/open the file - not_found. +include_name(Name) -> + try + {ok,lists:flatten(unicode:characters_to_list(Name, utf8))} + catch + _:_ -> {error,badarg} +end. -%% include_name(Body) -> bool(). -%% Gets the file name from the include-XXX body. +%% path_read_file(Path, Name, State) -> +%% {ok,Forms,State} | {error,State} | not_found. +%% Step down the path trying to read the file. -include_name(Name) -> - case io_lib:char_list(Name) of - true -> {ok,Name}; - false -> {error,badarg} - end; -include_name(_) -> {error,badarg}. +path_read_file(Path, Name, St) -> + case file:path_open(Path, Name, read,raw) of + {ok,F,Pname} -> + file:close(F), %Close it again + read_file(Pname, St); %Read it + {error,_} -> not_found %Not found + end. %% lib_file_name(LibPath) -> {ok,LibFileName} | {error,Error}. %% Construct path to true library file. -lib_file_name(Lpath) -> - Lname|Rest = filename:split(Lpath), - case code:lib_dir(list_to_atom(Lname)) of - Ldir when is_list(Ldir) -> - {ok,filename:join(Ldir|Rest)}; - {error,E} -> {error,E} +lib_file_name(Name) -> + try + App|Path = filename:split(Name), + LibDir = code:lib_dir(list_to_atom(App)), + {ok,filename_join(LibDir|Path)} + catch + _:_ -> error end. -%% read_file(FileName, State) -> {ok,Forms,State} | {error,Error}. +filename_join("." | _|_=Rest) -> + filename_join(Rest); +filename_join(Comp) -> + filename:join(Comp). + +%% lib_read_file(FileName, State) -> +%% {ok,Forms,State} | {error,State} | not_found. +%% Try to read the library file. Try to open the file to make sure +%% that even if we can find the lirbary the file is there. + +lib_read_file(Name, St) -> + case lib_file_name(Name) of + {ok,LibName} -> + case file:open(LibName, read,raw) of + {ok,F} -> + file:close(F), + read_file(LibName, St); + {error,_} -> not_found + end; + error -> not_found + end. + +%% read_file(FileName, State) -> {ok,Forms,State} | {error,State}. read_file(Name, St) -> case lists:suffix(".hrl", Name) of @@ -147,29 +185,33 @@ false -> read_lfe_file(Name, St) end. -read_lfe_file(Name, St) -> +%% read_lfe_file(FileName, State) -> {ok,Forms,State} | {error,State}. + +read_lfe_file(Name, #mac{errors=Es}=St) -> %% Read the file as an LFE file. case lfe_io:read_file(Name) of {ok,Fs} -> {ok,Fs,St}; - {error,E} -> {error,E} + {error,E} -> + {error,St#mac{errors=Es ++ E}} end. %% read_hrl_file(FileName, State) -> {ok,Forms,State} | {error,Error}. %% We use two undocumented functions of epp which allow us to get -%% inside and get out the macros. +%% inside and get out the macros but it must be called after the +%% whole file has been processed. 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! + Ms = epp:macro_defs(Epp), % then this undocumented! epp:close(Epp), %Now we close epp parse_hrl_file(Fs, Ms, St); - {error,E} -> {error,E} + {error,E} -> + {error,add_error({file_error,E}, St)} end. -%% parse_hrl_file(Forms, Macros, State) -> {ok,Forms,State} | {error,Error}. +%% parse_hrl_file(Forms, Macros, State) -> {ok,Forms,State} | {error,State}. %% All the attributes go in an extend-module form. In 18 and older a %% typed record definition would result in 2 attributes, the bare %% record def and the record type def. We want just the record type @@ -220,7 +262,7 @@ trans_form({attribute,Line,record,{Name,Fields}}, As, Lfs, St) -> case catch {ok,trans_record(Name, Line, Fields)} of {ok,Lrec} -> {As,Lrec|Lfs,St}; - {'EXIT',_} -> %Something went wrong + {'EXIT',_E}-> %Something went wrong {As,Lfs,add_warning({notrans_record,Name}, St)} end; trans_form({attribute,Line,type,{Name,Def,E}}, As, Lfs, St) -> @@ -255,7 +297,7 @@ trans_form({function,_,Name,Arity,Cls}, As, Lfs, St) -> case catch {ok,trans_function(Name, Arity, Cls)} of {ok,Lfunc} -> {As,Lfunc|Lfs,St}; - {'EXIT',_} -> %Something went wrong + {'EXIT',_E} -> %Something went wrong {As,Lfs,add_warning({notrans_function,Name,Arity}, St)} end; trans_form({error,E}, As, Lfs, #mac{errors=Es}=St) -> @@ -279,22 +321,22 @@ record_field(F) || F <- Fs . record_field({record_field,_,F}) -> %Just the field name - lfe_trans:from_lit(F); + lfe_translate:from_lit(F); record_field({record_field,_,F,Def}) -> %Field name and default value - Fd = lfe_trans:from_lit(F), - Ld = lfe_trans:from_expr(Def), + Fd = lfe_translate:from_lit(F), + Ld = lfe_translate:from_expr(Def), Fd,Ld; record_field({typed_record_field,Rf,Type}) -> typed_record_field(Rf, Type). typed_record_field({record_field,_,F}, Type) -> %% Just the field name, set default value to 'undefined. - Fd = lfe_trans:from_lit(F), + Fd = lfe_translate:from_lit(F), Td = lfe_types:from_type_def(Type), Fd,?Q(undefined),Td; typed_record_field({record_field,_,F,Def}, Type) -> - Fd = lfe_trans:from_lit(F), - Ld = lfe_trans:from_expr(Def), + Fd = lfe_translate:from_lit(F), + Ld = lfe_translate:from_expr(Def), Td = lfe_types:from_type_def(Type), Fd,Ld,Td. @@ -303,13 +345,13 @@ %% could also contain a typed record definition which we use. -ifdef(NEW_REC_CORE). -trans_type(Name, Line, Def, E) -> +trans_type(Name, _Line, Def, E) -> 'define-type',Name|lfe_types:from_type_defs(E), lfe_types:from_type_def(Def). -else. trans_type({record,Name}, Line, Def, _E) -> trans_record(Name, Line, Def); -trans_type(Name, _, Def, E) -> +trans_type(Name, _Line, Def, E) -> 'define-type',Name|lfe_types:from_type_defs(E), lfe_types:from_type_def(Def). -endif. @@ -331,7 +373,7 @@ trans_function(Name, _, Cls) -> %% Make it a fun and then drop the match-lambda. - 'match-lambda'|Lcs = lfe_trans:from_expr({'fun',0,{clauses,Cls}}), + 'match-lambda'|Lcs = lfe_translate:from_expr({'fun',0,{clauses,Cls}}), defun,Name|Lcs. %% trans_macros(MacroDefs, State) -> {LMacroDefs,State}. @@ -341,8 +383,8 @@ trans_macros({{atom,Mac},Defs}|Ms, St0) -> {Lms,St1} = trans_macros(Ms, St0), case catch trans_macro(Mac, Defs, St1) of - {'EXIT',E} -> %It crashed - {Lms,add_warning({notrans_macro,Mac,E}, St1)}; + {'EXIT',_E} -> %Something went wrong + {Lms,add_warning({notrans_macro,Mac}, St1)}; {none,St2} -> {Lms,St2}; %No definition, ignore {Mdef,St2} -> {Mdef|Lms,St2} end; @@ -386,11 +428,11 @@ %% io:format("parse: ~p\n",Ts1 ++ {dot,0}), {ok,E} = erl_parse:parse_exprs(Ts1 ++ {dot,0}), %% io:format("result: ~p\n",E), - ?BQ(lfe_trans:from_expr(E)); + ?BQ(lfe_translate:from_expr(E)); trans_macro_body(As, Ts0) -> Ts1 = trans_qm(Ts0), {ok,E} = erl_parse:parse_exprs(Ts1 ++ {dot,0}), - Le0 = lfe_trans:from_expr(E), + Le0 = lfe_translate:from_expr(E), %% Wrap variables in arg list with an (comma ...) call. Alist = A|comma,A || A <- As , Le1 = lfe:sublis(Alist, Le0), @@ -398,7 +440,7 @@ ?BQ(Le1). %% {ok,_=F} = erl_parse:parse_exprs(Ts1 ++ {dot,0}), - %% backquote_last(lfe_trans:from_body(F)). + %% backquote_last(lfe_translate:from_body(F)). %% unquote_vars(Alist, Expr) -> Expr. %% Special version of sublis which doesn't enter quotes. Specially
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_macro_record.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_macro_record.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 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,132 +12,86 @@ %% See the License for the specific language governing permissions and %% limitations under the License. -%% File : lfe_macro_record.erl -%% Author : Robert Virding -%% Purpose : Lisp Flavoured Erlang macro expander for records. +%%% File : lfe_macro_record.erl +%%% Author : Robert Virding +%%% Purpose : Lisp Flavoured Erlang macro expander for records. + +%%% Create macros for defining, creating and accessing records. Note +%%% we still create the older set-Name macros even though they have +%%% been deprecated. -module(lfe_macro_record). -export(define/3,format_error/1). --export(record_set_functions/4). - -import(lists, map/2,foldr/3,concat/1). +-include("lfe.hrl"). -include("lfe_macro.hrl"). %% Errors. -format_error({badrecord,R}) -> - lfe_io:format1("bad definition of record ~w",R); -format_error({undefined_record_field,R,F}) -> - lfe_io:format1("undefined field ~w in record ~w",F,R); -format_error({missing_field_value,R,F}) -> - lfe_io:format1("missing value to field ~w in record ~w",F,R); +format_error({bad_record,Name}) -> + lfe_io:format1(<<"bad definition of record ~w">>,Name); format_error(_) -> "record error". -%% define(Name|FieldDefs, Env, State) -> {Funs,Macs,Env,State}. -%% define(Name, FieldDefs, Env, State) -> {Funs,Macs,Env,State}. +%% define(Name|FieldDefs, Env, State) -> {ok,Form,State}. +%% define(Name, FieldDefs, Env, State) -> {Forms,Env,State}. %% Define a VERY simple record by generating macros for all accesses. %% (define-record point x y) %% => make-point, is-point, match-point, set-point, %% point-x, set-point-x, point-y, set-point-y. define(Name|Fdefs, Env, St0) -> - {Funs,Forms, _,St1} = define(Name, Fdefs, Env, St0), - {yes,progn,'eval-when-compile'|Funs|Forms,St1}. + {Macs,St1} = define(Name, Fdefs, Env, St0), + {yes,progn,'define-record',Name,Fdefs|Macs,St1}; +define(, _Env, _St) -> no. %Undefined macro -define(Name, Fdefs, Env, St) -> +define(Name, Fdefs, _Env, St) when is_atom(Name) -> %% Get field names, default values and indices. Fields = map(fun (F,_,_) when is_atom(F) -> F; (F,_) when is_atom(F) -> F; - (F) when is_atom(F) -> F + (F) when is_atom(F) -> F; + (F) when is_atom(F) -> F; + (_) -> bad_record_error(Name) end, Fdefs), - Defs = map(fun (F,D,_) when is_atom(F) -> ?Q(D); - (F,D) when is_atom(F) -> ?Q(D); - (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), %% Make access macros. - Macs = make_macro(Name, Defs, Fu), %make-Name - match_macro(Name, Fields, Fu), %match-Name + Macs = make_macro(Name), %make-Name + match_macro(Name), %match-Name test_macro(Name, Fields), %is-Name - set_macro(Name, Fields, Fi), %set-Name - emp_macro(Name, Fields, Fu), %emp-Name + update_macro(Name), %update-Name + set_macro(Name), %set-Name field_macro(Name, Fields), %fields-Name size_macro(Name, Fields) %size-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, - %% lfe_io:format("~p\n", {Funs,Forms}), - {Funs,Forms,Env,St}. - -field_indexes(Fs) -> field_indexes(Fs, 2). - -field_indexes(F|Fs, N) -> - {F,N}|field_indexes(Fs, N+1); -field_indexes(, _) -> . - -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_record_field),?Q(Name),f. - -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_field_value),?Q(Name),f, - ,i,i, - 'let',i,l,is,list_to_tuple,def, - tuple_to_list,i. - -make_macro(Name, Defs, Fu) -> + {Macs,St}; +define(Name, _Fdefs, _Env, _St) -> + bad_record_error(Name). + +make_macro(Name) -> Make = list_to_atom(concat('make','-',Name)), - 'defmacro',Make,fds, - 'let',def,list|Defs, - ?BQ(tuple,?Q(Name),?C_A(Fu,fds,def)). + 'defmacro',Make,fds,?BQ('record',Name,?C_A(fds)). -match_macro(Name, Fs, Fu) -> +match_macro(Name) -> Match = list_to_atom(concat('match','-',Name)), - 'defmacro',Match,fds, - 'let',def,list|lists:duplicate(length(Fs),?Q('_')), - ?BQ(tuple,?Q(Name),?C_A(Fu,fds,def)). + 'defmacro',Match,fds,?BQ('record',Name,?C_A(fds)). -test_macro(Name, Fs) -> +test_macro(Name, _Fs) -> Test = list_to_atom(concat('is','-',Name)), - 'defmacro',Test,rec, - ?BQ('is_record',?C(rec),?Q(Name),length(Fs)+1). + 'defmacro',Test,rec,?BQ('is-record',?C(rec),Name). + %% ?BQ('is_record',?C(rec),?Q(Name),length(Fs)+1). -set_macro(Name, Fs, Fi) -> +update_macro(Name) -> + Upd = list_to_atom(concat('update','-',Name)), + defmacro,Upd, + cons,rec,fds, + ?BQ('record-update',?C(rec),Name,?C_A(fds)). + +set_macro(Name) -> Set = list_to_atom(concat('set','-',Name)), defmacro,Set, cons,rec,fds, - 'let',tuple,lets,body, - ':',lfe_macro_record,record_set_functions, - fds,?Q(Name),lambda,f,Fi,f,?Q(rec), - ?BQ('let',rec,?C(rec),?C_A(lets), - 'if',is_record,rec,?Q(Name),length(Fs)+1, - ?C(body), - error,{badrecord,Name}). - -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),?C_A(Fu,fds,def)). + ?BQ('record-update',?C(rec),Name,?C_A(fds)). field_macro(Name, Fs) -> Recfields = list_to_atom(concat('fields','-',Name)), @@ -145,51 +99,23 @@ size_macro(Name, Fs) -> Recsize = list_to_atom(concat('size','-',Name)), - 'defmacro',Recsize,,length(Fs). + 'defmacro',Recsize,,length(Fs)+1. %Don't forget the record name field_macros(Name, Fs) -> - Fis = field_indexes(Fs), %Calculate indexes - foldr(fun ({F,N}, Fas) -> + Fun = fun (F, Fas) -> Get = list_to_atom(concat(Name,'-',F)), Set = list_to_atom(concat('set-',Name,'-',F)), + Upd = list_to_atom(concat('update-',Name,'-',F)), defmacro,Get, - ,N, %Field index - list,rec, %Field value - ?BQ(test_and_do(Name, Fs, rec, , element,N, rec)), - %%list,rec,?BQ(element,N,?C(rec)), + ,?Q('record-index',Name,F), + list,rec, + ?BQ('record-field',?C(rec),Name,F), + defmacro,Upd,rec,new, + ?BQ('record-update',?C(rec),Name,F,?C(new)), defmacro,Set,rec,new, - ?BQ(test_and_do(Name, Fs, rec, new, - setelement,N,rec,new)) | - %%?BQ(setelement,N,?C(rec),?C(new))| + ?BQ('record-update',?C(rec),Name,F,?C(new)) | Fas - end, , Fis). - -test_and_do(Name, Fs, Rv, Vs, Do) -> - %% Wrap Do inside a 'let' to avoid variable name clashes and an - %% 'if' to test record. - Ls = V,?C(V) || V <- Rv|Vs , - 'let',Ls, - 'if',is_record,Rv,?Q(Name),length(Fs)+1,Do, - error,{badrecord,Name}. - -type_information(Name, Fdefs, _St) -> - %% We push the problem of generating the right final forms to the - %% code generator which knows about the record attribute. - record,Name|Fdefs. - -%% record_set_functions(FieldUpds, Name, IndexFun, RecordVar) -> -%% {LetList,Body}. -%% Define list of V,Val for let wrapper and the set body. RecordVar -%% is the variable of value of the initial record. - -record_set_functions(Fds, Name, Index, Rec) -> - %% Must eval Lets first as it catches error. - Lets = fun (F,V|Ps, Fun) -> F,V|Fun(Ps, Fun); - (F, _) -> erlang:error({missing_field_value,Name,F}); - (, _) -> - end, - Body = fun (F,_|Ps, I, B, Fun) -> - Fun(Ps, I, setelement,I(F),B,F, Fun); - (, _, B, _) -> B - end, - {Lets(Fds, Lets),Body(Fds, Index, Rec, Body)}. + end, + lists:foldr(Fun, , Fs). + +bad_record_error(Name) -> error({bad_record,Name}).
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_macro_struct.erl
Added
@@ -0,0 +1,46 @@ +%% Copyright (c) 2008-2020 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_struct.erl +%%% Author : Robert Virding +%%% Purpose : Lisp Flavoured Erlang macro expander for structs. + +-module(lfe_macro_struct). + +-export(define/3,format_error/1). + +-import(lists, map/2,foldr/3,concat/1). + +-include("lfe.hrl"). +-include("lfe_macro.hrl"). + +%% Errors. +format_error(bad_struct_def) -> <<"bad definition of struct">>; +format_error(_) -> "struct error". + +define(Fdefs0, Env, St0) -> + Fdefs1 = evaluate_fdefs(Fdefs0, Env), + {yes,progn,'define-struct',Fdefs1,St0}. + +evaluate_fdefs(Fdefs0, Env) -> + Fun = fun (F,Def,T) when is_atom(F) -> F,lfe_eval:expr(Def, Env),T; + (F,Def) when is_atom(F) -> F,lfe_eval:expr(Def, Env); + (F) when is_atom(F) -> F; + (F) when is_atom(F) -> F; + (_) -> bad_struct_def_error() + end, + Fdefs1 = lists:map(Fun, Fdefs0), + Fdefs1. + +bad_struct_def_error() -> error(bad_struct_def).
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_ms.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_ms.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2020 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,28 +27,32 @@ -module(lfe_ms). --export(expand/1,format_error/1). +-export(expand/1,expand/2,format_error/1). -import(lists, foldr/3,mapfoldl/3). +-include("lfe.hrl"). + %% ets:test_ms/2. %% format_error(Error) -> ErrorString. format_error(match_spec_head) -> "Illegal number of head arguments". --define(Q(E), quote,E). %We do a lot of quoting! - -record(ms, {dc=1, %Dollar variable count from 1 bs=, %Variable/$var bindings + dialect=ets, %Which dialect are we doing where=guard %Where in spec head/guard/body }). %% expand(MSBody) -> Expansion. +%% expand(Dialect, MSBody) -> Expansion. %% Expand the match spec body. -expand(Cls) -> - case catch clauses(Cls, #ms{}) of +expand(Cls) -> expand(table, Cls). + +expand(Dialect, Cls) when Dialect =:= table ; Dialect =:= trace -> + case catch clauses(Cls, #ms{dialect=Dialect}) of {error,E} -> error(E); %Signals errors {'EXIT',E} -> error(E); %Signals errors {Exp,_} -> Exp %Hurrah it worked @@ -85,19 +89,42 @@ case Pats of %Test for top-level aliasing '=',S,Pat when is_atom(S) -> St2 = new_binding(S, '$_', St1), - pattern(Pat, St2); + head_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 + head_pattern(Pat, St2); + Pat -> head_pattern(Pat, St1); + _ -> throw({error,{match_spec_head,Pats}}) %Wrong size end. +%% head_pattern(Pattern, State) -> {Pattern,State}. +%% Check the head pattern has the right format for the dialect. + +head_pattern(Pat, St) -> %Just a variable + check_head(Pat, St#ms.dialect), %Correct format + pattern(Pat, St). + +check_head(Pat, _) when is_atom(Pat) -> ok; %Variable +check_head(Pat, table) when is_tuple(Pat) -> ok; +check_head(?Q(Pat), table) when is_tuple(Pat) -> ok; +check_head(tuple|_, table) -> ok; +check_head('record'|_, table) -> ok; +%% make-record has been deprecated but we sill accept it for now. +check_head('make-record'|_, table) -> ok; +check_head(?Q(Pat), trace) when is_list(Pat) -> ok; +check_head(list|_, trace) -> ok; +check_head(cons|_, trace) -> ok; +check_head(, trace) -> ok; +check_head(Pat, _Type) -> + throw({error,{match_spec_head,Pat}}). + +%% pattern(Pattern, State) -> {Pattern,State}. + pattern('_', St) -> {?Q('_'),St}; pattern(Symb, St0) when is_atom(Symb) -> %Variable {Dv,St1} = pat_binding(Symb, St0), {?Q(Dv),St1}; -pattern(quote,_=E, St) -> {E,St}; +pattern(?Q(_)=E, St) -> {E,St}; pattern(cons,H0,T0, St0) -> {H1,St1} = pattern(H0, St0), {T1,St2} = pattern(T0, St1), @@ -108,6 +135,21 @@ pattern(tuple|Ps0, St0) -> {Ps1,St1} = pat_list(Ps0, St0), {tuple|Ps1,St1}; +pattern('=',L0,R0, St0) -> %General aliasing + {L1,St1} = pattern(L0, St0), + {R1,St2} = pattern(R0, St1), + {'=',L1,R1,St2}; +pattern('record',R|Fs0, St0) -> + %% This is in a term but is going to be used as a pattern! + {Fs1,St1} = pat_rec_fields(Fs0, St0), + {'record',R|Fs1,St1}; +%% make-record has been deprecated but we sill accept it for now. +pattern('make-record',R|Fs0, St0) -> + %% This is in a term but is going to be used as a pattern! + {Fs1,St1} = pat_rec_fields(Fs0, St0), + {'make-record',R|Fs1,St1}; +pattern('record-index',R,F, St) -> + {'record-index',R,F,St}; %% Support old no constructor style list forms. pattern(H0|T0, St0) -> {H1,St1} = pattern(H0, St0), @@ -117,6 +159,20 @@ pat_list(Ps, St) -> mapfoldl(fun pattern/2, St, Ps). +%% pat_rec_fields(Fields, State) -> {Patterns,State}. + +pat_rec_fields(F,P0|Fs0, St0) when is_atom(F) -> + %% Field names go straight through untouched. + {P1,St1} = pattern(P0, St0), + {Fs1,St2} = pat_rec_fields(Fs0, St1), + {F,P1|Fs1,St2}; +pat_rec_fields(F0,P0|Fs0, St0) -> + {F1,St1} = pattern(F0, St0), + {P1,St2} = pattern(P0, St1), + {Fs1,St3} = pat_rec_fields(Fs0, St2), + {F1,P1|Fs1,St3}; +pat_rec_fields(, St) -> {,St}. + %% pat_binding(Var, Status) -> {DVar,Status}. %% Get dollar var for variable, creating a new one if neccessary. @@ -156,14 +212,14 @@ {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 +expr(?Q(A)=E, St) when is_atom(A) -> %Atom case atom_to_list(A) of $$|_ -> {tuple,?Q(const),E,St}; %Catch dollar variables _ -> {E,St} end; -expr(quote,T, St) when is_tuple(T) -> %Must tuple tuples +expr(?Q(T), St) when is_tuple(T) -> %Must tuple tuples {tuple,T,St}; -expr(quote,_=E, St) -> {E,St}; %No need for {const,E}? +expr(?Q(_)=E, St) -> {E,St}; %No need for {const,E}? expr(cons,H0,T0, St0) -> {H1,St1} = expr(H0, St0), {T1,St2} = expr(T0, St1), @@ -177,25 +233,56 @@ expr(binary|Segs0, St0) -> {Segs1,St1} = expr_bitsegs(Segs0, St0), {binary|Segs1,St1}; +%% Record special forms. +expr('record',Name|Fs, St0) -> + %% This is in a term and is going to be used as an expression! + {Efs,St1} = expr_rec_fields(Fs, St0), + {tuple,'record',Name|Efs,St1}; %Must tuple tuples +%% make-record has been deprecated but we sill accept it for now. +expr('make-record',Name|Fs, St0) -> + %% This is in a term and is going to be used as an expression! + {Efs,St1} = expr_rec_fields(Fs, St0), + {tuple,'make-record',Name|Efs,St1}; %Must tuple tuples +expr('is-record',E,Name, St0) -> + {Ee,St1} = expr(E, St0), + %% io:format(user, "is-record ~p ~p\n", E,Name), + {tuple,?Q('is_record'),Ee,?Q(Name),St1}; + %% {tuple,'is-record',Ee,Name,St1}; +expr('record-index',Name,F, St) -> + {'record-index',Name,F,St}; +expr('record-field',E,Name,F, St0) -> + %% We must remove all checks and return simple call to element/2. + {Ee,St1} = expr(E, St0), + {tuple,?Q(element),'record-index',Name,F,Ee,St1}; + %% {tuple,'record-field',Ee,Name,F,St1}; +expr('record-update',E,Name|Fs, St0) -> + %% We must remove all checks and return simple nested setelement/3 calls. + {Ee,St1} = expr(E, St0), + {Efs,St2} = expr_rec_fields(Fs, St1), + Set = expr_set_record(Efs, Ee, Name), + {Set,St2}; + %% {tuple,'record-update',Ee,Name|Efs,St2}; %% Special match spec calls. expr(bindings, St) -> {?Q('$*'),St}; %Special calls expr(object, St) -> {?Q('$_'),St}; %% General function calls. expr(call,?Q(erlang),?Q(Op)|Es0, St0) when is_atom(Op) -> Ar = length(Es0), - case is_ms_erlang_func(Op, Ar) of + case is_ms_erlang_func(Op, Ar, St0#ms.where) of true -> {Es1,St1} = expr_list(Es0, St0), {tuple,?Q(Op)|Es1,St1}; - false -> throw({error,{illegal_ms_func,{erlang,Op,Ar}}}) + false -> illegal_func_error({erlang,Op,Ar}) end; +expr(call,M,F|As, _St) -> + illegal_func_error({M,F,length(As)}); 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}}}) + false -> illegal_func_error({Op,Ar}) end; expr(_|_, _) -> throw({error,illegal_ms_call}); expr(, St) -> {,St}; @@ -229,27 +316,71 @@ (Sp, S) -> {Sp,S} end, St, Specs). -is_integer_list(I|Is) when is_integer(I) -> - is_integer_list(Is); -is_integer_list() -> true; -is_integer_list(_) -> false. +%% expr_rec_fields(Fields, State) -> {Patterns,State}. -is_ms_erlang_func(N, A) -> - is_ms_op(N, A) orelse is_ms_bif(N, A). +expr_rec_fields(F,V0|Fs0, St0) when is_atom(F) -> + %% Field names go straight through untouched. + {V1,St1} = expr(V0, St0), + {Fs1,St2} = expr_rec_fields(Fs0, St1), + {F,V1|Fs1,St2}; +expr_rec_fields(F0,V0|Fs0, St0) -> + {F1,St1} = expr(F0, St0), + {V1,St2} = expr(V0, St1), + {Fs1,St3} = expr_rec_fields(Fs0, St2), + {F1,V1|Fs1,St3}; +expr_rec_fields(, St) -> {,St}. -%% is_ms_func(Name, Arity, Where) -> bool(). -%% Test if Name/Arity is legal function in Where (guard/body). +%% expr_set_record(Fields, Expr, Record) -> SetRec. -is_ms_func(N, A, guard) -> - is_ms_op(N, A) orelse is_ms_bif(N, A) orelse is_ms_guard(N, A); -is_ms_func(N, A, body) -> - is_ms_op(N, A) orelse is_ms_bif(N, A) orelse is_ms_action(N, A). +expr_set_record(F,V|Fs, E0, R) -> + E1= tuple,?Q(setelement),'record-index',R,F,E0,V, + expr_set_record(Fs, E1, R); +expr_set_record(, E, _) -> E. -%% is_ms_guard(Name, Arity) -> bool(). -%% is_ms_action(Name, Arity) -> bool(). +is_integer_list(I|Is) when is_integer(I) -> + is_integer_list(Is); +is_integer_list() -> true; +is_integer_list(_) -> false. -is_ms_guard(get_tcw, 0) -> true; -is_ms_guard(_, _) -> false. +illegal_func_error(Func) -> + throw({error,{illegal_ms_func,Func}}). + +%% We are very explicit in what operators and functions are allowed. + +is_ms_test(is_atom,1) -> true; +is_ms_test(is_float,1) -> true; +is_ms_test(is_integer,1) -> true; +is_ms_test(is_list,1) -> true; +is_ms_test(is_number,1) -> true; +is_ms_test(is_pid,1) -> true; +is_ms_test(is_port,1) -> true; +is_ms_test(is_reference,1) -> true; +is_ms_test(is_tuple,1) -> true; +is_ms_test(is_map,1) -> true; +is_ms_test(is_binary,1) -> true; +is_ms_test(is_function,1) -> true; +is_ms_test(is_record,2) -> true; +is_ms_test(is_record,3) -> true; %We get this one directly +is_ms_test(is_seq_trace,0) -> true; +is_ms_test(_,_) -> false. + +is_erl_guard(abs,1) -> true; +is_erl_guard(element,2) -> true; +is_erl_guard(hd,1) -> true; +is_erl_guard(length,1) -> true; +is_erl_guard(node,0) -> true; +is_erl_guard(node,1) -> true; +is_erl_guard(round,1) -> true; +is_erl_guard(size,1) -> true; +is_erl_guard(map_size,1) -> true; +is_erl_guard(tl,1) -> true; +is_erl_guard(trunc,1) -> true; +is_erl_guard(self,0) -> true; +is_erl_guard(float,1) -> true; +is_erl_guard(_,_) -> false. + +is_ms_guard(get_tcw, 0) -> true; %MS pseudo guard function +is_ms_guard(N, A) -> is_erl_guard(N, A). is_ms_action(caller, 0) -> true; is_ms_action(disable_trace, 1) -> true; @@ -269,25 +400,55 @@ is_ms_action(trace, 3) -> true; is_ms_action(_, _) -> false. -%% is_ms_op(Name, Arity) -> bool(). -%% Valid match-spec operators. +is_ms_bool('and',2) -> true; +is_ms_bool('or',2) -> true; +is_ms_bool('xor',2) -> true; +is_ms_bool('not',1) -> true; +is_ms_bool('andalso',2) -> true; +is_ms_bool('orelse',2) -> true; +is_ms_bool(_,_) -> false. + +is_ms_arith('+',1) -> true; +is_ms_arith('+',2) -> true; +is_ms_arith('-',1) -> true; +is_ms_arith('-',2) -> true; +is_ms_arith('*',2) -> true; +is_ms_arith('/',2) -> true; +is_ms_arith('div',2) -> true; +is_ms_arith('rem',2) -> true; +is_ms_arith('band',2) -> true; +is_ms_arith('bor',2) -> true; +is_ms_arith('bxor',2) -> true; +is_ms_arith('bnot',1) -> true; +is_ms_arith('bsl',2) -> true; +is_ms_arith('bsr',2) -> true; +is_ms_arith(_,_) -> false. + +is_ms_comp('>',2) -> true; +is_ms_comp('>=',2) -> true; +is_ms_comp('<',2) -> true; +is_ms_comp('=<',2) -> true; +is_ms_comp('==',2) -> true; +is_ms_comp('=:=',2) -> true; +is_ms_comp('/=',2) -> true; +is_ms_comp('=/=',2) -> true; +is_ms_comp(_,_) -> false. is_ms_op(Op, Ar) -> - erl_internal:arith_op(Op, Ar) - orelse erl_internal:bool_op(Op, Ar) - orelse erl_internal:comp_op(Op, Ar). - -%% is_ms_bif(Name, Arity) -> bool(). -%% Valid match-spec bifs, both guard and body. All the standard ones -%% MINUS a few! - -is_ms_bif(setelement, 3) -> true; %Not true, dangerous!!!!! -is_ms_bif(bit_size, 1) -> false; -is_ms_bif(byte_size, 1) -> false; -is_ms_bif(tuple_size, 1) -> false; -is_ms_bif(binary_part, _) -> false; -is_ms_bif(N, Ar) -> - erl_internal:guard_bif(N, Ar). + is_ms_bool(Op, Ar) orelse is_ms_arith(Op, Ar) orelse is_ms_comp(Op, Ar). + +is_ms_erlang_func(N, A, _) -> + is_erl_guard(N, A) orelse is_ms_test(N, A) orelse is_ms_bool(N, A) orelse + is_ms_arith(N, A) orelse is_ms_comp(N, A). + +%% is_ms_func(Name, Arity, Where) -> bool(). +%% Test if Name/Arity is legal function in Where (guard/body). + +is_ms_func(N, A, body) -> + is_ms_action(N, A) orelse is_ms_guard(N, A) orelse is_ms_test(N, A) orelse + is_ms_op(N, A); +is_ms_func(N, A, guard) -> + is_ms_guard(N, A) orelse is_ms_test(N, A) orelse is_ms_op(N, A). %% new_binding(Name, Value, State) -> State. %% find_binding(Name, State) -> {ok,Value} | error.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_parse.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_parse.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2009-2017 Robert Virding +%% Copyright (c) 2009-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_parse.spell1 -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_parse.spell1
Changed
@@ -1,5 +1,5 @@ %% -*- mode: erlang -*- -%% Copyright (c) 2008-2015 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_qlc.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_qlc.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_scan.xrl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_scan.xrl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -64,7 +64,7 @@ #{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,_|Ds} = base_collect(tl(TokenChars), 10, 0), base_token(Ds, Base, TokenLine). %% String @@ -88,7 +88,7 @@ %% Strip sharpsign single-quote. FunStr = string:substr(TokenChars,3), {token,{'#\'',TokenLine,FunStr}}. -%% Atoms +%% Numbers +-?{D}+ : case catch {ok,list_to_integer(TokenChars)} of {ok,I} -> {token,{number,TokenLine,I}}; @@ -99,12 +99,18 @@ {ok,F} -> {token,{number,TokenLine,F}}; _ -> {error,"illegal float"} end. +%% Elixir alias symbol +#eE{SSYM}{SYM}* : + %% Strip sharpsign e | E. + AliasStr = string:substr(TokenChars,3), + symbol_token("Elixir." ++ AliasStr, TokenLine). +%% Symbols {SSYM}{SYM}* : symbol_token(TokenChars, TokenLine). {WS}+ : skip_token. Erlang code. -%% Copyright (c) 2008-2013 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -167,22 +173,25 @@ base_token(Cs, B, L) -> base_token(Cs, B, +1, L). base_token(Cs, B, S, L) -> - case base1(Cs, B, 0) of + case base_collect(Cs, B, 0) of {N,} -> {token,{number,L,S*N}}; {_,_} -> {error,"illegal based number"} end. -base1(C|Cs, Base, SoFar) when C >= $0, C =< $9, C < Base + $0 -> +%% base_collect(Chars, Base, SoFar) -> {Number,RestChars}. +%% Collect all numeric characters of base Base. + +base_collect(C|Cs, Base, SoFar) when C >= $0, C =< $9, C < Base + $0 -> Next = SoFar * Base + (C - $0), - base1(Cs, Base, Next); -base1(C|Cs, Base, SoFar) when C >= $a, C =< $z, C < Base + $a - 10 -> + base_collect(Cs, Base, Next); +base_collect(C|Cs, Base, SoFar) when C >= $a, C =< $z, C < Base + $a - 10 -> Next = SoFar * Base + (C - $a + 10), - base1(Cs, Base, Next); -base1(C|Cs, Base, SoFar) when C >= $A, C =< $Z, C < Base + $A - 10 -> + base_collect(Cs, Base, Next); +base_collect(C|Cs, Base, SoFar) when C >= $A, C =< $Z, C < Base + $A - 10 -> Next = SoFar * Base + (C - $A + 10), - base1(Cs, Base, Next); -base1(C|Cs, _Base, SoFar) -> {SoFar,C|Cs}; -base1(, _Base, N) -> {N,}. + base_collect(Cs, Base, Next); +base_collect(C|Cs, _Base, SoFar) -> {SoFar,C|Cs}; +base_collect(, _Base, N) -> {N,}. -define(IS_UNICODE(C), ((C >= 0) and (C =< 16#10FFFF))). @@ -192,7 +201,7 @@ %% unicode range. char_token($x,C|Cs, L) -> - case base1(C|Cs, 16, 0) of + case base_collect(C|Cs, 16, 0) of {N,} when ?IS_UNICODE(N) -> {token,{number,L,N}}; _ -> {error,"illegal character"} end; @@ -203,9 +212,9 @@ %% We know that the input string is correct. chars($\\,$x,C|Cs0) -> - case hex_char(C) of + case is_hex_char(C) of true -> - case base1(C|Cs0, 16, 0) of + case base_collect(C|Cs0, 16, 0) of {N,$;|Cs1} -> N|chars(Cs1); _Other -> escape_char($x)|chars(C|Cs0) end; @@ -215,10 +224,10 @@ chars(C|Cs) -> C|chars(Cs); chars() -> . -hex_char(C) when C >= $0, C =< $9 -> true; -hex_char(C) when C >= $a, C =< $f -> true; -hex_char(C) when C >= $A, C =< $F -> true; -hex_char(_) -> false. +is_hex_char(C) when C >= $0, C =< $9 -> true; +is_hex_char(C) when C >= $a, C =< $f -> true; +is_hex_char(C) when C >= $A, C =< $F -> true; +is_hex_char(_) -> false. escape_char($b) -> $\b; %\b = BS escape_char($t) -> $\t; %\t = TAB @@ -229,7 +238,7 @@ escape_char($e) -> $\e; %\e = ESC escape_char($s) -> $\s; %\s = SPC escape_char($d) -> $\d; %\d = DEL -escape_char(C) -> C. +escape_char(C) -> C. %\Other = Other %% Block Comment: %% Provide a sensible error when people attempt to include nested @@ -245,12 +254,15 @@ end. %% skip_until(String, Char1, Char2) -> String. -%% skip_past(String, Char1, Char2) -> String. +%% Skip characters until we get a C1 or C2. %% skip_until(C|_=Cs, C1, C2) when C =:= C1 ; C =:= C2 -> Cs; %% skip_until(_|Cs, C1, C2) -> skip_until(Cs, C1, C2); %% skip_until(, _, _) -> . +%% skip_past(String, Char1, Char2) -> String. +%% Skip characters until we get a C1 or C2 and then skip past it. + skip_past(C|Cs, C1, C2) when C =:= C1 ; C =:= C2 -> Cs; skip_past(_|Cs, C1, C2) -> skip_past(Cs, C1, C2); skip_past(, _, _) -> .
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_shell.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_shell.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2022 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,30 +27,27 @@ -module(lfe_shell). -export(start/0,start/1,server/0,server/1, - run_script/2,run_script/3,run_string/2,run_string/3). + run_script/2,run_script/3, + run_strings/1,run_strings/2,run_string/1,run_string/2, + new_state/2,new_state/3,upd_state/3). %% The shell commands which generally callable. --export(c/1,c/2,cd/1,doc/1,docs/1,ec/1,ec/2,ep/1,ep/2,epp/1,epp/2,help/0, - i/0,i/1,l/1,ls/1,clear/0,m/0,m/1,pid/3,p/1,p/2,pp/1,pp/2,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/2,get_fbinding/3,add_ibinding/5, - get_gbinding/3,add_mbinding/3). +-export(c/1,c/2,cd/1,ec/1,ec/2,ep/1,ep/2,epp/1,epp/2,help/0,h/1,h/2,h/3, + i/0,i/1,i/3,l/1,ls/1,clear/0,m/0,m/1,pid/3,p/1,p/2,pp/1,pp/2,pwd/0, + q/0,flush/0,regs/0,exit/0). -import(orddict, store/3,find/2). --import(ordsets, add_element/2). -import(lists, reverse/1,foreach/2). -include("lfe.hrl"). +-include("lfe_docs.hrl"). -%% Colours for the LFE banner +%% Coloured strings for the LFE banner, red, green, yellow and blue. -define(RED(Str), "\e31m" ++ Str ++ "\e0m"). -define(GRN(Str), "\e1;32m" ++ Str ++ "\e0m"). -define(YLW(Str), "\e1;33m" ++ Str ++ "\e0m"). -define(BLU(Str), "\e1;34m" ++ Str ++ "\e0m"). +-define(BOLD(Str), "\e1m" ++ Str ++ "\e0m"). %% -compile(export_all). @@ -65,41 +62,68 @@ -record(state, {curr,save,base, %Current, save and base env slurp=false}). %Are we slurped? +%% run_script(File, Args) -> {Value,State}. +%% run_string(File, Args, State) -> {Value,State}. + +-spec run_script(_, _) -> no_return(). +-spec run_script(_, _, _) -> no_return(). + run_script(File, Args) -> - run_script(File, Args, lfe_env:new()). + run_script(File, Args, new_state(File, Args)). + +run_script(File, Args, St0) -> + St1 = upd_state(File, Args, St0), + run_file(File, St1). + +%% run_strings(Strings) -> {Value,State}. +%% run_strings(Strings, State) -> {Value,State}. + +run_strings(Strings) -> + run_strings(Strings, new_state("lfe", )). + +run_strings(Strings, St) -> + lists:foldl(fun (S, St0) -> + {_,St1} = run_string(S, St0), + St1 + end, St, Strings). -run_script(File, Args, Env) -> - St = new_state(File, Args, Env), - run(File, St). +%% run_string(String) -> {Value,State}. +%% run_string(String, State) -> {Value,State}. -run_string(String, Args) -> - run_string(String, Args, lfe_env:new()). +run_string(String) -> + run_string(String, new_state("lfe", )). -run_string(String, As, Env) -> - St = new_state("lfe", As, Env), +run_string(String, St0) -> + St1 = upd_state(String, , St0), case read_script_string(String) of {ok,Forms} -> - run_loop(Forms, , St); + run_loop(Forms, St1); {error,E} -> slurp_errors("lfe", E), - {error,St} + {error,St1} end. -start() -> start(default). +%% start() -> Pid. +%% start(State) -> Pid. -start(Env) -> - spawn(fun () -> server(Env) end). +start() -> + spawn(fun () -> server() end). -server() -> server(default). +start(St) -> + spawn(fun () -> server(St) end). -server(default) -> - server(lfe_env:new()); -server(Env) -> - process_flag(trap_exit, true), %Must trap exists - io:put_chars(make_banner()), +%% server() -> no_return(). +%% server(State) -> no_return(). + +server() -> %% Create a default base env of predefined shell variables with %% default nil bindings and basic shell macros. - St = new_state("lfe", , Env), + St = new_state("lfe", ), + server(St). + +server(St) -> + process_flag(trap_exit, true), %Must trap exists + display_banner(), %% 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 @@ -186,7 +210,7 @@ end, Ff = fun (T, I) -> lfe_io:prettyprint1(T, 15, I, 80) end, Cs = lfe_lib:format_exception(Class, Reason, Stk, Sf, Ff, 1), - io:put_chars(Cs), + io:put_chars("** " ++ Cs), %Make it more note worthy io:nl(). %% read_expression(Prompt, Evaluator, State) -> {Return,Evaluator}. @@ -225,11 +249,23 @@ ?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("a") ++ ?GRN(" / /") ++ " | Source: " ++ ?BLU("http://github.com/lfe/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()). +display_banner() -> + %% When LFE is called with -noshell, we want to skip the banner. Also, there may be + %% circumstances where the shell is desired, but the banner needs to be disabled, + %% thus we want to support both use cases. + case init:get_argument(noshell) of + error -> case init:get_argument(nobanner) of + error -> io:put_chars(make_banner()); + _ -> false + end; + _ -> false + end. + 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 @@ -244,35 +280,44 @@ %% Generate a new shell state with all the default functions, macros %% and variables. -%% new_state(Script, Args) -> new_state(Script, Args, lfe_env:new()). +new_state(Script, Args) -> + new_state(Script, Args, lfe_env:new()). new_state(Script, Args, Env0) -> - Env1 = add_vbinding('script-name', Script, Env0), - Env2 = add_vbinding('script-args', Args, Env1), + Env1 = lfe_env:add_vbinding('script-name', Script, Env0), + Env2 = lfe_env:add_vbinding('script-args', Args, Env1), Base0 = add_shell_functions(Env2), Base1 = add_shell_macros(Base0), Base2 = add_shell_vars(Base1), #state{curr=Base2,save=Base2,base=Base2,slurp=false}. +upd_state(Script, Args, #state{curr=Curr,save=Save,base=Base}=St) -> + %% Update an environment with with script name and args. + Upd = fun (E0) -> + E1 = lfe_env:add_vbinding('script-name', Script, E0), + lfe_env:add_vbinding('script-args', Args, E1) + end, + St#state{curr=Upd(Curr),save=Upd(Save),base=Upd(Base)}. + add_shell_vars(Env0) -> %% Add default shell expression variables. - Env1 = foldl(fun (Symb, E) -> add_vbinding(Symb, , E) end, Env0, + Env1 = foldl(fun (Symb, E) -> lfe_env:add_vbinding(Symb, , E) end, Env0, '+','++','+++','-','*','**','***'), - add_vbinding('$ENV', Env1, Env1). %This gets it all + lfe_env:add_vbinding('$ENV', Env1, Env1). %This gets it all update_shell_vars(Form, Value, Env0) -> - Env1 = foldl(fun ({Symb,Val}, E) -> add_vbinding(Symb, Val, E) end, + Env1 = foldl(fun ({Symb,Val}, E) -> lfe_env:add_vbinding(Symb, Val, E) end, Env0, - {'+++',fetch_vbinding('++', Env0)}, - {'++',fetch_vbinding('+', Env0)}, + {'+++',lfe_env:fetch_vbinding('++', Env0)}, + {'++',lfe_env:fetch_vbinding('+', Env0)}, {'+',Form}, - {'***',fetch_vbinding('**', Env0)}, - {'**',fetch_vbinding('*', Env0)}, + {'***',lfe_env:fetch_vbinding('**', Env0)}, + {'**',lfe_env:fetch_vbinding('*', Env0)}, {'*',Value}), %% Be cunning with $ENV, remove self references so it doesn't grow %% indefinitely. - Env2 = del_vbinding('$ENV', Env1), - add_vbinding('$ENV', Env2, Env2). + Env2 = lfe_env:del_vbinding('$ENV', Env1), + lfe_env:add_vbinding('$ENV', Env2, Env2). add_shell_functions(Env0) -> Fs = @@ -282,9 +327,13 @@ {epp,1,lambda,e,':',lfe_shell,epp,e}, {epp,2,lambda,e,d,':',lfe_shell,epp,e,d}, {h,0,lambda,,':',lfe_shell,help}, + {h,1,lambda,m, ':',lfe_shell,h,m}, + {h,2,lambda,m,f, ':',lfe_shell,h,m,f}, + {h,3,lambda,m,f,a, ':',lfe_shell,h,m,f,a}, {help,0,lambda,,':',lfe_shell,help}, {i,0,lambda,,':',lfe_shell,i}, {i,1,lambda,ps,':',lfe_shell,i,ps}, + {i,3,lambda,x,y,z,':',lfe_shell,i,x,y,z}, {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}, @@ -297,19 +346,31 @@ {regs,0,lambda,,':',lfe_shell,regs}, {exit,0,lambda,,':',lfe_shell,exit} , + %% Any errors here will crash shell startup! Add = fun ({N,Ar,Def}, E) -> lfe_eval:add_dynamic_func(N, Ar, Def, E) end, Env1 = foldl(Add, Env0, Fs), Env1. +%% Last clause in match-lambda macro to catch-all as undefined function. +-define(UNDEF_MATCH_FUNC(Name), + args,'ENV',?BQ(error,{undefined_func,{Name,?C(length,args)}})). + add_shell_macros(Env0) -> %% We KNOW how macros are expanded and write them directly in %% expanded form here. Ms = {c,lambda,args,'$ENV',?BQ(':',lfe_shell,c,?C_A(args))}, - {describe,lambda,args,'$ENV', - ?BQ(':',lfe_shell,docs,?Q(?C(args)))}, - {doc,lambda,args,'$ENV',?BQ(':',lfe_shell,docs,?Q(?C(args)))}, + {describe,'match-lambda', + list,mod,'$ENV',?BQ(':',lfe_shell,doc,?Q(?C(mod))), + ?UNDEF_MATCH_FUNC(describe)}, + {doc,'match-lambda', + list,mod,'$ENV',?BQ(':',lfe_shell,h,?Q(?C(mod))), + list,mod,func,'$ENV', + ?BQ(':',lfe_shell,h,?Q(?C(mod)),?Q(?C(func))), + list,mod,func,arity,'$ENV', + ?BQ(':',lfe_shell,h,?Q(?C(mod)),?Q(?C(func)),?Q(?C(arity))), + ?UNDEF_MATCH_FUNC(doc)}, {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))}, @@ -348,7 +409,7 @@ eval_form(Form, Shell, St0) -> try - Ce1 = add_vbinding('-', Form, St0#state.curr), + Ce1 = lfe_env:add_vbinding('-', Form, St0#state.curr), %% Macro expand and evaluate it. {Value,St1} = eval_form(Form, St0#state{curr=Ce1}), %% Print the result, but only to depth 30. @@ -362,12 +423,11 @@ St2 catch exit:normal -> exit(normal); - Class:Reason -> - Stk = erlang:get_stacktrace(), + ?CATCH(Class, Reason, Stack) %% We don't want the ERROR REPORT generated by the %% emulator. Note: exit(kill) needs nothing special. Shell ! {eval_error,self(),Class}, - E = nocatch(Class, {Reason,Stk}), + E = nocatch(Class, {Reason,Stack}), exit(E) end. @@ -382,7 +442,7 @@ eval_form(Form, #state{curr=Ce}=St) -> %% Flatten progn nested forms. %% Don't deep expand, keep everything. - case lfe_macro:expand_forms({Form,1}, Ce, false, true) of + case lfe_macro:expand_fileforms({Form,1}, Ce, false, true) of {ok,Eforms,Ce1,Ws} -> list_warnings(Ws), St1 = St#state{curr=Ce1}, @@ -397,11 +457,6 @@ eval_form_1(progn|Eforms, St) -> %Top-level nested progn foldl(fun (F, {_,S}) -> eval_form_1(F, S) end, {,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}; @@ -412,17 +467,27 @@ %% Forget everything back to before current slurp. unslurp(St); eval_form_1(run|Args, St0) -> - {Value,St1} = run(Args, St0), + {Value,St1} = run_file(Args, St0), {Value,St1}; +eval_form_1('reset-environment', #state{base=Be}=St) -> + {ok,St#state{curr=Be}}; +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('define-record',Name,Fields, #state{curr=Ce0}=St) -> + %% Don't fully expand the record definition, push it till its used + %% in the same way as function and macro definitions. + Ce1 = lfe_env:add_record(Name, Fields, Ce0), + {Name,St#state{curr=Ce1}}; eval_form_1('define-function',Name,_Meta,Def, #state{curr=Ce0}=St) -> Ar = function_arity(Def), Ce1 = lfe_eval:add_dynamic_func(Name, Ar, Def, Ce0), {Name,St#state{curr=Ce1}}; eval_form_1('define-macro',Name,_Meta,Def, #state{curr=Ce0}=St) -> - Ce1 = add_mbinding(Name, Def, Ce0), + Ce1 = lfe_env:add_mbinding(Name, Def, Ce0), {Name,St#state{curr=Ce1}}; -eval_form_1('reset-environment', #state{base=Be}=St) -> - {ok,St#state{curr=Be}}; eval_form_1(Expr, St) -> %% General case just evaluate the expression. {lfe_eval:expr(Expr, St#state.curr),St}. @@ -459,7 +524,7 @@ Val = lfe_eval:expr(Exp, Ce0), %Evaluate expression case lfe_eval:match_when(Pat, Val, Guard, Ce0) of {yes,_,Bs} -> - Ce1 = foldl(fun ({N,V}, E) -> add_vbinding(N, V, E) end, + Ce1 = foldl(fun ({N,V}, E) -> lfe_env:add_vbinding(N, V, E) end, Ce0, Bs), {Val,St#state{curr=Ce1}}; no -> erlang:error({badmatch,Val}) @@ -501,16 +566,17 @@ Sl0 = #slurp{mod=Mod,funs=,imps=}, Sl1 = lists:foldl(fun collect_module/2, Sl0, Fs), %% Add imports to environment. - Env1 = foldl(fun ({M,Is}, Env) -> - foldl(fun ({{F,A},R}, E) -> - add_ibinding(M, F, A, R, E) - end, Env, Is) - end, Env0, Sl1#slurp.imps), + Ifun = fun ({M,Is}, Env) -> + foldl(fun ({{F,A},R}, E) -> + lfe_env:add_ibinding(M, F, A, R, E) + end, Env, Is) + end, + Env1 = foldl(Ifun, Env0, Sl1#slurp.imps), %% Add functions to environment. Env2 = foldl(fun ({N,Ar,Def}, Env) -> lfe_eval:add_dynamic_func(N, Ar, Def, Env) end, Env1, Sl1#slurp.funs), - {ok,Mod,add_env(Env2, Ce)}; + {ok,Mod,lfe_env:add_env(Env2, Ce)}; {error,Mews,Es,Ws} -> slurp_errors(Es), slurp_warnings(Ws), @@ -526,7 +592,7 @@ case lfe_comp:file(Name, binary,to_split,return) of {ok,{ok,Mod,Fs0,_}|_,Ws} -> %Only do first module %% Deep expand, don't keep everything. - case lfe_macro:expand_forms(Fs0, lfe_env:new(), true, false) of + case lfe_macro:expand_fileforms(Fs0, lfe_env:new(), true, false) of {ok,Fs1,Env,_} -> %% Flatten and trim away any eval-when-compile. {Fs2,42} = lfe_lib:proc_forms(fun slurp_form/3, Fs1, 42), @@ -547,14 +613,21 @@ slurp_form('eval-when-compile'|_, _, D) -> {,D}; slurp_form(F, L, D) -> {{F,L},D}. -collect_module({'define-module',Mod,_Mets,Atts,_}, Sl0) -> - Sl1 = collect_attrs(Atts, Sl0), - Sl1#slurp{mod=Mod}; -collect_module({'extend-module',_Meta,Atts,_}, Sl) -> - collect_attrs(Atts, Sl); +collect_module({'define-module',Mod,Meta,Atts,_}, Sl0) -> + Sl1 = collect_meta(Meta, Sl0), + Sl2 = collect_attrs(Atts, Sl1), + Sl2#slurp{mod=Mod}; +collect_module({'extend-module',Meta,Atts,_}, Sl0) -> + Sl1 = collect_meta(Meta, Sl0), + collect_attrs(Atts, Sl1); collect_module({'define-function',F,_Meta,Def,_}, #slurp{funs=Fs}=Sl) -> Ar = function_arity(Def), - Sl#slurp{funs={F,Ar,Def}|Fs}. + Sl#slurp{funs={F,Ar,Def}|Fs}; +collect_module({_,_}, Sl) -> + %% Ignore other forms, type and spec defs. + Sl. + +collect_meta(_, St) -> St. collect_attrs(import|Is|Atts, St) -> collect_attrs(Atts, collect_imps(Is, St)); @@ -598,15 +671,15 @@ lfe_io:format(Format, File,Line,Cs) end, Ews). -%% run(Args, State) -> {Value,State}. +%% run_file(Args, State) -> {Value,State}. %% Run the shell expressions in a file. Abort on errors and only %% return updated state if there are no errors. -run(File, #state{curr=Ce}=St) -> +run_file(File, #state{curr=Ce}=St) -> Name = lfe_eval:expr(File, Ce), %Get file name case read_script_file(Name) of %Read the file {ok,Forms} -> - run_loop(Forms, , St); + run_loop(Forms, St); {error,E} -> slurp_errors(Name, E), {error,St} @@ -619,19 +692,15 @@ read_script_file(File) -> case file:open(File, read) of - {ok,F} -> + {ok,Fd} -> %% Check if first a script line, if so skip it. - case io:get_line(F, '') of - "#!" ++ _ -> ok; - _ -> file:position(F, bof) %Reset to start of file - end, - Ret = case io:request(F, {get_until,unicode,'',lfe_scan,tokens,1}) of - {ok,Ts,Lline} -> parse_tokens(Ts, Lline, ); - {error,Error,_} -> {error,Error} - end, - file:close(F), %Close the file - Ret; - {error,Error} -> {error,{none,file,Error}} + case io:get_line(Fd, '') of + "#!" ++ _ -> + lfe_io:read_file(Fd, 2); + _ -> + file:position(Fd, bof), %Reset to start of file + lfe_io:read_file(Fd, 1) + end end. %% read_script_string(FileName) -> {ok,Sexpr} | {error,Error}. @@ -639,25 +708,15 @@ %% lfe_io:read_string except parse all forms. read_script_string(String) -> - case lfe_scan:string(String, 1) of - {ok,Ts,Lline} -> parse_tokens(Ts, Lline, ); - {error,E,_} -> {error,E} - end. + lfe_io:read_string(String). -parse_tokens(_|_=Ts0, Lline, Ss) -> - case lfe_parse:sexpr(Ts0) of - {ok,_,S,Ts1} -> parse_tokens(Ts1, Lline, 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,Lline}), - {error,E}; - {error,E,_} -> {error,E} - end; -parse_tokens(, _, Ss) -> {ok,reverse(Ss)}. +%% run_loop(Forms, State) -> {Value,State}. +%% run_loop(Forms PrevValue, State) -> {Value,State}. + +run_loop(Fs, St) -> run_loop(Fs, , St). run_loop(F|Fs, _, St0) -> - Ce1 = add_vbinding('-', F, St0#state.curr), + Ce1 = lfe_env:add_vbinding('-', F, St0#state.curr), {Value,St1} = eval_form(F, St0#state{curr=Ce1}), Ce2 = update_shell_vars(F, Value, St1#state.curr), run_loop(Fs, Value, St1#state{curr=Ce2}); @@ -748,17 +807,21 @@ "(cd dir) -- change working directory to <dir>\n" "(clear) -- clear the REPL output\n" "(doc mod) -- documentation of a module\n" - "(doc mod mac) -- documentation of a macro\n" - "(doc m f a) -- documentation of a function\n" + "(doc mod:mac) -- documentation of a macro\n" + "(doc m:f/a) -- documentation of a function\n" "(ec file) -- compile and load code in erlang <file>\n" "(ep expr) -- print a term in erlang form\n" "(epp expr) -- pretty print a term in erlang form\n" "(exit) -- quit - an alias for (q)\n" "(flush) -- flush any messages sent to the shell\n" "(h) -- an alias for (help)\n" + "(h m) -- help about module\n" + "(h m m) -- help about function and macro in module\n" + "(h m f a) -- help about function/arity in module\n" "(help) -- help info\n" "(i) -- information about the system\n" "(i pids) -- information about a list of pids\n" + "(i x y z) -- information about pid #Pid<x.y.z>\n" "(l module) -- load or reload <module>\n" "(ls) -- list files in the current directory\n" "(ls dir) -- list files in directory <dir>\n" @@ -766,11 +829,12 @@ "(m mod) -- information about module <mod>\n" "(p expr) -- print a term\n" "(pp expr) -- pretty print a term\n" - "(pid x y z) -- convert <x>, <y> and <z> to a pid\n" + "(pid x y z) -- convert x, y, z to a pid\n" "(pwd) -- print working directory\n" "(q) -- quit - shorthand for init:stop/0\n" - "(regs) -- information about registered processes\n\n" - "LFE shell built-in commands\n\n" + "(regs) -- information about registered processes\n" + "\n" + "LFE shell built-in forms\n\n" "(reset-environment) -- reset the environment to its initial state\n" "(run file) -- execute all the shell commands in a <file>\n" "(set pattern expr)\n" @@ -781,7 +845,7 @@ "(unslurp) -- revert back to the state before the last\n" " slurp\n\n" "LFE shell built-in variables\n\n" - "+/++/+++ -- the tree previous expressions\n" + "+/++/+++ -- the three previous expressions\n" "*/**/*** -- the values of the previous expressions\n" "- -- the current expression output\n" "$ENV -- the current LFE environment\n\n" @@ -793,6 +857,8 @@ i(Pids) -> c:i(Pids). +i(X, Y, Z) -> c:i(X, Y, Z). + %% l(Modules) -> ok. %% Load the modules. @@ -841,7 +907,7 @@ print_md5(Info) -> case lists:keyfind(md5, 1, Info) of {md5,<<MD5:128>>} -> lfe_io:format("MD5: ~.16b~n", MD5); - error -> ok + false -> ok end. print_compile_time(Info) -> @@ -870,7 +936,7 @@ lfe_io:format("Exported functions:~n", ), Exps = case lists:keyfind(exports, 1, Info) of {exports,Es} -> Es; - error -> + false -> end, print_names(fun ({N,Ar}) -> lfe_io:format1("~w/~w", N,Ar) end, Exps). @@ -882,14 +948,14 @@ (_) -> end, lists:flatmap(Fun, Attrs); - error -> + false -> end, print_names(fun (N) -> lfe_io:print1(N) end, Macs). print_names(Format, Names) -> %% Generate flattened list of strings. Strs = lists:map(fun (N) -> lists:flatten(Format(N)) end, - lists:sort(Names)), + lists:sort(Names)), %% Split into equal length lists and print out. {S1,S2} = lists:split(round(length(Strs)/2), Strs), print_name_strings(S1, S2). @@ -956,58 +1022,119 @@ exit() -> c:q(). -%% doc(Fun) -> ok. -%% docs(Funs) -> ok. +%% doc(Mod) -> ok | {error,Error}. +%% doc(Mod, Func) -> ok | {error,Error}. +%% doc(Mod, Func, Arity) -> ok | {error,Error}. %% Print out documentation of a module/macro/function. Always try to %% find the file and use it as this is the only way to get hold of %% the chunks. This may get a later version than is loaded. -docs(Fs) -> - lists:foreach(fun doc/1, Fs). - -doc(What) -> - Mod|F = lfe_lib:split_name(What), - io:format(?RED("~*c")++"\n", 60,$_), %Print a red line - case lfe_doc:get_module_docs(Mod) of - {ok,Docs} -> - case F of - -> %Only module name - print_module_doc(Mod, Docs); - Mac -> %Macro - print_macro_doc(Mac, Docs); - Fun,Ar -> %Function - print_function_doc(Fun, Ar, Docs) - end; - {error,module} -> - lfe_io:format("No module ~s\n\n", Mod); - {error,docs} -> - lfe_io:format("No module documentation for ~s\n\n", Mod) - end. +%% doc(?Q(What)) -> doc(What); %Be kind if they quote it +%% doc(What) -> +%% Mod|F = lfe_lib:split_name(What), -print_module_doc(Mod, Docs) -> - lfe_io:format(?BLU("~p")++"\n\n", Mod), - print_docs(lfe_doc:module_doc(Docs)), - io:nl(). +h(Mod) -> + case lfe_docs:get_module_docs(Mod) of + {ok,#docs_v1{}=Docs} -> + Ret = get_module_doc(Mod, Docs), + format_doc(Ret); + Error -> Error + end. -print_macro_doc(Mac, Docs) -> - case lfe_doc:macro_docs(Mac, Docs) of - {ok,Md} -> - lfe_io:format(?BLU("~p")++"\n", Mac), - print_docs(lfe_doc:macro_doc(Md)), - io:nl(); - error -> - lfe_io:format("No macro ~s defined\n\n", Mac) +h(Mod, Func) -> + case lfe_docs:get_module_docs(Mod) of + {ok,#docs_v1{}=Docs} -> + Ret = get_macro_doc(Mod, Func, Docs), + format_doc(Ret); + Error -> Error end. -print_function_doc(Fun, Ar, Docs) -> - case lfe_doc:function_docs(Fun, Ar, Docs) of - {ok,Fd} -> - lfe_io:format(?BLU("~p/~p")++"\n", Fun,Ar), - print_docs(lfe_doc:function_doc(Fd)), - io:nl(); - error -> - lfe_io:format("No function ~s/~p defined\n\n", Fun,Ar) +h(Mod, Func, Arity) -> + case lfe_docs:get_module_docs(Mod) of + {ok,#docs_v1{}=Docs} -> + Ret = get_function_doc(Mod, Func, Arity, Docs), + format_doc(Ret); + Error -> Error end. -print_docs(Ds) -> - foreach(fun (D) -> lfe_io:format("~s\n", D) end, Ds). +format_doc({error,_}=Error) -> Error; +format_doc(Docs) -> + {match,Lines} = re:run(Docs, "(.+\n|\n)", + unicode,global,{capture,all_but_first,binary}), + Pline = fun (Line) -> + io:put_chars(Line), + 1 %Output one line + end, + paged_output(Pline, Lines), + ok. + + +-ifdef(EEP48). + +get_module_doc(Mod, #docs_v1{format = ?NATIVE_FORMAT}=Docs) -> + shell_docs:render(Mod, Docs); +get_module_doc(Mod, #docs_v1{format = ?LFE_FORMAT}=Docs) -> + lfe_shell_docs:render(Mod, Docs); +get_module_doc(_Mod, #docs_v1{format = Enc}) -> + {error, {unknown_format, Enc}}. + +get_macro_doc(Mod, Name, #docs_v1{format = ?NATIVE_FORMAT}=Docs) -> + shell_docs:render(Mod, Name, Docs); +get_macro_doc(Mod, Name, #docs_v1{format = ?LFE_FORMAT}=Docs) -> + lfe_shell_docs:render(Mod, Name, Docs); +get_macro_doc(_Mod, _Name, #docs_v1{format = Enc}) -> + {error, {unknown_format, Enc}}. + +get_function_doc(Mod, Name, Arity, #docs_v1{format = ?NATIVE_FORMAT}=Docs) -> + shell_docs:render(Mod, Name, Arity, Docs); +get_function_doc(Mod, Name, Arity, #docs_v1{format = ?LFE_FORMAT}=Docs) -> + lfe_shell_docs:render(Mod, Name, Arity, Docs); +get_function_doc(_Mod, _Name, _Arity, #docs_v1{format = Enc}) -> + {error, {unknown_format, Enc}}. + +-else. + +get_module_doc(Mod, #docs_v1{format = ?LFE_FORMAT}=Docs) -> + lfe_shell_docs:render(Mod, Docs); +get_module_doc(_Mod, #docs_v1{format = Enc}) -> + {error, {unknown_format, Enc}}. + +get_macro_doc(Mod, Name, #docs_v1{format = ?LFE_FORMAT}=Docs) -> + lfe_shell_docs:render(Mod, Name, Docs); +get_macro_doc(_Mod, _Name, #docs_v1{format = Enc}) -> + {error, {unknown_format, Enc}}. + +get_function_doc(Mod, Name, Arity, #docs_v1{format = ?LFE_FORMAT}=Docs) -> + lfe_shell_docs:render(Mod, Name, Arity, Docs); +get_function_doc(_Mod, _Name, _Arity, #docs_v1{format = Enc}) -> + {error, {unknown_format, Enc}}. + +-endif. + +%% paged_output(PrintItem, Items) -> ok. +%% Output item lines a page at a time. This can handle an item +%% returning multiple lines. + +paged_output(Pitem, Items) -> + %% How many rows per "page", just set it to 30 for now. + Limit = 30, + paged_output(Pitem, 0, Limit, Items). + +paged_output(Pitem, Curr, Limit, Items) when Curr >= Limit -> + case more() of + more -> paged_output(Pitem, 0, Limit, Items); + less -> ok + end; +paged_output(Pitem, Curr, Limit, Item|Items) -> + Olines = Pitem(Item), + paged_output(Pitem, Curr + Olines, Limit, Items); +paged_output(_, _, _, ) -> ok. + +more() -> + case io:get_line('More (y/n)? ') of + "y\n" -> more; + "c\n" -> more; + "n\n" -> less; + "q\n" -> less; + _ -> more() + end.
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_shell_docs.erl
Added
@@ -0,0 +1,91 @@ +%% Copyright (c) 2022 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_shell_docs.erl +%% Author : Robert Virding +%% Purpose : Render LFE docs for output in shell. + +%% The interface is loosely modelled on the shell_docs module. + +-module(lfe_shell_docs). + +-export(render/2,render/3,render/4). + +-include("lfe.hrl"). +-include("lfe_docs.hrl"). + +%% Coloured strings for the LFE banner, red, green, yellow and blue. +-define(RED(Str), "\e31m" ++ Str ++ "\e0m"). +-define(GRN(Str), "\e1;32m" ++ Str ++ "\e0m"). +-define(YLW(Str), "\e1;33m" ++ Str ++ "\e0m"). +-define(BLU(Str), "\e1;34m" ++ Str ++ "\e0m"). +-define(BOLD(Str), "\e1m" ++ Str ++ "\e0m"). + +%% render(Module, Docs) -> unicode:chardata(). + +render(Bin, Docs) when is_binary(Bin) -> + {ok,{Mod,_}} = beam_lib:chunks(Bin, , ), %Sneaky! + render(Mod, Docs); +render(Mod, #docs_v1{format = ?LFE_FORMAT, module_doc=Mdoc}) -> + red_line(60), + lfe_io:format1(?BLU("~p")++"\n\n", Mod), + return_doc(Mod, Mdoc). + +%% render(Module, Function, Docs) -> unicode:chardata(). + +render(_Mod, Name, #docs_v1{format = ?LFE_FORMAT, docs = Docs}) -> + Render = fun ({{function,_Func,_Ar},_,Sig,Doc,Meta}) -> + red_line(60), + return_sig(function, Sig, Meta), + return_doc(Sig, Doc); + ({{macro,_Macro,_},_,Sig,Doc,Meta}) -> + red_line(60), + return_sig(macro, Sig, Meta), + return_doc(Sig, Doc) + end, + Ret = Render(F) || {{_,N,_},_,_,_,_}=F <- Docs, N =:= Name , + return_render(Ret, function_missing). + +%% render(Module, Function, Arity, Docs) -> unicode:chardata(). + +render(_Mod, Name, Arity, #docs_v1{format = ?LFE_FORMAT, docs = Docs}) -> + Render = fun ({{function,_Func,_Ar},_,Sig,Doc,Meta}) -> + red_line(60), + return_sig(function, Sig, Meta), + return_doc(Sig, Doc) + end, + Ret = Render(F) || {{function,N,A},_,_,_,_}=F <- Docs, + N =:= Name, A =:= Arity , + return_render(Ret, function_missing). + +return_doc(_Missing, #{<<"en">> := Dv}) -> + lfe_io:format1("~s\n", Dv); +return_doc(Missing, None) when None =:= none; None =:= #{} -> + lfe_io:format1(<<"No documentation for ~s\n">>, Missing); +return_doc(Missing, _Docs) -> + lfe_io:format1(<<"Unknown format for ~s\n">>, Missing). + +%% return_sig(_Type, _Sig, #{signature:=Spec}) -> +%% lfe_io:format1(?BLU("~s") ++ "\n", erl_pp:form(Spec)); +return_sig(Type, Sig, _Meta) -> + lfe_io:format1(?BLU("~s ~s") ++ "\n\n", Type,Sig). + +return_render(, Error) -> {error,Error}; +return_render(FDocs, _Error) -> FDocs. + +%% red_line(Length) -> ok. +%% Output a red line of Length characters. + +red_line(Len) -> + io_lib:format(?RED("~*c")++"\n", Len,$-).
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_struct.erl
Added
@@ -0,0 +1,29 @@ +%% Copyright (c) 2022 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_struct.erl +%% Author : Robert Virding +%% Purpose : Lisp Flavoured Erlang library for elixir structs. + +-module(lfe_struct). + +-export(to_assocs/1). + +-include("lfe.hrl"). + +to_assocs(Key,Val|Kvs) -> + tuple,Key,Val|to_assocs(Kvs); +to_assocs(Key) -> %Should we catch this? + error({missing_struct_field_value,Key}); +to_assocs() -> .
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_translate.erl
Added
@@ -0,0 +1,1698 @@ +%% Copyright (c) 2008-2021 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_trans.erl +%% Author : Robert Virding +%% Purpose : Lisp Flavoured Erlang translator. + +%%% Translate LFE code to/from vanilla Erlang AST. +%%% +%%% Note that we don't really check code here as such, we assume the +%%% input is correct. If there is an error in the input we just fail. +%%% This allows us to accept forms which are actually illegal but we +%%% may special case, for example functions call in patterns which +%%% will become macro expansions. +%%% +%%% Having import from and rename forces us to explicitly convert the +%%% call as we can't use an import attribute to do this properly for +%%% us. Hence we collect the imports in lfe_codegen and pass them onto +%%% us. +%%% +%%% Module aliases are collected in lfe_codegen and passed on to us. + +-module(lfe_translate). + +-export(from_expr/1,from_expr/2,from_body/1,from_body/2,from_lit/1). + +-export(to_expr/2,to_expr/3,to_exprs/2,to_exprs/3). +-export(to_gexpr/2,to_gexpr/3,to_gexprs/2,to_gexprs/3,to_lit/2). + +-include("lfe.hrl"). + +-record(from, {vc=0 %Variable counter + }). + +%% from_expr(AST) -> Sexpr. +%% from_expr(AST, Variables) -> {Sexpr,Variables}. +%% from_body(AST) -> Sexpr. +%% from_body(AST, Variables) -> {Sexpr,Variables}. +%% Translate a vanilla Erlang expression into LFE. The main +%% difficulty is in the handling of variables. The implicit matching +%% of known variables in vanilla must be translated into explicit +%% equality tests in guards (which is what the compiler does +%% internally). For this we need to keep track of visible variables +%% and detect when they reused in patterns. + +from_expr(E) -> + {S,_,_} = from_expr(E, ordsets:new(), #from{}), + S. + +from_expr(E, Vs0) -> + Vt0 = ordsets:from_list(Vs0), %We are clean + {S,Vt1,_} = from_expr(E, Vt0, #from{}), + {S,ordsets:to_list(Vt1)}. + +from_body(Es) -> + {Les,_,_} = from_body(Es, ordsets:new(), #from{}), + progn|Les. + +from_body(Es, Vs0) -> + 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}. +%% Convert one expression from Erlang AST to an LFE form. + +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({cons,_,H,T}, Vt0, St0) -> + {Car,Vt1,St1} = from_expr(H, Vt0, St0), + {Cdr,Vt2,St2} = from_expr(T, Vt1, St1), + {from_cons(Car, Cdr),Vt2,St2}; +%% {cons,Car,Cdr,Vt2,St2}; +from_expr({tuple,_,Es}, Vt0, St0) -> + {Ss,Vt1,St1} = from_expr_list(Es, Vt0, St0), + {tuple|Ss,Vt1,St1}; +from_expr({bin,_,Segs}, Vt0, St0) -> + {Ss,Vt1,St1} = from_bitsegs(Segs, Vt0, St0), + {binary|Ss,Vt1,St1}; +from_expr({map,_,Assocs}, Vt0, St0) -> %Build a map + {Ps,Vt1,St1} = from_map_assocs(Assocs, Vt0, St0), + {map|Ps,Vt1,St1}; +from_expr({map,_,Map,Assocs}, Vt0, St0) -> %Update a map + {Lm,Vt1,St1} = from_expr(Map, Vt0, St0), + from_map_update(Assocs, nul, Lm, Vt1, St1); +%% Record special forms, though some are function calls in Erlang. +from_expr({record,_,Name,Fs}, Vt0, St0) -> + {Lfs,Vt1,St1} = from_record_fields(Fs, Vt0, St0), + {'record',Name|Lfs,Vt1,St1}; +from_expr({call,_,{atom,_,is_record},E,{atom,_,Name}}, Vt0, St0) -> + {Le,Vt1,St1} = from_expr(E, Vt0, St0), + {'is-record',Le,Name,Vt1,St1}; +from_expr({record_index,_,Name,{atom,_,F}}, Vt, St) -> %We KNOW! + {'record-index',Name,F,Vt,St}; +from_expr({record_field,_,E,Name,{atom,_,F}}, Vt0, St0) -> %We KNOW! + {Le,Vt1,St1} = from_expr(E, Vt0, St0), + {'record-field',Le,Name,F,Vt1,St1}; +from_expr({record,_,E,Name,Fs}, Vt0, St0) -> + {Le,Vt1,St1} = from_expr(E, Vt0, St0), + {Lfs,Vt2,St2} = from_record_fields(Fs, Vt1, St1), + {'record-update',Le,Name|Lfs,Vt2,St2}; +from_expr({record_field,_,_,_}=M, Vt, St) -> %Pre R16 packages + from_package_module(M, Vt, St); +%% Function special forms. +from_expr({'fun',_,{clauses,Cls}}, Vt, St0) -> + {Lcls,St1} = from_fun_cls(Cls, Vt, St0), + {'match-lambda'|Lcls,Vt,St1}; %Don't bother using lambda +from_expr({'fun',_,{function,F,A}}, Vt, St) -> + %% These are just literal values. + {function,F,A,Vt,St}; +from_expr({'fun',_,{function,M,F,A}}, Vt, St) -> + %% These are abstract values. + {function,from_lit(M),from_lit(F),from_lit(A),Vt,St}; +%% Core control special forms. +from_expr({match,_,_,_}=Match, Vt, St) -> + from_match(Match, Vt, St); +from_expr({block,_,Es}, Vt, St) -> + from_block(Es, Vt, St); +from_expr({'if',_,Cls}, Vt0, St0) -> %This is the Erlang if + {Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0), + {'case',|Lcls,Vt1,St1}; +from_expr({'case',_,E,Cls}, Vt0, St0) -> + {Le,Vt1,St1} = from_expr(E, Vt0, St0), + {Lcls,Vt2,St2} = from_icrt_cls(Cls, Vt1, St1), + {'case',Le|Lcls,Vt2,St2}; +from_expr({'receive',_,Cls}, Vt0, St0) -> + {Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0), + {'receive'|Lcls,Vt1,St1}; +from_expr({'receive',_,Cls,Timeout,Body}, Vt0, St0) -> + {Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0), + {Lt,Vt2,St2} = from_expr(Timeout, Vt1, St1), + {Lb,Vt3,St3} = from_body(Body, Vt2, St2), + {'receive'|Lcls ++ 'after',Lt|Lb,Vt3,St3}; +from_expr({'catch',_,E}, Vt0, St0) -> + {Le,Vt1,St1} = from_expr(E, Vt0, St0), + {'catch',Le,Vt1,St1}; +from_expr({'try',_,Es,Scs,Ccs,As}, Vt, St) -> + from_try(Es, Scs, Ccs, As, Vt, St); +%% List/binary comprensions. +from_expr({lc,_,E,Qs}, Vt, St) -> + from_list_comp(E, Qs, Vt, St); +from_expr({bc,_,Seg,Qs}, Vt, St) -> + from_binary_comp(Seg, Qs, Vt, St); +%% Function calls. +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 + {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 + {Lf,Vt1,St1} = from_expr(F, Vt0, St0), + {Las,Vt2,St2} = from_expr_list(As, Vt1, St1), + {funcall,Lf|Las,Vt2,St2}; +from_expr({op,_,Op,A}, Vt0, St0) -> + {La,Vt1,St1} = from_expr(A, Vt0, St0), + {Op,La,Vt1,St1}; +from_expr({op,_,Op,L,R}, Vt0, St0) -> + {Ll,Vt1,St1} = from_expr(L, Vt0, St0), + {Lr,Vt2,St2} = from_expr(R, Vt1, St1), + {Op,Ll,Lr,Vt2,St2}. + +from_cons(Car, list|Es) -> list,Car|Es; +from_cons(Car, ) -> list,Car; +from_cons(Car, Cdr) -> cons,Car,Cdr. + +%% from_body(Expressions, VarTable, State) -> {Body,VarTable,State}. +%% Handle '=' specially here and translate into let containing rest +%% of body. + +from_body({match,_,_,_}=Match, Vt0,St0) -> %Last match + {Lm,Vt1,St1} = from_expr(Match, Vt0, St0), %Must return pattern as value + {Lm,Vt1,St1}; +from_body({match,_,P,E}|Es, Vt0, St0) -> + {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), + {Le,Vt2,St2} = from_expr(E, Vt1, St1), + {Les,Vt3,St4} = from_body(Es, Vt2, St2), + Leg = from_eq_tests(Eqt), %Implicit guard tests + Lbody = from_add_guard(Leg, Le), + {'let',Lp|Lbody|Les,Vt3,St4}; +from_body(E|Es, Vt0, St0) -> + {Le,Vt1,St1} = from_expr(E, Vt0, St0), + {Les,Vt2,St2} = from_body(Es, Vt1, St1), + {Le|Les,Vt2,St2}; +from_body(, Vt, St) -> {,Vt,St}. + +from_expr_list(Es, Vt, St) -> + mapfoldl2(fun from_expr/3, Vt, St, Es). + +%% from_block(Body, VarTable, State) -> {Block,State}. + +from_block(Es, Vt0, St0) -> + case from_body(Es, Vt0, St0) of + {Le,Vt1,St1} -> {Le,Vt1,St1}; + {Les,Vt1,St1} -> {progn|Les,Vt1,St1} + end. + +%% from_add_guard(GuardTests, Body) -> Body. +%% Only prefix with a guard when there are tests. + +from_add_guard(, Body) -> Body; %No guard tests +from_add_guard(Gts, Body) -> + 'when'|Gts|Body. + +%% from_match(Match, VarTable, State) -> {LetForm,State}. +%% Match returns the value of the expression. Use a let to do +%% matching with an alias which we return for value. + +from_match({match,L,P,E}, Vt0, St0) -> + {Alias,St1} = new_from_var(St0), %Alias variable value + MP = {match,L,{var,L,Alias},P}, + {Lp,Eqt,Vt1,St2} = from_pat(MP, Vt0, St1), %The alias pattern + {Le,Vt2,St3} = from_expr(E, Vt1, St2), %The expression + Leg = from_eq_tests(Eqt), %Implicit guard tests + Lbody = from_add_guard(Leg, Le), %Now build the whole body + {'let',Lp|Lbody,Alias,Vt2,St3}. + +%% from_bitsegs(Segs, VarTable, State) -> {Segs,VarTable,State}. + +from_bitsegs({bin_element,_,Seg,Size,Type}|Segs, Vt0, St0) -> + {S,Vt1,St1} = from_bitseg(Seg, Size, Type, Vt0, St0), + {Ss,Vt2,St2} = from_bitsegs(Segs, Vt1, St1), + {S|Ss,Vt2,St2}; +from_bitsegs(, Vt, St) -> {,Vt,St}. + +%% So it won't get confused with strings. +from_bitseg({integer,_,I}, default, default, Vt, St) -> {I,Vt,St}; +from_bitseg({integer,_,I}, Size, Type, Vt0, St0) -> + {Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0), + {I|from_bitseg_type(Type) ++ Lsize,Vt1,St1}; +from_bitseg({float,_,F}, Size, Type, Vt0, St0) -> + {Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0), + {F|from_bitseg_type(Type) ++ Lsize,Vt1,St1}; +from_bitseg({string,_,S}, Size, Type, Vt0, St0) -> + {Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0), + {S|from_bitseg_type(Type) ++ Lsize,Vt1,St1}; +from_bitseg(E, Size, Type, Vt0, St0) -> + {Le,Vt1,St1} = from_expr(E, Vt0, St0), + {Lsize,Vt2,St2} = from_bitseg_size(Size, Vt1, St1), + {Le|from_bitseg_type(Type) ++ Lsize,Vt2,St2}. + +from_bitseg_size(default, Vt, St) -> {,Vt,St}; +from_bitseg_size(Size, Vt0, St0) -> + {Ssize,Vt1,St1} = from_expr(Size, Vt0, St0), + {size,Ssize,Vt1,St1}. + +from_bitseg_type(default) -> ; +from_bitseg_type(Ts) -> + lists:map(fun ({unit,U}) -> unit,U; (T) -> T end, Ts). + +%% from_map_assocs(MapAssocs, VarTable, State) -> {Pairs,VarTable,State}. + +from_map_assocs({_,_,Key,Val}|As, Vt0, St0) -> + {Lk,Vt1,St1} = from_expr(Key, Vt0, St0), + {Lv,Vt2,St2} = from_expr(Val, Vt1, St1), + {Las,Vt3,St3} = from_map_assocs(As, Vt2, St2), + {Lk,Lv|Las,Vt3,St3}; +from_map_assocs(, Vt, St) -> {,Vt,St}. + +%% from_map_update(MapAssocs, CurrAssoc, CurrMap, VarTable, State) -> +%% {Map,VarTable,State}. +%% We need to be a bit cunning here and do everything left-to-right +%% and minimize nested calls. + +from_map_update({Assoc,_,Key,Val}|As, Curr, Map0, Vt0, St0) -> + {Lk,Vt1,St1} = from_expr(Key, Vt0, St0), + {Lv,Vt2,St2} = from_expr(Val, Vt1, St1), + %% Check if can continue this mapping or need to start a new one. + Map1 = if Assoc =:= Curr -> Map0 ++ Lk,Lv; + Assoc =:= map_field_assoc -> 'map-set',Map0,Lk,Lv; + Assoc =:= map_field_exact -> 'map-update',Map0,Lk,Lv + end, + from_map_update(As, Assoc, Map1, Vt2, St2); +%% from_map_update({Assoc,_,Key,Val}|Fs, Assoc, Map0, Vt0, St0) -> +%% {Lk,Vt1,St1} = from_expr(Key, Vt0, St0), +%% {Lv,Vt2,St2} = from_expr(Val, Vt1, St1), +%% from_map_update(Fs, Assoc, Map0 ++ Lk,Lv, Vt2, St2); +%% from_map_update({Assoc,_,Key,Val}|Fs, _, Map0, Vt0, St0) -> +%% {Lk,Vt1,St1} = from_expr(Key, Vt0, St0), +%% {Lv,Vt2,St2} = from_expr(Val, Vt1, St1), +%% Op = if Assoc =:= map_field_assoc -> 'map-set'; +%% true -> 'map-update' +%% end, +%% from_map_update(Fs, Assoc, Op,Map0,Lk,Lv, Vt2, St2); +from_map_update(, _, Map, Vt, St) -> {Map,Vt,St}. + +%% from_record_fields(Recfields, VarTable, State) -> {Recfields,VarTable,State}. + +from_record_fields({record_field,_,{atom,_,F},V}|Fs, Vt0, St0) -> + {Lv,Vt1,St1} = from_expr(V, Vt0, St0), + {Lfs,Vt2,St2} = from_record_fields(Fs, Vt1, St1), + {F,Lv|Lfs,Vt2,St2}; +from_record_fields({record_field,_,{var,_,F},V}|Fs, Vt0, St0) -> + %% Special case!! + {Lv,Vt1,St1} = from_expr(V, Vt0, St0), + {Lfs,Vt2,St2} = from_record_fields(Fs, Vt1, St1), + {F,Lv|Lfs,Vt2,St2}; +from_record_fields(, Vt, St) -> {,Vt,St}. + +%% from_icrt_cls(Clauses, VarTable, State) -> {Clauses,VarTable,State}. +%% from_icrt_cl(Clause, VarTable, State) -> {Clause,VarTable,State}. +%% If/case/receive/try clauses. +%% No ; in guards, so no guard sequence only one list of guard tests. + +from_icrt_cls(Cls, Vt, St) -> from_cls(fun from_icrt_cl/3, Cls, Vt, St). + +from_icrt_cl({clause,_,,G,B}, Vt0, St0) -> %If clause + {Lg,Vt1,St1} = from_body(G, Vt0, St0), + {Lb,Vt2,St2} = from_body(B, Vt1, St1), + Lbody = from_add_guard(Lg, Lb), + {'_'|Lbody,Vt2,St2}; +from_icrt_cl({clause,_,H,,B}, Vt0, St0) -> + {Lh,Eqt,Vt1,St1} = from_pats(H, Vt0, St0), %List of one + {Lb,Vt2,St2} = from_body(B, Vt1, St1), + Leg = from_eq_tests(Eqt), + Lbody = from_add_guard(Leg, Lb), + {Lh|Lbody,Vt2,St2}; +from_icrt_cl({clause,_,H,G,B}, Vt0, St0) -> + {Lh,Eqt,Vt1,St1} = from_pats(H, Vt0, St0), %List of one + {Lg,Vt2,St2} = from_body(G, Vt1, St1), + {Lb,Vt3,St3} = from_body(B, Vt2, St2), + Leg = from_eq_tests(Eqt), + Lbody = from_add_guard(Leg ++ Lg, Lb), + {Lh|Lbody,Vt3,St3}. + +%% from_fun_cls(Clauses, VarTable, State) -> {Clauses,State}. +%% from_fun_cl(Clause, VarTable, State) -> {Clause,VarTable,State}. +%% Function clauses, all variables in the patterns are new variables +%% which shadow existing variables without equality tests. + +from_fun_cls(Cls, Vt, St0) -> + {Lcls,_,St1} = from_cls(fun from_fun_cl/3, Cls, Vt, St0), + {Lcls,St1}. + +from_fun_cl({clause,_,H,,B}, Vt0, St0) -> + {Lh,Eqt,Vtp,St1} = from_pats(H, , St0), + Vt1 = ordsets:union(Vtp, Vt0), %All variables so far + {Lb,Vt2,St2} = from_body(B, Vt1, St1), + Leg = from_eq_tests(Eqt), + Lbody = from_add_guard(Leg, Lb), + {Lh|Lbody,Vt2,St2}; +from_fun_cl({clause,_,H,G,B}, Vt0, St0) -> + {Lh,Eqt,Vtp,St1} = from_pats(H, , St0), + Vt1 = ordsets:union(Vtp, Vt0), %All variables so far + {Lg,Vt2,St2} = from_body(G, Vt1, St1), + {Lb,Vt3,St3} = from_body(B, Vt2, St2), + Leg = from_eq_tests(Eqt), + Lbody = from_add_guard(Leg ++ Lg, Lb), + {Lh|Lbody,Vt3,St3}. + +%% from_cls(ClauseFun, Clauses, VarTable, State) -> {Clauses,VarTable,State}. +%% Translate the clauses but only export variables that are defined +%% in all clauses, the intersection of the variables. + +from_cls(Fun, C, Vt0, St0) -> + {Lc,Vt1,St1} = Fun(C, Vt0, St0), + {Lc,Vt1,St1}; +from_cls(Fun, C|Cs, Vt0, St0) -> + {Lc,Vtc,St1} = Fun(C, Vt0, St0), + {Lcs,Vtcs,St2} = from_cls(Fun, Cs, Vt0, St1), + {Lc|Lcs,ordsets:intersection(Vtc, Vtcs),St2}. + +from_eq_tests(Gs) -> '=:=',V,V1 || {V,V1} <- Gs . + +%% from_try(Exprs, CaseClauses, CatchClauses, After, VarTable, State) -> +%% {Try,State}. +%% Only return the parts which have contents. + +from_try(Es, Scs, Ccs, As, Vt, St0) -> + %% Try does not allow any exports! + {Les,_,St1} = from_body(Es, Vt, St0), + %% These maybe empty. + {Lscs,_,St2} = if Scs =:= -> {,,St1}; + true -> from_icrt_cls(Scs, Vt, St1) + end, + {Lccs,_,St3} = if Ccs =:= -> {,,St2}; + true -> from_icrt_cls(Ccs, Vt, St2) + end, + {Las,_,St4} = from_body(As, Vt, St3), + {'try',progn|Les| + from_maybe('case', Lscs) ++ + from_maybe('catch', Lccs) ++ + from_maybe('after', Las),Vt,St4}. + +from_maybe(_, ) -> ; +from_maybe(Tag, Es) -> Tag|Es. + +%% from_list_comp(Expr, Qualifiers, VarTable, State) -> {Listcomp,State}. + +from_list_comp(E, Qs, Vt0, St0) -> + {Lqs,Vt1,St1} = from_comp_quals(Qs, Vt0, St0), + {Le,Vt2,St2} = from_expr(E, Vt1, St1), + {'list-comp',Lqs,Le,Vt2,St2}. + +%% from_binary_comp(BitStringExpr, Qualifiers, VarTable, State) -> +%% {BinaryComp,State}. + +from_binary_comp(E, Qs, Vt0, St0) -> + {Lqs,Vt1,St1} = from_comp_quals(Qs, Vt0, St0), + {Le,Vt2,St2} = from_expr(E, Vt1, St1), + {'binary-comp',Lqs,Le,Vt2,St2}. + +%% from_comp_quals(Qualifiers, VarTable, State) -> {Qualifiers,VarTable,State}. +%% from_comp_qual(Pattern, Expr, VarTable, State) -> {Qualifier,VarTable,State}. +%% Qualifiers, all variables in the patterns are new variables which +%% shadow existing variables without equality tests. + +from_comp_quals({generate,_,P,E}|Qs, Vt0, St0) -> + {Lp,Lbody,Vt1,St1} = from_comp_qual(P, E, Vt0, St0), + {Lqs,Vt2,St2} = from_comp_quals(Qs, Vt1, St1), + {'<-',Lp|Lbody|Lqs,Vt2,St2}; +from_comp_quals({b_generate,_,P,E}|Qs, Vt0, St0) -> + {Lp,Lbody,Vt1,St1} = from_comp_qual(P, E, Vt0, St0), + {Lqs,Vt2,St2} = from_comp_quals(Qs, Vt1, St1), + {'<=',Lp|Lbody|Lqs,Vt2,St2}; +from_comp_quals(Test|Qs, Vt0, St0) -> + {Ltest,Vt1,St1} = from_expr(Test, Vt0, St0), + {Lqs,Vt2,St2} = from_comp_quals(Qs, Vt1, St1), + {Ltest|Lqs,Vt2,St2}; +from_comp_quals(, Vt, St) -> {,Vt,St}. + +from_comp_qual(Pat, Exp, Vt0, St0) -> + {Lpat,Eqt,Vtp,St1} = from_pat(Pat, , St0), + Vt1 = ordsets:union(Vtp, Vt0), + {Lexp,Vt2,St2} = from_expr(Exp, Vt1, St1), + Leg = from_eq_tests(Eqt), + Lbody = from_add_guard(Leg, Lexp), + {Lpat,Lbody,Vt2,St2}. + +%% from_package_module(Module, VarTable, State) -> {Module,VarTable,State}. +%% We must handle the special case where in pre-R16 you could have +%% packages with a dotted module path. It used a special record_field +%% tuple. This does not work in R16 and later! + +from_package_module({record_field,_,_,_}=M, Vt, St) -> + Segs = erl_parse:package_segments(M), + A = list_to_atom(packages:concat(Segs)), + {?Q(A),Vt,St}. + +%% new_from_var(State) -> {VarName,State}. + +new_from_var(#from{vc=C}=St) -> + V = list_to_atom(lists:concat('-var-',C,'-')), + {V,St#from{vc=C+1}}. + +%% from_pat(Pattern, VarTable, State) -> +%% {Pattern,EqualVar,VarTable,State}. + +from_pat({var,_,_}=V, Vt, St) -> + from_pat_var(V, Vt, St); +from_pat({nil,_}, Vt, St) -> {,,Vt,St}; +from_pat({integer,_,I}, Vt, St) -> {I,,Vt,St}; +from_pat({float,_,F}, Vt, St) -> {F,,Vt,St}; +from_pat({atom,_,A}, Vt, St) -> {?Q(A),,Vt,St}; %Quoted atom +from_pat({string,_,S}, Vt, St) -> {?Q(S),,Vt,St}; %Quoted string +from_pat({cons,_,H,T}, Vt0, St0) -> + {Car,Eqt1,Vt1,St1} = from_pat(H, Vt0, St0), + {Cdr,Eqt2,Vt2,St2} = from_pat(T, Vt1, St1), + {from_cons(Car, Cdr),Eqt1++Eqt2,Vt2,St2}; +from_pat({tuple,_,Es}, Vt0, St0) -> + {Ss,Eqt,Vt1,St1} = from_pats(Es, Vt0, St0), + {tuple|Ss,Eqt,Vt1,St1}; +from_pat({bin,_,Segs}, Vt0, St0) -> + {Ss,Eqt,Vt1,St1} = from_pat_bitsegs(Segs, Vt0, St0), + {binary|Ss,Eqt,Vt1,St1}; +from_pat({map,_,Assocs}, Vt0, St0) -> + {Ps,Eqt,Vt1,St1} = from_pat_map_assocs(Assocs, Vt0, St0), + {map|Ps,Eqt,Vt1,St1}; +from_pat({record,_,Name,Fs}, Vt0, St0) -> %Match a record + {Sfs,Eqt,Vt1,St1} = from_pat_rec_fields(Fs, Vt0, St0), + {'record',Name|Sfs,Eqt,Vt1,St1}; +from_pat({record_index,_,Name,{atom,_,F}}, Vt, St) -> %We KNOW! + {'record-index',Name,F,Vt,St}; +from_pat({match,_,P1,P2}, Vt0, St0) -> %Pattern 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}; +%% Basically illegal syntax which maybe generated by internal tools. +from_pat({call,_,{atom,_,F},As}, Vt0, St0) -> + %% This will never occur in real code but for macro expansions. + {Las,Eqt,Vt1,St1} = from_pats(As, Vt0, St0), + {F|Las,Eqt,Vt1,St1}. + +from_pats(P|Ps, Vt0, St0) -> + {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), + {Lps,Eqts,Vt2,St2} = from_pats(Ps, Vt1, St1), + {Lp|Lps,Eqt++Eqts,Vt2,St2}; +from_pats(, Vt, St) -> {,,Vt,St}. + +from_pat_var({var,_,'_'}, Vt, St) -> %Don't need to handle _ + {'_',,Vt,St}; +from_pat_var({var,_,V}, Vt, St0) -> + case ordsets:is_element(V, Vt) of %Is variable bound? + true -> + {V1,St1} = new_from_var(St0), %New var for pattern + {V1,{V,V1},Vt,St1}; %Add to guard tests + false -> + {V,,ordsets:add_element(V, Vt),St0} + end. + +%% from_pat_bitsegs(Segs, VarTable, State) -> {Segs,EqTable,VarTable,State}. + +from_pat_bitsegs(Seg|Segs, Vt0, St0) -> + {S,Eqt,Vt1,St1} = from_pat_bitseg(Seg, Vt0, St0), + {Ss,Eqts,Vt2,St2} = from_pat_bitsegs(Segs, Vt1, St1), + {S|Ss,Eqt++Eqts,Vt2,St2}; +from_pat_bitsegs(, Vt, St) -> {,,Vt,St}. + +from_pat_bitseg({bin_element,_,Seg,Size,Type}, Vt, St) -> + from_pat_bitseg(Seg, Size, Type, Vt, St). + +from_pat_bitseg({string,_,S}, Size, Type, Vt0, St0) -> + {Lsize,Vt1,St1} = from_pat_bitseg_size(Size, Vt0, St0), + {S|from_bitseg_type(Type) ++ Lsize,,Vt1,St1}; +from_pat_bitseg(P, Size, Type, Vt0, St0) -> + {Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0), + {Lsize,Vt2,St2} = from_pat_bitseg_size(Size, Vt1, St1), + {Lp|from_bitseg_type(Type) ++ Lsize,Eqt,Vt2,St2}. + +from_pat_bitseg_size(default, Vt, St) -> {,Vt,St}; +from_pat_bitseg_size({var,_,V}, Vt, St) -> %Size vars never match + {size,V,Vt,St}; +from_pat_bitseg_size(Size, Vt0, St0) -> + {Ssize,_,Vt1,St1} = from_pat(Size, Vt0, St0), + {size,Ssize,Vt1,St1}. + +%% from_pat_map_assocs(Fields, VarTable, State) -> +%% {Fields,EqTable,VarTable,State}. + +from_pat_map_assocs({map_field_exact,_,Key,Val}|As, Vt0, St0) -> + {Lk,Eqt1,Vt1,St1} = from_pat(Key, Vt0, St0), + {Lv,Eqt2,Vt2,St2} = from_pat(Val, Vt1, St1), + {Lfs,Eqt3,Vt3,St3} = from_pat_map_assocs(As, Vt2, St2), + {Lk,Lv|Lfs,Eqt1 ++ Eqt2 ++ Eqt3,Vt3,St3}; +from_pat_map_assocs(, 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_lit(Literal) -> Literal. +%% Build a literal value from AST. No quoting here. + +from_lit(Lit) -> + erl_parse:normalise(Lit). + +%% Converting LFE to Erlang AST. +%% This is relatively straightforward except for 2 things: +%% - No shadowing of variables so they must be uniquely named. +%% - Local functions must lifted to top level. This is difficult for +%% one expression so this is illegal here as we don't do it. +%% +%% We keep track of all existing variables so when we get a variable +%% in a pattern we can check if this variable has been used before. If +%% so then we must create a new unique variable, add a guard test and +%% add the old-new mapping to the variable table. The existence is +%% global while the mapping is local to that scope. Multiple +%% occurences of variables in an LFE pattern map directly to multiple +%% occurrences in the Erlang AST. + +%% Use macros for key-value tables if they exist. + -ifdef(HAS_FULL_KEYS). +-define(NEW_VT, #{}). +-define(VT_GET(K, Vt), maps:get(K, Vt)). +-define(VT_GET(K, Vt, Def), maps:get(K, Vt, Def)). +-define(VT_IS_KEY(K, Vt), maps:is_key(K, Vt)). +-define(VT_PUT(K, V, Vt), Vt#{K => V}). +-else. +-define(NEW_VT, orddict:new()). +-define(VT_GET(K, Vt), orddict:fetch(K, Vt)). +-define(VT_GET(K, Vt, Def), + %% Safe as no new variables created. + case orddict:is_key(K, Vt) of + true -> orddict:fetch(K, Vt); + false -> Def + end). +-define(VT_IS_KEY(K, Vt), orddict:is_key(K, Vt)). +-define(VT_PUT(K, V, Vt), orddict:store(K, V, Vt)). +-endif. + +%% Define how () should look in Erlang. +-define(TO_NIL(Line), {nil,Line}). + +%% safe_fetch(Key, Dict, Default) -> Value. +%% Fetch a value with a default if it doesn't exist. + +%% safe_fetch(Key, Dict, Def) -> +%% case orddict:find(Key, Dict) of +%% {ok,Val} -> Val; +%% error -> Def +%% end. + +-record(to, {vs=, %Existing variables + vc=?NEW_VT, %Variable counters + imports=, %Function renames + aliases= %Module aliases + }). + +%% to_expr(Expr, LineNumber) -> ErlExpr. +%% to_expr(Expr, LineNumber, {Imports, Aliases}) -> ErlExpr. +%% to_exprs(Exprs, LineNumber) -> ErlExprs. +%% to_exprs(Exprs, LineNumber, {Imports, Aliases}) -> ErlExprs. + +to_expr(E, L) -> + to_expr(E, L, {,}). + +to_expr(E, L, {Imports,Aliases}) -> + ToSt = #to{imports=Imports,aliases=Aliases}, + {Ee,_} = to_expr(E, L, ?NEW_VT, ToSt), + Ee. + +to_exprs(Es, L) -> + to_exprs(Es, L, {,}). + +to_exprs(Es, L, {Imports,Aliases}) -> + ToSt = #to{imports=Imports,aliases=Aliases}, + {Ees,_} = to_expr_list(Es, L, ?NEW_VT, ToSt), + Ees. + +to_gexpr(E, L) -> + to_gexpr(E, L, {,}). + +to_gexpr(E, L, {Imports,Aliases}) -> + ToSt = #to{imports=Imports,aliases=Aliases}, + {Ee,_} = to_gexpr(E, L, ?NEW_VT, ToSt), + Ee. + +to_gexprs(Es, L) -> + to_gexprs(Es, L, {,}). + +to_gexprs(Es, L, {Imports,Aliases}) -> + ToSt = #to{imports=Imports,aliases=Aliases}, + {Ees,_} = to_gexprs(Es, L, ?NEW_VT, ToSt), + Ees. + +%% to_expr(Expr, LineNumber, VarTable, State) -> {ErlExpr,State}. +%% Convert one expression from an LFE form to an Erlang AST. + +%% Core data special forms. +to_expr(?Q(Lit), L, _, St) -> + {to_lit(Lit, L),St}; +to_expr(cons,H,T, L, Vt, St0) -> + {Eh,St1} = to_expr(H, L, Vt, St0), + {Et,St2} = to_expr(T, L, Vt, St1), + {{cons,L,Eh,Et},St2}; +to_expr(car,E, L, Vt, St0) -> + {Ee,St1} = to_expr(E, L, Vt, St0), + {{call,L,{atom,L,hd},Ee},St1}; +to_expr(cdr,E, L, Vt, St0) -> + {Ee,St1} = to_expr(E, L, Vt, St0), + {{call,L,{atom,L,tl},Ee},St1}; +to_expr(list|Es, L, Vt, St) -> + to_list(fun to_expr/4, Es, L, Vt, St); +to_expr('list*'|Es, L, Vt, St) -> %Macro + to_list_s(fun to_expr/4, Es, L, Vt, St); +to_expr(tuple|Es, L, Vt, St0) -> + {Ees,St1} = to_expr_list(Es, L, Vt, St0), + {{tuple,L,Ees},St1}; +to_expr(tref,T,I, L, Vt, St0) -> + {Et,St1} = to_expr(T, L, Vt, St0), + {Ei,St2} = to_expr(I, L, Vt, St1), + %% Get the argument order correct. + {{call,L,{atom,L,element},Ei,Et},St2}; +to_expr(tset,T,I,V, L, Vt, St0) -> + {Et,St1} = to_expr(T, L, Vt, St0), + {Ei,St2} = to_expr(I, L, Vt, St1), + {Ev,St2} = to_expr(V, L, Vt, St2), + %% Get the argument order correct. + {{call,L,{atom,L,setelement},Ei,Et,Ev},St2}; +to_expr(binary|Segs, L, Vt, St0) -> + {Esegs,St1} = to_expr_bitsegs(Segs, L, Vt, St0), + {{bin,L,Esegs},St1}; +to_expr(map|Pairs, L, Vt, St0) -> + {Eps,St1} = to_map_pairs(fun to_expr/4, Pairs, map_field_assoc, L, Vt, St0), + {{map,L,Eps},St1}; +to_expr(msiz,Map, L, Vt, St) -> + to_expr(map_size,Map, L, Vt, St); +to_expr(mref,Map,Key, L, Vt, St) -> + to_map_get(Map, Key, L, Vt, St); +to_expr(mset,Map|Pairs, L, Vt, St) -> + to_map_set(Map, Pairs, L, Vt, St); +to_expr(mupd,Map|Pairs, L, Vt, St) -> + to_map_update(Map, Pairs, L, Vt, St); +to_expr(mrem,Map|Keys, L, Vt, St) -> + to_map_remove(Map, Keys, L, Vt, St); +to_expr('map-size',Map, L, Vt, St) -> + to_expr(map_size,Map, L, Vt, St); +to_expr('map-get',Map,Key, L, Vt, St) -> + to_map_get(Map, Key, L, Vt, St); +to_expr('map-set',Map|Pairs, L, Vt, St) -> + to_map_set(Map, Pairs, L, Vt, St); +to_expr('map-update',Map|Pairs, L, Vt, St) -> + to_map_update(Map, Pairs, L, Vt, St); +to_expr('map-remove',Map|Keys, L, Vt, St) -> + to_map_remove(Map, Keys, L, Vt, St); +%% Record special forms. +to_expr('record',Name|Fs, L, Vt, St0) -> + {Efs,St1} = to_record_fields(fun to_expr/4, Fs, L, Vt, St0), + {{record,L,Name,Efs},St1}; +%% make-record has been deprecated but we sill accept it for now. +to_expr('make-record',Name|Fs, L, Vt, St) -> + to_expr('record',Name|Fs, L, Vt, St); +to_expr('is-record',E,Name, L, Vt, St0) -> + {Ee,St1} = to_expr(E, L, Vt, St0), + %% This expands to a function call. + {{call,L,{atom,L,is_record},Ee,{atom,L,Name}},St1}; +to_expr('record-index',Name,F, L, _, St) -> + {{record_index,L,Name,{atom,L,F}},St}; +to_expr('record-field',E,Name,F, L, Vt, St0) -> + {Ee,St1} = to_expr(E, L, Vt, St0), + {{record_field,L,Ee,Name,{atom,L,F}},St1}; +to_expr('record-update',E,Name|Fs, L, Vt, St0) -> + {Ee,St1} = to_expr(E, L, Vt, St0), + {Efs,St2} = to_record_fields(fun to_expr/4, Fs, L, Vt, St1), + {{record,L,Ee,Name,Efs},St2}; +%% Struct special forms. +%% We try and do the same as Elixir 1.13.3 when we can. +to_expr('struct',Name|Fs, L, Vt, St) -> + %% Need the right format to call the predefined mod:__struct_ function. + %% Call mod:__struct__ at runtime so we know ours is loaded, BAD! + Pairs = to_struct_pairs(Fs), + Make = call,?Q(Name),?Q('__struct__'),list|Pairs, + to_expr(Make, L, Vt, St); +to_expr('is-struct',E, L, Vt, St) -> + Is = 'case',E, + map,?Q('__struct__'),'|-struct-|', + 'when',is_atom,'|-struct-|',?Q(true), + '_',?Q(false), + to_expr(Is, L, Vt, St); +to_expr('is-struct',E,Name, L, Vt, St) -> + Is = 'case',E, + map,?Q('__struct__'),?Q(Name),?Q(true), + '_',?Q(false), + to_expr(Is, L, Vt, St); +to_expr('struct-field',E,Name,F, L, Vt, St) -> + Field = 'case',E, + map,?Q('__struct__'),?Q(Name),?Q(F),'|-field-|','|-field-|', + '|-struct-|', + call,?Q(erlang),?Q(error), + tuple,?Q(badstruct),?Q(Name),'|-struct-|', + to_expr(Field, L, Vt, St); +to_expr('struct-update',E,Name|Fs, L, Vt, St) -> + Update = 'case',E, + '=',map,?Q('__struct__'),?Q(Name),'|-struct-|', + 'map-update','|-struct-|'|to_struct_fields(Fs), + '|-struct-|', + call,?Q(erlang),?Q(error), + tuple,?Q(badstruct),?Q(Name),'|-struct-|', + to_expr(Update, L, Vt, St); +%% Function forms. +to_expr(function,F,Ar, L, Vt, St) -> + %% Must handle the special cases here. + case lfe_internal:is_erl_bif(F, Ar) of + true -> to_expr(function,erlang,F,Ar, L, Vt, St); + false -> + case lfe_internal:is_lfe_bif(F, Ar) of + true -> to_expr(function,lfe,F,Ar, L, Vt, St); + false -> {{'fun',L,{function,F,Ar}},St} + end + end; +to_expr(function,M,F,Ar, L, _, St) -> + %% Need the abstract values here. + {{'fun',L,{function,to_lit(M, L),to_lit(F, L),to_lit(Ar, L)}},St}; +%% Special known data type operations. +to_expr('andalso'|Es, L, Vt, St) -> + to_lazy_logic(fun to_expr/4, Es, 'andalso', L, Vt, St); +to_expr('orelse'|Es, L, Vt, St) -> + to_lazy_logic(fun to_expr/4, Es, 'orelse', L, Vt, St); +%% Core closure special forms. +to_expr(lambda,Args|Body, L, Vt, St) -> + to_lambda(Args, Body, L, Vt, St); +to_expr('match-lambda'|Cls, L, Vt, St) -> + to_match_lambda(Cls, L, Vt, St); +to_expr('let',Lbs|B, L, Vt, St) -> + to_let(Lbs, B, L, Vt, St); +to_expr('let-function'|_, L, _, _) -> %Can't do this efficently + illegal_code_error(L, 'let-function'); +to_expr('letrec-function'|_, L, _, _) -> %Can't do this efficently + illegal_code_error(L, 'letrec-function'); +%% Core control special forms. +to_expr(progn|B, L, Vt, St) -> + to_block(B, L, Vt, St); +to_expr('if'|Body, L, Vt, St) -> + to_if(Body, L, Vt, St); +to_expr('case'|Body, L, Vt, St) -> + to_case(Body, L, Vt, St); +to_expr('receive'|Cls, L, Vt, St) -> + to_receive(Cls, L, Vt, St); +to_expr('catch'|B, L, Vt, St0) -> + {Eb,St1} = to_block(B, L, Vt, St0), + {{'catch',L,Eb},St1}; +to_expr('try'|Try, L, Vt, St) -> %Can't do this yet + %% lfe_io:format("try ~w\n~p\n", L,'try'|Try), + to_try(Try, L, Vt, St); +to_expr(funcall,F|As, L, Vt, St0) -> + {Ef,St1} = to_expr(F, L, Vt, St0), + {Eas,St2} = to_expr_list(As, L, Vt, St1), + {{call,L,Ef,Eas},St2}; +%% List/binary comprehensions. +to_expr(lc,Qs,E, L, Vt, St) -> + to_list_comp(Qs, E, L, Vt, St); +to_expr('list-comp',Qs,E, L, Vt, St) -> + to_list_comp(Qs, E, L, Vt, St); +to_expr(bc,Qs,BS, L, Vt, St) -> + to_binary_comp(Qs, BS, L, Vt, St); +to_expr('binary-comp',Qs,BS, L, Vt, St) -> + to_binary_comp(Qs, BS, L, Vt, St); +%% General function calls. +to_expr(call,?Q(erlang),?Q(F)|As, L, Vt, St0) -> + %% This is semantically the same but some tools behave differently + %% (qlc_pt). + {Eas,St1} = to_expr_list(As, L, Vt, St0), + case is_erl_op(F, length(As)) of + true -> {list_to_tuple(op,L,F|Eas),St1}; + false -> + to_remote_call({atom,L,erlang}, {atom,L,F}, Eas, L, St1) + end; +to_expr(call,?Q(M0),F|As, L, Vt, St0) -> + %% Alias modules are literals. + Mod = case orddict:find(M0, St0#to.aliases) of + {ok,M1} -> M1; + error -> M0 + end, + {Ef,St1} = to_expr(F, L, Vt, St0), + {Eas,St2} = to_expr_list(As, L, Vt, St1), + to_remote_call({atom,L,Mod}, Ef, Eas, L, St2); +to_expr(call,M,F|As, L, Vt, St0) -> + {Em,St1} = to_expr(M, L, Vt, St0), + {Ef,St2} = to_expr(F, L, Vt, St1), + {Eas,St3} = to_expr_list(As, L, Vt, St2), + to_remote_call(Em, Ef, Eas, L, St3); +%% General function call. +to_expr(F|As, L, Vt, St0) when is_atom(F) -> + {Eas,St1} = to_expr_list(As, L, Vt, St0), + Ar = length(As), %Arity + %% Check for import. + case orddict:find({F,Ar}, St1#to.imports) of + {ok,{Mod,R}} -> %Imported + to_remote_call({atom,L,Mod}, {atom,L,R}, Eas, L, St1); + error -> %Not imported + case is_erl_op(F, Ar) of + true -> {list_to_tuple(op,L,F|Eas),St1}; + false -> + case lfe_internal:is_lfe_bif(F, Ar) of + true -> + to_remote_call({atom,L,lfe}, {atom,L,F}, Eas, L, St1); + false -> + {{call,L,{atom,L,F},Eas},St1} + end + end + end; +to_expr(_|_=List, L, _, St) -> + case lfe_lib:is_posint_list(List) of + true -> {{string,L,List},St}; + false -> + illegal_code_error(L, list) %Not right! + end; +to_expr(V, L, Vt, St) when is_atom(V) -> %Unquoted atom + to_expr_var(V, L, Vt, St); +to_expr(Lit, L, _, St) -> %Everything else is a literal + {to_lit(Lit, L),St}. + +%% to_expr_list(Exprs, LineNumber, VarTable, State) -> {ErlExprs,State}. +%% Convert a list of expressions to a list of Erlang ASTs. + +to_expr_list(Es, L, Vt, St) -> + Fun = fun (E, St0) -> to_expr(E, L, Vt, St0) end, + lists:mapfoldl(Fun, St, Es). + +to_expr_var(V, L, Vt, St) -> + Var = ?VT_GET(V, Vt, V), %Hmm + {{var,L,Var},St}. + +%% to_list(ExprFun, Elements, LineNumber, VarTable, State) -> {ListExpr, State}. +%% Convert a list of expressions to an Erlang AST list. + +to_list(Expr, Es, L, Vt, St) -> + Cons = fun (E, {Tail,St0}) -> + {Ee,St1} = Expr(E, L, Vt, St0), + {{cons,L,Ee,Tail},St1} + end, + lists:foldr(Cons, {?TO_NIL(L),St}, Es). + +%% to_list_s(ExprFun, Elements, LineNumber, VarTable, State) -> +%% {ListExpr, State}. +%% A list* macro expression that probably should have been expanded. + +to_list_s(Expr, E, L, Vt, St) -> Expr(E, L, Vt, St); +to_list_s(Expr, E|Es, L, Vt, St0) -> + {Le,St1} = Expr(E, L, Vt, St0), + {Les,St2} = to_list_s(Expr, Es, L, Vt, St1), + {{cons,L,Le,Les},St2}; +to_list_s(_Expr, _Es, L, _Vt, St) -> {?TO_NIL(L),St}. + +%% to_remote_call(Module, Function, Args, LineNumber, VarTable, State) -> +%% {Call,State}. +%% We expect the module, function name and arguments to be already +%% converted. + +to_remote_call(M, F, As, L, St) -> + {{call,L,{remote,L,M,F},As},St}. + +%% is_erl_op(Op, Arity) -> bool(). +%% Is Op/Arity one of the known Erlang operators? + +is_erl_op(Op, Ar) -> + erl_internal:arith_op(Op, Ar) + orelse erl_internal:bool_op(Op, Ar) + orelse erl_internal:comp_op(Op, Ar) + orelse erl_internal:list_op(Op, Ar) + orelse erl_internal:send_op(Op, Ar). + +%% to_body(Exprs, LineNumber, VarTable, State) -> {ErlExprs,State}. +%% A body MUST be a list of expressions. If the input list is empty +%% then return a list which contains (). + +to_body(, L, _Vt, St) -> + {?TO_NIL(L),St}; +to_body(Es, L, Vt, St) -> + to_expr_list(Es, L, Vt, St). + +%% to_expr_bitsegs(Segs, LineNumber, VarTable, State) -> {Segs,State}. +%% We don't do any real checking here but just assume that everything +%% is correct and in worst case pass the buck to the Erlang compiler. + +to_expr_bitsegs(Segs, L, Vt, St) -> + BitSeg = fun (Seg, St0) -> to_bitseg(fun to_expr/4, Seg, L, Vt, St0) end, + lists:mapfoldl(BitSeg, St, Segs). + +%% to_bitseg(ExprFun, Seg, LineNumber, VarTable, State) -> {Seg,State}. +%% We must specially handle the case where the segment is a string. +%% ExprFun translates the segment Value. + +to_bitseg(ExprFun, Val|Specs=Seg, L, Vt, St) -> + %% io:format("tbs ~p ~p\n ~p\n", Seg,Vt,St), + case lfe_lib:is_posint_list(Seg) of + true -> + {{bin_element,L,{string,L,Seg},default,default},St}; + false -> + to_bin_element(ExprFun, Val, Specs, L, Vt, St) + end; +to_bitseg(ExprFun, Val, L, Vt, St) -> + to_bin_element(ExprFun, Val, , L, Vt, St). + +to_bin_element(ExprFun, Val, Specs, L, Vt, St0) -> + {Eval,St1} = ExprFun(Val, L, Vt, St0), + {Size,Type} = to_bitseg_type(Specs, default, ), + {Esiz,St2} = to_bit_size(Size, L, Vt, St1), + {{bin_element,L,Eval,Esiz,Type},St2}. + +to_bitseg_type(size,Size|Specs, _, Type) -> + to_bitseg_type(Specs, Size, Type); +to_bitseg_type(unit,Unit|Specs, Size, Type) -> + to_bitseg_type(Specs, Size, Type ++ {unit,Unit}); +to_bitseg_type(Spec|Specs, Size, Type) -> + to_bitseg_type(Specs, Size, Type ++ Spec); +to_bitseg_type(, Size, ) -> {Size,default}; +to_bitseg_type(, Size, Type) -> {Size,Type}. + +to_bit_size(all, _, _, St) -> {default,St}; +to_bit_size(default, _, _, St) -> {default,St}; +to_bit_size(undefined, _, _, St) -> {default,St}; +to_bit_size(Size, L, Vt, St) -> to_expr(Size, L, Vt, St). + +%% to_map_get(Map, Key, L, Vt, State) -> {MapGet, State}. +%% Check if there is a BIF and in that case use it as this will also +%% work in a guard. The linter has checked if map_get is guardable. + +to_map_get(Map, Key, L, Vt, St0) -> + {Eas,St1} = to_expr_list(Key,Map, L, Vt, St0), + case erlang:function_exported(erlang, map_get, 2) of + true -> {{call,L,{atom,L,map_get},Eas},St1}; + false -> + to_remote_call({atom,L,maps}, {atom,L,get}, Eas, L, St1) + end. + +%% to_map_set(Map, Pairs, L, Vt, State) -> {MapSet,State}. +%% to_map_update(Map, Pairs, L, Vt, State) -> {MapUpdate,State}. +%% to_map_remove(Map, Keys, L, Vt, State) -> {MapRemove,State}. + +to_map_set(Map, Pairs, L, Vt, St0) -> + {Em,St1} = to_expr(Map, L, Vt, St0), + {Eps,St2} = to_map_pairs(fun to_expr/4, Pairs, map_field_assoc, L, Vt, St1), + {{map,L,Em,Eps},St2}. + +to_map_update(Map, Pairs, L, Vt, St0) -> + {Em,St1} = to_expr(Map, L, Vt, St0), + {Eps,St2} = to_map_pairs(fun to_expr/4, Pairs, map_field_exact, L, Vt, St1), + {{map,L,Em,Eps},St2}. + +to_map_remove(Map, Keys, L, Vt, St0) -> + {Em,St1} = to_expr(Map, L, Vt, St0), + {Eks,St2} = to_expr_list(Keys, L, Vt, St1), + Fun = fun (K, {F,St}) -> + to_remote_call({atom,L,maps}, {atom,L,remove}, K,F, L, St) + end, + lists:foldl(Fun, {Em,St2}, Eks). + +%% to_map_pairs(ExprFun, Pairs, FieldType, LineNumber, VarTable, State) -> +%% {Fields,State}. + +to_map_pairs(Expr, K,V|Ps, Field, L, Vt, St0) -> + {Ek,St1} = Expr(K, L, Vt, St0), + {Ev,St2} = Expr(V, L, Vt, St1), + {Eps,St3} = to_map_pairs(Expr, Ps, Field, L, Vt, St2), + {{Field,L,Ek,Ev}|Eps,St3}; +to_map_pairs(_Expr, , _Field, _L, _Vt, St) -> {,St}. + +%% to_record_fields(ExprFun, Fields, LineNumber, VarTable, State) -> +%% {Fields,State}. + +to_record_fields(Expr, '_',V|Fs, L, Vt, St0) -> + %% Special case!! + {Ev,St1} = Expr(V, L, Vt, St0), + {Efs,St2} = to_record_fields(Expr, Fs, L, Vt, St1), + {{record_field,L,{var,L,'_'},Ev}|Efs,St2}; +to_record_fields(Expr, F,V|Fs, L, Vt, St0) -> + {Ev,St1} = Expr(V, L, Vt, St0), + {Efs,St2} = to_record_fields(Expr, Fs, L, Vt, St1), + {{record_field,L,{atom,L,F},Ev}|Efs,St2}; +to_record_fields(_Expr, , _L, _Vt, St) -> {,St}. + +%% to_struct_fields(Fields) -> Fields. + +to_struct_fields(F,V|Fs) -> + ?Q(F),V|to_struct_fields(Fs); +to_struct_fields() -> . + +to_struct_pairs(F,V|Fs) -> + tuple,?Q(F),V|to_struct_pairs(Fs); +to_struct_pairs() -> . + +%% to_fun_cls(Clauses, LineNumber) -> Clauses. +%% to_fun_cl(Clause, LineNumber) -> Clause. +%% Function clauses. + +to_fun_cls(Cls, L, Vt, St) -> + Fun = fun (Cl, St0) -> to_fun_cl(Cl, L, Vt, St0) end, + lists:mapfoldl(Fun, St, Cls). + +to_fun_cl(As,'when'|B, L, Vt0, St0) -> + %% Skip empty guards. + {Eas,Vt1,St1} = to_pats(As, L, Vt0, St0), + {Eb,St2} = to_body(B, L, Vt1, St1), + {{clause,L,Eas,,Eb},St2}; +to_fun_cl(As,'when'|G|B, L, Vt0, St0) -> + {Eas,Vt1,St1} = to_pats(As, L, Vt0, St0), + {Eg,St2} = to_guard(G, L, Vt1, St1), + {Eb,St3} = to_body(B, L, Vt1, St2), + {{clause,L,Eas,Eg,Eb},St3}; +to_fun_cl(As|B, L, Vt0, St0) -> + {Eas,Vt1,St1} = to_pats(As, L, Vt0, St0), + {Eb,St2} = to_body(B, L, Vt1, St1), + {{clause,L,Eas,,Eb},St2}. + +%% to_lazy_logic(ExprFun, Exprs, Type, LineNumber, VarTable, State) -> +%% {Logic,State}. +%% These go pairwise right-to-left. + +to_lazy_logic(Expr, E1,E2, Type, L, Vt, St0) -> + {Ee1,St1} = Expr(E1, L, Vt, St0), + {Ee2,St2} = Expr(E2, L, Vt, St1), + {{op,L,Type,Ee1,Ee2},St2}; +to_lazy_logic(Expr, E1|Es, Type, L, Vt, St0) -> + {Ee1,St1} = Expr(E1, L, Vt, St0), + {Ees,St2} = to_lazy_logic(Expr, Es, Type, L, Vt, St1), + {{op,L,Type,Ee1,Ees},St2}. + +%% to_lambda(Args, Body, LineNumber, VarTable, State) -> {Fun,State}. + +to_lambda(As, B, L, Vt, St0) -> + {Ecl,St1} = to_fun_cl(As|B, L, Vt, St0), + {{'fun',L,{clauses,Ecl}},St1}. + +%% to_match_lambda(Clauses, LineNumber, VarTable, State) -> {Fun,State}. + +to_match_lambda(Cls, L, Vt, St0) -> + {Ecls,St1} = to_fun_cls(Cls, L, Vt, St0), + {{'fun',L,{clauses,Ecls}},St1}. + +%% to_let(Bindings, Block, LineNumber, VarTable, State) -> {Block,State}. +%% Transform a let into sequence of nested match and case +%% expressions. At the bottom comes the let body. Note that the +%% value expressions for the bindings all use the variable values +%% from before the let whereas the let body uses the of the created +%% bindings. + +to_let(Lbs, B, L, Vt, St0) -> + {Eb,St1} = to_let_body(Lbs, B, L, Vt, Vt, St0), + {{block,L,Eb},St1}. + +%% to_let_body(Bindings, Block, LineNumber, LetVarTable, VarTable, State) -> +%% {LetExprs,State}. +%% When we have a guard translate into a case but special case where +%% we have an empty guard as erlang compiler doesn't like this. + +to_let_body(P,E|Lbs, B, L, Lvt, Vt0, St0) -> + {Ee,St1} = to_expr(E, L, Lvt, St0), + {Ep,Vt1,St2} = to_pat(P, L, Vt0, St1), + {Elet,St3} = to_let_body(Lbs, B, L, Lvt, Vt1, St2), + {{match,L,Ep,Ee}|Elet,St3}; +to_let_body(P,'when',E|Lbs, B, L, Lvt, Vt, St) -> + %% Skip empty guards. + to_let_body(P,E|Lbs, B, L, Lvt, Vt, St); +to_let_body(P,'when'|G,E|Lbs, B, L, Lvt, Vt0, St0) -> + {Ee,St1} = to_expr(E, L, Lvt, St0), + {Ep,Vt1,St2} = to_pat(P, L, Vt0, St1), + {Eg,St3} = to_guard(G, L, Vt1, St2), + {BadMatch,St4} = to_let_binding_error(L, St3), + {Elet,St5} = to_let_body(Lbs, B, L, Lvt, Vt1, St4), + {{'case',L,Ee,{clause,L,Ep,Eg,Elet},BadMatch},St5}; +to_let_body(, B, L, _Lvt, Vt0, St0) -> + {Eb,St1} = to_body(B, L, Vt0, St0), + {Eb,St1}. + +to_let_binding_error(L, St0) -> + {Other,St1} = new_to_var('let-other',St0), + OtherVar = {var,L,Other}, + {{clause,L,OtherVar,, + {call,L,{atom,L,error},{tuple,L,{atom,L,badmatch},OtherVar}}},St1}. + +%% to_block(Expressions, LineNumber, VarTable, State) -> {Block,State}. +%% Return ONE expression. Specially check for empty block and then +%% just return (), and for block with one expression then just return +%% that expression. + +to_block(Es, L, Vt, St0) -> + case to_expr_list(Es, L, Vt, St0) of + {Ee,St1} -> {Ee,St1}; %No need to wrap + {,St1} -> {?TO_NIL(L),St1}; %Returns () + {Ees,St1} -> {{block,L,Ees},St1} %Must wrap + end. + +%% to_if(IfBody, LineNumber, VarTable, State) -> {ErlCase,State}. + +to_if(Test,True, L, Vt, St) -> + to_if(Test, True, ?Q(false), L, Vt, St); +to_if(Test,True,False, L, Vt, St) -> + to_if(Test, True, False, L, Vt, St); +to_if(_, L, _, _) -> + illegal_code_error(L, 'if'). + +to_if(Test, True, False, L, Vt, St0) -> + {Etest,St1} = to_expr(Test, L, Vt, St0), + {Ecls,St2} = to_icr_cls(?Q(true),True,?Q(false),False, L, Vt, St1), + {{'case',L,Etest,Ecls},St2}. + +%% to_case(CaseBody, LineNumber, VarTable, State) -> {ErlCase,State}. + +to_case(E|Cls, L, Vt, St0) -> + {Ee,St1} = to_expr(E, L, Vt, St0), + {Ecls,St2} = to_icr_cls(Cls, L, Vt, St1), + {{'case',L,Ee,Ecls},St2}; +to_case(_, L, _, _) -> + illegal_code_error(L, 'case'). + +%% to_receive(RecClauses, LineNumber, VarTable, State) -> {ErlRec,State}. + +to_receive(Cls0, L, Vt, St0) -> + %% Get the right receive form depending on whether there is an after. + Split = fun ('after'|_) -> false; + (_) -> true + end, + {Cls1,A} = lists:splitwith(Split, Cls0), + {Ecls,St1} = to_icr_cls(Cls1, L, Vt, St0), + case A of + 'after',T|B -> + {Et,St2} = to_expr(T, L, Vt, St1), + {Eb,St3} = to_body(B, L, Vt, St2), + {{'receive',L,Ecls,Et,Eb},St3}; + -> + {{'receive',L,Ecls},St1} + end. + +%% to_icr_cls(Clauses, LineNumber, VarTable, State) -> {Clauses,State}. +%% to_icr_cl(Clause, LineNumber, VarTable, State) -> {Clause,State}. +%% If/case/receive clauses. + +to_icr_cls(Cls, L, Vt, St) -> + Fun = fun (Cl, St0) -> to_icr_cl(Cl, L, Vt, St0) end, + lists:mapfoldl(Fun, St, Cls). + +to_icr_cl(P,'when'|B, L, Vt0, St0) -> + %% Skip empty guards. + {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0), + {Eb,St2} = to_body(B, L, Vt1, St1), + {{clause,L,Ep,,Eb},St2}; +to_icr_cl(P,'when'|G|B, L, Vt0, St0) -> + {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0), + {Eg,St2} = to_guard(G, L, Vt1, St1), + {Eb,St3} = to_body(B, L, Vt1, St2), + {{clause,L,Ep,Eg,Eb},St3}; +to_icr_cl(P|B, L, Vt0, St0) -> + {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0), + {Eb,St2} = to_body(B, L, Vt1, St1), + {{clause,L,Ep,,Eb},St2}. + +%% to_try(Try, LineNumber, VarTable, State) -> {ErlTry,State}. +%% Step down the try body doing each section separately then put them +%% together. We expand _ catch pattern to {_,_,_}. We remove wrapping +%% progn in try expression which is not really necessary. + +to_try(E|Try, L, Vt, St0) -> + {Ee,St1} = to_try_expr(E, L, Vt, St0), + {Ecase,Ecatch,Eafter,St2} = to_try_sections(Try, L, Vt, St1, , , ), + {{'try',L,Ee,Ecase,Ecatch,Eafter},St2}. + +to_try_expr(progn|Exprs, L, Vt, St) -> + to_expr_list(Exprs, L, Vt, St); +to_try_expr(Expr, L, Vt, St) -> + to_expr_list(Expr, L, Vt, St). + +to_try_sections('case'|Case|Try, L, Vt, St0, _, Ecatch, Eafter) -> + {Ecase,St1} = to_icr_cls(Case, L, Vt, St0), + to_try_sections(Try, L, Vt, St1, Ecase, Ecatch, Eafter); +to_try_sections('catch'|Catch|Try, L, Vt, St0, Ecase, _, Eafter) -> + {Ecatch,St1} = to_try_catch_cls(Catch, L, Vt, St0), + to_try_sections(Try, L, Vt, St1, Ecase, Ecatch, Eafter); +to_try_sections('after'|After|Try, L, Vt, St0, Ecase, Ecatch, _) -> + {Eafter,St1} = to_expr_list(After, L, Vt, St0), + to_try_sections(Try, L, Vt, St1, Ecase, Ecatch, Eafter); +to_try_sections(, _, _, St, Ecase, Ecatch, Eafter) -> + {Ecase,Ecatch,Eafter,St}. + +to_try_catch_cls(Cls, L, Vt, St) -> + Fun = fun (Cl, St0) -> to_try_catch_cl(Cl, L, Vt, St0) end, + lists:mapfoldl(Fun, St, Cls). + +to_try_catch_cl('_'|Body, L, Vt, St) -> + to_try_catch_cl(tuple,'_','_','_'|Body, L, Vt, St); +to_try_catch_cl(Cl, L, Vt, St) -> + to_icr_cl(Cl, L, Vt, St). + +%% to_list_comp(Qualifiers, Expr, LineNumber, VarTable. State) -> +%% {ListComprehension,State}. + +to_list_comp(Qs, Expr, L, Vt0, St0) -> + {Eqs,Vt1,St1} = to_comp_quals(Qs, L, Vt0, St0), + {Eexpr,St2} = to_expr(Expr, L, Vt1, St1), + {{lc,L,Eexpr,Eqs},St2}. + +%% to_binary_comp(Qualifiers, BitStringExpr, LineNumber, VarTable. State) -> +%% {BinaryComprehension,State}. + +to_binary_comp(Qs, Expr, L, Vt0, St0) -> + {Eqs,Vt1,St1} = to_comp_quals(Qs, L, Vt0, St0), + {Eexpr,St2} = to_expr(Expr, L, Vt1, St1), + {{bc,L,Eexpr,Eqs},St2}. + +%% to_comp_quals(Qualifiers, LineNumber, VarTable, State) -> +%% {Qualifiers,VarTable,State}. +%% Can't use mapfoldl2 as guard handling modifies Qualifiers. + +to_comp_quals('<-',P,E|Qs, L, Vt0, St0) -> + {Gen,Vt1,St1} = to_comp_listgen(P, E, L, Vt0, St0), + {Eqs,Vt2,St2} = to_comp_quals(Qs, L, Vt1, St1), + {Gen|Eqs,Vt2,St2}; +to_comp_quals('<-',P,'when'|G,E|Qs, L, Vt, St) -> + %% Move guards to qualifiers as tests. + to_comp_quals('<-',P,E|G ++ Qs, L, Vt, St); +to_comp_quals('<=',P,E|Qs, L, Vt0, St0) -> + {Gen,Vt1,St1} = to_comp_binarygen(P, E, L, Vt0, St0), + {Eqs,Vt2,St2} = to_comp_quals(Qs, L, Vt1, St1), + {Gen|Eqs,Vt2,St2}; +to_comp_quals('<=',P,'when'|G,E|Qs, L, Vt, St) -> + %% Move guards to qualifiers as tests. + to_comp_quals('<=',P,E|G ++ Qs, L, Vt, St); +to_comp_quals(Test|Qs, L, Vt0, St0) -> + {Etest,St1} = to_expr(Test, L, Vt0, St0), + {Eqs,Vt1,St2} = to_comp_quals(Qs, L, Vt0, St1), + {Etest|Eqs,Vt1,St2}; +to_comp_quals(, _, Vt, St) -> {,Vt,St}. + +%% to_comp_listgen(Pattern, ListExpr, LineNumber, VarTable, State) -> +%% {Generator,VarTable,State}. +%% to_comp_binarygen(BitStringPattern, BitStringExpr, LineNumber, VarTable, State) -> +%% {Generator,VarTable,State}. +%% Must be careful in a generator to do the Expression first as the +%% Pattern may update variables in it and changes should only be seen +%% AFTER the generator. + +to_comp_listgen(Pat, Expr, L, Vt0, St0) -> + {Eexpr,St1} = to_expr(Expr, L, Vt0, St0), + {Epat,Vt1,St2} = to_pat(Pat, L, Vt0, St1), + {{generate,L,Epat,Eexpr},Vt1,St2}. + +to_comp_binarygen(binary|Segs, Expr, L, Vt0, St0) -> + {Eexpr,St1} = to_expr(Expr, L, Vt0, St0), + {Ebin,_Pva,Vt1,St2} = to_pat_binary(Segs, L, , Vt0, St1), + {{b_generate,L,Ebin,Eexpr},Vt1,St2}. + +%% new_to_var(Base, State) -> {VarName, State}. +%% Each base has it's own counter which makes it easier to keep track +%% of a series. We make sure the variable actually is new and update +%% the state. + +new_to_var(Base, #to{vs=Vs,vc=Vct}=St) -> + C = ?VT_GET(Base, Vct, 0), + new_to_var_loop(Base, C, Vs, Vct, St). + +new_to_var_loop(Base, C, Vs, Vct, St) -> + V = list_to_atom(lists:concat("-",Base,"-",C,"-")), + case lists:member(V, Vs) of + true -> new_to_var_loop(Base, C+1, Vs, Vct, St); + false -> + {V,St#to{vs=V|Vs,vc=?VT_PUT(Base, C+1, Vct)}} + end. + +%% to_guard(GuardTests, LineNumber, VarTable, State) -> {ErlGuard,State}. +%% to_guard_test(Test, LineNumber, VarTable, State) -> {ErlGuardTest,State}. +%% Having a top level guard function allows us to optimise at the top +%% guard level + +to_guard(Es, L, Vt, St) -> + Fun = fun (E, St0) -> to_guard_test(E, L, Vt, St0) end, + lists:mapfoldl(Fun, St, Es). + +to_guard_test('is-struct',E, L, Vt, St) -> + Is = is_atom,mref,E,?Q('__struct__'), + to_gexpr(Is, L, Vt, St); +to_guard_test('is-struct',E,Name, L, Vt, St) -> + Is = '=:=',mref,E,?Q('__struct__'),?Q(Name), + to_gexpr(Is, L, Vt, St); +to_guard_test(Test, L, Vt, St) -> + to_gexpr(Test, L, Vt, St). + +%% to_gexpr(Expr, LineNumber, VarTable, State) -> {ErlExpr,State}. + +to_gexpr(?Q(Lit), L, _, St) -> + {to_lit(Lit, L),St}; +to_gexpr(cons,H,T, L, Vt, St0) -> + {Eh,St1} = to_gexpr(H, L, Vt, St0), + {Et,St2} = to_gexpr(T, L, Vt, St1), + {{cons,L,Eh,Et},St2}; +to_gexpr(car,E, L, Vt, St0) -> + {Ee,St1} = to_gexpr(E, L, Vt, St0), + {{call,L,{atom,L,hd},Ee},St1}; +to_gexpr(cdr,E, L, Vt, St0) -> + {Ee,St1} = to_gexpr(E, L, Vt, St0), + {{call,L,{atom,L,tl},Ee},St1}; +to_gexpr(list|Es, L, Vt, St) -> + to_list(fun to_gexpr/4, Es, L, Vt, St); +to_gexpr('list*'|Es, L, Vt, St) -> %Macro + to_list_s(fun to_gexpr/4, Es, L, Vt, St); +to_gexpr(tuple|Es, L, Vt, St0) -> + {Ees,St1} = to_gexprs(Es, L, Vt, St0), + {{tuple,L,Ees},St1}; +to_gexpr(tref,T,I, L, Vt, St0) -> + {Et,St1} = to_gexpr(T, L, Vt, St0), + {Ei,St2} = to_gexpr(I, L, Vt, St1), + %% Get the argument order correct. + {{call,L,{atom,L,element},Ei,Et},St2}; +to_gexpr(binary|Segs, L, Vt, St0) -> + {Esegs,St1} = to_gexpr_bitsegs(Segs, L, Vt, St0), + {{bin,L,Esegs},St1}; +to_gexpr(map|Pairs, L, Vt, St0) -> + {Eps,St1} = to_map_pairs(fun to_gexpr/4, Pairs, map_field_assoc, L, Vt, St0), + {{map,L,Eps},St1}; +to_gexpr(msiz,Map, L, Vt, St) -> + to_gexpr(map_size,Map, L, Vt, St); +to_gexpr(mref,Map,Key, L, Vt, St) -> + to_gmap_get(Map, Key, L, Vt, St); +to_gexpr(mset,Map|Pairs, L, Vt, St) -> + to_gmap_set(Map, Pairs, L, Vt, St); +to_gexpr(mupd,Map|Pairs, L, Vt, St) -> + to_gmap_update(Map, Pairs, L, Vt, St); +to_gexpr('map-size',Map, L, Vt, St) -> + to_gexpr(map_size,Map, L, Vt, St); +to_gexpr('map-get',Map,Key, L, Vt, St) -> + to_gmap_get(Map, Key, L, Vt, St); +to_gexpr('map-set',Map|Pairs, L, Vt, St) -> + to_gmap_set(Map, Pairs, L, Vt, St); +to_gexpr('map-update',Map|Pairs, L, Vt, St) -> + to_gmap_update(Map, Pairs, L, Vt, St); +%% Record special forms. +to_gexpr('record',Name|Fs, L, Vt, St0) -> + {Efs,St1} = to_record_fields(fun to_gexpr/4, Fs, L, Vt, St0), + {{record,L,Name,Efs},St1}; +to_gexpr('is-record',E,Name, L, Vt, St0) -> + {Ee,St1} = to_gexpr(E, L, Vt, St0), + %% This expands to a function call. + {{call,L,{atom,L,is_record},Ee,{atom,L,Name}},St1}; +to_gexpr('record-index',Name,F, L, _, St) -> + {{record_index,L,Name,{atom,L,F}},St}; +to_gexpr('record-field',E,Name,F, L, Vt, St0) -> + {Ee,St1} = to_gexpr(E, L, Vt, St0), + {{record_field,L,Ee,Name,{atom,L,F}},St1}; +%% Struct special forms. +%% We try and do the same as Elixir 1.13.3 when we can. +to_gexpr('is-struct',E, L, Vt, St) -> + Is = 'andalso', + is_map,E, + call,?Q(erlang),?Q(is_map_key),?Q('__struct__'),E, + is_atom,mref,E,?Q('__struct__'), + to_gexpr(Is, L, Vt, St); +to_gexpr('is-struct',E,Name, L, Vt, St) -> + Is = 'andalso', + is_map,E, + call,?Q(erlang),?Q(is_map_key),?Q('__struct__'),E, + '=:=',mref,E,?Q('__struct__'),?Q(Name), + to_gexpr(Is, L, Vt, St); +to_gexpr('struct-field',E,Name,F, L, Vt, St) -> + Field = 'andalso', + is_map,E,'=:=',mref,E,?Q('__struct__'),?Q(Name), + mref,E,?Q(F), + to_gexpr(Field, L, Vt, St); +%% Special known data type operations. +to_gexpr('andalso'|Es, L, Vt, St) -> + to_lazy_logic(fun to_gexpr/4, Es, 'andalso', L, Vt, St); +to_gexpr('orelse'|Es, L, Vt, St) -> + to_lazy_logic(fun to_gexpr/4, Es, 'orelse', L, Vt, St); +%% General function call. +to_gexpr(call,?Q(erlang),?Q(F)|As, L, Vt, St0) -> + {Eas,St1} = to_gexprs(As, L, Vt, St0), + case is_erl_op(F, length(As)) of + true -> {list_to_tuple(op,L,F|Eas),St1}; + false -> + to_remote_call({atom,L,erlang}, {atom,L,F}, Eas, L, St1) + end; +to_gexpr(call|_, L, _Vt, _St) -> + illegal_code_error(L, call); +to_gexpr(F|As, L, Vt, St0) when is_atom(F) -> + {Eas,St1} = to_gexprs(As, L, Vt, St0), + Ar = length(As), + case is_erl_op(F, Ar) of + true -> {list_to_tuple(op,L,F|Eas),St1}; + false -> + {{call,L,{atom,L,F},Eas},St1} + end; +to_gexpr(_|_=List, L, _, St) -> + case lfe_lib:is_posint_list(List) of + true -> {{string,L,List},St}; + false -> + illegal_code_error(L, list) %Not right! + end; +to_gexpr(V, L, Vt, St) when is_atom(V) -> %Unquoted atom + to_gexpr_var(V, L, Vt, St); +to_gexpr(Lit, L, _, St) -> %Everything else is a literal + {to_lit(Lit, L),St}. + +to_gexprs(Es, L, Vt, St) -> + Fun = fun (E, St0) -> to_gexpr(E, L, Vt, St0) end, + lists:mapfoldl(Fun, St, Es). + +to_gexpr_var(V, L, Vt, St) -> + Var = ?VT_GET(V, Vt, V), %Hmm + {{var,L,Var},St}. + +%% to_gexpr_bitsegs(Segs, LineNumber, VarTable, State) -> {Segs,State}. + +to_gexpr_bitsegs(Segs, L, Vt, St) -> + BitSeg = fun (Seg, St0) -> to_bitseg(fun to_gexpr/4, Seg, L, Vt, St0) end, + lists:mapfoldl(BitSeg, St, Segs). + +%% to_gmap_get(Map, Key, LineNumber, VarTable, State) -> {MapGet,State}. +%% to_gmap_set(Map, Pairs, LineNumber, VarTable, State) -> {MapSet,State}. +%% to_gmap_update(Map, Pairs, LineNumber, VarTable, State) -> {MapUpdate,State}. + +to_gmap_get(Map, Key, L, Vt, St0) -> + {Eas,St1} = to_gexprs(Key,Map, L, Vt, St0), + {{call,L,{atom,L,map_get},Eas},St1}. + +to_gmap_set(Map, Pairs, L, Vt, St0) -> + {Em,St1} = to_gexpr(Map, L, Vt, St0), + {Eps,St2} = to_map_pairs(fun to_gexpr/4, Pairs, map_field_assoc, L, Vt, St1), + {{map,L,Em,Eps},St2}. + +to_gmap_update(Map, Pairs, L, Vt, St0) -> + {Em,St1} = to_gexpr(Map, L, Vt, St0), + {Eps,St2} = to_map_pairs(fun to_gexpr/4, Pairs, map_field_exact, L, Vt, St1), + {{map,L,Em,Eps},St2}. + +%% to_pat(Pattern, LineNumber, VarTable, State) -> {Pattern,VarTable,State}. +%% to_pat(Pattern, LineNumber, PatVars, VarTable, State) -> +%% {Pattern,VarTable,State}. + +to_pat(Pat, L, Vt0, St0) -> + {Epat,_Pvs,Vt1,St1} = to_pat(Pat, L, , Vt0, St0), + {Epat,Vt1,St1}. + +to_pat(, L, Pvs, Vt, St) -> {?TO_NIL(L),Pvs,Vt,St}; +to_pat(I, L, Pvs, Vt, St) when is_integer(I) -> + {{integer,L,I},Pvs,Vt,St}; +to_pat(F, L, Pvs, Vt, St) when is_float(F) -> + {{float,L,F},Pvs,Vt,St}; +to_pat(V, L, Pvs, Vt, St) when is_atom(V) -> %Unquoted atom + to_pat_var(V, L, Pvs, Vt, St); +to_pat(T, L, Pvs, Vt, St) when is_tuple(T) -> %Tuple literal + {to_lit(T, L),Pvs,Vt,St}; +to_pat(B, L, Pvs, Vt, St) when is_binary(B) -> %Binary literal + {to_lit(B, L),Pvs,Vt,St}; +to_pat(M, L, Pvs, Vt, St) when ?IS_MAP(M) -> %Map literal + {to_lit(M, L),Pvs,Vt,St}; +to_pat(?Q(P), L, Pvs, Vt, St) -> %Everything quoted here + {to_lit(P, L),Pvs,Vt,St}; +to_pat(cons,H,T, L, Pvs0, Vt0, St0) -> + {Eh,Et,Pvs1,Vt1,St1} = to_pats(H,T, L, Pvs0, Vt0, St0), + {{cons,L,Eh,Et},Pvs1,Vt1,St1}; +to_pat(list|Es, L, Pvs, Vt, St) -> + to_pat_list(Es, L, Pvs, Vt, St); +to_pat('list*'|Es, L, Pvs, Vt, St) -> %Macro + to_pat_list_s(Es, L, Pvs, Vt, St); +to_pat(tuple|Es, L, Pvs0, Vt0, St0) -> + {Ees,Pvs1,Vt1,St1} = to_pats(Es, L, Pvs0, Vt0, St0), + {{tuple,L,Ees},Pvs1,Vt1,St1}; +to_pat(binary|Segs, L, Pvs, Vt, St) -> + to_pat_binary(Segs, L, Pvs, Vt, St); +to_pat(map|Pairs, L, Pvs0, Vt0, St0) -> + {As,Pvs1,Vt1,St1} = to_pat_map_pairs(Pairs, L, Pvs0, Vt0, St0), + {{map,L,As},Pvs1,Vt1,St1}; +%% Record patterns. +to_pat('record',R|Fs, L, Pvs0, Vt0, St0) -> + {Efs,Pvs1,Vt1,St1} = to_pat_rec_fields(Fs, L, Pvs0, Vt0, St0), + {{record,L,R,Efs},Pvs1,Vt1,St1}; +%% make-record has been deprecated but we sill accept it for now. +to_pat('make-record',R|Fs, L, Pvs, Vt, St) -> + to_pat('record',R|Fs, L, Pvs, Vt, St); +to_pat('record-index',R,F, L, Pvs, Vt, St) -> + {{record_index,L,R,{atom,L,F}},Pvs,Vt,St}; +%% Struct patterns. +to_pat('struct',Name|Fs, L, Pvs, Vt, St) -> + Pat = map,?Q('__struct__'),?Q(Name)|to_struct_fields(Fs), + to_pat(Pat, L, Pvs, Vt, St); +%% Alias pattern. +to_pat('=',P1,P2, L, Pvs0, Vt0, St0) -> %Alias + {Ep1,Pvs1,Vt1,St1} = to_pat(P1, L, Pvs0, Vt0, St0), + {Ep2,Pvs2,Vt2,St2} = to_pat(P2, L, Pvs1, Vt1, St1), + {{match,L,Ep1,Ep2},Pvs2, Vt2,St2}; +%% General string pattern. +to_pat(_|_=List, L, Pvs, Vt, St) -> + case lfe_lib:is_posint_list(List) of + true -> {to_lit(List, L),Pvs,Vt,St}; + false -> illegal_code_error(L, string) + end. + +to_pats(Ps, L, Vt0, St0) -> + {Eps,_Pvs1,Vt1,St1} = to_pats(Ps, L, , Vt0, St0), + {Eps,Vt1,St1}. + +to_pats(Ps, L, Pvs, Vt, St) -> + Fun = fun (P, Pvs0, Vt0, St0) -> to_pat(P, L, Pvs0, Vt0, St0) end, + mapfoldl3(Fun, Pvs, Vt, St, Ps). + +to_pat_var('_', L, Pvs, Vt, St) -> %Don't need to handle _ + {{var,L,'_'},Pvs,Vt,St}; +to_pat_var(V, L, Pvs, Vt0, St0) -> + case lists:member(V, Pvs) of + true -> %Have seen this var in pattern + V1 = ?VT_GET(V, Vt0), % so reuse it + {{var,L,V1},Pvs,Vt0,St0}; + false -> + {V1,St1} = new_to_var(V, St0), + Vt1 = ?VT_PUT(V, V1, Vt0), + {{var,L,V1},V|Pvs,Vt1,St1} + end. + +%% to_pat_list(Elements, LineNumber, PatVars, VarTable, State) -> +%% {ListPat,PatVars,VarTable,State}. + +to_pat_list(Es, L, Pvs, Vt, St) -> + Cons = fun (E, {Tail,Pvs0,Vt0,St0}) -> + {Ee,Pvs1,Vt1,St1} = to_pat(E, L, Pvs0, Vt0, St0), + {{cons,L,Ee,Tail},Pvs1,Vt1,St1} + end, + lists:foldr(Cons, {?TO_NIL(L),Pvs,Vt,St}, Es). + +%% to_pat_list_s(Elements, LineNumber, PatVars, VarTable, State) -> +%% {ListPat,PatVars,VarTable,State}. +%% A list* macro expression that probably should have been expanded. + +to_pat_list_s(E, L, Pvs, Vt, St) -> to_pat(E, L, Pvs, Vt, St); +to_pat_list_s(E|Es, L, Pvs0, Vt0, St0) -> + {Les,Pvs1,Vt1,St1} = to_pat_list_s(Es, L, Pvs0, Vt0, St0), + {Le,Pvs2, Vt2,St2} = to_pat(E, L, Pvs1, Vt1, St1), + {{cons,L,Le,Les},Pvs2,Vt2,St2}; +to_pat_list_s(, L, Pvs, Vt, St) -> {?TO_NIL(L),Pvs,Vt,St}. + +%% to_pat_map_pairs(MapPairs, LineNumber, PatVars, VarTable, State) -> +%% {Args,PatVars,VarTable,State}. + +to_pat_map_pairs(K,V|Ps, L, Pvs0, Vt0, St0) -> + {Ek,Pvs1,Vt1,St1} = to_pat(K, L, Pvs0, Vt0, St0), + {Ev,Pvs2,Vt2,St2} = to_pat(V, L, Pvs1, Vt1, St1), + {Eps,Pvs3,Vt3,St3} = to_pat_map_pairs(Ps, L, Pvs2, Vt2, St2), + {{map_field_exact,L,Ek,Ev}|Eps,Pvs3,Vt3,St3}; +to_pat_map_pairs(, _, Pvs, Vt, St) -> {,Pvs,Vt,St}. + +%% to_pat_binary(Segs, LineNumber, PatVars, VarTable, State) -> +%% {Segs,PatVars,VarTable,State}. +%% We don't do any real checking here but just assume that everything +%% is correct and in worst case pass the buck to the Erlang compiler. + +to_pat_binary(Segs, L, Pvs0, Vt0, St0) -> + {Esegs,Pvs1,Vt1,St1} = to_pat_bitsegs(Segs, L, Pvs0, Vt0, St0), + {{bin,L,Esegs},Pvs1,Vt1,St1}. + +to_pat_bitsegs(Segs, L, Pvs, Vt, St) -> + BitSeg = fun (Seg, Pvs0, Vt0, St0) -> + to_pat_bitseg(Seg, L, Pvs0, Vt0, St0) + end, + mapfoldl3(BitSeg, Pvs, Vt, St, Segs). + +%% to_pat_bitseg(Seg, LineNumber, PatVars, VarTable, State) -> +%% {Seg,PatVars,VarTable,State}. +%% We must specially handle the case where the segment is a string. + +to_pat_bitseg(Val|Specs=Seg, L, Pvs, Vt, St) -> + case lfe_lib:is_posint_list(Seg) of + true -> + {{bin_element,L,{string,L,Seg},default,default},Pvs,Vt,St}; + false -> + to_pat_bin_element(Val, Specs, L, Pvs, Vt, St) + end; +to_pat_bitseg(Val, L, Pvs, Vt, St) -> + to_pat_bin_element(Val, , L, Pvs, Vt, St). + +to_pat_bin_element(Val, Specs, L, Pvs0, Vt0, St0) -> + {Eval,Pvs1,Vt1,St1} = to_pat(Val, L, Pvs0, Vt0, St0), + {Size,Type} = to_bitseg_type(Specs, default, ), + {Esiz,Pvs2,Vt2,St2} = to_pat_bit_size(Size, L, Pvs1, Vt1, St1), + {{bin_element,L,Eval,Esiz,Type},Pvs2,Vt2,St2}. + +to_pat_bit_size(all, _, Pvs, Vt, St) -> {default,Pvs,Vt,St}; +to_pat_bit_size(default, _, Pvs, Vt, St) -> {default,Pvs,Vt,St}; +to_pat_bit_size(undefined, _, Pvs, Vt, St) -> {default,Pvs,Vt,St}; +to_pat_bit_size(Size, L, Pvs, Vt, St) when is_integer(Size) -> + {{integer,L,Size},Pvs,Vt,St}; +to_pat_bit_size(Size, L, Pvs, Vt, St) when is_atom(Size) -> + %% We require the variable to have a value here. + Var = ?VT_GET(Size, Vt, Size), %Hmm + {{var,L,Var},Pvs,Vt,St}. + +%% to_pat_rec_fields(Fields, LineNumber, PatVars, VarTable, State) -> +%% {Fields,PatVars,VarTable,State}. + +to_pat_rec_fields('_',P|Fs, L, Pvs0, Vt0, St0) -> + %% Special case!! + {Ep,Pvs1,Vt1,St1} = to_pat(P, L, Pvs0, Vt0, St0), + {Efs,Pvs2,Vt2,St2} = to_pat_rec_fields(Fs, L, Pvs1, Vt1, St1), + {{record_field,L,{var,L,'_'},Ep}|Efs,Pvs2,Vt2,St2}; +to_pat_rec_fields(F,P|Fs, L, Pvs0, Vt0, St0) -> + {Ep,Pvs1,Vt1,St1} = to_pat(P, L, Pvs0, Vt0, St0), + {Efs,Pvs2,Vt2,St2} = to_pat_rec_fields(Fs, L, Pvs1, Vt1, St1), + {{record_field,L,{atom,L,F},Ep}|Efs,Pvs2,Vt2,St2}; +to_pat_rec_fields(, _, Pvs, Vt, St) -> {,Pvs,Vt,St}. + +%% to_lit(Literal, LineNumber) -> ErlLiteral. +%% Convert a literal value. Note that we KNOW it is a literal value. + +to_lit(Lit, L) -> + %% This does all the work for us. + erl_parse:abstract(Lit, L). + +%% mapfoldl2(Fun, Acc1, Acc2, List) -> {List,Acc1,Acc2}. +%% mapfoldl3(Fun, Acc1, Acc2, Acc3, List) -> {List,Acc1,Acc2,Acc3}. +%% Like normal mapfoldl but with 2/3 accumulators. + +mapfoldl2(Fun, A0, B0, E0|Es0) -> + {E1,A1,B1} = Fun(E0, A0, B0), + {Es1,A2,B2} = mapfoldl2(Fun, A1, B1, Es0), + {E1|Es1,A2,B2}; +mapfoldl2(_, A, B, ) -> {,A,B}. + +mapfoldl3(Fun, A0, B0, C0, E0|Es0) -> + {E1,A1,B1,C1} = Fun(E0, A0, B0, C0), + {Es1,A2,B2,C2} = mapfoldl3(Fun, A1, B1, C1, Es0), + {E1|Es1,A2,B2,C2}; +mapfoldl3(_, A, B, C, ) -> {,A,B,C}. + +illegal_code_error(Line, Error) -> + error({illegal_code,Line,Error}).
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfe_types.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfe_types.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2016-2017 Robert Virding +%% Copyright (c) 2016-2021 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,6 +24,7 @@ -module(lfe_types). +-export(is_type_decl/1). -export(format_error/1). -export(from_type_def/1,from_type_defs/1,to_type_def/2,to_type_defs/2, @@ -32,24 +33,27 @@ -export(from_func_spec_list/1,to_func_spec_list/2, check_func_spec_list/3). --export(is_predefined_type/2). - --compile(export_all). +%% -compile(export_all). -include("lfe.hrl"). %% format_error(Error) -> String. %% Do we really need this here? -format_error({bad_type,T}) -> +format_error({bad_type_def,T}) -> lfe_io:format1("bad ~w type definition", T); -format_error({type_syntax,T}) -> - lfe_io:format1(<<"bad ~w type">>, T); -format_error({undefined_type,{T,A}}) -> - lfe_io:format1(<<"type ~w/~w undefined">>, T,A); -format_error({bad_spec,S}) -> +format_error({bad_type_syntax,T}) -> + lfe_io:format1(<<"bad ~w type syntax">>, T); +format_error({bad_function_spec,S}) -> lfe_io:format1("bad function spec: ~w", S). +%% is_type_decl(Tag) -> boolean(). +%% Is Name a type declaration? + +is_type_decl(type) -> true; +is_type_decl(opaque) -> true; +is_type_decl(_Other) -> false. + %% from_type_def(AST) -> Def. %% Translate an Erlang type definition to LFE. This takes the Erlang %% AST form of a type definition and translates to the LFE type @@ -58,13 +62,18 @@ %% Our special cases. from_type_def({type,_L,union,Types}) -> %Special case union 'UNION'|from_type_defs(Types); -from_type_def({type,_L,tuple,any}) -> tuple; +from_type_def({type,_L,tuple,any}) -> %Special case tuple() -> (tuple) + tuple; +from_type_def({type,_L,tuple,Elems}) -> + list_to_tuple(from_type_defs(Elems)); from_type_def({type,_L,binary,Bits}) when Bits =/= -> - bitstring|from_type_defs(Bits); %Flip binary<->bitstring here + bitstring|from_type_defs(Bits); %Flip binary<->bitstring here %% from_type_def({type,_L,bitstring,}) -> bitstring,; +from_type_def({type,_L,map,any}) -> %Special case map() -> (map) + map; from_type_def({type,_L,map,Pairs}) -> - map|from_map_pairs(Pairs); -from_type_def({type,_L,record,{atom,_L,Name}|Fields}) -> + maps:from_list(from_map_pairs(Pairs)); +from_type_def({type,_L1,record,{atom,_L2,Name}|Fields}) -> record,Name|from_rec_fields(Fields); from_type_def({type,_L,'fun',Args,Ret}) -> lambda,from_lambda_args(Args),from_type_def(Ret); @@ -78,16 +87,20 @@ from_type_def({remote_type,_L,{atom,_,M},{atom,_,T},Args}) -> Type = list_to_atom(lists:concat(M,":",T)), Type|from_type_defs(Args); +%% Literal values. from_type_def({var,_L,Var}) -> Var; %A type variable from_type_def({atom,_L,Atom}) -> ?Q(Atom); %Literal atom -from_type_def({integer,_L,Int}) -> Int. %Literal integer +from_type_def({integer,_L,Int}) -> Int; %Literal integer +from_type_def({float,_L,Float}) -> Float. %Literal float from_type_defs(Ts) -> lists:map(fun from_type_def/1, Ts). from_map_pairs(Pairs) -> %% Lose distinction between assoc and exact pairs. - Fun = fun ({type,_L,_P,Types}) -> from_type_defs(Types) end, + Fun = fun ({type,_L,_P,Kt,Vt}) -> + {from_type_def(Kt),from_type_def(Vt)} + end, lists:map(Fun, Pairs). from_rec_fields(Fields) -> @@ -110,12 +123,14 @@ {type,Line,range,to_type_defs(I1,I2, Line)}; to_type_def(bitstring,I1,I2, Line) -> %Flip binary<->bitstring here {type,Line,binary,to_type_defs(I1,I2, Line)}; -to_type_def(tuple, Line) -> %Undefined tuple +to_type_def(tuple, Line) -> %Special case (tuple) -> tuple() {type,Line,tuple,any}; to_type_def(tuple|Args, Line) -> %Not a user defined type {type,Line,tuple,to_type_defs(Args, Line)}; -to_type_def(map|Pairs, Line) -> - {type,Line,map,to_map_pairs(Pairs, Line)}; +to_type_def(map, Line) -> %Special case (map) -> map() + {type,Line,map,any}; +to_type_def(map|Elems, Line) -> + {type,Line,map,to_map_pairs(to_pair_list(Elems), Line)}; to_type_def(record,Name|Fields, Line) -> {type,Line,record,to_lit(Name, Line)|to_rec_fields(Fields, Line)}; to_type_def(lambda,Args,Ret, Line) -> @@ -141,8 +156,15 @@ end, {Tag,Line,Type,Dargs} end; +to_type_def(Tup, Line) when is_tuple(Tup) -> + {type,Line,tuple,to_type_defs(tuple_to_list(Tup), Line)}; +to_type_def(Map, Line) when ?IS_MAP(Map) -> + ToPairs = to_map_pairs(maps:to_list(Map), Line), + {type,Line,map,ToPairs}; to_type_def(Val, Line) when is_integer(Val) -> %Literal integer value to_lit(Val, Line); +to_type_def(Val, Line) when is_float(Val) -> %Literal float value + to_lit(Val, Line); to_type_def(Val, Line) when is_atom(Val) -> %Variable {var,Line,Val}. @@ -150,12 +172,17 @@ lists:map(fun (D) -> to_type_def(D, Line) end, Ds). to_lit(Val, Line) when is_atom(Val) -> {atom,Line,Val}; -to_lit(Val, Line) when is_integer(Val) -> {integer,Line,Val}. +to_lit(Val, Line) when is_integer(Val) -> {integer,Line,Val}; +to_lit(Val, Line) when is_float(Val) -> {float,Line,Val}. + +to_pair_list(K,V|Rest) -> + {K,V}|to_pair_list(Rest); +to_pair_list() -> . to_map_pairs(Pairs, Line) -> %% Have lost distinction between assoc and exact pairs. - Fun = fun (Pair) -> - {type,Line,map_field_assoc,to_type_defs(Pair, Line)} + Fun = fun ({K,V}) -> + {type,Line,map_field_assoc,to_type_defs(K,V, Line)} end, Fun(P) || P <- Pairs . @@ -169,109 +196,117 @@ to_lambda_args(any, Line) -> {type,Line,any}; to_lambda_args(Args, Line) -> to_func_prod(Args, Line). -%% check_type_def(Def, KnownTypes, TypeVars) -> +%% check_type_defs(Defs, KnownRecords, TypeVars) -> +%% {ok,TypeVars} | {error,Error,TypeVars}. +%% check_type_def(Def, KnownRecords, TypeVars) -> %% {ok,TypeVars} | {error,Error,TypeVars}. %% Check a type definition. TypeVars is an orddict of variable names %% and usage counts. Errors returned are: -%% {bad_type,Type} - error in the type definition -%% {undefined_type,Type} - referring to an undefined type +%% {bad_type_syntax,Type} - error in the type syntax +%% {bad_type_def,Type} - error in the type definition %% Our special cases. -check_type_def('UNION'|Types, Kts, Tvs) -> - check_type_defs(Types, Kts, Tvs); -check_type_def(range,I1,I2, _Kts, Tvs) -> +check_type_def('UNION'|Types, Recs, Tvs) -> + check_type_defs(Types, Recs, Tvs); +check_type_def(range,I1,I2, _Recs, Tvs) -> if is_integer(I1) and is_integer(I2) and (I1 =< I2) -> {ok,Tvs}; - true -> type_syntax_error(range, Tvs) + true -> bad_type_syntax_error(range, Tvs) end; -check_type_def(tuple|Ts, Kts, Tvs) -> - check_type_defs(Ts, Kts, Tvs); -check_type_def(bitstring,I1,I2, _Kts, Tvs) -> +check_type_def(tuple|Ts, Recs, Tvs) -> + check_type_defs(Ts, Recs, Tvs); +check_type_def(bitstring,I1,I2, _Recs, Tvs) -> if is_integer(I1) and is_integer(I2) and (I1 >= 0) and (I2 >= 0) -> {ok,Tvs}; - true -> type_syntax_error(bitstring, Tvs) + true -> bad_type_syntax_error(bitstring, Tvs) end; -check_type_def(map|Pairs, Kts, Tvs) -> - check_map_pairs(Pairs, Kts, Tvs); -check_type_def(record,Name|Fields, Kts, Tvs) -> - if is_atom(Name) -> check_record_fields(Fields, Kts, Tvs); - true -> type_syntax_error(record, Tvs) - end; -check_type_def(lambda,Args,Ret, Kts, Tvs0) -> - case check_lambda_args(Args, Kts, Tvs0) of - {ok,Tvs1} -> check_type_def(Ret, Kts, Tvs1); +check_type_def(map|Pairs, Recs, Tvs) -> + check_map_pairs(Pairs, Recs, Tvs); +check_type_def(record,Name|Fields, Recs, Tvs) -> + check_record(Name, Fields, Recs, Tvs); + %% if is_atom(Name) -> check_record_fields(Fields, Recs, Tvs); + %% true -> bad_type_syntax_error(record, Tvs) + %% end; +check_type_def(lambda,Args,Ret, Recs, Tvs0) -> + case check_lambda_args(Args, Recs, Tvs0) of + {ok,Tvs1} -> check_type_def(Ret, Recs, Tvs1); Error -> Error end; -check_type_def(?Q(Val), _Kts, Tvs) -> check_type_lit(Val, Tvs); -check_type_def(call,?Q(M),?Q(T)|Args, Kts, Tvs) when is_atom(M), is_atom(T) -> - check_type_defs(Args, Kts, Tvs); +check_type_def(?Q(Val), _Recs, Tvs) -> check_type_lit(Val, Tvs); +check_type_def(call,?Q(M),?Q(T)|Args, Recs, Tvs) when is_atom(M), is_atom(T) -> + check_type_defs(Args, Recs, Tvs); %% The standard Erlang types. -check_type_def(Type|Args, Kts, Tvs0) when is_atom(Type) -> - case check_type_defs(Args, Kts, Tvs0) of - {ok,Tvs1} -> - case string:tokens(atom_to_list(Type), ":") of - _M,_T -> {ok,Tvs1}; %Remote so we just accept it - _ -> - Arity = length(Args), %It's a proper list - case lists:member({Type,Arity}, Kts) - or is_predefined_type(Type, Arity) of - true -> {ok,Tvs1}; - false -> undefined_type_error(Type, Arity, Tvs1) - end - end; - Error -> Error - end; -%% Only integers and atoms (type variables) legally left now. -check_type_def(Val, _Kts, Tvs) when is_integer(Val) -> {ok,Tvs}; -check_type_def(Val, _Kts, Tvs) when is_atom(Val) -> +check_type_def(Type|Args, Recs, Tvs0) when is_atom(Type) -> + check_type_defs(Args, Recs, Tvs0); +%% Only literal tuples, maps, integers and atoms (type variables) left now. +check_type_def(Tup, Recs, Tvs) when is_tuple(Tup) -> + check_type_defs(tuple_to_list(Tup), Recs, Tvs); +check_type_def(Map, Recs, Tvs) when ?IS_MAP(Map) -> + ToPairs = fun ({K,V}) -> K,V end, %Convert to list pairs + check_map_pairs(lists:flatmap(ToPairs, maps:to_list(Map)), Recs, Tvs); +check_type_def(Val, _Recs, Tvs) when is_integer(Val) -> {ok,Tvs}; +check_type_def(Val, _Recs, Tvs) when is_atom(Val) -> %% It's a type variable. {ok,orddict:update_counter(Val, 1, Tvs)}; -check_type_def(Def, _Kts, Tvs) -> - bad_type_error(Def, Tvs). +check_type_def(Def, _Recs, Tvs) -> + bad_type_def_error(Def, Tvs). -check_type_defs(Defs, Kts, Tvs) -> - check_type_list(fun check_type_def/3, Defs, Kts, Tvs). +check_type_defs(Defs, Recs, Tvs) -> + check_type_list(fun check_type_def/3, Defs, Recs, Tvs). check_type_lit(Val, Tvs) when is_integer(Val) ; is_atom(Val) -> {ok,Tvs}; -check_type_lit(Val, Tvs) -> bad_type_error(Val, Tvs). - -check_map_pairs(Pairs, Kts, Tvs) -> - check_type_list(fun check_map_pair/3, Pairs, Kts, Tvs). +check_type_lit(Val, Tvs) -> bad_type_def_error(Val, Tvs). -check_map_pair(K,V, Kts, Tvs0) -> - case check_type_def(K, Kts, Tvs0) of - {ok,Tvs1} -> check_type_def(V, Kts, Tvs1); +check_map_pairs(K,V|Pairs, Recs, Tvs0) -> + case check_map_pair(K, V, Recs, Tvs0) of + {ok,Tvs1} -> + check_map_pairs(Pairs, Recs, Tvs1); Error -> Error end; -check_map_pair(Other, _Kts, Tvs) -> - bad_type_error(Other, Tvs). +check_map_pairs(, _Recs, Tvs) -> {ok,Tvs}; +check_map_pairs(_Other, _Recs, Tvs) -> + bad_type_syntax_error(map, Tvs). -check_record_fields(Fs, Kts, Tvs) -> - check_type_list(fun check_record_field/3, Fs, Kts, Tvs). +check_map_pair(K, V, Recs, Tvs0) -> + case check_type_def(K, Recs, Tvs0) of + {ok,Tvs1} -> check_type_def(V, Recs, Tvs1); + Error -> Error + end. -check_record_field(F,T, Kts, Tvs) when is_atom(F) -> - check_type_def(T, Kts, Tvs); -check_record_field(Other, _Kts, Tvs) -> - bad_type_error(Other, Tvs). +%% check_record(Record, Fields, KnownRecords, TypeVars) -> +%% {ok,TypeVars} | {error,Error,TypeVars}. -check_lambda_args(any, _Kts, Tvs) -> {ok,Tvs}; -check_lambda_args(Args, Kts, Tvs) -> - check_type_defs(Args, Kts, Tvs). +check_record(Name, Fields, Recs, Tvs) -> + case orddict:is_key(Name, Recs) of + true -> + check_record_fields(Fields, Recs, Tvs); + false -> + if is_atom(Name) -> + undefined_record_error(Name, Tvs); + true -> bad_type_syntax_error(record, Tvs) + end + end. -check_type_list(Check, E|Es, Kts, Tvs0) -> - case Check(E, Kts, Tvs0) of - {ok,Tvs1} -> check_type_list(Check, Es, Kts, Tvs1); - Error -> Error - end; -check_type_list(_Check, , _Kts, Tvs) -> {ok,Tvs}; -check_type_list(_Check, Other, _Kts, Tvs) -> %Not a proper list - bad_type_error(Other, Tvs). +check_record_fields(Fs, Recs, Tvs) -> + check_type_list(fun check_record_field/3, Fs, Recs, Tvs). -bad_type_error(Type, Tvs) -> {error,{bad_type,Type},Tvs}. +check_record_field(F,T, Recs, Tvs) when is_atom(F) -> + check_type_def(T, Recs, Tvs); +check_record_field(Other, _Recs, Tvs) -> + bad_type_def_error(Other, Tvs). -type_syntax_error(Type, Tvs) -> {error,{type_syntax,Type},Tvs}. +check_lambda_args(any, _Recs, Tvs) -> {ok,Tvs}; +check_lambda_args(Args, Recs, Tvs) -> + check_type_defs(Args, Recs, Tvs). -undefined_type_error(Type, Ar, Tvs) -> {error,{undefined_type,{Type,Ar}},Tvs}. +check_type_list(Check, E|Es, Recs, Tvs0) -> + case Check(E, Recs, Tvs0) of + {ok,Tvs1} -> check_type_list(Check, Es, Recs, Tvs1); + Error -> Error + end; +check_type_list(_Check, , _Recs, Tvs) -> {ok,Tvs}; +check_type_list(_Check, Other, _Recs, Tvs) -> %Not a proper list + bad_type_def_error(Other, Tvs). %% from_func_spec_list(FuncType) -> Type. @@ -324,75 +359,72 @@ {type,Line,constraint,{atom,Line,is_subtype}, {var,Line,Var},to_type_def(Type, Line)}. -%% check_func_spec_list(FuncType, Arity, KnownTypes, TypeVars) -> +%% check_func_spec_list(FuncType, Arity, KnownRecords) -> %% {ok,TypeVars} | {error,Error,TypeVars}. +%% check_func_spec(FuncType, Arity, KnownRecords) -> +%% {ok,TypeVars} | {error,Error,TypeVars}. %% Check a list of function specs. TypeVars is an orddict of variable %% names and usage counts. Errors returned are: -%% {bad_spec,Spec} - error in the type definition +%% {bad_function_spec,Spec} - error in the type definition -check_func_spec_list(Ss, Ar, Kts) -> - check_spec_list(fun check_func_spec/3, Ss, Ar, Kts). +check_func_spec_list(Ss, Ar, Recs) -> + check_spec_list(fun check_func_spec/3, Ss, Ar, Recs). -check_func_spec(Prod,Ret, Ar, Kts) -> - check_func_spec(Prod,Ret,, Ar, Kts); -check_func_spec(Prod,Ret,Cs, Ar, Kts) -> +check_func_spec(Prod,Ret, Ar, Recs) -> + check_func_spec(Prod,Ret,, Ar, Recs); +check_func_spec(Prod,Ret,Cs, Ar, Recs) -> Tvs0 = , - case check_func_prod(Prod, Ar, Kts, Tvs0) of + case check_func_prod(Prod, Ar, Recs, Tvs0) of {ok,Tvs1} -> - case check_type_def(Ret, Kts, Tvs1) of + case check_type_def(Ret, Recs, Tvs1) of {ok,Tvs2} -> - check_func_constraints(Cs, Kts, Tvs2); + check_func_constraints(Cs, Recs, Tvs2); Error -> Error end; Error -> Error end; -check_func_spec(Other, _Ar, _Kts) -> - bad_spec_error(Other, ). +check_func_spec(Other, _Ar, _Recs) -> + bad_function_spec_error(Other, ). -check_func_prod(Args, Ar, Kts, Tvs0) -> +check_func_prod(Args, Ar, Recs, Tvs0) -> %% This checks both the list and the types. - case check_type_defs(Args, Kts, Tvs0) of + case check_type_defs(Args, Recs, Tvs0) of {ok,Tvs1} -> if length(Args) =:= Ar -> {ok,Tvs1}; - true -> bad_spec_error(Args, Tvs1) + true -> bad_function_spec_error(Args, Tvs1) end; Error -> Error end. -check_func_constraints(Var,Type|Cs, Kts, Tvs0) when is_atom(Var) -> +check_func_constraints(Var,Type|Cs, Recs, Tvs0) when is_atom(Var) -> Tvs1 = orddict:update_counter(Var, 1, Tvs0), - case check_type_def(Type, Kts, Tvs1) of - {ok,Tvs2} -> check_func_constraints(Cs, Kts, Tvs2); + case check_type_def(Type, Recs, Tvs1) of + {ok,Tvs2} -> check_func_constraints(Cs, Recs, Tvs2); Error -> Error end; -check_func_constraints(, _Kts, Tvs) -> {ok,Tvs}; -check_func_constraints(Other, _Kts, Tvs) -> - bad_spec_error(Other, Tvs). +check_func_constraints(, _Recs, Tvs) -> {ok,Tvs}; +check_func_constraints(Other, _Recs, Tvs) -> + bad_function_spec_error(Other, Tvs). -check_spec_list(Check, Es, Ar, Kts) -> - check_spec_list(Check, Es, Ar, Kts, ). +check_spec_list(Check, Es, Ar, Recs) -> + check_spec_list(Check, Es, Ar, Recs, ). -check_spec_list(Check, E|Es, Ar, Kts, Tvss) -> - case Check(E, Ar, Kts) of - {ok,Tvs} -> check_spec_list(Check, Es, Ar, Kts, Tvss ++ Tvs); +check_spec_list(Check, E|Es, Ar, Recs, Tvss) -> + case Check(E, Ar, Recs) of + {ok,Tvs} -> check_spec_list(Check, Es, Ar, Recs, Tvss ++ Tvs); Error -> Error end; -check_spec_list(_Check, , _Ar, _Kts, Tvss) -> {ok,Tvss}; -check_spec_list(_Check, Other, _Ar, _Kts, Tvss) -> +check_spec_list(_Check, , _Ar, _Recs, Tvss) -> {ok,Tvss}; +check_spec_list(_Check, Other, _Ar, _Recs, Tvss) -> %% Not a proper list. - bad_spec_error(Other, Tvss). - -bad_spec_error(Val, Tvs) -> {error,{bad_spec,Val},Tvs}. - -%% is_predefined_type(Name, Arity) -> bool(). -%% Check whether Name/Arity is a predefined type. - -is_predefined_type('UNION', Ar) -> is_integer(Ar) and (Ar >= 0); -is_predefined_type(call, Ar) -> is_integer(Ar) and (Ar >= 0); -is_predefined_type(lambda, Ar) -> is_integer(Ar) and (Ar >= 0); -is_predefined_type(map, Ar) -> is_integer(Ar) and (Ar >= 0); -is_predefined_type(range, 2) -> true; -is_predefined_type(bitstring, 2) -> true; -is_predefined_type(tuple, Ar) -> is_integer(Ar) and (Ar >= 0); -is_predefined_type(Name, Arity) -> - erl_internal:is_type(Name, Arity). + bad_function_spec_error(Other, Tvss). + +%% Return errors. + +bad_function_spec_error(Val, Tvs) -> {error,{bad_function_spec,Val},Tvs}. + +bad_type_def_error(Type, Tvs) -> {error,{bad_type_def,Type},Tvs}. + +bad_type_syntax_error(Type, Tvs) -> {error,{bad_type_syntax,Type},Tvs}. + +undefined_record_error(Rec, Tvs) -> {error,{undefined_record,Rec},Tvs}.
View file
_service:tar_scm:lfe-1.3.tar.gz/src/lfescript.erl -> _service:tar_scm:lfe-2.1.1.tar.gz/src/lfescript.erl
Changed
@@ -1,4 +1,4 @@ -%% Copyright (c) 2008-2016 Robert Virding +%% Copyright (c) 2008-2020 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -25,6 +25,10 @@ -export(start/0,start/1). -export(run/1,run/2). +-include("lfe.hrl"). + +%% External API. + script_name() -> Sname|_ = init:get_plain_arguments(), Sname. @@ -34,10 +38,10 @@ -define(OK_STATUS, 0). -define(ERROR_STATUS, 127). -%% start() -> no_return(). -%% start(Options) -> no_return(). -%% run(CmdLine) -> no_return(). -%% run(CmdLine, Options) -> no_return(). +-spec start() -> no_return(). +-spec start(_Options) -> no_return(). +-spec run(_CmdLine) -> no_return(). +-spec run(_CmdLine, _Options) -> no_return(). %% Evaluate the LFE script. All errors which are caught here are %% internal errors. Start gets its arguments from the command line %% while run gets them as an argument. @@ -58,8 +62,7 @@ throw:Str -> lfe_io:format("lfescript: ~s\n", Str), halt(?ERROR_STATUS); - _:Reason -> - Stack = erlang:get_stacktrace(), %Need to get this first + ?CATCH(_, Reason, Stack) lfe_io:format("lfescript: Internal error: ~p\n", Reason), lfe_io:format("~p\n", Stack), halt(?ERROR_STATUS) @@ -142,7 +145,7 @@ %% expand_macros(Forms, File, Args, Lopts) -> {Forms,Fenv}. expand_macros(Fs0, File, _, _) -> - case lfe_macro:expand_forms(Fs0, lfe_env:new(), true, false) of + case lfe_macro:expand_fileforms(Fs0, lfe_env:new(), true, false) of {ok,Fs1,Fenv,Ws} -> list_warnings(File, Ws), {Fs1,Fenv}; @@ -163,13 +166,17 @@ %% make_env(Forms, File, Args, Lopts) -> FunctionEnv. -make_env(Fs, Fenv, _, _, _) -> - {Fbs,null} = lfe_lib:proc_forms(fun collect_form/3, Fs, null), +make_env(Forms, Fenv, _, _, _) -> + {Fbs,null} = lfe_lib:proc_forms(fun collect_function/3, Forms, null), lfe_eval:make_letrec_env(Fbs, Fenv). -collect_form('define-function',F,_Meta,Def, _, St) -> +collect_function('define-function',F,_Meta,Def, _, St) -> Ar = function_arity(Def), - {{F,Ar,Def},St}. + {{F,Ar,Def},St}; +%% Ignore everything else including types and eval-when-compile. +collect_function(_Form, _, St) -> + {,St}. + function_arity(lambda,As|_) -> length(As); function_arity('match-lambda',Pats|_|_) -> length(Pats). @@ -184,11 +191,10 @@ 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 + ?CATCH(Class, Error, Stack) Skip = fun (_) -> false end, Format = fun (T, I) -> lfe_io:prettyprint1(T, 15, I, 80) end, - Cs = lfe_lib:format_exception(Class, Error, St, Skip, Format, 1), + Cs = lfe_lib:format_exception(Class, Error, Stack, Skip, Format, 1), io:put_chars(Cs), halt(?ERROR_STATUS) end.
View file
_service:tar_scm:lfe-2.1.1.tar.gz/src/scm.erl
Added
@@ -0,0 +1,276 @@ +%% Copyright (c) 2020 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 : scm.erl +%% Author : Robert Virding +%% Purpose : Lisp Flavoured Erlang scheme like macros + +-module(scm). + +-export('LFE-EXPAND-EXPORTED-MACRO'/3). + +-export(mbe_syntax_rules_proc/4,mbe_syntax_rules_proc/5, + mbe_match_pat/3,mbe_get_bindings/3,mbe_expand_pattern/3). + +-import(lists, member/2,map/2,all/2,any/2). + +%% 'LFE-EXPAND-EXPORTED-MACRO'(Name, Args, Env) -> {yes,Expansion} | no. +%% Explicitly define this function so we can call the begin, define, +%% define-syntax and let-syntax macros without having to include +%% scm.lfe. These are exactly equivalent to those macros. + +'LFE-EXPAND-EXPORTED-MACRO'(MacroName, MacroArgs, _Env) -> + case MacroName|MacroArgs of + %% These are easy. + 'begin'|Body -> + {yes,progn|Body}; + 'define',Head|Body -> + Exp = case lfe_lib:is_symb_list(Head) of + true -> + hd(Head),,lambda,tl(Head)|Body; + false -> + Head,,Body + end, + {yes,'define-function'|Exp}; + %% Now for the syntax macros. + 'define-syntax',Name,Def -> + {Meta,Mdef} = exp_syntax(Name, Def), + {yes,'define-macro',Name,Meta,Mdef}; + 'let-syntax',Defs|Body -> + Fun = fun (Name,Def) -> + {_,Def} = exp_syntax(Name, Def), + Name,Def + end, + Mdefs = map(Fun, Defs), + {yes,'let-macro',Mdefs|Body}; + defsyntax,Name|Rules -> + {Meta,Mdef} = exp_rules(Name, , Rules), + {yes,'define-macro',Name,Meta,Mdef}; + _ -> no + end. + + +%% exp_syntax(Name, Def) -> {Meta,Lambda | MatchLambda}. +%% N.B. New macro definition is function of 2 arguments, the whole +%% argument list of macro call, and the current macro environment. + +exp_syntax(Name, Def) -> + case Def of + macro|Cls -> + Mcls = map(fun (Pat|Body) -> Pat,'$ENV'|Body end, Cls), + {,'match-lambda'|Mcls}; + 'syntax-rules'|Rules -> + exp_rules(Name, , Rules) + end. + +%% exp_rules(Name, Keywords, Rules) -> {Meta,Lambda}. +%% Expand into call function which expands macro an invocation time, +%% this saves much space and costs us nothing. +%% N.B. New macro definition is function of 2 arguments, the whole +%% argument list of macro call, and the current macro environment. + +exp_rules(Name, Keywords, Rules) -> + {,lambda,args,'$ENV', + ':',scm,mbe_syntax_rules_proc, + quote,Name,quote,Keywords,quote,Rules,args}. + +%% Macro by Example +%% Proper syntax-rules which can handle ... ellipsis by Dorai Sitaram. +%% +%% While we extend patterns to include tuples and binaries as in +%% normal LFE we leave the keyword handling in even though it is +%% subsumed by quotes and not really used. + +%% To make it more lispy! +-define(car(L), hd(L)). +-define(cdr(L), tl(L)). +-define(cadr(L), hd(tl(L))). +-define(cddr(L), tl(tl(L))). + +-define(mbe_ellipsis(Car, Cddr), Car,'...'|Cddr). + +is_mbe_symbol(S) -> + is_atom(S) andalso not is_boolean(S). + +%% Tests if ellipsis pattern, (p ... . rest) +%% is_mbe_ellipsis(?mbe_ellipsis(_, _)) -> true; +%% is_mbe_ellipsis(_) -> false. + +mbe_match_pat(quote,P, E, _) -> P =:= E; +mbe_match_pat(tuple|Ps, tuple|Es, Ks) -> %Match tuple constructor + mbe_match_pat(Ps, Es, Ks); +mbe_match_pat(tuple|Ps, E, Ks) -> %Match literal tuple + case is_tuple(E) of + true -> mbe_match_pat(Ps, tuple_to_list(E), Ks); + false -> false + end; +mbe_match_pat(?mbe_ellipsis(Pcar, _), E, Ks) -> + case lfe_lib:is_proper_list(E) of + true -> + all(fun (X) -> mbe_match_pat(Pcar, X, Ks) end, E); + false -> false + end; +mbe_match_pat(Pcar|Pcdr, E, Ks) -> + case E of + Ecar|Ecdr -> + mbe_match_pat(Pcar, Ecar, Ks) andalso + mbe_match_pat(Pcdr, Ecdr, Ks); + _ -> false + end; +mbe_match_pat(Pat, E, Ks) -> + case is_mbe_symbol(Pat) of + true -> + case member(Pat, Ks) of + true -> Pat =:= E; + false -> true + end; + false -> Pat =:= E + end. + +mbe_get_ellipsis_nestings(Pat, Ks) -> + m_g_e_n(Pat, Ks). + +m_g_e_n(quote,_, _) -> ; +m_g_e_n(tuple|Ps, Ks) -> m_g_e_n(Ps, Ks); +m_g_e_n(?mbe_ellipsis(Pcar, Pcddr), Ks) -> + m_g_e_n(Pcar, Ks)|m_g_e_n(Pcddr, Ks); +m_g_e_n(Pcar|Pcdr, Ks) -> + m_g_e_n(Pcar, Ks) ++ m_g_e_n(Pcdr, Ks); +m_g_e_n(Pat, Ks) -> + case is_mbe_symbol(Pat) of + true -> + case member(Pat, Ks) of + true -> ; + false -> Pat + end; + false -> + end. + +mbe_ellipsis_sub_envs(Nestings, R) -> + ormap(fun (C) -> + case mbe_intersect(Nestings, ?car(C)) of + true -> ?cdr(C); + false -> false + end end, R). + +%% Return first value of F applied to elements in list which is not false. +ormap(F, H|T) -> + case F(H) of + false -> ormap(F, T); + V -> V + end; +ormap(_, ) -> false. + +mbe_intersect(V, Y) -> + case is_mbe_symbol(V) orelse is_mbe_symbol(Y) of + true -> V =:= Y; + false -> + any(fun (V0) -> + any(fun (Y0) -> mbe_intersect(V0, Y0) end, Y) + end, V) + end. + +%% mbe_get_bindings(Pattern, Expression, Keywords) -> Bindings. + +mbe_get_bindings(quote,_, _, _) -> ; +mbe_get_bindings(tuple|Ps, tuple|Es, Ks) -> %Tuple constructor + mbe_get_bindings(Ps, Es, Ks); +mbe_get_bindings(tuple|Ps, E, Ks) -> %Literal tuple + mbe_get_bindings(Ps, tuple_to_list(E), Ks); +mbe_get_bindings(?mbe_ellipsis(Pcar, _), E, Ks) -> + mbe_get_ellipsis_nestings(Pcar, Ks) | + map(fun (X) -> mbe_get_bindings(Pcar, X, Ks) end, E); +mbe_get_bindings(Pcar|Pcdr, Ecar|Ecdr, Ks) -> + mbe_get_bindings(Pcar, Ecar, Ks) ++ + mbe_get_bindings(Pcdr, Ecdr, Ks); +mbe_get_bindings(Pat, E, Ks) -> + case is_mbe_symbol(Pat) of + true -> + case member(Pat, Ks) of + true -> ; + false -> Pat|E + end; + false -> + end. + +%% mbe_expand_pattern(Pattern, Bindings, Keywords) -> Form. + +mbe_expand_pattern(quote,P, R, Ks) -> + quote,mbe_expand_pattern(P, R, Ks); +mbe_expand_pattern(tuple|Ps, R, Ks) -> + tuple|mbe_expand_pattern(Ps, R, Ks); +mbe_expand_pattern(?mbe_ellipsis(Pcar, Pcddr), R, Ks) -> + Nestings = mbe_get_ellipsis_nestings(Pcar, Ks), + Rr = mbe_ellipsis_sub_envs(Nestings, R), + map(fun (R0) -> mbe_expand_pattern(Pcar, R0 ++ R, Ks) end, Rr) ++ + mbe_expand_pattern(Pcddr, R, Ks); +mbe_expand_pattern(Pcar|Pcdr, R, Ks) -> + mbe_expand_pattern(Pcar, R, Ks)| + mbe_expand_pattern(Pcdr, R, Ks); +mbe_expand_pattern(Pat, R, Ks) -> + case is_mbe_symbol(Pat) of + true -> + case member(Pat, Ks) of + true -> Pat; + false -> + case lfe:assoc(Pat, R) of + _|Cdr -> Cdr; + -> Pat + end + end; + false -> Pat + end. + +%% mbe_syntax_rules_proc(Name, Keywords, Rules, Argsym, Keywordsym) -> +%% Sexpr. +%% Generate the sexpr to evaluate in a macro from Name and +%% Rules. When the sexpr is applied to arguments (in Argsym) and +%% evaluated then expansion is returned. + +%% Return sexpr to evaluate. +mbe_syntax_rules_proc(Name, Ks0, Cls, Argsym, Ksym) -> + Ks = Name|Ks0, + %% Don't prepend the macro name to the arguments! + 'let',Ksym,quote,Ks, + 'cond' ++ + map(fun (C) -> + Inpat = hd(C), + Outpat = hd(tl(C)), + ':',lfe_macro,mbe_match_pat,quote,Inpat, Argsym, Ksym, + 'let', + r,':',lfe_macro,mbe_get_bindings, + quote,Inpat,Argsym,Ksym, + ':',lfe_macro,mbe_expand_pattern, + quote,Outpat,r,Ksym + end, Cls) ++ + quote,true,':',erlang,error, + tuple, + quote,expand_macro, + cons,quote,Name,Argsym, %??? Must check this + quote,macro_clause. + +%% Do it all directly. +mbe_syntax_rules_proc(Name, Ks0, Cls, Args) -> + Ks = Name|Ks0, + case ormap(fun (Pat,Exp) -> + case mbe_match_pat(Pat, Args, Ks) of + true -> + R = mbe_get_bindings(Pat, Args, Ks), + mbe_expand_pattern(Exp, R, Ks); + false -> false + end + end, Cls) of + Res -> Res; + false -> erlang:error({expand_macro,Name|Args,macro_clause}) + end.
View file
_service:tar_scm:lfe-1.3.tar.gz/test/andor_SUITE.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/test/andor_SUITE.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -372,31 +372,41 @@ (line (test-pat 'true (COMB 'true 'true 'true))) ;; This next one crashed the compiler! - (line (test-pat (tuple 'EXIT (tuple 'if_clause _)) - (catch (COMB 'true 'blurf 'false)))) (line (test-pat 'false (COMB 'false 'blurf 'false))) (line (test-pat 'true (COMB 'false 'blurf 'true))) (line (test-pat 'true (COMB 'true 'true 'blurf))) + (test-pat 'false (simple-comb 'false 'false)) + (test-pat 'false (simple-comb 'false 'true)) + (test-pat 'false (simple-comb 'true 'false)) + (test-pat 'true (simple-comb 'true 'true)) + 'ok)) (defun comb (a b c) (let* ((r0 (orelse (andalso a b) c)) - (r1 (when (=:= r0 r1)) - (eif (orelse (andalso a b) c) 'true 'true 'false)) - (n0 (eif (not (orelse (andalso a b) c)) 'true 'true 'false)) - (n1 (when (=:= n0 n1)) - (id (not r1))) - (r2 (when (=:= r1 r2)) - (orelse (andalso a b) c)) - (r3 (when (=:= r2 r3)) - (eif (orelse (andalso a b) c) 'true 'true 'false)) - (n2 (when (=:= n1 n2)) - (id (not r3))) - (r4 (when (=:= r3 r4)) - (eif (orelse (andalso a b) c) 'true 'true 'false))) + (r1 (when (=:= r0 r1)) + (eif (orelse (andalso a b) c) 'true 'true 'false)) + (n0 (eif (not (orelse (andalso a b) c)) 'true 'true 'false)) + (n1 (when (=:= n0 n1)) + (id (not r1))) + (r2 (when (=:= r1 r2)) + (orelse (andalso a b) c)) + (r3 (when (=:= r2 r3)) + (eif (orelse (andalso a b) c) 'true 'true 'false)) + (n2 (when (=:= n1 n2)) + (id (not r3))) + (r4 (when (=:= r3 r4)) + (eif (orelse (andalso a b) c) 'true 'true 'false))) (id r4))) +(defun simple-comb (a b) + ;; Use res twice, to ensure that a careless optimization of 'not' + ;; doesn't leave res as a free variable. + (let* ((res (andalso a b)) + (_ (id res))) + res)) + ;; Test that a boolean expression in a case expression is properly ;; optimized (in particular, that the error behaviour is correct). (defun in_case
View file
_service:tar_scm:lfe-1.3.tar.gz/test/clj-tests.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/test/clj-tests.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2016 Eric Bailey +;; Copyright (c) 2016-2020 Eric Bailey ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -16,7 +16,6 @@ ;; Author : Eric Bailey ;; Purpose : Test clj exports. - (defmodule clj-tests "Test clj exports.") @@ -30,11 +29,12 @@ ;;; defn (defun test-defn (f a def) - (let* ((forms `((defmodule dummy) ,def)) - (`#(ok (#(ok dummy ,beam))) (lfe_comp:forms forms)) - (`#(ok ,docs) (lfe_doc:get_module_docs beam))) - (lfe_io:format "~s/~w ~p~n" (list f a docs)) - (lfe_doc:function_docs f a docs))) + `#(ok #"doc")) + ;; (let* ((forms `((defmodule dummy) ,def)) + ;; (`#(ok (#(ok dummy ,beam))) (lfe_comp:forms forms)) + ;; (`#(ok ,docs) (lfe_doc:get_module_docs beam))) + ;; (lfe_io:format "~s/~w ~p~n" (list f a docs)) + ;; (lfe_doc:function_docs f a docs))) (deftest defn (are* f a def (ok? (is-match `#(ok ,_doc) (test-defn f a def))) @@ -77,7 +77,7 @@ 1540.0 (clj:->> (clj:seq 42) (lists:map (lambda (x) (math:pow x 2))) - (lists:filter (clj:comp #'clj:even?/1 #'round/1)) + (lists:filter (clj:comp #'even?/1 #'round/1)) (clj:take 10) (lists:foldl (fun + 2) 0)))) @@ -196,16 +196,16 @@ (is-equal (clj:identity (+ 1 2 3)) (c0 6)) (is-equal (clj:identity (quote foo)) (c0 'foo))) (let ((asin-result (funcall (clj:comp #'math:sin/1 #'math:asin/1) 0.5))) - (is-equal "0.5" (car (io_lib:format "~.1f" `(,asin-result))))) + (is-equal "0.5" (lists:flatten (io_lib:format "~.1f" `(,asin-result))))) (is-equal 1.5 (funcall (clj:comp `(,(lambda (x) (+ x 1)) ,#'math:sin/1 ,#'math:asin/1)) 0.5)) (is-equal '(1 2 3 4) - (lists:filter (clj:comp #'not/1 #'clj:zero?/1) + (lists:filter (clj:comp #'not/1 #'zero?/1) '(0 1 0 2 0 3 0 4))) (let ((asin-result (clj:comp #'math:sin/1 #'math:asin/1 0.5))) - (is-equal "0.5" (car (io_lib:format "~.1f" `(,asin-result)))))) + (is-equal "0.5" (lists:flatten (io_lib:format "~.1f" `(,asin-result)))))) (deftest partial (flet (;; (p0 (x) (funcall (clj:partial inc) x)) @@ -331,7 +331,7 @@ (deftest record? (is (clj:record? (make-foo) 'foo)) (is-not (clj:record? (make-foo) 'barf)) - ;; This fails due a bug: https://github.com/rvirding/lfe/issues/266 + ;; This fails due a bug: https://github.com/lfe/lfe/issues/266 ;; (is-not (clj:record? #(foo) 'foo)) (is-not (clj:record? 'foo)) (is-not (clj:record? 'a 'foo))) @@ -488,8 +488,8 @@ (IFF-MAPS (is (clj:empty? (call 'maps 'new))))) (deftest every? - (is-not (clj:every? #'clj:zero?/1 '(0 0 0 0 1))) - (is (clj:every? #'clj:zero?/1 '(0 0 0 0 0)))) + (is-not (clj:every? #'zero?/1 '(0 0 0 0 1))) + (is (clj:every? #'zero?/1 '(0 0 0 0 0)))) ;; Based on lists_SUITE. (deftest all? @@ -501,12 +501,16 @@ (is-not (lists:all (lambda (n) (=:= (rem n 2) 0)) l)))) (deftest any? - (is-not (clj:any? #'clj:zero?/1 '(1 1 1 1 1))) - (is (clj:any? #'clj:zero?/1 '(0 1 1 1 1)))) + (is-not (clj:any? #'zero?/1 '(1 1 1 1 1))) + (is (clj:any? #'zero?/1 '(0 1 1 1 1)))) (deftest not-any? - (is-not (clj:not-any? #'clj:zero?/1 '(0 1 1 1 1))) - (is (clj:not-any? #'clj:zero?/1 '(1 1 1 1 1)))) + (is-not (clj:not-any? #'zero?/1 '(0 1 1 1 1))) + (is (clj:not-any? #'zero?/1 '(1 1 1 1 1)))) + +;; Functional forms of clj module macros. +(defun zero? (x) (clj:zero? x)) +(defun even? (x) (clj:even? x)) (deftest element? (are* data (not (clj:element? 'z data))
View file
_service:tar_scm:lfe-1.3.tar.gz/test/eval_SUITE.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/test/eval_SUITE.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License.
View file
_service:tar_scm:lfe-1.3.tar.gz/test/example_SUITE.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/test/example_SUITE.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2016 Eric Bailey +;; Copyright (c) 2016-2020 Eric Bailey ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -27,5 +27,6 @@ (defun compile (config) (let* ((dpath (config 'data_dir config)) (efile (filename:join dpath "example.lfe"))) - (line (test-pat #(ok (#(ok example ()) #(ok another-example ())) ()) + ;; We can get warnings from the erlang compiler. + (line (test-pat `#(ok (#(ok example ,_) #(ok another-example ,_)) ()) (lfe_comp:file efile '(return))))))
View file
_service:tar_scm:lfe-1.3.tar.gz/test/guard_SUITE.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/test/guard_SUITE.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -212,7 +212,7 @@ (defun nested-not-1 (x y (when (not (and (or (> x y) (not (is_atom x))) - (or (is_atom y) (== x 3.4))))) + (or (is_atom y) (== x 3.4))))) 'true) (_ _ 'false)) @@ -240,14 +240,14 @@ (config (when (is_list config)) ;; ',' combinations of literal true/false. - (line (check (lambda () (eif (progn 'true 'false) 'ok 'true 'error)) 'error)) - (line (check (lambda () (eif (progn 'false 'true) 'ok 'true 'error)) 'error)) - (line (check (lambda () (eif (progn 'true 'true) 'ok)) 'ok)) - (line (check (lambda () (eif (progn 'false 'false) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and 'true 'false) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and 'false 'true) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and 'true 'true) 'ok)) 'ok)) + (line (check (lambda () (eif (and 'false 'false) 'ok 'true 'error)) 'error)) (line (check (lambda () (let (((tuple 'EXIT (tuple (tuple 'case_clause _) _)) - (catch (eif (progn 'true 'false) 'ok - (progn 'false 'true) 'ok - (progn 'false 'false) 'ok)))) + (catch (eif (and 'true 'false) 'ok + (and 'false 'true) 'ok + (and 'false 'false) 'ok)))) 'exit)) 'exit)) @@ -257,45 +257,45 @@ (atuple (id #(a b c)))) ;; ',' combinations of true/false in variables. - (line (check (lambda () (eif (progn true false) 'ok 'true 'error)) 'error)) - (line (check (lambda () (eif (progn false true) 'ok 'true 'error)) 'error)) - (line (check (lambda () (eif (progn true true) 'ok 'true 'error)) 'ok)) + (line (check (lambda () (eif (and true false) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and false true) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and true true) 'ok 'true 'error)) 'ok)) ;; These used to crash the compiler! - (line (check (lambda () (eif (progn false false) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and false false) 'ok 'true 'error)) 'error)) (line (check (lambda () (let (((tuple 'EXIT (tuple (tuple 'case_clause _) _)) - (catch (eif (progn true false) 'ok - (progn false true) 'ok - (progn false false) 'ok)))) + (catch (eif (and true false) 'ok + (and false true) 'ok + (and false false) 'ok)))) 'exit)) 'exit)) ;; ',' combinations of true/false, and non-boolean in variables. - (line (check (lambda () (eif (progn true glurf) 'ok 'true 'error)) 'error)) - (line (check (lambda () (eif (progn glurf true) 'ok 'true 'error)) 'error)) - (line (check (lambda () (eif (progn true true) 'ok)) 'ok)) + (line (check (lambda () (eif (and true glurf) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and glurf true) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and true true) 'ok)) 'ok)) ;; These used to crash the compiler! - (line (check (lambda () (eif (progn glurf glurf) 'ok 'true 'error)) 'error)) + (line (check (lambda () (eif (and glurf glurf) 'ok 'true 'error)) 'error)) (line (check (lambda () (let (((tuple 'EXIT (tuple (tuple 'case_clause _) _)) - (catch (eif (progn true glurf) 'ok - (progn glurf true) 'ok - (progn glurf glurf) 'ok)))) + (catch (eif (and true glurf) 'ok + (and glurf true) 'ok + (and glurf glurf) 'ok)))) 'exit)) 'exit)) ;; ',' combinations of true/false with errors. - (line (check (lambda () (eif (progn true (element 42 atuple)) 'ok + (line (check (lambda () (eif (and true (element 42 atuple)) 'ok 'true 'error)) 'error)) - (line (check (lambda () (eif (progn (element 42 atuple) true) 'ok + (line (check (lambda () (eif (and (element 42 atuple) true) 'ok 'true 'error)) 'error)) - (line (check (lambda () (eif (progn true true) 'ok)) 'ok)) - (line (check (lambda () (eif (progn (element 42 atuple) + (line (check (lambda () (eif (and true true) 'ok)) 'ok)) + (line (check (lambda () (eif (and (element 42 atuple) (element 42 atuple)) 'ok 'true 'error)) 'error)) (line (check (lambda () (let (((tuple 'EXIT (tuple (tuple 'case_clause _) _)) - (catch (eif (progn true (element 42 atuple)) 'ok - (progn (element 42 atuple) true) 'ok - (progn (element 42 atuple) + (catch (eif (and true (element 42 atuple)) 'ok + (and (element 42 atuple) true) 'ok + (and (element 42 atuple) (element 42 atuple)) 'ok)))) 'exit)) 'exit))) @@ -968,15 +968,18 @@ (config (when (is_list config)) (let ((t (id #(type integers 23 42)))) (line (test-pat 65 (eif (andalso (=:= (element 1 t) 'type) - (=:= (tuple_size t) 4) - (=:= (element 2 t) 'integers)) - (+ (element 3 t) (element 4 t)) - 'true 'error))) - (line (test-pat 65 (case () - (() (andalso (=:= (element 1 t) 'type) - (=:= (tuple_size t) 4) - (=:= (element 2 t) 'integers)) - (+ (element 3 t) (element 4 t)))))) + (=:= (tuple_size t) 4) + (=:= (element 2 t) 'integers)) + (+ (element 3 t) (element 4 t)) + 'true 'error))) + ;; XXX The following causes this test to fail on Erlang 22; we're not sure + ;; why. Here's the ticket: + ;; * https://github.com/lfe/lfe/issues/386 + ;; (line (test-pat 65 (case () + ;; (() (andalso (=:= (element 1 t) 'type) + ;; (=:= (tuple_size t) 4) + ;; (=:= (element 2 t) 'integers)) + ;; (+ (element 3 t) (element 4 t)))))) (line (test-pat 42 (basic-rt #(type integers 40 2)))) (line (test-pat 5.0 (basic-rt #(vector #(3.0 4.0))))) (line (test-pat 20 (basic-rt '(+ 3 7)))) @@ -990,29 +993,29 @@ (line (test-pat 'error (basic-rt ()))) (let ((rel-prod-body (lambda (r1 r2) - (eif (andalso (=:= (: erlang size r1) 3) - (=:= (: erlang element 1 r1) 'Set) - (=:= (: erlang size r2) 3) - (=:= (: erlang element 1 r2) 'Set)) - 'ok)))) + (eif (andalso (=:= (: erlang size r1) 3) + (=:= (: erlang element 1 r1) 'Set) + (=:= (: erlang size r2) 3) + (=:= (: erlang element 1 r2) 'Set)) + 'ok)))) (line (test-pat 'ok (funcall rel-prod-body #(Set a b) #(Set a b))))) ;; 'andalso'/'orelse' with calls known to fail already at compile time. ;; Used to crash the code generator. (let (('error (funcall (lambda () - (let ((r #(vars true))) - (eif (andalso (is_record r 'vars 2) - (element 99 r)) - 'ok - 'true 'error))) - )) - ('error (funcall (lambda (x) - (let ((l #(a b c))) - (eif (andalso (is_list x) - (> (length l) 4)) - 'ok - 'true 'error))) - ()))) + (let ((r #(vars true))) + (eif (andalso (is_record r 'vars 2) + (element 99 r)) + 'ok + 'true 'error))) + )) + ('error (funcall (lambda (x) + (let ((l #(a b c))) + (eif (andalso (is_list x) + (> (length l) 4)) + 'ok + 'true 'error))) + ()))) ()) 'ok))) @@ -1024,7 +1027,7 @@ (t (when (andalso (is_tuple t) (=:= (tuple_size t) 2) (=:= (element 1 t) 'vector))) (let (((tuple x y) (element 2 t))) - (eif (progn (is_float x) (is_float y)) (: math sqrt (+ (* x x) (* y y)))) + (eif (and (is_float x) (is_float y)) (: math sqrt (+ (* x x) (* y y)))) )) ((list '+ a b) (* (id (+ a b)) 2))
View file
_service:tar_scm:lfe-2.1.1.tar.gz/test/maps-tests.lfe
Added
@@ -0,0 +1,32 @@ +;; Copyright (c) 2021 Duncan McGreggor +;; +;; 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 : maps-tests.lfe +;; Author : Duncan McGreggor +;; Purpose : Tests map functions support across multiple versions of Erlang. + +(defmodule maps-tests + "Test various map functions.") + +(include-file "ltest-macros.lfe") + +(defun test-data () + '#m(a 1 + b 2)) + +(deftest mref + (is-equal 1 (mref (test-data) 'a))) + +(deftest map-get + (is-equal 2 (map-get (test-data) 'b)))
View file
_service:tar_scm:lfe-1.3.tar.gz/test/ms_transform_SUITE.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/test/ms_transform_SUITE.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 Robert Virding ;; ;; Licensed under the Apache License, Version 2.0 (the "License"); ;; you may not use this file except in compliance with the License. @@ -6,7 +6,7 @@ ;; ;; http://www.apache.org/licenses/LICENSE-2.0 ;; -;; Unless required by applicable law or agreed to in writing, software +;; Unless required by applicable law or agreed tfo 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 @@ -24,32 +24,37 @@ ;; Note that some of these tests are not LFE specific but more general ;; guard tests but we include them anyway for completeness. ;; -;; As match-spec is a macro we can expand it directly inline which -;; means that many errors/inconsistencies will be detected at compile +;; As ets-ms is a macro we can expand it directly inline which means +;; that many errors/inconsistencies will be detected at compile ;; time. Should we write it to a file or in memory and compile at ;; run-time? +;; +;; NOTE: ets-ms generates a pattern so when testing the pattern with +;; test-pat it *must* be used in the pattern not in the value. (include-file "test_server.lfe") (defmodule ms_transform_SUITE (export (all 0) (suite 0) (groups 0) (init_per_suite 1) (end_per_suite 1) - (init_per_group 2) (end_per_group 2) - (init_per_testcase 2) (end_per_testcase 2) - (basic_ets 1) (basic_dbg 1) (from_shell 1) (records 1) - (record_index 1) (multipass 1) (top_match 1) (old_guards 1) - (autoimported 1) (semicolon 1) (bitsyntax 1) - (record_defaults 1) (andalso_orelse 1) - (float_1_function 1) (action_function 1) (warnings 1) - )) + (init_per_group 2) (end_per_group 2) + (init_per_testcase 2) (end_per_testcase 2)) + (export (basic_ets 1) (basic_dbg 1) (from_shell 1) (records 1) + (record_index 1) (multipass 1) (top_match 1) (old_guards 1) + (autoimported 1) (semicolon 1) (bitsyntax 1) + (record_defaults 1) (andalso_orelse 1) + (float_1_function 1) (action_function 1) + (warnings 1) (no_warnings 1))) (defmacro MODULE () `'ms_transform_SUITE) (defun all () ;; (: test_lib recompile (MODULE)) - (list 'basic_ets 'basic_dbg 'from_shell 'records - 'record_index 'multipass 'top_match 'old_guards - 'autoimported 'semicolon 'bitsyntax 'record_defaults - 'andalso_orelse 'float_1_function 'action_function 'warnings)) + (list 'from_shell 'basic_ets 'basic_dbg 'records + 'record_index 'multipass 'bitsyntax 'record_defaults + 'andalso_orelse 'float_1_function 'action_function + 'warnings 'no_warnings 'top_match 'old_guards + 'autoimported 'semicolon + )) ;;(defun suite () (list (tuple 'ct_hooks (list 'ts_install_cth)))) (defun suite () ()) @@ -72,43 +77,143 @@ (let ((dog (config 'watchdog config))) (: test_server timetrap_cancel dog))) +(defun warnings + ('suite ()) + ('doc '"Check that shadowed variables in fun head generate warning") + (config (when (is_list config)) + ;; Not relevant to LFE. + 'ok)) + +(defun no_warnings + ('suite ()) + ('doc '"Check that variables bound in other function clauses don't generate warning.") + (config (when (is_list config)) + ;; Not relevant to LFE. + 'ok)) + +(defun andalso_orelse + ('suite ()) + ('doc '"Tests that andalso and orelse are allowed in guards.") + (config (when (is_list config)) + (setup config) + ;; {{'$1','$2'}, + ;; {'and',{is_integer,'$1'},{'>',{'+','$1',5},'$2'}}, + ;; {'andalso','$1','$2'}} + (test-pat '(#(#($1 $2) + (#(and #(is_integer $1) #(> #(+ $1 5) $2))) + (#(andalso $1 $2)))) + (ets-ms ((tuple a b) + (when (and (is_integer a) (> (+ a 5) b))) + (andalso a b)))) + ;; {{'$1','$2'}, + ;; {'or',{is_atom,'$1'},{'>',{'+','$1',5},'$2'}}, + ;; {'orelse','$1','$2'}} + (test-pat '(#(#($1 $2) + (#(or #(is_atom $1) #(> #(+ $1 5) $2))) + (#(orelse $1 $2)))) + (ets-ms ((tuple a b) + (when (or (is_atom a) (> (+ a 5) b))) + (orelse a b)))) + ;; {{'$1','$2'}, + ;; {'andalso',{is_integer,'$1'},{'>',{'+','$1',5},'$2'}}, + ;; '$1'} + (test-pat '(#(#($1 $2) + (#(andalso #(is_integer $1) #(> #(+ $1 5) $2))) + ($1))) + (ets-ms ((tuple a b) + (when (andalso (is_integer a) (> (+ a 5) b))) + a))) + ;; {{'$1','$2'}, + ;; {'orelse',{is_atom,'$1'},{'>',{'+','$1',5},'$2'}}, + ;; '$1'} + (test-pat '(#(#($1 $2) + (#(orelse #(is_atom $1) #(> #(+ $1 5) $2))) + ($1))) + (ets-ms ((tuple a b) + (when (orelse (is_atom a) (> (+ a 5) b))) + a))) + + 'ok)) + +(defun bitsyntax + ('suite ()) + ('doc '"Tests that bitsyntax works and does not work where appropriate") + (config (when (is_list config)) + (line (setup config)) + (line (let ((a 27)) + (test-pat '(#(_ () (#b(0 27 0 27)))) + (ets-ms (_ (binary (a (size 16)) (27 (size 16))))) + ))) + (line (let ((a 13)) ;Must fit in 4 bits! + (test-pat '(#(#(#b(15 47) $1 $2) + (#(=:= $1 #b(0 13)) #(=:= $2 #b(27 28 19))) + (#b(220 0 13)))) + (ets-ms ((tuple #b(15 47) b c) + (when (=:= b (binary (a (size 16)))) + (=:= c (binary 27 28 19))) + (binary (a (size 4)) (12 (size 4)) + (13 (size 16))))) + ))) + + 'ok)) + +(defrecord d a b c (d 'foppa)) ;Changed record name from a + +(defun record_defaults + ('suite ()) + ('doc '"Tests that record defaults works") + (config (when (is_list config)) + (line (setup config)) + ;; {{<<27>>,{a,5,'$1',hej,hej}}, + ;; , + ;; {{a,hej,{'*','$1',2},flurp,flurp}}} + (line (test-pat '(#(#(#b(27) #(d 5 $1 hej hej)) + () + (#(#(d hej #(* $1 2) flurp flurp))))) + (ets-ms ((tuple #b(27) (match-d a 5 b b _ 'hej)) + (make-d a 'hej b (* b 2) _ 'flurp))))) + + 'ok)) + (defun basic_ets ('suite ()) ('doc '"Tests basic ets:fun2ms") (config (when (is_list config)) (line (setup config)) - (line (test-pat '(#(#(a b) () (true))) (match-spec ((tuple 'a 'b) 'true)))) + (line (test-pat '(#(#(a b) () (true))) + (ets-ms ((tuple 'a 'b) 'true)))) (line (test-pat '(#(#($1 foo) (#(is_list $1)) (#(#(#(hd $1) $_)))) - #(#($1 $1) (#(is_tuple $1)) (#(#(#(element 1 $1) $*))))) - (match-spec ((tuple x 'foo) (when (is_list x)) - (tuple (hd x) (object))) - ((tuple x x) (when (is_tuple x)) - (tuple (element 1 x) (bindings)))) - )) + #(#($1 $1) (#(is_tuple $1)) (#(#(#(element 1 $1) $*))))) + (ets-ms ((tuple x 'foo) (when (is_list x)) + (tuple (hd x) (object))) + ((tuple x x) (when (is_tuple x)) + (tuple (element 1 x) (bindings)))) + )) (line (test-pat '(#(#($1 $2) () (#(#($2 $1))))) - (match-spec ((tuple a b) (tuple b a))))) + (ets-ms ((tuple a b) (tuple b a))))) (line (test-pat '(#(#($1 $2) () (($2 $1)))) - (match-spec ((tuple a b) (list b a))))) + (ets-ms ((tuple a b) (list b a))))) 'ok)) (defun basic_dbg ('suite ()) - ('doc '"Tests basic ets:fun2ms") + ('doc '"Tests basic dbg:fun2ms using the trace-ms macro") (config (when (is_list config)) (line (setup config)) (line (test-pat '(#((a b) () (#(message banan) #(return_trace)))) - (match-spec ((list 'a 'b) - (message 'banan) (return_trace))))) + (trace-ms ((list 'a 'b) + (message 'banan) (return_trace))))) (line (test-pat '(#(($1 $2) () (#(#($2 $1))))) - (match-spec ((list a b) (tuple b a))))) + (trace-ms ((list a b) (tuple b a))))) (line (test-pat '(#(($1 $2) () (($2 $1)))) - (match-spec ((list a b) (list b a))))) + (trace-ms ((list a b) (list b a))))) (line (test-pat '(#(($1 $2) () ($*))) - (match-spec ((list a b) (bindings))))) + (trace-ms ((list a b) (bindings))))) (line (test-pat '(#(($1 $2) () ($_))) - (match-spec ((list a b) (object))))) - + (trace-ms ((list a b) (object))))) + (line (test-pat '(#(() () (#(return_trace)))) + (trace-ms (() (return_trace))))) 'ok)) (defun from_shell @@ -120,20 +225,28 @@ (defrecord t (t1 ()) (t2 'foo) t3 t4) +;; Some of these tests must be compiled as we cannot build a pattern +;; of them. + (defun records ('suite ()) ('doc '"Tests expansion of records in fun2ms") (config (when (is_list config)) (line (setup config)) + + ;; {{t,'$1','$2',foo,'_'},{is_list,'$1'},{{{hd,'$1'},'$_'}}}, + ;; {{t,'_','_','_','_'},{'==',{element,2,{hd,'$_'}},nisse},{{'$*'}}} + (line (test-pat '(#(#(t $1 $2 foo _) (#(is_list $1)) (#(#(#(hd $1) $_)))) #(#(t _ _ _ _) (#(== #(element 2 $_) nisse)) (#(#($*))))) - (match-spec ((match-t t1 x t2 y t3 'foo) (when (is_list x)) - (tuple (hd x) (object))) - ((match-t) (when (== (t-t1 (object)) 'nisse)) - (tuple (bindings)))) + (ets-ms ((match-t t1 x t2 y t3 'foo _ '_) (when (is_list x)) + (tuple (hd x) (object))) + ((match-t _ '_) (when (== (t-t1 (object)) 'nisse)) + (tuple (bindings)))) )) + ;; {{t,'$1','$2','_',foo},{'==',{element,4,'$_'},7},{is_list,'$1'}, ;; {{{hd,'$1'},'$_'}}}, ;; {'$1',{is_record,'$1',t,5}, @@ -143,27 +256,30 @@ (line (test-pat '(#(#(t $1 $2 _ foo) (#(== #(element 4 $_) 7) #(is_list $1)) - (#(#(#(hd $1) $_)))) - #($1 (#(is_record $1 t 5)) - (#(#(#(element 2 $1) - #(#(t $1 foo undefined undefined)) - #(setelement 5 $1 boooo)))))) - (match-spec ((match-t t1 x t2 y t4 'foo) - (when (== (t-t3 (object)) 7) (is_list x)) - (tuple (hd x) (object))) - (a (when (is-t a)) - (tuple (t-t1 a) (make-t t1 a) (set-t-t4 a 'boooo)))) + (#(#(#(hd $1) $_)))) + #($1 + (#(is_record $1 t)) + (#(#(#(element 2 $1) + #(#(t $1 foo undefined undefined)) + #(setelement 5 $1 boooo)))))) + (ets-ms ((match-t t1 x t2 y t4 'foo _ '_) + (when (== (t-t3 (object)) 7) (is_list x)) + (tuple (hd x) (object))) + (a + (when (is-t a)) + (tuple (t-t1 a) (make-t t1 a) (set-t-t4 a 'boooo)))) )) + ;; {{t,'$1','$2',foo,'_'},{is_list,'$1'},{{{hd,'$1'},'$_'}}}, ;; {{t,'_','_','_','_'},{'==',{element,2,{hd,'$_'}},nisse},{{'$*'}}} (line (test-pat '(#((#(t $1 $2 foo _)) (#(is_list $1)) (#(#(#(hd $1) $_)))) #((#(t _ _ _ _)) (#(== #(element 2 #(hd $_)) nisse)) (#(#($*))))) - (match-spec ((list (match-t t1 x t2 y t3 'foo)) (when (is_list x)) - (tuple (hd x) (object))) - ((list (match-t)) (when (== (t-t1 (hd (object))) 'nisse)) - (tuple (bindings)))) + (trace-ms ((list (match-t t1 x t2 y t3 'foo _ '_)) (when (is_list x)) + (tuple (hd x) (object))) + ((list (match-t _ '_)) (when (== (t-t1 (hd (object))) 'nisse)) + (tuple (bindings)))) )) 'ok)) @@ -175,18 +291,17 @@ ('doc '"Tests expansion of records in fun2ms, part 2") (config (when (is_list config)) (line (setup config)) - - - 'ok)) - -(defun multipass - ('suite ()) - ('doc '"Tests that multi-defined fields in records give errors.") - (config (when (is_list config)) + (line (test-pat '(#(#(2) () (true))) + (ets-ms ((tuple (a-a)) 'true)))) + (line (test-pat '(#(#(2) () (2))) + (ets-ms ((tuple (a-a)) (a-a))))) + (line (test-pat '(#(#(2 $1) (#(> $1 2)) (2))) + (ets-ms ((tuple (a-a) a) (when (> a (a-a))) (a-a))))) 'ok)) -(defrecord a a b) +;; Already defined. +;; (defrecord a a b) (defun top_match ('suite ()) @@ -194,13 +309,20 @@ (config (when (is_list config)) (line (setup config)) (line (test-pat '(#(#(a 3 _) () ($_))) - (match-spec ((= a (match-a a 3)) a)))) + (ets-ms ((= (match-a a 3 _ '_) a) a)))) (line (test-pat '(#(#(a 3 _) () ($_))) - (match-spec ((= (match-a a 3) a) a)))) + (ets-ms ((= (match-a a 3 _ '_) a) a)))) (line (test-pat '(#((a b) () ($_))) - (match-spec ((= a (list 'a 'b)) a)))) + (trace-ms ((= a (list 'a 'b)) a)))) (line (test-pat '(#((a b) () ($_))) - (match-spec ((= (list 'a 'b) a) a)))) + (trace-ms ((= (list 'a 'b) a) a)))) + + 'ok)) + +(defun multipass + ('suite ()) + ('doc '"Tests that multi-defined fields in records give errors.") + (config (when (is_list config)) 'ok)) @@ -225,44 +347,6 @@ ;; Not relevant to LFE. 'ok)) -(defun bitsyntax - ('suite ()) - ('doc '"Tests that bitsyntax works and does not work where appropriate") - (config (when (is_list config)) - (line (setup config)) - (line (test-pat '(#(_ () (#b(0 27 0 27)))) - (let ((a 27)) - (match-spec (_ (binary (a (size 16)) (27 (size 16)))))) - )) - (line (test-pat '(#(#(#b(15 47) $1 $2) - (#(=:= $1 #b(0 27)) #(=:= $2 #b(27 28 19))) - (#b(188 0 13)))) - (let ((a 27)) - (match-spec ((tuple #b(15 47) b c) - (when (=:= b (binary (a (size 16)))) - (=:= c (binary 27 28 19))) - (binary (a (size 4)) (12 (size 4)) - (13 (size 16)))))) - )) - - - 'ok)) - -(defun record_defaults - ('suite ()) - ('doc '"Tests that record defaults works") - (config (when (is_list config)) - (line (setup config)) - - 'ok)) - -(defun andalso_orelse - ('suite ()) - ('doc '"Tests that andalso and orelse are allowed in guards.") - (config (when (is_list config)) - - 'ok)) - (defun float_1_function ('suite ()) ('doc '"OTP-5297. The function float/1.") @@ -276,35 +360,42 @@ (config (when (is_list config)) (line (setup config)) (line (test-pat '(#(($1 $2) () (#(set_seq_token label 0) - #(get_seq_token) - #(message $1) - #(return_trace) - #(exception_trace)))) - (match-spec ((list x y) - (set_seq_token 'label 0) - (get_seq_token) - (message x) - (return_trace) - (exception_trace))))) + #(get_seq_token) + #(message $1) + #(return_trace) + #(exception_trace)))) + (trace-ms ((list x y) + (set_seq_token 'label 0) + (get_seq_token) + (message x) + (return_trace) + (exception_trace))))) (line (test-pat '(#(($1 $2) () (#(process_dump) - #(enable_trace send) - #(enable_trace $2 send) - #(disable_trace procs) - #(disable_trace $2 procs)))) - (match-spec ((list x y) - (process_dump) - (enable_trace 'send) - (enable_trace y 'send) - (disable_trace 'procs) - (disable_trace y 'procs))))) - - 'ok)) + #(enable_trace send) + #(enable_trace $2 send) + #(disable_trace procs) + #(disable_trace $2 procs)))) + (trace-ms ((list x y) + (process_dump) + (enable_trace 'send) + (enable_trace y 'send) + (disable_trace 'procs) + (disable_trace y 'procs))))) + (line (let ((a 16)) + (test-pat '(#(($1 $2) () (#(display $1) + #(caller) + #(set_tcw 16) ;#(const 16)? + #(silent true) + #(trace (send) (procs)) + #(trace $2 (procs) (send))))) + (trace-ms ((list x y) + (display x) + (caller) + (set_tcw a) + (silent 'true) + (trace (list 'send) (list 'procs)) + (trace y (list 'procs) (list 'send))))))) -(defun warnings - ('suite ()) - ('doc '"Check that shadowed variables in fun head generate warning") - (config (when (is_list config)) - ;; Not relevant to LFE. 'ok)) ;; Utilites @@ -313,13 +404,22 @@ (put 'mts_config config) (put 'mts_tf_counter 0)) -(defun temp_name () +(defun temp-name () (let* ((conf (get 'mts_config)) - (c (get 'mts_tf_counter))) + (c (get 'mts_tf_counter))) (put 'mts_tf_counter (+ c 1)) (: filename join (list (config 'priv_dir conf) - (++ '"tempfile" (integer_to_list c) '".tmp"))))) + (++ '"tempfile" (integer_to_list c) '".tmp"))))) +(defun compile-and-run (recs expr) + (let ((fn (++ (temp-name) ".lfe")) + (prog (++ "(defmodule tmp (export (tmp 0)))\n" + recs + "(defun tmp () " expr ")\n"))) + (file:write_file fn prog) + (let ((`#(ok (#(ok tmp ,bin))) (lfe_comp:file fn '(binary)))) + (code:load_binary 'tmp fn bin) + (tmp:tmp)))) + (defun do-eval (s) - (let* (((tuple 'ok ts _) (: lfe_scan tokens s 1)) - ((tuple 'ok e) (: lfe_parse sexpr ts))) - (: lfe_eval expr e))) + (let (((tuple 'ok e) (lfe_io:read_string s))) + (lfe_eval:expr e)))
View file
_service:tar_scm:lfe-2.1.1.tar.gz/test/prop_lfe_docs.erl
Added
@@ -0,0 +1,169 @@ +%% Copyright (c) 2016-2020 Eric Bailey +%% +%% 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 : prop_lfe_docs.erl +%% Author : Eric Bailey, Robert Virding +%% Purpose : PropEr tests for the lfe_docs module. + +%% This module is a modified version of the older test module for +%% lfe_doc written by Eric Bailey. + +-module(prop_lfe_docs). + +-export(prop_define_lambda/0,prop_define_match/0). + +-include_lib("proper/include/proper.hrl"). + +-include("lfe_docs.hrl"). + +%%%=================================================================== +%%% Properties +%%%=================================================================== + +%% These only test the formats of the saved data. + +prop_define_lambda() -> ?FORALL(Def, define_lambda(), validate(Def)). + +prop_define_match() -> ?FORALL(Def, define_match(), validate(Def)). + +validate({'define-function',Name,_Doc,Def,_}=Func) -> + validate_function(Name, function_arity(Def), Func); +validate({'define-macro',Name,_Doc,_Def,_}=Mac) -> + validate_macro(Name, Mac). + +function_arity(lambda,Args|_) -> length(Args); +function_arity('match-lambda',Pat|_|_) -> length(Pat). + +validate_function(Name, Arity, {_Define,_Name,_Meta,_Def,Line}=Func) -> + Info = export_all_funcs(),Func, %Add function export + case lfe_docs:make_docs_info(Info, ) of + {ok,#docs_v1{docs=Fdoc}} -> + {{function,N,A},Anno,_,_,_} = Fdoc, + (Line =:= Anno) and (Name =:= N) and (Arity =:= A); + _ -> false + end. + +validate_macro(Name, {_Define,_Name,_Meta,_Lambda,Line}=Mac) -> + Info = export_macro(Name),Mac, %Add macro export + case lfe_docs:make_docs_info(Info, ) of + {ok,#docs_v1{docs=Mdoc}} -> + {{macro,N,_},Anno,_,_,_} = Mdoc, + (Line =:= Anno) and (Name =:= N); + _ -> false + end. + +export_all_funcs() -> {'extend-module',,export,all,1}. + +export_macro(Mac) -> {'extend-module',,'export-macro',Mac,1}. + +%%%=================================================================== +%%% Definition shapes +%%%=================================================================== + +define_lambda() -> + {'define-function',atom(),meta_with_doc(),lambda(),line()}. + +define_match() -> + ?LET(D, define(), {D,atom(),meta_with_doc(),'match-lambda'(D),line()}). + + +%%%=================================================================== +%%% Custom types +%%%=================================================================== + +%%% Definitions + +define() -> oneof('define-function','define-macro'). + +lambda() -> lambda,arglist_simple()|body(). + +'match-lambda'('define-function') -> + 'match-lambda'|non_empty(list(function_pattern_clause())); +'match-lambda'('define-macro') -> + 'match-lambda'|non_empty(list(macro_pattern_clause())). + +arglist_simple() -> list(atom()). + +body() -> non_empty(list(form())). + +form() -> union(form_elem(),atom()|list(form_elem())). + +form_elem() -> union(non_string_term(),printable_string(),atom()). + +meta_with_doc() -> doc,docstring(). + +docstring() -> printable_string(). + +line() -> pos_integer(). + + +%%% Patterns + +pattern() -> union(non_string_term(),printable_string(),pattern_form()). + +pattern_form() -> + oneof('=','++*',, + backquote,quote, + binary,cons,list,map,tuple, + match_fun()) + | body(). + +match_fun() -> 'match-record'. + +macro_pattern_clause() -> pattern_clause(rand_arity(), true). + +function_pattern_clause() -> pattern_clause(rand_arity(), false). + +pattern_clause(Arity, Macro) -> + arglist_patterns(Arity, Macro)|oneof(guard(),form())|body(). + +arglist_patterns(Arity, false) -> vector(Arity, pattern()); +arglist_patterns(Arity, true) -> vector(Arity, pattern()),'$ENV'. + +guard() -> 'when'|non_empty(list(union(logical_clause(),comparison()))). + + +%%% Logical clauses + +logical_clause() -> + X = union(atom(),comparison()), + logical_operator(),X|non_empty(list(X)). + +logical_operator() -> oneof('and','andalso','or','orelse'). + + +%%% Comparisons + +comparison() -> comparison_operator(),atom()|list(atom()). + +comparison_operator() -> oneof('==','=:=','=/=','<','>','=<','>='). + + +%%% Strings and non-strings + +non_string_term() -> + union(atom(),number(),,bitstring(),binary(),boolean(),tuple()). + +printable_char() -> union(integer(32, 126),integer(160, 255)). + +printable_string() -> list(printable_char()). + + +%%% Rand compat + +-ifdef(NEW_RAND). +rand_arity() -> rand:uniform(10). +-else. +rand_arity() -> random:uniform(10). +-endif.
View file
_service:tar_scm:lfe-1.3.tar.gz/test/test_server.lfe -> _service:tar_scm:lfe-2.1.1.tar.gz/test/test_server.lfe
Changed
@@ -1,4 +1,4 @@ -;; Copyright (c) 2008-2013 Robert Virding +;; Copyright (c) 2008-2020 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,10 +23,10 @@ (,pat val)) val)) -;; We don't have any sensible line numbers to save so we save form. -(defmacro line (expr) - `(progn (put 'test_server_loc (tuple (MODULE) ',expr)) - ,expr)) +;; Backwards compatibility for test_server test suites only. +;; DO NOT USE IN NEW TEST SUITES. + +(defmacro line (expr) expr) (defmacro config args `(: test_server lookup_config . ,args))
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
.
浙ICP备2022010568号-2