diff --git a/BUGS b/BUGS index 57d18b9..7e5cf1a 100644 --- a/BUGS +++ b/BUGS @@ -1,4 +1,13 @@ -BUGS encountered during fLisp refactoring and batch mode +BUGS encountered since fLisp refactoring and batch mode + +funcmap.c:86:22: warning: variable 'count' set but not used [-Wunused-but-set-variable] + 86 | int count = 0; + | ^ + +lisp.c:2690:18: warning: address of stack memory associated with compound literal {type_cons, .car = io_error, .cdr = o} returned [-Wreturn-stack-address] + 2690 | return &(Object) { type_cons, .car = io_error, .cdr = o }; + | ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + - valgrind detects several memory leaks, call with: FEMTO_DEBUG=0 valgrind --leak-check=full --track-origins=yes femto diff --git a/README.flisp.md b/README.flisp.md index 094215c..fe52bde 100644 --- a/README.flisp.md +++ b/README.flisp.md @@ -29,6 +29,10 @@ meant to be very small. - To be easy to understand without extensive study (to encourage further experimentation). +Size by version: + + Version Binary C-Lines/sloc/Files Lisp-Lines/sloc/Files + 0.13 85584 3.6k/2.4k/6 373/272/3 ## History @@ -88,6 +92,10 @@ In 2025 another set of changes were introduced: - Numbers are represented by 64 bit integers instead of double floats. - The Lisp libraries have been extended and functions have been improved for compatibilty. +- Lisp object space adjusts dynamically when needed. +- setq was replaced by bind +- Enough framework was built to implement the repl completely in Lisp. + ## Building @@ -99,8 +107,7 @@ fLisp should be buildable with only the standard C libraries. ## Future -- Expand Lisp garbage collected memory as needed. -- Implement the backtick and comma reader macros. See [ +- Implement the backtick and comma reader macros. See [5] - Adapt build system to be able to un/install `flisp` binary. Includes preparing a Lisp library and a startup file. - Extend file extension to be usable for Lisp programs. @@ -117,3 +124,4 @@ fLisp should be buildable with only the standard C libraries. - [5] mal - quasiquote https://github.com/kanaka/mal - [6] Scheme https://www.scheme.org/ - [7] Scheme v7 Standard https://standards.scheme.org/official/r7rs.pdf +- [8] TSPL2d https://www.scheme.com/tspl2d/ diff --git a/README.md b/README.md index 18e48c9..62470a0 100644 --- a/README.md +++ b/README.md @@ -18,7 +18,7 @@ Femto comes with Markdown and HTML documentation. To rebuild the documentation [Pandoc](https://pandoc.org/) is required. Rebuild both documentation formats from their respective source files by running: - make doc + make doc The documentation is prebuilt in this repository and can be found in @@ -65,11 +65,11 @@ decending order with each further reduction of functionality. The Nano and Pico Emacs editors have been around for a while. * Nano means 10 to the power of minus 9 -* Pico means 10 to the power of minus 12 +* Pico means 10 to the power of minus 12 * Femto means 10 to power of minus 15 * Atto means 10 to power of minus 18 * Zepto means 10 to the power of minus 21 -* Zep is smaller version of Zepto Emacs +* Zep is smaller version of Zepto Emacs In Defining Atto as the lowest functional Emacs I have had to consider the essential feature set that makes Emacs, 'Emacs'. I have defined @@ -114,24 +114,24 @@ For a full version history please refer to the file [CHANGE.LOG.md](./CHANGE.LOG ## Comparisons with Other Emacs Implementations Femto has almost the same level of functionality as MicroEmacs 3.10 -for a codebase about 15% of the size. - - Editor Binary BinSize KLOC Files - - atto atto 33002 1.9k 10 - pEmacs pe 59465 5.7K 16 - Esatz-Emacs ee 59050 5.7K 14 - femto femto 144008 8.4k/6.0k 24/36 ** - GNOME GNOME 55922 9.8k 13 - Zile zile 257360 11.7k 48 - Mg mg 585313 16.5K 50 - uEmacs/Pk em 147546 17.5K 34 - Pico pico 438534 24.0k 29 - Nano nano 192008 24.8K 17 - jove jove 248824 34.7k 94 - Qemacs qe 379968 36.9k 59 - ue3.10 uemacs 171664 52.4K 16 ++ - GNUEmacs emacs 14632920 358.0k 186 +for a codebase less then half of the size. + + Editor Binary BinSize KLOC Files + + atto atto 33002 1.9k 10 + pEmacs pe 59465 5.7K 16 + Esatz-Emacs ee 59050 5.7K 14 + femto femto 162392 10.8k/7.6k 25/37 ** + GNOME GNOME 55922 9.8k 13 + Zile zile 257360 11.7k 48 + Mg mg 585313 16.5K 50 + uEmacs/Pk em 147546 17.5K 34 + Pico pico 438534 24.0k 29 + Nano nano 192008 24.8K 17 + jove jove 248824 34.7k 94 + Qemacs qe 379968 36.9k 59 + ue3.10 uemacs 171664 52.4K 16 ++ + GNUEmacs emacs 14632920 358.0k 186 Since femto 2.12 C code has been moved out to Lisp. The first number in the KLOC column is the line count, the second the sloccount. The @@ -140,31 +140,34 @@ includes the required Lisp files. ## Building -### Build and Installation +### Build Debendencies -These instructions should work with most versions of linux +Debian and Ubuntu: - $ cd $HOME - $ mkdir -p ~/src - $ git clone https://github.com/hughbarney/femto.git - $ cd femto - $ sudo make install +Before ncurses 6 and as of Femto 1.2 you will need to install the +libcurses dev package. -### Building on Ubuntu (using UTF8 support in ncurses / ncursesw) + $ sudo apt-get install libncurses5-dev libncursesw5-dev -When building on Ubuntu you will need to install the libcurses dev package. -NOTE: As of Femto 1.2 you will also need the libncursesw (wide) library +Since ncurses 6: - $ sudo apt-get install apt-file - $ apt-file update + $ sudo apt-get install ncurses-dev -now search for which package would have curses.h +Alpine Linux: - $ apt-file search curses.h + $ sudo apk add ncurses-dev - libncurses5-dev: /usr/include/curses.h +FreeBSD: - $ sudo apt-get install libncurses5-dev libncursesw5-dev + $ sudo pkg install devel/ncurses + +### Build, Test and Installation + + $ git clone https://github.com/hughbarney/femto.git + $ cd femto + $ make femto + $ make test + $ sudo make install ## Future Enhancements @@ -173,8 +176,6 @@ The following enhancements are envisaged. * Directory and file manegement (Dired) functionality. A basic start has been made with dired.lsp -* Ability to configure the syntax highlighter for python - * Ability to load a file in read-only-mode * Ability to setup themes of colors that can be applied to different buffers @@ -183,9 +184,40 @@ The following enhancements are envisaged. * Pipe a buffer through a shell command and read the output back into a different buffer -## Coding Style +## Development + +See the [coding style](./style.md) guide. + +Pandoc is required for doc generation. +- Debian/Ubuntu: `sudo apt-get install pandoc` +- Alpine: `sudo apk add pandoc-cli` +- NetBSD: `sudo pkgin install pandoc-cli` +- FreeBSD: `pkg install hs-pandoc` + +There is a Doxyfile to create full cross references and call graphs. + +Usefull build targets: + +- femto: build femto binary +- flisp: build fLisp binary +- doc: build some markdown files from Poshdoc and some html files from markdown +- doxygen: build the Doxygen source code documentation +- measure: count # of files and code lines +- test: run unit tests in summary mode +- check: run unit tests and return success if none fails +- ftest: call femto several times with different commandline parameters. +- val: run femto with valgrind. Logs are found in val.log +- clean: clean up build artifacts +- deb: build Debian package +- install/uninstall: install/uninstall locally + +Make sure to run: + + make clean test + make clean ftest + make clean doc -See [STYLE.MD](./style.md) +before commiting code to Github. ## Copying diff --git a/debian/changelog b/debian/changelog index 4a0921a..a1ad318 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,12 +1,19 @@ +femto (2.24.1-1) bookworm; urgency=medium + + * Dynamic memory allocation for Lisp object space. + * Lisp test suite. + * Improved file extension. + -- Georg Lehner Fri, 05 Sep 2025 15:30:31 +0200 + femto (2.23.1-1) bookworm; urgency=medium - * Improved syntax highlighter: C, Lisp and text mode - * File read hook + * Improved syntax highlighter: C, Lisp and text mode + * File read hook -- Georg Lehner Thu, 07 Aug 2025 13:05:41 +0200 femto (2.22.1-1) bookworm; urgency=medium - * Minor bug fixes and documentation updates. Upstream version bump. + * Minor bug fixes and documentation updates. Upstream version bump. -- Georg Lehner Tue, 05 Aug 2025 15:17:33 +0100 femto (2.21.7-1) bookworm; urgency=medium diff --git a/docs/develop.md b/docs/develop.md new file mode 100644 index 0000000..a995c34 --- /dev/null +++ b/docs/develop.md @@ -0,0 +1,293 @@ +# fLisp Implementation Details + +[fLisp Manual](flisp.html) [(Markdown)](flisp.md) + +### Table of Contents + +1. [Embedding Overview](#embedding) +2. [fLisp C Interface](#c_api) +3. [Building Extensions](#extensions) + +[Implementation Details](implementation) + +1. [Garbage Collection](#gc) +2. [Memory Usage](#memory) +3. [Future Directions](#future) + +### Embedding fLisp + +#### Embedding Overview + +fLisp can be embedded into a C application. Two examples of embedding +are the `femto` editor and the simplistic `flisp` command line Lisp +interpreter. + +Currently embedding can only be done by extending the build system. +Application specific binary Lisp extensions are stored in separated C +files and the interface code is conditionally included into the `lisp.c` +file. Three extensions are provided: the Femto extension which provides +the editor functionality, the file extension which provides access to +the low level stream I/O functions and others and the double extensions +which provides double float arithmetic. + +*fLisp* exposes the following public interface functions: + +`lisp_new()` +Create a new interpreter. + +`lisp_destroy()` +Destroy an interpreter, releasing resources. + +`lisp_eval()` +Evaluate a string or the input stream until exhausted or error. + +`lisp_write_object()` +Format and write object to file descriptor. + +`lisp_write_error()` +Format and write the error object and error message of an interpreter to +a file descriptor. + +Different flows of operation can be implemented. The *femto* editor +initializes the interpreter without input/output file descriptors and +sends strings of Lisp commands to the interpreter, either when a key is +pressed or upon explicit request via the editor interface. + +The `flisp` command line interpreter sets `stdout` as the default output +file descriptors of the *fLisp* interpreter and feeds it with strings of +lines read from the terminal. If the standard input is not a terminal +`stdin` is set as the default input file descriptor and *fLisp* reads +through it until end of file. + +After processing the input, the interpreter holds the results +corresponding to a [`catch`](interp_ops) result in its internal +structure. They can be accessed with the following C-macros: + +*error_type* +`FLISP_RESULT_CODE(interpreter)` + +*message* +`FLISP_RESULT_MESSAGE(interpreter)` + +*object* +`FLISP_RESULT_OBJECT(interpreter)` + +Check for `(FLISP_RESULT_OBJECT(interpreter) != nil)` to find out if the +result is an error. Then check for +`(FLISP_RESULT_OBJECT(interpreter) == out_of_memory)` to see if a fatal +condition occured. + +On error use `lisp_write_error()` to write the standard error message to +a file descriptor of choice, or use the above C-macros and +`FLISP_ERROR_MESSAGE(interpreter)->string` for executing a specific +action. + +*fLisp* sends all output to the default output stream. If it is set to +`NULL` on initialization, output is suppressed altogether. + +#### fLisp C Interface + +*Interpreter*` *lisp_new(char **«argv», char *«library_path», FILE *input, FILE *output, FILE* debug)` +`lisp_new()` creates and initializes an fLisp interpreter and returns a +pointer to an *Interpreter* struct to be used in the other functions. +The arguments to `lisp_new()` are: + +*argv* +*library_path* +The fLisp environment is initialized with this two argument to contain +the following symbols: + +*argv0* +The string stored in `*«argv»[0]`, if any + +*argv* +The list of strings stored in *argv* + +*script_dir* +The string stored in *library_path* + +*input* +Default input stream. If *input* is set to `NULL`, the input stream has +to be specified for each invocation of `lisp_eval()`. + +*output* +Default output stream. If *output* is set to `NULL` a memory stream is +created at the first invocation of the interpreter and set as the +default output stream. + +*debug* +Debug output stream. If set to `NULL` no debug information is generated. + +`void lisp_destroy(Interpreter *«interp»)` +Frees all resources used by the interpreter. + +`void lisp_eval(Interpreter *«interp», char *«string»)` +If *string* is not `NULL` evaluates all Lisp expressions in *string*. + +If *string* is `NULL` input from the file descriptor in the *input* +field of the *fLisp* interpreter *interp* is evaluated until end of +file. + +If no memory can be allocated for the input string or the input file +descriptor is `NULL` no Lisp evaluation takes place and +`FLISP_RESULT_CODE` field of the interpreter is set to an `io-error`. + +`void lisp_write_object(Interpreter *«interp», FILE «*fd», Object *«object», bool readably)` +Format *object* into a string and write it to *stream*. If *readably* is +true, the string can be read in by the interpreter and results in the +same object. + +`void lisp_write_error(Interpreter *«interp», FILE «*fd»)` +Format the error *object* and the error message of the interpreter into +a string and write it to *fd*. The *object* is written with *readably* +`true`. + +Note: currently only creating one interpreter has +been tested. + +#### Building Extensions + +An extensions has to create C functions with the signature: +`Object *«primitive»(Interpreter *interp, Object **args, Object **env)`, +where *primitive* is a distinct name in C space. This function has to be +added to the global variable `primitives` in the following format: +`{"«name»", «argMin», «argMax», «type_check», «primitive»}`. Here *name* +is a distinct name in Lisp space. + +*interp* is the fLisp interpreter in which *primitive* is executed. +*argMin* is the minimum number of arguments, *argMax* is the maximum +number of arguments allowed for the function. If *argMax* is a negative +number, arguments must be given in tuples of *argMax* and the number of +tuples is not restricted. + +When type check is set to on of the `TYPE_*` C-macros the interpreter +assures that all arguments are of the given type and creates a +standardized exception otherwise. When type check is set to `0` the +primitive has to take care of type checking by itself. The C-macro +`CHECK_TYPE` helps with this. + +When creating more then one new objects within a primitive, care has to +be taken to register them with the garbage collector. Registration is +started with the `GC_CHECKPOINT` CPP macro. `GC_TRACE(«name», «value»` +creates an object variable *name*, sets it to *value* and registers it +with the garbage collector. The macro `GC_RELEASE` must be called to +finalize the registration. The convenience macro `GC_RETURN(«object»)` +calls `GC_RELEASE` and returns *object*. + +Some CPP macros are provided to simplify argument access and validation +in primitives: + +`FLISP_HAS_ARGS` +`FLISP_HAS_ARG_TWO` +`FLISP_HAS_ARG_THREE` +Evaluate to true if there are arguments or the respective argument is +available. + +`FLISP_ARG_ONE` +`FLISP_ARG_TWO` +`FLISP_ARG_THREE` +Evaluate to the respective argument. + +`CHECK_TYPE(«argument», «type», «signature»)` +Assures that the given argument is of the given type. *type* must be a +type variable like `type_string`. *signature* is the signature of the +primitive followed by “` - `” and the name of the argument to be type +checked. This is used to form a standardized `wrong-type-argument` error +message. + +### Implementation Details + +#### Garbage Collection + +*fLisp* implements Cheney's copying garbage collector, with which memory +is divided into two equal halves (semi spaces): from- and to-space. +From-space is where new objects are allocated, whereas to-space is used +during garbage collection. The from-space part of the memory is also +called the Lisp object space. + +When garbage collection is performed, objects that are still in use +(live) are copied from from-space to to-space. To-space then becomes the +new from-space and vice versa, thereby discarding all objects that have +not been copied. + +Our garbage collector takes as input a list of root objects. Objects +that can be reached by recursively traversing this list are considered +live and will be moved to to-space. When we move an object, we must also +update its pointer within the list to point to the objects new location +in memory. + +However, this implies that our interpreter cannot use raw pointers to +objects in any function that might trigger garbage collection (or risk +causing a SEGV when accessing an object that has been moved). Instead, +objects must be added to the list and then only accessed through the +pointer inside the list. + +Thus, whenever we would have used a raw pointer to an object, we use a +pointer to the pointer inside the list instead: + + function: pointer to pointer inside list (Object **) + | + v + list of root objects: pointer to object (Object *) + | + v + semi space: object in memory + + +*GC_TRACE* adds an object to the list and declares a variable which +points to the objects pointer inside the list. + +*GC_TRACE*`(«gcX», «X»)`: add object *X* to the list and declare +`Object **«gcX»` to point to the pointer to *X* inside the list. + +Information about the garbage collection process and memory status is +written to the debug file descriptor. + +#### Memory Allocation + +Object allocation adjusts the size of the Lisp object space on demand: +If after garbage collection the free space is less then the required +memory plus some reserved space for exception reporting, the memory is +increased by a multiple of the amount specified in the C-macro +`FLISP_MEMORY_INC`, defined in `lisp.h`. The multiple is calculated to +hold at least the additional requested space. + +`lisp_new()` allocates `FLISP_MIN_MEMORY`, defined in `lisp.h`, and then +allocates all initial objects without taking care of garbage collection. +Then it prints out the amount of Lisp object space consumed to the debug +file descriptor. For *fLisp* this is currently about 21 kB, for *femto* +about 34 kB. + +In order to reduce garbage collection frequency, especially during +startup, one can set `FLISP_INITIAL_MEMORY` to a desired additional +amount of memory to allocate on startup. + +Some other compile time adjustable limits in `lisp.h`: + +Input buffer +2048, `INPUT_FMT_BUFSIZ`, size of the formatting buffer for +`lisp_eval()` and for the input buffer of `(fgets)`. + +Output buffer +2048, `WRITE_FMT_BUFSIZ`, size of the output and message formatting +buffer. + +*fLisp* can live with as little as 50k object memory up to startup. The +Femto editor requires much more memory because of the needs of the “OXO” +game. + +#### Future Directions + +Loops are availble via the labelled let macro and supported by `iota`. +It could made easier, by any combination of: + +- loop/while/for macro +- Demoing hand crafted loops including breaking with throw. + +Implement backquote and friends. + +Pluggable extensions. + +Take away more things. + +[^](#toc) diff --git a/docs/editor.md b/docs/editor.md new file mode 100644 index 0000000..03832d1 --- /dev/null +++ b/docs/editor.md @@ -0,0 +1,392 @@ +# fLisp Femto Editor Extension + +[fLisp Manual](flisp.html) [(Markdown)](flisp.md) + +### Overview + +The [editor extension](#primitives) introduces several types of objects: + +- Buffers hold text +- Windows display buffer contents to the user +- Keyboard Input allows the user to interact + with buffers and windows +- The Message Line gives feedback to the user +- Several other function for operating system or user interaction + +Several [Lisp libraries](#libraries) make use of the extensions +primitives to provide advanced functionality. + +### Table of Contents + +1. [Overview](#overview) +2. Table of Contents +3. [Editor Extension](#primitives) + 1. [Buffers](#buffers) + 1. [Text manipulation](#text) + 2. [Selection](#selection) + 3. [Cursor Movement](#cursor) + 4. [Buffer management](#buffer_management) + 2. [User Interaction](#ui) + 1. [Window Handling"](#windows) + 2. [Message Line](#message_line) + 3. [Keyboard Handling](#keyboard) + 4. [Programming and System Interaction](#programming_system) +4. [Lisp Libraries](#libraries) + 1. [`femto`](#femto_lib) + 2. [`bufmenu`](#bufmenu) Buffer Selection Menu + 3. [`defmacro`](#defmacro) Editor Macros + 4. [`dired`](#dired) Directory Navigation + 5. [`info`](#info) Builtin Help + 6. [`git`](#git) Git Repo Helper + 7. [`grep`](#grep) File Content Search + 8. [`oxo`](#oxo) Tic-Tac-Toe Game + +### Editor Extension + +#### Buffers + +This section describes the buffer related functions added by Femto to +fLisp. The description is separated in function related to buffer +management and text manipulation. Text manipulation always operates on +the current buffer. Buffer management creates, +deletes buffers, or selects one of the existing buffers as the current +buffer. + +Buffers store text and allow to manipulate it. A buffer has the +following properties: + +*name* +Buffers are identified by their name. If a buffer name is enclosed in +`*`asterisks`*` the buffer receives special treatment. + +*text* +zero or more characters. + +*point* +The position in the text where text manipulation takes place. The first +position in the text is 0. Note: in Emacs the first position is 1. + +*mark* +An optional second position in the text. If the *mark* is set, the text +between *point* and *mark* is called the +selection or region. + +*filename* +If set the buffer is associated with the respective file. + +*flags* +Different flags determine the behavior of the buffer. Editor specific +flags: `special`, `modified`. + +Mode flags determine the syntax highlighter mode: `cmode` and `lispmode` +are available. If none is set `text` mode is used for syntax +hightlighting. + +In the following, any mention to one of them refers to the respective +current buffers property. + +##### Text manipulation + +`(insert-string «string»)` +Inserts *string* before *point*. S: insert. + +`(insert-file-contents-literally «string» `\[*flag*\]`)` +Inserts the file *string* after *point*. If *flag* is not nil the buffer +is marked as not modified. B + +Note: Currently the flag is forced to nil. The function should return +`(«filename» «count»)` but it returns a flag indicating if the operation +succeeded. + +`(erase-buffer)` +Erases all text in the current buffer. C + +`(delete)` +Deletes the character after *point*. S: delete-char + +`(backspace)` +Deletes the character to the left of *point*. S: +delete-backward-char + +`(get-char)` +Returns the character at *point*. S: get-byte + +`(copy-region)` +Copies *region* to the *clipboard*. S: copy-region-as-kill + +`(kill-region)` +Deletes the text in the *region* and copies it to the *clipboard*. +D + +`(yank)` +Pastes the *clipboard* before *point*. C + +##### Selection + +`(set-mark)` +Sets *mark* to *point*. D + +`(get-mark)` +Returns the position of *mark*, -1 if *mark* is unset. S: mark + +`(get-point)` +Returns the position of *point*. S: point + +`(get-point-max)` +Returns the maximum accessible value of point in the current buffer. +S: point-max + +`(set-clipboard «variable»)` +`Sets «clipboard» to the contents of «variable».` S: +gui-set-selection + +`(get-clipboard)` +Returns the *clipboard* contents. S: gui-get-selection + +##### Cursor Movement + +`(set-point «number»)` +Sets the point to in the current buffer to the position *number*. S: +goto-char + +`(goto-line «number»)` +Sets the point in the current buffer to the first character on line +*number*. S: goto-line, not an Elisp function. + +`(search-forward «string»)` +Searches for *string* in the current buffer, starting from point +forward. If string is found, sets the point after the first occurrence +of *string* and returns `t`, otherwise leaves point alone and returns +`nil`. D + +`(search-backward «string»)` +Searches for *string* in the current buffer, starting from point +backwards. If string is found, sets the point before the first +occurrence of *string* and returns `t`, otherwise leaves point alone and +returns `nil`. D + +`(beginning-of-buffer)` +Sets the point in the current buffer to the first buffer position, +leaving mark in its current position. C + +`(end-of-buffer)` +Sets the point in the current buffer to the last buffer position, +leaving mark in its current position. C + +`(beginning-of-line)` +Sets point before the first character of the current line, leaving mark +in its current position. S: move-beginning-of-line + +`(end-of-line)` +Sets point after the last character of the current line, i.e. before the +end-of-line character sequence, leaving mark in its current position. +S: move-end-of-line + +`(forward-word)` +Moves the point in the current buffer forward before the first char of +the next word. If there is no word left the point is set to the end of +the buffer. If the point is already at the start or within a word, the +current word is skipped. D: **Note**: Elisp moves to the *end* of +the the next word. + +`(backward-word)` +Moves the point in the current buffer backward after the last char of +the previous word. If there is no word left the point is set to the +beginning of the buffer. If the point is already at the end or within a +word, the current word is skipped. D: **Note**: Elisp moves to +the *beginning* of the previous word. + +`(forward-char)` +Moves the point in the current buffer one character forward, but not +past the end of the buffer. C + +`(backward-char)` +Moves the point in the current buffer one character backward, but not +before the end of the buffer. C + +`(forward-page)` +Moves the point of the current buffer to the beginning of the last +visible line of the associated screen and scrolls the screen up to show +it as the first line. S: scroll-up + +`(backward-page)` +Moves the point of the current buffer to the beginning of the first +visible line of the associated screen and scrolls the screen down to +show it as the last line. S: scroll-down + +`(next-line)` +Moves the point in the current buffer to the same character position in +the next line, or to the end of the next line if there are not enough +characters. In the last line of the buffer moves the point to the end of +the buffer. C + +`(previous-line)` +Moves the point in the current buffer to the same character position in +the previous line, or to the end of the previous line if there are not +enough characters. In the first line of the buffer the point is not +moved. C + +##### Buffer management + +`(list-buffers)` +Lists all the buffers in a buffer called `*buffers*`. + +`(get-buffer-count)` +Returns the number of buffers, includes all special buffers and +`*buffers*`. + +`(select-buffer «string»)` +Makes the buffer named *string* the current buffer. Note: C to +`set-buffer` in Elisp. + +`(rename-buffer «string»)` +Rename the current buffer to *string*. C + +`(kill-buffer «string»)` +Kill the buffer names *string*. Unsaved changes are discarded. C + +`(get-buffer-name)` +Return the name of the current buffer. Note: C to `buffer-name` +in Elisp. + +`(add-mode-global «string»)` +Sets global mode *string* for all buffers. Currently the only global +mode is undo. + +`(add-mode «string»)` +Set a flag for the current buffer. + +`(delete-mode «string»)` +Reset a flag for the current buffer. + +`(find-file «string»)` +Loads file with path *string* into a new buffer. After loading +`(read-hook «string»)` is called. C + +`(save-buffer «string»)` +Saves the buffer named *string* to disk. C + +#### User Interaction + +This section lists function related to window and message line +manipulation, keyboard input and system interaction. + +##### Window Handling + +`(delete-other-windows)` +Make current window the only window. C + +`(split-window)` +Splits the current window. Creates a new window for the current buffer. +C + +`(other-window)` +Moves the cursor to the next window down on the screen. Makes the buffer +in that window the current buffer. D + +Note: Elisp `other-window` has a required parameter *count*, which +specifies the number of windows to move down or up. + +`(update-display)` +Updates all modified windows. + +`(refresh)` +Updates all windows by marking them modified and calling +`update-display`. + +##### Message Line + +`(message «string»)` +Displays *string* in the message line. D + +`(clear-message-line)` +Displays the empty string in the message line. + +`(prompt «prompt» «default»)` +Displays *prompt* in the command line and sets *default* as initial +value for the user response. The user can edit the response. When +hitting return, the final response is returned. + +`(show-prompt «prompt» «default»)` +Displays *prompt* and *default* in the command line, but does not allow +editing. Returns `t`. + +`(prompt-filename «prompt»)` +Displays *prompt* in the command line and allows to enter or search for +a file name. Returns the relative path to the selected file name or the +response typed by the user. + +##### Keyboard Handling + +`(set-key «key-name» «lisp-func»)` +Binds key key-name to the lisp function *lisp-func*. + +`(get-key-name)` +Returns the name of the currently pressed key, eg: `c-k` for control-k. + +`(get-key-funcname)` +Return the name of the function bound to the currently pressed key. + +`(execute-key)` +Executes the function of the last bound key. Tbd. +bound or pressed? + +`(describe-bindings)` +Creates a listing of all current key bindings, in a buffer named +`*help*` and displays it in a new window. C + +`(describe-functions)` +Creates a listing of all functions bound to keys in a buffer named +`*help*` and displays it in a new window. + +`(getch)` +Waits for a key to be pressed and returns the key as string. See also +`get-key-name`, `get-key-funcname` and `execute-key`. + +##### Programming and System Interaction + +`(exit)` +Exit Femto without saving modified buffers. + +`(eval-block)` +Evaluates the *region* in the current buffer, inserts the result at +*point* and returns it. If *mark* in the current buffer is before +*point* `eval-block` evaluates this *region* and inserts the result at +*point*. If *point* is before *mark* `eval-block` does nothing but +returning `t`. + +`(log-message «string»)` +Logs *string* to the `*messages*` buffer. + +`(log-debug «string»)` +Logs string to the file `debug.out`. + +`(get-version-string)` +Returns the complete version string of Femto, including the copyright. + +### Lisp Libraries + +Tbd.: document the libraries. + +#### `femto` + +*Femto* editor specific functions. + +This library implements helper function required by the Femto editor. It +is written only in *fLisp* primitives and plus the `flisp` Library. + +#### `bufmenu` Buffer Selection Menu + +#### `defmacro` Editor Macros + +#### `dired` Directory Navigation + +#### `info` Builtin Help + +#### `git` Git Repo Helper + +#### `grep` File Content Search + +#### `oxo` Tic-Tac-Toe Game + +[^](#toc) diff --git a/docs/flisp.md b/docs/flisp.md index c95ea4d..4f60d48 100644 --- a/docs/flisp.md +++ b/docs/flisp.md @@ -8,20 +8,20 @@ > — Antoine de Saint-Exupery *fLisp* is a tiny yet practical interpreter for a dialect of the Lisp -programming language. It is used as extension language for the -[Femto](https://github.com/hughbarney/femto) text editor. +programming language. It can be embedded into other applications and is +extensible via C libraries. *fLisp* is used as extension language for +the *Femto* text editor, see the [editor extension +manual](editor.html) [(Markdown)](editor.md) for details. -*fLisp* is hosted in the Femto -[Github](https://github.com/hughbarney/femto) repository, it is released -to the public domain. +*fLisp* is hosted in the *Femto* +[Github](https://github.com/hughbarney/femto) repository and released to +the public domain. *fLisp* is a Lisp-1 interpreter with Scheme like lexical scoping, -tailcall optimization and other Scheme influences. - -*fLisp* originates from [Tiny-Lisp by -matp](https://github.com/matp/tiny-lisp) (pre 2014), was integrated into -[Femto](https://github.com/hughbarney/femto) by Hugh Barney (pre 2016) -and compacted by Georg Lehner in 2023. +tailcall optimization and other Scheme influences. *fLisp* originates +from [Tiny-Lisp by matp](https://github.com/matp/tiny-lisp) (pre 2014), +was integrated into [Femto](https://github.com/hughbarney/femto) by Hugh +Barney (pre 2016) and extended by Georg Lehner since 2023. This is a reference manual. If you want to learn about Lisp programming use other resources eg. @@ -32,7 +32,7 @@ use other resources eg. or - [The Scheme Programming Language](https://www.scheme.org/). -This manual refers to version 0.6 or later of fLisp. +This manual refers to version 0.13 or later of fLisp. ### Table of Contents @@ -50,33 +50,17 @@ This manual refers to version 0.6 or later of fLisp. 2. [Input / Output and Others](#in_out) 3. [Object Operations](#object_ops) 4. [Arithmetic Operations](#arithmetic_ops) - 5. [String Operations](#string_ops) -6. [Double Extension](#double) + 5. [Bitwise Integer Operations](#bitwise_ops) + 6. [String Operations](#string_ops) +6. [Extensions](#extend) + 1. [File Extension](#file) + 2. [Double Extension](#double) 7. [Lisp Libraries](#libraries) 1. [Library Loading](#startup) 2. [Core Library](#core_lib) 3. [fLlisp Library](#flisp_lib) - 4. [Standard Library](#std_lib) - 5. [Femto Library](#femto_lib) -8. [Editor Extension](#editor) - 1. [Buffers](#buffers) - 1. [Text manipulation](#text) - 2. [Selection](#selection) - 3. [Cursor Movement](#cursor) - 4. [Buffer management](#buffer_management) - 2. [User Interaction](#ui) - 1. [Window Handling"](#windows) - 2. [Message Line](#message_line) - 3. [Keyboard Handling](#keyboard) - 4. [Programming and System Interaction](#programming_system) -9. [Embedding fLisp](#embedding) - 1. [Embedding Overview](#embedding) - 2. [fLisp C Interface](#c_api) - 3. [Building Extensions](#extensions) -10. [Implementation Details](#implementation) - 1. [Garbage Collection](#gc) - 2. [Memory Usage](#memory) - 3. [Future Directions](#future) +8. [fLisp Embedding and + Development](develop.html) [(Markdown)](develop.md) #### Notation Convention @@ -98,13 +82,13 @@ A single space is used to denote an arbitrary sequence of whitespace. *fLisp* does not use `[`square brackets`]` and double-dots `..` as syntactical elements. -Variables names convey the following context: +Variable names convey the following context: Lisp object of any type: *object* *value* *o* *a* *b* *c* Program elements: -*params* *opt* *body* *expr* *pred* +*arg* *args* *params* *opt* *body* *expr* *pred* *p* Integer: *i* *j* *k* @@ -113,7 +97,7 @@ Double: *x* *y* *z* Any numeric type: -*num* *num1* *num2* +*n* *n1* *n2* Symbol: *symbol* @@ -125,7 +109,10 @@ List/Cons: *cons* *l* *l1* *l2* … Stream: -*stream* *f* +*stream* *f* *fd* + +Function/lambda: +*f* *fLisp* fancies to converge towards Emacs and Common Lisp, but includes also Scheme functions. Function descriptions are annotated according to @@ -144,9 +131,10 @@ Lisp or Scheme. B Buggy/incompatible implementation. -By default compatibility with Common Lisp is annotated. The suffix -e is used to indicate reference to Emacs Lisp, s for -Scheme. *fLisp* specific function are annotated with f. +Compatibility with Emacs is omitted. By default compatibility with +Common Lisp is annotated. The suffix e is used to indicate +reference to Emacs Lisp, s for Scheme. *fLisp* specific function +are annotated with f. [^](#toc) @@ -287,22 +275,11 @@ is then replaced by its object. #### Error handling Whenever fLisp encounters an error an exception is thrown. Exceptions -have an error type symbol and a human readable error message. fLisp does -not implement stack backtracking. Exceptions are either caught on the -top level of an evaluation or by a `catch` statement. - -In the `flisp` interpreter the error message is formated as -`error: «message»` if the error object is `nil` otherwise as -`error: '«object»', «message»`, where *object* is the serialization of -the object causing the error and *message* is the error message. - -When an exception occurs while calling `lisp_eval()` or -`lisp_eval_string()` from C-code, the `object` field of the interpreter -is set to the object causing the error, the `result` field is set to the -error type symbol and the `msg_buf` field is set to the error message. - -Exceptions can be thrown from within in Lisp code via the -[`throw`](#interp_ops) function. +have an error type symbol a human readable +error message and the object +in error, which is nil with generic errors. fLisp does not +implement stack backtracking. Exceptions are either caught on the top +level of an evaluation or by a [`catch`](#interp_ops) statement. The following error type symbols are defined and used internally: @@ -318,6 +295,14 @@ The following error type symbols are defined and used internally: - `out-of-memory` - `gc-error` +Exceptions can be thrown via the [`throw`](#interp_ops) function. As +long as applicable use one of the existing error codes with `throw`. + +*fLisp* outputs an error message formated as `error: «message»` if the +error object is `nil` otherwise as `error: '«object»', «message»`, where +*object* is the serialization of the object causing the error. *message* +is the error message. + [^](#toc) ### *fLisp* Primitives @@ -340,11 +325,13 @@ is tested. If *pred* evaluates not to `nil` and if there is no *action* the value of *pred* is returned, otherwise `(progn «action» ..)` is returned and no more *clause*s are evaluated. -`(setq «symbol» «value»[ «symbol» «value»..])` -Create or update named objects: If *symbol* is the name of an existing -named object in the current or a parent environment the named object is -set to *value*, if no symbol with this name exists, a new one is created -in the top level environment. `setq` returns the last *value*. +`(bind «symbol» «value»[ «globalp»)` ⇒ *value* +Create or update *symbol* and bind it to *value*. Return value. First +*symbol* is looked up in the current environment, then recursively in +the parent environments. If it is not found, it is created in the +current environment as long as *globalp* is `nil` or omitted. If +*globalp* is not `nil` *symbol* is always created in the global (top +level) environment. `(define «symbol» «value»[ «symbol» «value»..])` Ss: define, let Create or update named objects: If *symbol* is the name of an existing @@ -380,8 +367,8 @@ Returns *expr* without evaluating it. `(catch «expr»)` D Evaluates *expr* and returns a list with three elements: -*result* -`0` on success or any other number indicating an error. +*error_type* +`nil` on success or an error type symbol. *message* A human readable error message. @@ -396,8 +383,7 @@ error type symbol, *message* is a human readable error string and #### Input / Output and Others -`(open «path»[ «mode»])` S: open - +`(open «path»[ «mode»])` S: open Open file at string *path* with string *mode* and return a stream object. *mode* is `"r"`ead only by default. @@ -419,50 +405,30 @@ The name of the opened file is set to ``. The name of the opened file is set to `>STRING`. -`(close «stream»)` S: close - +`(close «stream»)` S: close Close *stream* object -`(file-info «stream»)` f - +`(file-info «stream»)` f Returns `(«path» «buf» «fd»)` for *stream*. *buf* is either `nil` or the text buffer of a memory stream. *fd* is either the integer representation of the file descriptor or `nil` when *stream* is already closed. -`(read` *stream*`[ eof-value])` S: read - +`(read` *stream*`[ eof-value])` S: read Reads the next complete Lisp expression from *stream*. The read in object is returned. If end of file is reached, an exception is raised, unless *eof-value* is not `nil`. In that case `eof-value` is returned. -`(write «object»[ «keys»..]]` - -*keys*: - -`:stream` *stream* - -`:readably` *flag* - +`(write «object»[ «readably»[ «fd»]]` → object Formats *object* into a string and writes it to the default output -stream. With key `:stream` output is written to the given stream. With -key `:readable` not `nil` output is formatted in a way which which gives -the same object when read again. `write` returns the *object*. - -`(eval «object»)` +stream. When *readably* is not `nil` output is formatted in a way which +which gives the same object when read again. When stream *fd* is given +output is written to the given stream else to the output stream. `write` +returns the *object*. +`(eval «object»)` Evaluates *object* and returns the result. -`(system «string»)` - -Executes the -[system(1)](https://man7.org/linux/man-pages/man3/system.3.html) -function with *string* as parameter. - -`(os.getenv «string») ` - -Returns the value of the environment variable named *string*. - #### Object Operations `(null «object»)` @@ -518,6 +484,26 @@ Returns the rest (modulo) of the integer division of *i* by *j*. Throws These predicate functions apply the respective comparison operator between *i* *j*. +#### Bitwise Integer Operations + +`(& «i» «j»)` +Returns the bitwise and operation on *i* and *j*. + +`(| «i» «j»)` +Returns the bitwise or operation on *i* and *j*. + +`(^ «i» «j»)` +Returns the bitwise xor operation on *i* and *j*. + +`(<< «i» «j»)` +Returns *i* shift left by *j* bits. + +`(>> «i» «j»)` +Returns *i* shift right by *j* bits. + +`(~ «i»)` +Returns the bitwise negation of *i*. + #### String Operations `(string-length «string»)` @@ -538,10 +524,6 @@ to the start of *string*. Returns the position of *needle* if it is contained in *haystack*, otherwise `nil`. -`(string-to-number «string»)` -Converts *string* into a corresponding *integer* object. String is -interpreted as decimal based integer. - `(ascii «integer»)` Converts *integer* into a *string* with one character, which corresponds to the ASCII representation of *integer*. @@ -552,6 +534,60 @@ corresponds to its ASCII value. [^](#toc) +### File Extension + +Tbd. carry over comprehensive documentation from +`file.c` + +`(fflush[ «stream»])` +Flush *stream*, output or all streams + +`(fseek «stream» «offset»[ «relativep»])` +Seek position *offset* in *stream* or input. If *offset* is negative +seek from end, if *relativep* is not null seek from current position, be +default seek from start + +`(ftell[ «stream»])` +Return current position in *stream* or input. + +`(feof[ «stream»])` +Return `end-of-file` if stream or input are exhausted, else `nil` + +`(fgetc[ «stream»])` +Return the next character from *stream* or input. + +`(fungetc «i»[ «stream»])` +`ungetc()` integer *i* as char to *stream* or input. + +`(fgets[ «stream»])` +Read a line or up to `INPUT_FMT_BUFSIZ` from *stream* or input. + +`(fstat «path»[ «linkp»])` +Get information about file at *path*. + +`(fttyp[ «fd»])` +Return true if input or stream *fd* is associated with a TTY. + +`(fmkdir «path»[ «mode»])` +Create directory at *path* with *mode*. + +`(popen «line»[ «mode»])` +Run command line and read from/write to it + +`(pclose «stream»)` +Close a *stream* opened with `(popen)` + +`(system «string»)` ⇒ *exit_code* +Execute *string* as command line of a system shell subpprocess according +to the [system(1)](https://man7.org/linux/man-pages/man3/system.3.html) +and return the shell *exit_code* as integer. + +`(getenv «name»)` ⇒ *value* +Return the value of the environment variable *name* as string. If *name* +does not exist return `nil`. + +[^](#toc) + ### Double Extension `(d+ «x» «y»)` @@ -589,16 +625,16 @@ default location and name of this startup file are hardcoded in the binary and can be overwritten with environment variables: -Library path -femto: `/usr/local/share/femto`, `FEMTOLIB` - -flisp: `/usr/local/share/flisp`, `FLISPLIB` - Startup file femto: `femto.rc`, `FEMTORC` flisp: `flisp.rc`, `FLISPRC` +Library path +femto: `/usr/local/share/femto`, `FEMTOLIB` + +flisp: `/usr/local/share/flisp`, `FLISPLIB` + The library path is exposed to the Lisp interpreter as the variable `script_dir`. @@ -607,12 +643,23 @@ allows to load Lisp files from the library path conveniently and without repetition. The command to load the file `example.lsp` from the library is `(require 'example)`. -Femto provides a set of libraries, some of them are required by the -editor +*fLisp* provides the following set of libraries: -#### Core Library +core +Integrated in the `.rc` files, always loaded. The core library +implements the minimum required Lisp features for loading libraries. + +flisp +Implements expected standard Lisp functions and additions expected by +`femto` and `flisp`. + +string +String manipulation library. -This library is built into the startup file. +The *Femto* specific libraries are described together with the +[editor](editor.html) [(Markdown)](editor.md) extension. + +#### Core Library `(list` \[*element* ..\]`)` C Returns the list of all provided elements. @@ -621,6 +668,12 @@ Returns the list of all provided elements. `(defun «name» «params» «body»)` C Defines and returns a macro or function, respectively. +`(setq «symbol» «value»[ «symbol» «value»..])` +Create or update named objects: If *symbol* is the name of an existing +named object in the current or a parent environment the named object is +set to *value*, if no symbol with this name exists, a new one is created +in the top level environment. `setq` returns the last *value*. + `(curry («func» «a»))` Returns a lambda with one parameter which returns `(«func» «a» «b»)`. @@ -628,6 +681,7 @@ Returns a lambda with one parameter which returns `(«func» «a» «b»)`. Returns true if *object* has *type*. `(integerp «object»)` C +`(doublep «object»)` C `(stringp «object»)` C `(symbolp «object»)` C `(lamdap «object»)` C @@ -636,29 +690,54 @@ Returns true if *object* has *type*. Return `t` if *object* is of the respective type, otherwise `nil`. `(numberp «object»)` C +Return `t` if *object* is integer or double, otherwise `nil`. + `(cadr «list»)` C Return the second element in *list*, `(car (cdr «list»))`. `(cddr «list»)` C Return all elements after the second one in *list*, `(cdr (cdr «list»))`. `(caddr «list»)` C Return the third element in list, `(car (cdr (cdr «list»)))`. -`(number-to-string «number»)` C +`(append [list ..][ a])` +Append all elements in all *list*s into a single list. If atom *a* is +present, make it a dotted list terminating with *a*. + +`(fold-left «func» «init» «list»)` Ss: fold-left +Apply the binary *func*tion to *start* and the first element of *list* +and then recursively to the result of the previous invocation and the +first element of the rest of *list*. If *list* is empty return *start*. + +`(flip «func»)` f +Returns a lambda which calls binary *func* with it's two arguments +reversed (flipped). + +`(reverse «l»)` +Returns a list with all elements of *l* in reverse order + +`(apply «f» [«arg» ..][ l])` +If *arg* is a single list call lambda *f* with all its elements as +parameters, else call *f* with all *arg*s as parameters. If list *l* is +present append all its elements to the parameter list. + +`(print «o»[ «fd»])` +`write` object *o* `:readably` to stream *fd* or output. + +`(princ «o»[ «fd»])` +`write` object *o* as is to stream *fd* or output. + +`(string-to-number «string»)` +Converts *string* into a corresponding *integer* object. String is +interpreted as decimal based integer. + Converts *integer* into a *string* object. `(eq «a» «b»)` Returns `t` if *a* and *b* evaluate to the same object, number or string, `nil` otherwise. -Synonym for `integerp`. - `(not «object»)` C Logical inverse. In Lisp a synonym for `null` -`(fold-left «func» «init» «list»)` Ss: fold-left -Apply the binary *func*tion to *start* and the first element of *list* -and then recursively to the result of the previous invocation and the -first element of the rest of *list*. If *list* is empty return *start*. - `(length «obj»)` C Returns the length of *obj* if it is a string or a list, otherwise throws a type exception. @@ -673,16 +752,31 @@ Returns concatenation of all arguments converted to strings. If *arg* is contained in *list*, returns the sub list of *list* starting with the first occurrence of *arg*, otherwise returns `nil`. -`(map1 «func» «list»)` S: mapcar -Apply func to each element in list and return a list of the results. +`(mapcar «func» «list»)` Se, Dc +Apply *func* to each element in list and return the list of results. + +In Elisp func has to be quoted, in CL variadic *func* operates on a list +of lists. + +`(nfold «f» «i» «l»)` +“Number fold”: `left-fold`s binary function *f* on list *l* with initial +value *i*. Helper function for n-ary generic number type arithmetic. + +`(coerce ifunc dfunc x y)` +If *x* and *y* are `type-integer` apply binary integer arithmetic +function *ifunc* to them and return the result. If any of them is +`type-double` apply binary double arithmethich function *dfunc* instead. +Helper function for n-ary generic number type arithmetic. -`map1` is a specialized form of `mapcar` restricted to one list only. +`(coercec «ifunc» «dfunc»)` +“Coerce curry”: return a lambda `coerce`ing parameters *x* and *y* and +applying *ifunc* or *dfunc* respectively. Helper function for n-ary +generic number type arithmetic. -`nfold` -`coerce` -`coercec` -`fold-leftp` -Helper functions for n-ary generic number type arithmetic. See below. +`(fold-leftp «predicate» «start» «list»)` +“Predicate fold”: `fold-left` binary function *predicate* to *list* with +initial value *start*. Returns `t` if *list* is empty. Helper functions +for n-ary generic number type comparison. `(let ((«name» «value»)[ («name» «value»)..]) «body»)` C Bind all *name*s to the respective *value*s then evaluate body. @@ -747,11 +841,19 @@ only one *num* is given they all return `t`. This library implements commonly excpected Lisp idioms. *fLisp* implements a carefully selected minimum set of commonly used functions. -listp +`(listp «o»)` D -and +Returns true if *o* is `nil` or a *cons*. -or +`(and[ o..])` + +Returns `t` or the last object *o* if none is given or all evaluate to +non `nil`, `nil` otherwise. + +`(or[ o..])` + +Returns `nil` if all objects o are `nil`, otherwise returns the first +object which evaluates to non `nil`. `(reduce «func» «list» «start»)` D @@ -762,643 +864,52 @@ or Since `reduce` is right associative and *start* is not optional, it differs significantly both from Common Lisp and Scheme. -max - -min - -nthcdr - -nth - -`(fold-right «func» «end» «list»)` Cs - -`(unfold «func» «init» «pred»)` Cs - -`(iota «count»[ «start»[ «step»]])` Cs - -#### Standard Library - -This library implements some Common Lisp functions, which are not used -in the editor libraries. They are provided for reference. - -atom - -zerop - -if - -equal - -append - -print - -princ - -#### Femto Library - -This library implements helper function required by the Femto editor. It -is written only in Lisp idioms provided by fLisp itself plus the [fLisp -Library](#flisp_lib). - -[^](#toc) - -### Editor Extension - -The editor extensions introduces several types of objects/functionality: - -- Buffers hold text -- Windows display buffer contents to the user -- Keyboard Input allows the user to interact - with buffers and windows -- The Message Line gives feedback to the user -- Several other function for operating system or user interaction - -#### Buffers - -This section describes the buffer related functions added by Femto to -fLisp. The description is separated in function related to buffer -management and text manipulation. Text manipulation always operates on -the current buffer. Buffer management creates, -deletes buffers, or selects one of the existing buffers as the current -buffer. - -Buffers store text and allow to manipulate it. A buffer has the -following properties: - -*name* -Buffers are identified by their name. If a buffer name is enclosed in -`*`asterisks`*` the buffer receives special treatment. - -*text* -zero or more characters. - -*point* -The position in the text where text manipulation takes place. The first -position in the text is 0. Note: in Emacs the first position is 1. +`(max «n»[ «n»..])` -*mark* -An optional second position in the text. If the *mark* is set, the text -between *point* and *mark* is called the -selection or region. +`(min «n»[ «n»..])` -*filename* -If set the buffer is associated with the respective file. +Return the biggest/smallest number of all given *n*s. -*flags* -Different flags determine the behavior of the buffer. Editor specific -flags: `special`, `modified`. +`(nthcdr «i» «l»)` -Mode flags determine the syntax highlighter mode: `cmode` and `lispmode` -are available. If none is set `text` mode is used for syntax -hightlighting. +Return sub list of *l* starting from zero-based *i*th element to the +last. -In the following, any mention to one of them refers to the respective -current buffers property. +`(nth «i» «l»)` -##### Text manipulation +Return zero-based *i*th element of list *l* -`(insert-string «string»)` -Inserts *string* before *point*. S: insert. +`(fold-right «f» «o» «l»)` Cs -`(insert-file-contents-literally «string» `\[*flag*\]`)` -Inserts the file *string* after *point*. If *flag* is not nil the buffer -is marked as not modified. B +Apply binary function *f* to last element of *l* and *o*, then +recursively to the previous element and the result. -Note: Currently the flag is forced to nil. The function should return -`(«filename» «count»)` but it returns a flag indicating if the operation -succeeded. +`(unfold «f» «o» «p»)` Cs -`(erase-buffer)` -Erases all text in the current buffer. C +Create a list starting with *o* followed by the result of successive +application of *f* to *o* until applying *p* to the result is not `nil` +anymore. -`(delete)` -Deletes the character after *point*. S: delete-char - -`(backspace)` -Deletes the character to the left of *point*. S: -delete-backward-char - -`(get-char)` -Returns the character at *point*. S: get-byte - -`(copy-region)` -Copies *region* to the *clipboard*. S: copy-region-as-kill - -`(kill-region)` -Deletes the text in the *region* and copies it to the *clipboard*. -D - -`(yank)` -Pastes the *clipboard* before *point*. C - -##### Selection - -`(set-mark)` -Sets *mark* to *point*. D - -`(get-mark)` -Returns the position of *mark*, -1 if *mark* is unset. S: mark - -`(get-point)` -Returns the position of *point*. S: point - -`(get-point-max)` -Returns the maximum accessible value of point in the current buffer. -S: point-max - -`(set-clipboard «variable»)` -`Sets «clipboard» to the contents of «variable».` S: -gui-set-selection - -`(get-clipboard)` -Returns the *clipboard* contents. S: gui-get-selection - -##### Cursor Movement - -`(set-point «number»)` -Sets the point to in the current buffer to the position *number*. S: -goto-char - -`(goto-line «number»)` -Sets the point in the current buffer to the first character on line -*number*. S: goto-line, not an Elisp function. - -`(search-forward «string»)` -Searches for *string* in the current buffer, starting from point -forward. If string is found, sets the point after the first occurrence -of *string* and returns `t`, otherwise leaves point alone and returns -`nil`. D - -`(search-backward «string»)` -Searches for *string* in the current buffer, starting from point -backwards. If string is found, sets the point before the first -occurrence of *string* and returns `t`, otherwise leaves point alone and -returns `nil`. D - -`(beginning-of-buffer)` -Sets the point in the current buffer to the first buffer position, -leaving mark in its current position. C - -`(end-of-buffer)` -Sets the point in the current buffer to the last buffer position, -leaving mark in its current position. C - -`(beginning-of-line)` -Sets point before the first character of the current line, leaving mark -in its current position. S: move-beginning-of-line - -`(end-of-line)` -Sets point after the last character of the current line, i.e. before the -end-of-line character sequence, leaving mark in its current position. -S: move-end-of-line - -`(forward-word)` -Moves the point in the current buffer forward before the first char of -the next word. If there is no word left the point is set to the end of -the buffer. If the point is already at the start or within a word, the -current word is skipped. D: **Note**: Elisp moves to the *end* of -the the next word. - -`(backward-word)` -Moves the point in the current buffer backward after the last char of -the previous word. If there is no word left the point is set to the -beginning of the buffer. If the point is already at the end or within a -word, the current word is skipped. D: **Note**: Elisp moves to -the *beginning* of the previous word. - -`(forward-char)` -Moves the point in the current buffer one character forward, but not -past the end of the buffer. C - -`(backward-char)` -Moves the point in the current buffer one character backward, but not -before the end of the buffer. C - -`(forward-page)` -Moves the point of the current buffer to the beginning of the last -visible line of the associated screen and scrolls the screen up to show -it as the first line. S: scroll-up - -`(backward-page)` -Moves the point of the current buffer to the beginning of the first -visible line of the associated screen and scrolls the screen down to -show it as the last line. S: scroll-down - -`(next-line)` -Moves the point in the current buffer to the same character position in -the next line, or to the end of the next line if there are not enough -characters. In the last line of the buffer moves the point to the end of -the buffer. C - -`(previous-line)` -Moves the point in the current buffer to the same character position in -the previous line, or to the end of the previous line if there are not -enough characters. In the first line of the buffer the point is not -moved. C - -##### Buffer management - -`(list-buffers)` -Lists all the buffers in a buffer called `*buffers*`. - -`(get-buffer-count)` -Returns the number of buffers, includes all special buffers and -`*buffers*`. - -`(select-buffer «string»)` -Makes the buffer named *string* the current buffer. Note: C to -`set-buffer` in Elisp. - -`(rename-buffer «string»)` -Rename the current buffer to *string*. C - -`(kill-buffer «string»)` -Kill the buffer names *string*. Unsaved changes are discarded. C - -`(get-buffer-name)` -Return the name of the current buffer. Note: C to `buffer-name` -in Elisp. - -`(add-mode-global «string»)` -Sets global mode *string* for all buffers. Currently the only global -mode is undo. - -`(add-mode «string»)` -Set a flag for the current buffer. - -`(delete-mode «string»)` -Reset a flag for the current buffer. - -`(find-file «string»)` -Loads file with path *string* into a new buffer. After loading -`(read-hook «string»)` is called. C - -`(save-buffer «string»)` -Saves the buffer named *string* to disk. C - -#### User Interaction - -This section lists function related to window and message line -manipulation, keyboard input and system interaction. - -##### Window Handling - -`(delete-other-windows)` -Make current window the only window. C - -`(split-window)` -Splits the current window. Creates a new window for the current buffer. -C - -`(other-window)` -Moves the cursor to the next window down on the screen. Makes the buffer -in that window the current buffer. D - -Note: Elisp `other-window` has a required parameter *count*, which -specifies the number of windows to move down or up. - -`(update-display)` -Updates all modified windows. - -`(refresh)` -Updates all windows by marking them modified and calling -`update-display`. - -##### Message Line - -`(message «string»)` -Displays *string* in the message line. D - -`(clear-message-line)` -Displays the empty string in the message line. - -`(prompt «prompt» «default»)` -Displays *prompt* in the command line and sets *default* as initial -value for the user response. The user can edit the response. When -hitting return, the final response is returned. - -`(show-prompt «prompt» «default»)` -Displays *prompt* and *default* in the command line, but does not allow -editing. Returns `t`. - -`(prompt-filename «prompt»)` -Displays *prompt* in the command line and allows to enter or search for -a file name. Returns the relative path to the selected file name or the -response typed by the user. - -##### Keyboard Handling - -`(set-key «key-name» «lisp-func»)` -Binds key key-name to the lisp function *lisp-func*. - -`(get-key-name)` -Returns the name of the currently pressed key, eg: `c-k` for control-k. - -`(get-key-funcname)` -Return the name of the function bound to the currently pressed key. - -`(execute-key)` -Executes the function of the last bound key. Tbd. -bound or pressed? - -`(describe-bindings)` -Creates a listing of all current key bindings, in a buffer named -`*help*` and displays it in a new window. C - -`(describe-functions)` -Creates a listing of all functions bound to keys in a buffer named -`*help*` and displays it in a new window. - -`(getch)` -Waits for a key to be pressed and returns the key as string. See also -`get-key-name`, `get-key-funcname` and `execute-key`. - -##### Programming and System Interaction - -`(exit)` -Exit Femto without saving modified buffers. - -`(eval-block)` -Evaluates the *region* in the current buffer, inserts the result at -*point* and returns it. If *mark* in the current buffer is before -*point* `eval-block` evaluates this *region* and inserts the result at -*point*. If *point* is before *mark* `eval-block` does nothing but -returning `t`. - -`(log-message «string»)` -Logs *string* to the `*messages*` buffer. - -`(log-debug «string»)` -Logs string to the file `debug.out`. - -`(get-version-string)` -Returns the complete version string of Femto, including the copyright. - -[^](#toc) - -### Embedding fLisp - -#### Embedding Overview - -fLisp can be embedded into a C application. Two examples of embedding -are the \`femto\` editor and the simplistic \`flisp\` command line Lisp -interpreter. - -Currently embedding can only be done by extending the build system. -Application specific binary Lisp extensions are stored in separated C -files and the interface code is conditionally included into the `lisp.c` -file. Two extensions are provided: the Femto extension which provides -the editor functionality and the file extension which provides access to -the low level stream I/O functions and adds some more. - -fLisp exposes the following public interface functions: - -`lisp_new()` -Create a new interpreter. - -`lisp_destroy()` -Destroy an interpreter, releasing resources. - -`lisp_eval()` -Evaluate input stream until exhausted or error. - -`lisp_eval_string()` -Evaluate given string until exhausted or error. - -`lisp_write_object()` -Format and write object to file descriptor. - -`lisp_write_error()` -Format and write the error object and error message of an interpreter to -a file descriptor. - -Different flows of operation can be implemented. The Femto editor -initializes the interpreter without input/output file descriptors and -sends strings of Lisp commands to the interpreter, either when a key is -pressed or upon explicit request via the editor interface. - -The `flisp` command line interpreter sets `stdout` as the default output -file descriptors of the fLisp interpreter and feeds it with strings of -lines read from the terminal. If the standard input is not a terminal -`stdin` is set as the default input file descriptor and fLisp reads it -through until end of file. - -After processing the given input, the interpreter puts a pointer to the -object which is the result of the last evaluation into the `object` -field of the interpreter structure. The `result` field is set to the -`nil` and the `msg_buf` field is set to the empty string. - -fLisp sends all output to the default output stream. If `NULL` is given -on initialization, output is suppressed altogether. - -If an exception is thrown inside the Lisp interpreter an error message -is formatted and copied to the `msg_buf` buffer of the interpreter, A -pointer to the object causing the error is set to the `object` field. -The `result` field is set to the respective error type symbol. - -In this error state of the interpreter, the -function `lisp_write_error()` can be used to write a standardized error -message including the error object to a file descriptor of choice - -#### fLisp C Interface - -*Interpreter*` *lisp_new(int «size», char **«argv», char *«library_path», FILE *input, FILE *output, FILE* debug)` -`lisp_new()` creates and initializes an fLisp interpreter. The initial -environment contains the following symbols: - -*argv0* -The string stored in `*«argv»[0]`, if any - -*argv* -The list of strings stored in *argv* - -*script_dir* -The string stored in *library_path* - -A pointer to an *Interpreter* struct is returned, which is used to -operate the interpreter. - -The other arguments to `lisp_new()` are: - -*size* -Memory size to allocate for the Lisp objects. This is divided into two -pages for garbage collection. Only one page is used by the interpreter -at any moment. - -*input* -Default input stream. If *input* is set to `NULL`, the input stream has -to be specified for each invocation of `lisp_eval()`. - -*output* -Default output stream. If *output* is set to `NULL` a memory stream is -created at the first invocation of the interpreter and set as the -default output stream. - -*debug* -Debug output stream. If set to `NULL` no debug information is generated. - -`void lisp_destroy(Interpreter *«interp»)` -Frees all resources used by the interpreter. - -`void lisp_eval(Interpreter *«interp»)` -Evaluates the input file set in the *input* field of the fLisp -interpreter *interp* until end of file. If no input file is set, -`interp` is set to a respective error state. - -`void lisp_eval_string(Interpreter *«interp», char *«string»)` -Evaluates all Lisp expressions in *string*. - -`void lisp_write_object(Interpreter *«interp», FILE «*fd», Object *«object», bool readably)` -Format *object* into a string and write it to *stream*. If *readably* is -true, the string can be read in by the interpreter and results in the -same object. - -`void lisp_write_error(Interpreter *«interp», FILE «*fd»)` -Format the error *object* and the error message of the interpreter into -a string and write it to *fd*. The *object* is written with *readably* -`true`. - -Note: currently only creating one interpreter has -been tested. +`(iota «count»[ «start»[ «step»]])` Cs -#### Building Extensions +Create a list of *count* numbers starting with *start* or `0` if not +given by successively adding *step* or `1` if not given. -An extensions has to create C functions with the signature: -`Object *«primitive»(Interpreter *interp, Object **args, Object **env)`, -where *primitive* is a distinct name in C space. This function has to be -added to the global variable `primitives` in the following format: -`{"«name»", «argMin», «argMax», «primitive»}`. Here *name* is a distinct -name in Lisp space. +`(atom «o»)` -*interp* is the fLisp interpreter in which *primitive* is executed. -*argMin* is the minimum number of arguments, *argMax* is the maximum -number of arguments allowed for the function. If *argMax* is a negative -number, arguments must be given in tuples of *argMax* and the number of -tuples is not restricted. +`t` if *o* is not a *cons*. -When creating more then one new objects within a primitive, care has to -be taken to register them with the garbage collector. Registration is -started with the `GC_CHECKPOINT` CPP macro. `GC_TRACE(«name», «value»` -creates an object variable *name*, sets it to *value* and registers it -with the garbage collector. The macro `GC_RELEASE` must be called to -finalize the registration. The convenience macro `GC_RETURN(«object»)` -calls `GC_RELEASE` and returns *object*. +`(zerop «x»)` -Some CPP macros are provided to simplify argument validation in -primitives, all of them receive the *name* of the primitive as a -parameter: +`t` if number *x* is zero. -`TWO_STRING_ARGS(«name»)` -Assures that the first two arguments are of type string. They are -assigned to the `Object *` variables *first* and *second*. +`(if «p» «then»[ «else»)` -`ONE_STRING_ARG(«name»)` -Assures that the first argument is of type string. It is assigned to the -`Object *` variable *arg*. +Evaluate *then* if predicate *p* evaluates to not `nil`, else evaluate +*else*. -`ONE_NUMBER_ARG(«name»)` -Assures that the first argument is of type number. It is assigned to the -`Object *` variable *num*. +`(equal «o1» «o2»)` -`ONE_STREAM_ARG(«name»)` -Assures that the first argument is of type stream. It is assigned to the -`Object *` variable *stream*. +Return `nil` if *o1* and *o2* are not isomorphic. [^](#toc) - -### Implementation Details - -#### Garbage Collection - -fLisp implements Cheney's copying garbage collector, with which memory -is divided into two equal halves (semi spaces): from- and to-space. -From-space is where new objects are allocated, whereas to-space is used -during garbage collection. - -When garbage collection is performed, objects that are still in use -(live) are copied from from-space to to-space. To-space then becomes the -new from-space and vice versa, thereby discarding all objects that have -not been copied. - -Our garbage collector takes as input a list of root objects. Objects -that can be reached by recursively traversing this list are considered -live and will be moved to to-space. When we move an object, we must also -update its pointer within the list to point to the objects new location -in memory. - -However, this implies that our interpreter cannot use raw pointers to -objects in any function that might trigger garbage collection (or risk -causing a SEGV when accessing an object that has been moved). Instead, -objects must be added to the list and then only accessed through the -pointer inside the list. - -Thus, whenever we would have used a raw pointer to an object, we use a -pointer to the pointer inside the list instead: - - function: pointer to pointer inside list (Object **) - | - v - list of root objects: pointer to object (Object *) - | - v - semi space: object in memory - - -*GC_TRACE* adds an object to the list and declares a variable which -points to the objects pointer inside the list. - -*GC_TRACE*`(«gcX», «X»)`: add object *X* to the list and declare -`Object **«gcX»` to point to the pointer to *X* inside the list. - -Information about the garbage collection process and memory status is -written to the debug file descriptor. - -#### Memory Usage - -Some compile time adjustable limits in `lisp.h`: - -Input buffer -2048, `INPUT_FMT_BUFSIZ`, size of the formatting buffer for -`lisp_eval()`. - -Output buffer -2048, `WRITE_FMT_BUFSIZ`, size of the output and message formatting -buffer. - -fLisp can live with as little as 300k object memory. The Femto editor -requires 16M since the “OXO” game requires a lot of memory. - -#### Future Directions - -The two memory pages should be separated and the second one should be -allocated only during garbage collection. When memory runs out, the -garbage collection should be restarted with an increased capacity of the -new page. - -It is now possible to catch exceptions within Lisp code and exceptions -return differentiated error codes and use POSIX stream I/O. This, -together with the `(eval)` primitive would allow to write the repl -directly in Lisp, and reading and eval'ing until no more “incomplete -input” result codes are returned. - -Integer arithmetic would be sufficient for all current purposes and -increase portability and speed while reducing size. - -The file extension only contains `(fflush)`, `(ftell)` and `(fgetc)` and -could easily be extended into something useful. `(fstat)` would be most -pressing for improving `femto.rc` and `flisp.rc`. - -The string library should implement Elisp `substring` to replace -`string.substring` and a simplified version of `string-search` without -start index. - -Implement `(type «object»)` returning symbols for each type in C and -implement individual type checking predicates in Lisp. - -loop programming is availble via the labelled let macro. It could made -easier, by any combination of: - -- iota -- loop/while/for macro -- Demoing hand crafted loops including breaking with throw. diff --git a/docs/implementation.md b/docs/implementation.md new file mode 100644 index 0000000..2764e6b --- /dev/null +++ b/docs/implementation.md @@ -0,0 +1,106 @@ +# fLisp Implementation Details + +[fLisp Manual](flisp.html) [(Markdown)](flisp.md) + +### Table of Contents + +1. 1. [Garbage Collection](#gc) + 2. [Memory Usage](#memory) + 3. [Future Directions](#future) + +### Implementation Details + +#### Garbage Collection + +*fLisp* implements Cheney's copying garbage collector, with which memory +is divided into two equal halves (semi spaces): from- and to-space. +From-space is where new objects are allocated, whereas to-space is used +during garbage collection. The from-space part of the memory is also +called the Lisp object space. + +When garbage collection is performed, objects that are still in use +(live) are copied from from-space to to-space. To-space then becomes the +new from-space and vice versa, thereby discarding all objects that have +not been copied. + +Our garbage collector takes as input a list of root objects. Objects +that can be reached by recursively traversing this list are considered +live and will be moved to to-space. When we move an object, we must also +update its pointer within the list to point to the objects new location +in memory. + +However, this implies that our interpreter cannot use raw pointers to +objects in any function that might trigger garbage collection (or risk +causing a SEGV when accessing an object that has been moved). Instead, +objects must be added to the list and then only accessed through the +pointer inside the list. + +Thus, whenever we would have used a raw pointer to an object, we use a +pointer to the pointer inside the list instead: + + function: pointer to pointer inside list (Object **) + | + v + list of root objects: pointer to object (Object *) + | + v + semi space: object in memory + + +*GC_TRACE* adds an object to the list and declares a variable which +points to the objects pointer inside the list. + +*GC_TRACE*`(«gcX», «X»)`: add object *X* to the list and declare +`Object **«gcX»` to point to the pointer to *X* inside the list. + +Information about the garbage collection process and memory status is +written to the debug file descriptor. + +#### Memory Allocation + +Object allocation adjusts the size of the Lisp object space on demand: +If after garbage collection the free space is less then the required +memory plus some reserved space for exception reporting, the memory is +increased by a multiple of the amount specified in the C-macro +`FLISP_MEMORY_INC`, defined in `lisp.h`. The multiple is calculated to +hold at least the additional requested space. + +`lisp_new()` allocates `FLISP_MIN_MEMORY`, defined in `lisp.h`, and then +allocates all initial objects without taking care of garbage collection. +Then it prints out the amount of Lisp object space consumed to the debug +file descriptor. For *fLisp* this is currently about 21 kB, for *femto* +about 34 kB. + +In order to reduce garbage collection frequency, especially during +startup, one can set `FLISP_INITIAL_MEMORY` to a desired additional +amount of memory to allocate on startup. + +Some other compile time adjustable limits in `lisp.h`: + +Input buffer +2048, `INPUT_FMT_BUFSIZ`, size of the formatting buffer for +`lisp_eval()` and for the input buffer of `(fgets)`. + +Output buffer +2048, `WRITE_FMT_BUFSIZ`, size of the output and message formatting +buffer. + +*fLisp* can live with as little as 50k object memory up to startup. The +Femto editor requires much more memory because of the needs of the “OXO” +game. + +#### Future Directions + +Loops are availble via the labelled let macro and supported by `iota`. +It could made easier, by any combination of: + +- loop/while/for macro +- Demoing hand crafted loops including breaking with throw. + +Implement backquote and friends. + +Pluggable extensions. + +Take away more things. + +[^](#toc) diff --git a/double.c b/double.c index 41408a7..f6bd7c5 100644 --- a/double.c +++ b/double.c @@ -1,6 +1,3 @@ -#ifndef DOUBLE_C -#define DOUBLE_C - #include #include #include @@ -92,8 +89,6 @@ Object *doubleMod(Interpreter *interp, Object **args, Object **env) return newDouble(interp, fmod(FLISP_ARG_ONE->number, FLISP_ARG_TWO->number)); } -#endif - /* * Local Variables: * c-file-style: "k&r" diff --git a/double.h b/double.h index 51cfdfe..621cb90 100644 --- a/double.h +++ b/double.h @@ -10,7 +10,7 @@ extern Object *double_one; extern Object *newDouble(Interpreter *, double); extern Object *readDouble(Interpreter *); -extern Object *readNumberOrSymbol(Interpreter *, FILE *); + extern Object *integerFromDouble(Interpreter *, Object **, Object **); extern Object *doubleFromInteger(Interpreter *, Object **, Object **); extern Object *doubleAdd(Interpreter *, Object **, Object **); diff --git a/femto.sht b/femto.sht index 001fcd9..cd20e71 100644 --- a/femto.sht +++ b/femto.sht @@ -13,9 +13,7 @@ $(cat lisp/core.lsp) ;; Batch mode processing and Femto editor startup -(setq - ~ (os.getenv "HOME") - env-batch-mode (os.getenv "FEMTO_BATCH")) +(setq env-batch-mode (getenv "FEMTO_BATCH")) (cond ((eq "0" env-batch-mode) (require 'startup)) diff --git a/file.c b/file.c index 47dccbb..b475f45 100644 --- a/file.c +++ b/file.c @@ -1,48 +1,498 @@ -#ifndef FILE_C -#define FILE_C +#include +#include +#include +#include +#include +#include -/** file_fflush - flush output stream - * - * @param interp fLisp interpreter - * @param stream open output stream +#include "lisp.h" +#include "file.h" + +Object *permission_denied = (Object *) (&(Symbol) { NULL, .string = "permission-denied" }); +Object *not_found = &(Object) { NULL, .string = "not-found" }; +Object *file_exists = &(Object) { NULL, .string = "file-exists" }; +Object *read_only = &(Object) { NULL, .string = "read-only" }; + +Constant flisp_file_constants[] = { + { &permission_denied, &permission_denied }, + { ¬_found, ¬_found }, + { &file_exists, &file_exists }, + { &read_only, &read_only }, + { NULL, NULL } +}; + +/** (fflush[ stream]) - flush stream, output or all streams * - * returns: 0 on success, erno otherwise + * @param stream Stream to flush. If t all streams are flushed, if + * not given the interpreter output is flushed. * - * Public C Interface + * @returns t + * @throws io-error */ -int file_fflush(Interpreter *interp, Object *stream) -{ - return (fflush(stream->fd) == EOF) ? errno : 0; -} Object *primitiveFflush(Interpreter *interp, Object** args, Object **env) { - if (FLISP_ARG_ONE->fd == NULL) - exception(interp, invalid_value, "(fflush stream) - stream already closed"); - return newInteger(interp, file_fflush(interp, FLISP_ARG_ONE)); -} + FILE *fd = interp->output; + + if (FLISP_HAS_ARGS) + if (FLISP_ARG_ONE == t) + fd = NULL; + else { + CHECK_TYPE(FLISP_ARG_ONE, type_stream, "(fflush[ stream]) - stream"); + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(fflush[ stream]) - stream already closed"); + fd = FLISP_ARG_ONE->fd; + } + else if (fd == NULL) + exception(interp, invalid_value, "(fflush[ stream]) - output stream not set"); -off_t file_ftell(Interpreter *interp, Object *stream) + if (fflush(fd) == EOF) + exception(interp, io_error, "(fflush[ stream]) - fflush() failed: %s", strerror(errno)); + + return t; +} +/** (fseek stream offset[ relativep]) - seek position in stream or input + * + * @param stream stream object, if nil interpreter input stream. + * @param offset offset from start if positive, from end if + * negative. + * @param relativep if given and not nil seek from current position. + */ +Object *primitiveFseek(Interpreter *interp, Object** args, Object **env) { - return ftello(stream->fd); + int result, whence = SEEK_SET; + FILE *fd = interp->input.fd; + off_t pos; + + if (FLISP_ARG_ONE == nil) { + if (fd == NULL) + exception(interp, invalid_value, "(fseek stream offset[ relativep]) - input stream not set"); + } else { + CHECK_TYPE(FLISP_ARG_ONE, type_stream, "(fseek stream offset) - stream"); + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(fseek stream) - stream already closed"); + fd = FLISP_ARG_ONE->fd; + } + CHECK_TYPE(FLISP_ARG_TWO, type_integer, "(fseek stream offset) - offset"); + + if (FLISP_HAS_ARG_THREE && FLISP_ARG_THREE != nil) + whence = SEEK_CUR; + else if (FLISP_ARG_TWO->integer < 0) + whence = SEEK_END; + result = fseeko(fd, FLISP_ARG_TWO->integer, whence); + if (result == -1) + exception(interp, io_error, "(fseek stream offset) - fseeko() failed: %s", strerror(errno)); + + if ((pos = ftello(fd)) == -1) + exception(interp, io_error, "(fseek stream offset) - ftello() failed: %s", strerror(errno)); + + return newInteger(interp, pos); } +/** (ftell[ stream]) - return current position in stream or input + * + * @param stream stream. If not given the input stream is used. + * + * @returns current position in stream. + * + * @throws + * - invalid-value if stream is already closed. + * - io-error if ftello fails. + */ Object *primitiveFtell(Interpreter *interp, Object** args, Object **env) { - if (FLISP_ARG_ONE->fd == NULL) - exception(interp, invalid_value, "(ftell stream) - stream already closed"); - return newInteger(interp, file_ftell(interp, FLISP_ARG_ONE)); + FILE *fd = interp->input.fd; + off_t pos; + + if (FLISP_HAS_ARGS) { + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(ftell[ stream]) - stream already closed"); + fd = FLISP_ARG_ONE->fd; + } else if (fd == NULL) + exception(interp, invalid_value, "(ftell[ stream]) - input stream not set"); + if ((pos = ftello(fd)) == -1) + exception(interp, io_error, "(ftell[ stream]) - ftello() failed: %s", strerror(errno)); + + return newInteger(interp, pos); } +/** (feof[ stream]) - return end-of-file status of stream or input + * + * @param stream stream. If not given the input stream is used. + * + * @returns nil or end-of-file + */ +Object *primitiveFeof(Interpreter *interp, Object** args, Object **env) +{ + FILE *fd = interp->input.fd; + + if (FLISP_HAS_ARGS) { + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(feof[ stream]) - stream already closed"); + fd = FLISP_ARG_ONE->fd; + } else if (fd == NULL) + exception(interp, invalid_value, "(feof[ stream]) - input stream not set"); + return (feof(fd)) ? end_of_file : nil; +} +/** (fgetc[ stream]) - read one character from stream or input + * + * @param stream stream to read input from, if not given read from + * interpreter input stream. + */ Object *primitiveFgetc(Interpreter *interp, Object** args, Object **env) { char s[] = "\0\0"; + int c; + FILE *fd = interp->input.fd; - int c = getc(FLISP_ARG_ONE->fd); + if (FLISP_HAS_ARGS) { + CHECK_TYPE(FLISP_ARG_ONE, type_stream, "(fgetc[ stream] - stream)"); + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(fgetc[ stream]) - stream already closed"); + fd = FLISP_ARG_ONE->fd; + } else if (fd == NULL) + exception(interp, invalid_value, "(fgetc[ stream]) - input stream not set"); + + c = streamGetc(interp, fd); if (c == EOF) - return nil; + return end_of_file; s[0] = (char)c; return newString(interp, s); } +/** (fungetc i[ stream]) - ungetc integer i as char to stream or input + * + * @param i integer converted to unsigned char + * @param stream stream, if not given the interpreter input stream + * + * Caution: ungetc'ing the interpreter input stream will likely cause + * undesired results like memory exhaustion. + * + * @returns i + * @throws: + * - invalid-value If stream is closed or interpreter input stream is + * not set. + * - io-error When ungetc() fails. + */ +/* Note: not yet sure if (fungetc i) is a) a good idea, b) any way + * secure. + */ +Object *primitiveFungetc(Interpreter *interp, Object** args, Object **env) +{ + int c; + FILE *fd = interp->input.fd; + + CHECK_TYPE(FLISP_ARG_ONE, type_integer, "(fungetc char[ stream] - char)"); + if (FLISP_HAS_ARG_TWO) { + CHECK_TYPE(FLISP_ARG_TWO, type_stream, "(fungetc char[ stream] - stream)"); + if (FLISP_ARG_TWO->fd == NULL) + exception(interp, invalid_value, "(fungetc char [ stream]) - stream already closed"); + fd = FLISP_ARG_TWO->fd; + } else if (fd == NULL) + exception(interp, invalid_value, "(fungetc char [ stream]) - input stream not set"); + + c = ungetc((int)(FLISP_ARG_ONE->integer), fd); + if (c == EOF) + exception(interp, io_error, "(fungetc char [ stream]) - ungetc() failed"); + + return newInteger(interp, FLISP_ARG_ONE->integer); +} +/** (fgets[ stream]) - read a line or up to INPUT_FMT_BUFSIZ from stream or input + * + * @param stream stream to read from. If not give use the input stream. + * + * @returns The string read from stream or end-of-file if no input is + * available. If a line is read it includes the trailing \n. + * + * @throws + * - invalid-value If stream is already closed. + * - out-of-memory If the input buffer cannot be allocated. + * - io-error If fgets() failed. + */ +Object *primitiveFgets(Interpreter *interp, Object** args, Object **env) +{ + Object *string = nil; + char *input; + FILE *fd = interp->input.fd; + + if (FLISP_HAS_ARGS) { + CHECK_TYPE(FLISP_ARG_ONE, type_stream, "(fgets[ stream] - stream)"); + if (FLISP_ARG_ONE->fd == NULL) + exception(interp, invalid_value, "(fgets[ stream]) - stream already closed"); + fd = FLISP_ARG_ONE->fd; + } + input = malloc(INPUT_FMT_BUFSIZ); + if(input == NULL) + exception(interp, out_of_memory, "fgets() failed, %s", strerror(errno)); + + *input = '\0'; + + if(fgets(input, INPUT_FMT_BUFSIZ, fd) != NULL) { + string = newString(interp, input); + free(input); + return string; + } + free(input); + if (!feof(fd)) + exceptionWithObject(interp, FLISP_ARG_ONE, io_error, "fgets() failed: %s", strerror(errno)); + return end_of_file; +} +/** (fstat path[ linkp]) - get information about file + * + * @param path String containing the path to the file to query. + * @param linkp If given and not null do not follow the symbolic link + * if path is one, return the link information instead. + * + * @returns A property list with size, mode uid and gid as integer, type as character: + * - b block device + * - c character device + * - d directory + * - p fifo + * - f regular file + * - l symbolic link + * - s socket + * - - unkown file type + * + * @trhows + * - permission-denied + * - not-found + * - invalid-value if path is to long. + * - io-error + */ +Object *primitiveFstat(Interpreter *interp, Object** args, Object **env) +{ + struct stat info; + int result; + Object *object; + char *type; + + CHECK_TYPE(FLISP_ARG_ONE, type_string, "(fstat path[ linkp]) - stream"); + + if (FLISP_HAS_ARG_TWO && FLISP_ARG_TWO != nil) + result = lstat(FLISP_ARG_ONE->string, &info); + else + result = stat(FLISP_ARG_ONE->string, &info); + + if (result == -1) { + switch(errno) { + case EACCES: + exceptionWithObject(interp, FLISP_ARG_ONE, permission_denied, "(fstat path[ linkp]): %s", strerror(errno)); + break; + case ENOENT: + case ENOTDIR: + exceptionWithObject(interp, FLISP_ARG_ONE, not_found, "(fstat path[ linkp]): %s", strerror(errno)); + break; + case ENAMETOOLONG: + exceptionWithObject(interp, FLISP_ARG_ONE, invalid_value, "(fstat path[ linkp]): %s", strerror(errno)); + } + exceptionWithObject(interp, FLISP_ARG_ONE, io_error, "(fstat path[ linkp]): l/stat() failed: %s", strerror(errno)); + } + + /* (size _size_ type _type_ mode _mode_ uid _uid_ gid _gid_ ) */ + GC_CHECKPOINT; + if (S_ISBLK(info.st_mode)) type = "b"; + else if (S_ISCHR(info.st_mode)) type = "c"; + else if (S_ISDIR(info.st_mode)) type = "d"; + else if (S_ISFIFO(info.st_mode)) type = "p"; + else if (S_ISREG(info.st_mode)) type = "f"; + else if (S_ISLNK(info.st_mode)) type = "l"; + else if (S_ISSOCK(info.st_mode)) type = "s"; +#if 0 + /* This works with muslc, but not gnu libc */ + else if (S_TYPEISMQ(info)) type = "Q"; + else if (S_TYPEISSEM(info)) type = "S"; + else if (S_TYPEISSHM(info)) type = "M"; + else if (S_TYPEISTMO(info)) type = "T"; #endif + else type = "-"; + + object = newString(interp, type); + GC_TRACE(gcObject, object); + object = newCons(interp, gcObject, &nil); + GC_TRACE(gcResult, object); + + *gcObject = newSymbol(interp, "type"); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newInteger(interp, info.st_gid); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newSymbol(interp, "gid"); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newInteger(interp, info.st_uid); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newSymbol(interp, "uid"); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newInteger(interp, info.st_mode & 07777); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newSymbol(interp, "mode"); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newInteger(interp, info.st_size); + *gcResult = newCons(interp, gcObject, gcResult); + + *gcObject = newSymbol(interp, "size"); + *gcResult = newCons(interp, gcObject, gcResult); + + GC_RETURN(*gcResult); +} +/** (fttyp[ fd]) - check if input or stream has a tty + * + * @param fd stream + * + * @returns t if fd is associated with a tty. + * + */ +Object *primitiveFttyP(Interpreter *interp, Object** args, Object **env) +{ + FILE* fd = interp->input.fd; + if (FLISP_HAS_ARGS) + fd = FLISP_ARG_ONE->fd; + return (isatty(fileno(fd))) ? t : nil; +} +/** (fmkdir path[ mode]) - create directory + * + * @param path String, directory to create. + * @param mode Integer, mode for creating the directory, 0775 if not given. + * + * @returns t on success + * + * @throws + * - invalid-value If path is too long, a component of path is not an + * existing directory or path is the empty string. + * - permission-denied If search or write permission is denied. + * - file-exists If the directory already exists. + * - io-error + * + */ +Object *primitiveMkdir(Interpreter *interp, Object** args, Object **env) +{ + mode_t mode = S_IRWXU | S_IRWXG | S_IROTH | S_IXOTH; + CHECK_TYPE(FLISP_ARG_ONE, type_string, "(fmkdir path[ mode) - path"); + if (FLISP_HAS_ARG_TWO) { + CHECK_TYPE(FLISP_ARG_TWO, type_integer, "(fmkdir path[ mode) - mode"); + mode = FLISP_ARG_TWO->integer; + } + if (mkdir(FLISP_ARG_ONE->string, mode) == -1) { + switch(errno) { + case EACCES: + case EROFS: + exceptionWithObject(interp, FLISP_ARG_ONE, permission_denied, + "(fmkdir path[ mode]): %s", strerror(errno)); + case EEXIST: + exceptionWithObject(interp, FLISP_ARG_ONE, file_exists, + "(fmkdir path[ mode]): %s", strerror(errno)); + case ENAMETOOLONG: + case ENOENT: + case ENOTDIR: + exceptionWithObject(interp, FLISP_ARG_ONE, invalid_value, + "(fmkdir path[ mode]): %s", strerror(errno)); + } + exceptionWithObject(interp, FLISP_ARG_ONE, io_error, + "(fmkdir path[ mode]): %s", strerror(errno)); + } + return t; +} +/** (popen line[ mode]) - run command line and read from/write to it + * + * @param line String containing a command line to be run by the + * system shell. + * @param mode "r" for reading from the standard output of the + * command. "w" for writing to the standard input of the + * command. If not given defaults to "r". + * + * @returns A stream object to read from/write to. + * + * @trows + * - invalid-value if mode is not "r" or "w". + * - io-error + * + * Note: the stream must be closed with (pclose), it is an error to + * use (fclose) on (popen) streams. + */ +Object *primitivePopen(Interpreter *interp, Object** args, Object **env) +{ + FILE *fd; + char *mode = "r"; + + if(FLISP_HAS_ARG_TWO) { + if (strcmp(FLISP_ARG_TWO->string, "r") && strcmp(FLISP_ARG_TWO->string, "w")) + exception(interp, invalid_value, + "(popen path[ mode]) - mode must be \"r\" or \"w\", got: %s", + FLISP_ARG_TWO->string); + mode = FLISP_ARG_TWO->string; + } + + fd = popen(FLISP_ARG_ONE->string, mode); + if (fd == NULL) + exception(interp, io_error, "(popen path[ mode]) - popen() failed: %s", strerror(errno)); + + return newStreamObject(interp, fd, FLISP_ARG_ONE->string); +} +/** (pclose stream) - close a stream opened with popen + * + * @param stream Stream to close. Must be a stream opened with + * (popen). + * + * @returns The exit status of the command. + * + * @throws io-error if pclose() failed. + */ +Object *primitivePclose(Interpreter *interp, Object** args, Object **env) +{ + int result = pclose(FLISP_ARG_ONE->fd); + + if (result == -1) + exceptionWithObject(interp, FLISP_ARG_ONE, io_error, "pclose() failed: %s", strerror(errno)); + + return newInteger(interp, result); +} + +/* OS interface */ + +/** (system s) ⇒ i: run a command line in the system shell + * + * @param s .. Command line + * + * @returns The exit code of the shell. + */ +Object *fl_system(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, system(FLISP_ARG_ONE->string)); +} + +/** (getenv name) ⇒ value: get value of environment variable + * + * @param name .. Name of environment variable + * + * @returns *value* of environment variable *name* as string or `nil` + * if *name* does not exit. + */ +Object *fl_getenv(Interpreter *interp, Object **args, Object **env) +{ + char *e = getenv(FLISP_ARG_ONE->string); + if (e == NULL) return nil; + return newStringWithLength(interp, e, strlen(e)); +} + + +Primitive flisp_file_primitives[] = { + {"fflush", 0, 1, 0, primitiveFflush}, + {"fseek", 2, 3, 0, primitiveFseek}, + {"ftell", 0, 1, TYPE_STREAM, primitiveFtell}, + {"feof", 0, 1, TYPE_STREAM, primitiveFeof}, + {"fgetc", 0, 1, 0, primitiveFgetc}, + {"fungetc", 1, 2, 0, primitiveFungetc}, + {"fgets", 0, 1, 0, primitiveFgets}, + {"fstat", 1, 2, 0, primitiveFstat}, + {"fttyp", 0, 1, TYPE_STREAM, primitiveFttyP}, + {"fmkdir", 1, 2, 0, primitiveMkdir}, + {"popen", 1, 2, TYPE_STRING, primitivePopen}, + {"pclose", 1, 1, TYPE_STREAM, primitivePclose}, + {"system", 1, 1, TYPE_STRING, fl_system}, + {"getenv", 1, 1, TYPE_STRING, fl_getenv}, +}; /* diff --git a/file.h b/file.h new file mode 100644 index 0000000..09dfe41 --- /dev/null +++ b/file.h @@ -0,0 +1,20 @@ +#ifndef FILE_H +#define FILE_H + +#include "lisp.h" + +extern Primitive flisp_file_primitives[]; + +extern Object *permission_denied; +extern Object *not_found; + +extern Constant flisp_file_constants[]; + +#endif +/* + * Local Variables: + * c-file-style: "k&r" + * c-basic-offset: 4 + * indent-tabs-mode: nil + * End: + */ diff --git a/flisp.c b/flisp.c index 96ccdf7..e59a830 100644 --- a/flisp.c +++ b/flisp.c @@ -3,123 +3,46 @@ */ #include -#include -#include -#include -#include #include "lisp.h" -// Specify in kByte. -#define FLISP_MEMORY_SIZE 400 -// less then this is too small for femto.lsp - - -#define CPP_XSTR(s) CPP_STR(s) -#define CPP_STR(s) #s - -int exit_code = 0; - -// Note: wouldn't need, if we could implement the repl in fLisp -#define INPUT_BUFSIZE 4095 -char input[INPUT_BUFSIZE+1]; // Note: termios paste limit or so - void fatal(char *msg) { - fprintf(stderr, "\n%s %s:\n%s\n", FL_NAME, FL_VERSION, msg); + fputs("\n" FL_NAME " " FL_VERSION ": ", stderr); + fputs(msg, stderr); + fputc('\n', stderr); exit(1); } -// Note: we'd like to implement the repl() in fLisp itself, for this we'd need: -// - isatty() -// - exception handling in fLisp -// - file output for error messages -void repl(Interpreter *interp) -{ - size_t i; - - puts(FL_NAME " " FL_VERSION); - puts("exit with Ctrl+D"); - while (true) { - printf("> "); - fflush(stdout); - - if (!fgets(input, sizeof(input), stdin)) break; - i=strlen(input); - //if (!i) continue; - if (input[i-1] == '\n') - input[i-1] = '\0'; - else { - fprintf(stderr, "error: more then " CPP_STR(INPUT_BUFSIZ) "read, skipping...\n"); - fflush(stderr); - continue; - } - - lisp_eval3(interp, input); - if (interp->object->car != nil) - lisp_write_error2(interp, stderr); - } - if (interp->object->car != nil) { - lisp_write_error2(interp, stderr); - exit_code = 1; - } - return; -} - int main(int argc, char **argv) { - char *library_path, *init_file, *debug_file; - FILE *fd = NULL; + char *library_path, *rcfile, *debug_file; + FILE *debug_fd = NULL, *input_fd = stdin; Interpreter *interp; - if ((init_file = getenv("FLISPRC")) == NULL) - init_file = FL_LIBDIR "/" FL_INITFILE; + if ((rcfile = getenv("FLISPRC")) == NULL) + rcfile = FL_LIBDIR "/" FL_RCFILE; + + if (*rcfile != '\0') + if (!(input_fd = fopen(rcfile, "r"))) + fatal("failed to open rcfile"); + + if ((debug_file=getenv("FLISP_DEBUG")) != NULL) + if ((debug_fd = fopen(debug_file, "w")) == NULL) + fatal("failed to open debug file"); if ((library_path=getenv("FLISPLIB")) == NULL) library_path = FL_LIBDIR; - debug_file=getenv("FLISP_DEBUG"); - if (debug_file != NULL) { - if (!(fd = fopen(debug_file, "w"))) - fprintf(stderr, "failed to open debug file %s for writing: %d\n", debug_file, errno); - } - - interp = lisp_new(FLISP_MEMORY_SIZE*1024, argv, library_path, stdin, stdout, fd); + interp = lisp_new(argv, library_path, input_fd, stdout, debug_fd); if (interp == NULL) fatal("fLisp interpreter initialization failed"); - if (strlen(init_file)) { - if (!(fd = fopen(init_file, "r"))) - fprintf(stderr, "failed to open inifile %s: %d\n", init_file, errno); - else { - // load inifile - interp->input = fd; - lisp_eval3(interp, NULL); - if (interp->object->car != nil) { - lisp_write_error2(interp, stderr); - fprintf(stderr, "failed to load inifile %s: %s\n", init_file, interp->msg_buf); - // Note: if we could implement the repl in fLisp itself we'd bail out here. - } - if (fclose(fd)) - // Note: the error object can be printed with lisp_write_object - fprintf(stderr, "failed to close inifile %s %s\n", init_file, interp->msg_buf); - } - } - // Start repl - //Note: could be omitted if we could implement the repl in fLisp itself. - if (isatty(0)) { - repl(interp); - } else { - - // Just eval the standard input - interp->input = stdin; - lisp_eval3(interp, NULL); - if (interp->object->car != nil) { - lisp_write_error2(interp, stderr); - exit_code = 1; - } + lisp_eval(interp, NULL); + if (FLISP_RESULT_CODE(interp) != nil) { + lisp_write_error(interp, stderr); + return 1; } - lisp_destroy(interp); - return exit_code; + return 0; } /* diff --git a/flisp.sht b/flisp.sht index 8ac0ead..6f30278 100644 --- a/flisp.sht +++ b/flisp.sht @@ -1,14 +1,9 @@ ;; -*-Lisp-*- ;; -;; flisp startup file +;; fLisp startup file $(cat lisp/core.lsp) -;; flisp initialzation -(setq - ~ (os.getenv "HOME") - config_file (concat ~ "/" ".config/flisp/flisp.rc")) - (defun getopts (opts pos) (setq o (car opts)) (cond @@ -17,8 +12,29 @@ $(cat lisp/core.lsp) (load o) (getopts (cdr opts) 0)))) -(require 'flisp) -(require 'stdlib) +(defun prompt s + (cond ((fttyp) (princ (concat "\n" s)))) ) + +(defun repl (r) + (prompt "> ") + (let ((result (catch (eval (read))))) + (cond ((same (car result) end-of-file) (prompt) r) + ((car result) + (prompt "error: "(car result)": '"(caddr result)"' - "(cadr result)) + (repl result) ) + (t + (prompt (caddr result)) + (repl result)) ))) + +(catch (load (concat (getenv "HOME") "/" ".config/flisp/flisp.rc"))) + +(let ((result (catch (getopts argv 0)))) + (cond ((car result) (princ "could not load rc file\n")))) -;; if not found we get not past this but rather err out: (load config_file) -(getopts argv 0) +(progn + (interp 'input (open "<0")) + (prompt (interp 'version)) + (prompt "exit with C-d") + (let ((result (repl nil))) + (cond ((car result) (apply throw result)) + (t (caddr result))) )) diff --git a/header.h b/header.h index 0ab868e..75bc512 100644 --- a/header.h +++ b/header.h @@ -505,22 +505,11 @@ extern window_t* new_window(void); extern window_t *popup_window(char *); extern window_t *split_current_window(void); -/* fLisp interpreter used for femto */ -//#define FLISP_MEMORY_SIZE 131072UL // 128k -//#define FLISP_MEMORY_SIZE 262144UL // 256k -//#define FLISP_MEMORY_SIZE 524288UL // 512k -//#define FLISP_MEMORY_SIZE 1048576UL // 1M -//#define FLISP_MEMORY_SIZE 1572864UL // 1.5M -//#define FLISP_MEMORY_SIZE 2097152UL // 2M -//#define FLISP_MEMORY_SIZE 4194304UL // 4M -//#define FLISP_MEMORY_SIZE 6291456UL // 6M -//#define FLISP_MEMORY_SIZE 8388608UL // 8M -#define FLISP_MEMORY_SIZE 16777216UL // 16M -//#define FLISP_MEMORY_SIZE 33554432UL // 32M - extern char *eval_string(bool, char *, ...); extern void free_lisp_output(void); +#define FLISP_INITIAL_MEMORY 5242886UL /* 256k Lisp object space, no gc on startup */ + /* * Local Variables: * c-file-style: "k&r" diff --git a/lisp.c b/lisp.c index 11a0539..f2491ca 100644 --- a/lisp.c +++ b/lisp.c @@ -26,6 +26,20 @@ #include "double.h" #endif +#ifdef FLISP_FILE_EXTENSION +#include "file.h" +#endif + +#define EXCEPTION_MEM_RESERVE 4*sizeof(Object) +//Note: debugging //#define EXCEPTION_MEM_RESERVE 8*sizeof(Object) + +/* No user servicable parts inside */ + +#ifndef FLISP_INITIAL_MEMORY +#define FLISP_INITIAL_MEMORY 0 +#endif + + #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) #define MAP_ANONYMOUS MAP_ANON #endif @@ -33,40 +47,38 @@ #define CPP_XSTR(s) CPP_STR(s) #define CPP_STR(s) #s +#define COUNTFMT long unsigned int /* Constants */ /* Fundamentals */ -Object *nil = &(Object) { NULL, .string = "nil" }; -Object *t = &(Object) { NULL, .string = "t" }; +Object *nil = &(Object) { NULL, .string = "nil" }; +Object *t = &(Object) { NULL, .string = "t" }; /* Types */ -Object *type_integer = &(Object) { NULL, .string = "type-integer" }; -Object *type_string = &(Object) { NULL, .string = "type-string" }; -Object *type_symbol = &(Object) { NULL, .string = "type-symbol" }; -Object *type_cons = &(Object) { NULL, .string = "type-cons" }; -Object *type_lambda = &(Object) { NULL, .string = "type-lambda" }; -Object *type_macro = &(Object) { NULL, .string = "type-macro" }; -Object *type_primitive = &(Object) { NULL, .string = "type-primitive" }; -Object *type_stream = &(Object) { NULL, .string = "type-stream" }; +Object *type_integer = &(Object) { NULL, .string = "type-integer" }; +Object *type_string = &(Object) { NULL, .string = "type-string" }; +Object *type_symbol = &(Object) { NULL, .string = "type-symbol" }; +Object *type_cons = &(Object) { NULL, .string = "type-cons" }; +Object *type_lambda = &(Object) { NULL, .string = "type-lambda" }; +Object *type_macro = &(Object) { NULL, .string = "type-macro" }; +Object *type_primitive = (Object *) (&(Symbol) { NULL, .string = "type-primitive" }); +Object *type_stream = &(Object) { NULL, .string = "type-stream" }; /* Exceptions */ -Object *end_of_file = &(Object) { NULL, .string = "end-of-file" }; -Object *read_incomplete = &(Object) { NULL, .string = "read-incomplete" }; -Object *invalid_read_syntax = &(Object) { NULL, .string = "invalid-read-syntax" }; -Object *range_error = &(Object) { NULL, .string = "range-error" }; -Object *wrong_type_argument = &(Object) { NULL, .string = "wrong-type-argument" }; -Object *invalid_value = &(Object) { NULL, .string = "invalid-value" }; -Object *wrong_num_of_arguments = &(Object) { NULL, .string = "wrong-num-of-arguments" }; /* 'number' is two characters to long */ -Object *arith_error = &(Object) { NULL, .string = "arith-error"}; -Object *io_error = &(Object) { NULL, .string = "io-error" }; -Object *out_of_memory = &(Object) { NULL, .string = "out-of-memory" }; -Object *gc_error = &(Object) { NULL, .string = "gc-error" }; +Object *end_of_file = &(Object) { NULL, .string = "end-of-file" }; +Object *read_incomplete = (Object *) (&(Symbol) { NULL, .string = "read-incomplete" }); +Object *invalid_read_syntax = (Object *) (&(Symbol) { NULL, .string = "invalid-read-syntax" }); +Object *range_error = &(Object) { NULL, .string = "range-error" }; +Object *wrong_type_argument = (Object *) (&(Symbol) { NULL, .string = "wrong-type-argument" }); +Object *invalid_value = (Object *) (&(Symbol) { NULL, .string = "invalid-value" }); +Object *wrong_number_of_arguments = (Object *) (&(Symbol) { NULL, .string = "wrong-number-of-arguments" }); +Object *arith_error = &(Object) { NULL, .string = "arith-error"}; +Object *io_error = &(Object) { NULL, .string = "io-error" }; +Object *out_of_memory = (Object *) (&(Symbol) { NULL, .string = "out-of-memory" }); +Object *gc_error = &(Object) { NULL, .string = "gc-error" }; /* Internal */ -Object *type_env = &(Object) { NULL, .string = "type-env" }; -Object *type_moved = &(Object) { NULL, .string = "type-moved" }; -Object *empty = &(Object) { NULL, .string = "\0" }; -Object *one = &(Object) { NULL, .integer = 1 }; -Object *okObject = &(Object) { NULL }; -Object *okMessage = &(Object) { NULL }; -Object *ok = &(Object) { NULL }; +Object *type_env = &(Object) { NULL, .string = "type-env" }; +Object *type_moved = &(Object) { NULL, .string = "type-moved" }; +Object *empty = &(Object) { NULL, .string = "\0" }; +Object *one = &(Object) { NULL, .integer = 1 }; Constant flisp_constants[] = { /* Fundamentals */ @@ -91,7 +103,7 @@ Constant flisp_constants[] = { { &range_error, &range_error }, { &wrong_type_argument, &wrong_type_argument }, { &invalid_value, &invalid_value }, - { &wrong_num_of_arguments, &wrong_num_of_arguments }, + { &wrong_number_of_arguments, &wrong_number_of_arguments }, { &arith_error, &arith_error }, { &io_error, &io_error }, { &out_of_memory, &out_of_memory }, @@ -122,18 +134,18 @@ Object **flisp_object_type[] = { }; -typedef enum ResultCode { - FLISP_OK, - FLISP_ERROR, - FLISP_RETURN, /* successful return */ -} ResultCode; - bool gc_always = false; /* List of interpreters */ Interpreter *lisp_interpreters = NULL; +void fl_fatal(char *message, int code) +{ + fputs(message, stderr); + exit(code); +} + // DEBUG LOG /////////////////////////////////////////////////////////////////// #ifdef __GNUC__ @@ -157,10 +169,10 @@ void fl_debug(Interpreter *interp, char *format, ...) va_start(args, format); if (vfprintf(interp->debug, format, args) < 0) { va_end(args); - (void)fprintf(interp->debug, "fatal: failed to print debug message: %d, %s", errno, format); + (void)fprintf(interp->debug, + "fatal: failed to print debug message %s: %s", format, strerror(errno)); } va_end(args); - (void)fputc('\n', interp->debug); (void)fflush(interp->debug); } @@ -169,60 +181,48 @@ void fl_debug(Interpreter *interp, char *format, ...) void resetBuf(Interpreter *); -/** exceptionWithObject - break out of errors +/** setInterpreterResult() - set the interpreter catch object * - * @param interp interpreter in which the error occured. + * @param interp interpreter in which to set the catch object. * @param object object on which an error occured, set to nil if none. - * @param result result symbol corresponding to error type. + * @param error error type symbol * @param format ... printf style human readable error message * - * *object* and *result* are stored in the interpreter structure. - * The return code for longjmp is FLISP_ERROR + * *object* and *error* are stored in the interpreter structure. + * + * The error message specified with *format* and it's va_args is + * formatted into the message object of the interpreter. If it is + * longer then WRITE_FMT_BUFSIZ - by default 2048 characters - it is + * truncated and the last three characters are overwritten with "..." * - * The error message is formatted into the message buffer of the interpreter. If it has to - * be truncated the last three characters are overwritten with "..." + * If format is NULL, the message is set to the empty string. */ #ifdef __GNUC__ -void exceptionWithObject(Interpreter *, Object *object, Object *result, char *format, ...) - __attribute__ ((noreturn, format(printf, 4, 5))); +void setInterpreterResult(Interpreter *, Object *, Object *, char *, ...) + __attribute__ ((format(printf, 4, 5))); #endif -void exceptionWithObject(Interpreter *interp, Object *object, Object *result, char *format, ...) +void setInterpreterResult(Interpreter *interp, Object *object, Object *error, char *format, ...) { size_t written; - interp->object = object; - interp->result = result; - resetBuf(interp); + interp->result = object; + interp->error = error; - size_t len = sizeof(interp->msg_buf); + if (format == NULL) { + interp->message.string[0] = '\0'; + return; + } + size_t len = sizeof(interp->message.string); va_list(args); va_start(args, format); - written = vsnprintf(interp->msg_buf, len, format, args); + written = vsnprintf(interp->message.string, len, format, args); va_end(args); if (written > len) - strcpy(interp->msg_buf+len-4, "..."); + strcpy(interp->message.string+len-4, "..."); else if (written < 0) - strncpy(interp->msg_buf, "failed to format error message", len); - - assert(interp->catch != NULL); - longjmp(*interp->catch, FLISP_ERROR); + strncpy(interp->message.string, "failed to format error message", len); } -/** exception - break out of errors - * - * @param interp interpreter in which the error occurred. - * @param result result symbol corresponding to error type. - * - * *result* is stored in the interpreter structures result field, nil in the object field - * The longjmp return code is FLISP_ERROR. - * - * - * The error message is formatted into the message buffer of the interpreter. If it has to - * be truncated the last three characters are overwritten with "..." - */ -// #define exception(interp, result, ...) exceptionWithObject(interp, nil, result, __VA_ARGS__) - - // GARBAGE COLLECTION ///////////////////////////////////////////////////////// /* This implements Cheney's copying garbage collector, with which memory is @@ -298,7 +298,7 @@ bool gcCollectableObject(Interpreter *interp, Object *object) { typedef struct gcStats { size_t moved, constant, skipped; } gcStats; Object *gcMoveObject(Interpreter *interp, Object *object, gcStats *stats) { - // skip object if it is not within from-space (i.e. on the stack) + /* Skip object if it is not within from-space, i.e. on the stack or a constant */ if (!gcCollectableObject(interp, object)) { stats->constant++; return object; @@ -316,10 +316,12 @@ Object *gcMoveObject(Interpreter *interp, Object *object, gcStats *stats) #if DEBUG_GC if (object->type == type_stream) - fl_debug(interp, "moved stream %p, path %p/%s %s to %p", - (void *)object, (void *)object->path, object->path->string, object->path->type->string, (void *)forward); + fl_debug(interp, "moved stream %p, path %p/%s %s to %p\n", + (void *)object, (void *)object->path, object->path->string, + object->path->type->string, (void *)forward + ); if (object->type == type_symbol) - fl_debug(interp, "moved symbol %s", object->string); + fl_debug(interp, "moved symbol %s\n", object->string); #endif // mark object as moved and set forwarding pointer object->type = type_moved; @@ -337,22 +339,35 @@ void gc(Interpreter *interp) Object *object; gcStats stats = {0}; - fl_debug(interp, "collecting garbage, memory: %lu/%lu", interp->memory->fromOffset, interp->memory->capacity); - + fl_debug(interp, "collecting garbage, memory: %lu/%lu, free %lu\n", + (COUNTFMT) interp->memory->fromOffset, (COUNTFMT) interp->memory->capacity, + (COUNTFMT) interp->memory->capacity - interp->memory->fromOffset - EXCEPTION_MEM_RESERVE + ); interp->memory->toOffset = 0; - // move trace, symbols and root objects + // move trace, symbols, root and interp result objects for (object = interp->gcTop; object != nil; object = object->cdr) { -#if DEBUG_GC - fl_debug(interp, "moving gc traced object %p of type %s", (void *)object->car, object->car->type->string); +#if DEBUG_GC | FLISP_TRACK_GCTOP + fl_debug(interp, "moving gc traced object %p of type %s\n", + (void *)object->car, object->car->type->string + ); +#if FLISP_TRACK_GCTOP + lisp_write_object(interp, interp->debug, object->car, true); + fl_debug(interp, "\n"); +#endif #endif object->car = gcMoveObject(interp, object->car, &stats); } #if DEBUG_GC - fl_debug(interp, "gc traced objects: %lu, skipped %lu, constant %lu", stats.moved, stats.skipped, stats.constant); + fl_debug(interp, "gc traced objects: %lu, skipped %lu, constant %lu\n", + stats.moved, stats.skipped, stats.constant + ); #endif interp->symbols = gcMoveObject(interp, interp->symbols, &stats); interp->global = gcMoveObject(interp, interp->global, &stats); + interp->result = gcMoveObject(interp, interp->result, &stats); + interp->error = gcMoveObject(interp, interp->error, &stats); + interp->input.path = gcMoveObject(interp, interp->input.path, &stats); // iterate over objects in to-space and move all objects they reference for (object = interp->memory->toSpace; @@ -361,7 +376,9 @@ void gc(Interpreter *interp) if (object->type == type_stream) { #if DEBUG_GC - fl_debug(interp, "moving path %p/%s of stream %p", (void *)object->path, object->path->string, (void *)object); + fl_debug(interp, "moving path %p/%s of stream %p\n", + (void *)object->path, object->path->string, (void *)object + ); #endif object->path = gcMoveObject(interp, object->path, &stats); } else if (object->type == type_cons) { @@ -391,10 +408,14 @@ void gc(Interpreter *interp) interp->memory->fromSpace = interp->memory->toSpace; interp->memory->toSpace = swap; - fl_debug(interp, "collected %lu objects, skipped %lu, constants %lu, saved %lu bytes, memory: %lu/%lu", - stats.moved, stats.skipped, stats.constant, - interp->memory->fromOffset - interp->memory->toOffset, - interp->memory->toOffset, interp->memory->capacity + /* report before overwriting offset difference */ + fl_debug(interp, "collected %lu objects, skipped %lu, constants %lu, saved %lu bytes, " + "memory: %lu/%lu free: %lu(%lu) bytes\n", + (COUNTFMT) stats.moved, (COUNTFMT) stats.skipped, (COUNTFMT) stats.constant, + (COUNTFMT) interp->memory->fromOffset - interp->memory->toOffset, + (COUNTFMT) interp->memory->toOffset, (COUNTFMT) interp->memory->capacity, + (COUNTFMT) interp->memory->capacity - interp->memory->toOffset - EXCEPTION_MEM_RESERVE, + (COUNTFMT) interp->memory->capacity - interp->memory->toOffset ); interp->memory->fromOffset = interp->memory->toOffset; @@ -408,31 +429,77 @@ size_t memoryAlign(size_t size, size_t alignment) return (size + alignment - 1) & ~(alignment - 1); } +/** memoryAllocObject() - Acquire memory for a new Lisp object + * + * Lisp object space is divided intox 'from' space and 'to' space. + * Objects are always allocated in 'from' space. If memory there is + * exhausted, active objects are garbage collected into 'to' space and + * 'to' and 'from' spaces are swapped by gc(). + * + * If gc() does not release sufficient space, 'from' and 'to' space + * are increased by a multiple of FLISP_MEMORY_INC_SIZE. + * + */ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) { size = memoryAlign(size, sizeof(void *)); - // allocate from- and to-space + /* If not done already allocate to space */ if (!interp->memory->fromSpace) { - if (!(interp->memory->fromSpace = mmap(NULL, interp->memory->capacity * 2, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) { - if (!interp->catch) return nil; - exception(interp, out_of_memory, "mmap() failed, %s", strerror(errno)); - } - interp->memory->toSpace = (char *)interp->memory->fromSpace + interp->memory->capacity; + if (!(interp->memory->fromSpace = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0))) + fl_fatal("OOM, allocating from space, exiting\n", 64); } - // run garbage collection if capacity exceeded -#if DEBUG_GC - if (gc_always) + /* Run garbage collection if capacity exceeded */ + if ( + (interp->memory->fromOffset + size + EXCEPTION_MEM_RESERVE >= interp->memory->capacity) +#if DEBUG_GC_ALWAYS + || gc_always +#endif + ) { + fl_debug(interp, "memoryAllocObject: requesting %lu bytes\n", (COUNTFMT) size); + /* If not done already allocate to space */ + if (!interp->memory->toSpace) { + if (!(interp->memory->toSpace = mmap(NULL, interp->memory->capacity, + PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, + -1, 0))) + fl_fatal("OOM allocating to space, exiting\n", 65); + } gc(interp); -#else - if ((interp->memory->fromOffset + size >= interp->memory->capacity)) + } + /* Check if we now have enough space */ + if (interp->memory->fromOffset + size + EXCEPTION_MEM_RESERVE >= interp->memory->capacity) { + int blocks = size / FLISP_MEMORY_INC_SIZE + 1; + size_t memory = blocks * FLISP_MEMORY_INC_SIZE; + fl_debug(interp, "memoryAllocObject: %lu bytes needed, increasing memory by %lu\n", + (COUNTFMT) size, (COUNTFMT) memory + ); + /* Increase to space */ + void *new; + new = mmap(NULL, interp->memory->capacity + FLISP_MEMORY_INC_SIZE, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); + if (new == (void *) -1) { + interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + exception(interp, out_of_memory, "OOM reallocating toSpace: %s", strerror(errno)); + } + if (munmap(interp->memory->toSpace, interp->memory->capacity) == -1) { + interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + exception(interp, out_of_memory, "munmap(toSpace) failed: %s", strerror(errno)); + } + interp->memory->toSpace = new; + interp->memory->capacity += memory; gc(interp); -#endif - if (interp->memory->fromOffset + size >= interp->memory->capacity) { - if (!interp->catch) return nil; - exception(interp, out_of_memory, "out of memory, %lu bytes", (unsigned long)size); + /* Increase former from space */ + //new = mmap(NULL, interp->memory->capacity, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); + //if (new == (void *) -1) { + // interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + // exception(interp, out_of_memory, "OOM reallocating fromSpace: %s", strerror(errno)); + //} + if (munmap(interp->memory->toSpace, interp->memory->capacity - memory) == -1) { + interp->memory->capacity+= EXCEPTION_MEM_RESERVE; + exception(interp, out_of_memory, "munmap(fromSpace) failed: %s", strerror(errno)); + } + interp->memory->toSpace = NULL; } - // allocate object in from-space + /* Allocate object in from-space */ Object *object = (Object *) ((char *)interp->memory->fromSpace + interp->memory->fromOffset); object->type = type; object->size = size; @@ -444,11 +511,26 @@ Object *memoryAllocObject(Interpreter *interp, Object *type, size_t size) // CONSTRUCTING OBJECTS /////////////////////////////////////////////////////// +/** newObject - allocate a new object in the Lisp object store and set + * it's type. + * + * @param interp fLisp Interpreter + * @param type Type object to set in the new Object + * + * @returns New Object + */ Object *newObject(Interpreter *interp, Object *type) { return memoryAllocObject(interp, type, sizeof(Object)); } +/** newObjectFrom - allocate a new object in the Lisp object store by cloning an existing one. + * + * @param interp fLisp Interpreter + * @param from Object to clone. + * + * @returns New Object + */ Object *newObjectFrom(Interpreter *interp, Object ** from) { GC_CHECKPOINT; @@ -459,6 +541,13 @@ Object *newObjectFrom(Interpreter *interp, Object ** from) return object; } +/** newInteger - allocate a new Integer object in the Lisp object store and set it's value + * + * @param interp fLisp Interpreter + * @param number Integer value of the object. + * + * @returns New Object + */ Object *newInteger(Interpreter *interp, int64_t number) { Object *object = newObject(interp, type_integer); @@ -466,15 +555,35 @@ Object *newInteger(Interpreter *interp, int64_t number) return object; } -Object *newObjectWithString(Interpreter *interp, Object *type, size_t size) +/** objectSize() - Calculate expected space to allocate for object with string + * + * @param size length of string to store + * + * @returns Size of an object if string fits into it completely, the needed size otherwise. + */ +size_t objectSize(size_t size) { - size = (size > sizeof(((Object *) NULL)->string)) - ? size - sizeof(((Object *) NULL)->string) - : 0; + return sizeof(Object) + + ((size > sizeof(((Object *) NULL)->string)) ? size - sizeof(((Object *) NULL)->string) : 0); +} - return memoryAllocObject(interp, type, sizeof(Object) + size); +/** newObjectWithString() - allocate a new variable size Object in the Lisp object store + * + * @param interp fLisp Interpreter + * @param type Object type of the new Object + * @param size Number of bytes to allocate + * + * If the size fit's directly into the "standard object" (abount 24 + * bytes) only allocate the object, otherwise allocate the missing bytes. + * + * @returns New Object + */ +Object *newObjectWithString(Interpreter *interp, Object *type, size_t size) +{ + return memoryAllocObject(interp, type, objectSize(size)); } -/** unescapeString - copy a string, converting escaped symbols + +/** unescapeString() - copy a string, converting escaped symbols * * @param dst destination * @param src escaped string to copy @@ -633,10 +742,10 @@ Object *newEnv(Interpreter *interp, Object ** func, Object ** vals) else if (val != nil && val->type != type_cons) exceptionWithObject(interp, val, wrong_type_argument, "(env) is not a list: val %d", nArgs); else if (param == nil && val != nil) - exceptionWithObject(interp, *func, wrong_num_of_arguments, "(env) expects at most %d arguments", nArgs); + exceptionWithObject(interp, *func, wrong_number_of_arguments, "(env) expects at most %d arguments", nArgs); else if (param != nil && val == nil) { for (; param->type == type_cons; param = param->cdr, ++nArgs); - exceptionWithObject(interp, *func, wrong_num_of_arguments, "(env) expects at least %d arguments", nArgs); + exceptionWithObject(interp, *func, wrong_number_of_arguments, "(env) expects at least %d arguments", nArgs); } } @@ -659,7 +768,7 @@ Object *newStreamObject(Interpreter *interp, FILE *fd, char *path) size_t len = strlen(path); if (!(buf = malloc(len+1))) - exception(interp, out_of_memory, "failed to allocate %lu bytes for stream path", len); + exception(interp, out_of_memory, "failed to allocate %lu bytes for stream path", (COUNTFMT) len); memcpy(buf, path, len+1); GC_CHECKPOINT; @@ -783,31 +892,14 @@ int streamGetc(Interpreter *interp, FILE *fd) int c; if ((c = fgetc(fd)) == EOF) if (ferror(fd)) - exception(interp, io_error, "failed to fgetc, errno: %d", errno); - return c; -} -/** streamUngetc - push back the last streamGetc'd to file descriptor - * - * @param interp fLisp interpreter - * @param fd open readable file descriptor - * - * returns: pushed back character or EOF on error - * - * throws: io-error - * - */ -int streamUngetc(Interpreter *interp, FILE *fd, int c) -{ - if ((c = ungetc(c, fd)) == EOF) - exception(interp, io_error, "failed to ungetc, errno: %d", errno); + exception(interp, io_error, "failed to fgetc, errno: %s", strerror(errno)); return c; } - // Begin helpers ////////// int isSymbolChar(int ch) { - static const char *valid = "!#$%&*+-./:<=>?@^_~"; + static const char *valid = "!#$%&*+-./:<=>?@^_|~"; return isalnum(ch) || strchr(valid, ch); } @@ -858,7 +950,7 @@ size_t addCharToBuf(Interpreter *interp, int c) if (interp->len >= interp->capacity) { interp->capacity += BUFSIZ; if ((r = realloc(interp->buf, interp->capacity)) == NULL) - exception(interp, out_of_memory, "failed to allocate %ld bytes for readString buffer", interp->capacity); + exception(interp, out_of_memory, "failed to allocate %lu bytes for readString buffer", (COUNTFMT) interp->capacity); interp->buf = r; } interp->buf[interp->len++] = c; @@ -882,7 +974,6 @@ Object *readInteger(Interpreter *interp) addCharToBuf(interp, '\0'); errno = 0; - /* Note: we allow hex and octal scanning, but the reader does not support it */ n = strtoimax(interp->buf, NULL, 0); if (errno == ERANGE) exception(interp, range_error, "integer out of range,: %"PRId64, n); @@ -899,15 +990,13 @@ Object *readInteger(Interpreter *interp) * @param interp fLisp interpreter * @param fd open readable file descriptor * - * returns: next character in stream or EOF - * - * throws: io-error + * @returns next character in stream or EOF */ int streamPeek(Interpreter *interp, FILE *fd) { int c = streamGetc(interp, fd); if (c != EOF) - streamUngetc(interp, fd, c); + c = ungetc(c, fd); return c; } @@ -938,15 +1027,13 @@ int readNext(Interpreter *interp, FILE *fd) * @param interp fLisp interpreter * @param fd open readable file descriptor * - * returns: next not space, not comment character - * - * throws: io-error + * @returns next not space, not comment character */ int peekNext(Interpreter *interp, FILE *fd) { int c = readNext(interp, fd); if (c != EOF) - streamUngetc(interp, fd, c); + c = ungetc(c, fd); return c; } /** readWhile - skip to next charater not fullfilling a predicate in input file @@ -1021,13 +1108,27 @@ Object *readNumberOrSymbol(Interpreter *interp, FILE *fd) (void)addCharToBuf(interp, streamGetc(interp, fd)); ch = streamPeek(interp, fd); } - // try to read a number in integer or decimal format - // Note: readInteger support hex and octal, but we do not support it here. + /* Try to read a number in integer or decimal (float) format. + * C notation applies: 010 = 8, 0x10 = 16 + */ +#ifdef FLISP_DOUBLE_EXTENSION if (ch == '.' || isdigit(ch)) { +#else + if (isdigit(ch)) { +#endif + if (ch == '0') { + (void)addCharToBuf(interp, streamGetc(interp, fd)); + ch = streamPeek(interp, fd); + if (ch == 'x') { + (void)addCharToBuf(interp, streamGetc(interp, fd)); + ch = streamPeek(interp, fd); + } + } if (isdigit(ch)) ch = readWhile(interp, fd, isdigit); if (!isSymbolChar(ch)) return readInteger(interp); +#ifdef FLISP_DOUBLE_EXTENSION if (ch == '.') { addCharToBuf(interp, ch); ch = streamGetc(interp, fd); @@ -1037,6 +1138,7 @@ Object *readNumberOrSymbol(Interpreter *interp, FILE *fd) return readDouble(interp); } } +#endif } // non-numeric character encountered, read a symbol readWhile(interp, fd, isSymbolChar); @@ -1084,7 +1186,8 @@ Object *readList(Interpreter *interp, FILE *fd) (*gcList)->cdr = last; return list; } else { - streamUngetc(interp, fd, ch); + if (ungetc(ch, fd) == EOF) + exception(interp, io_error, "readList: failed to ungetc, errno: %s", strerror(errno)); GC_CHECKPOINT; GC_TRACE(gcList, list); GC_TRACE(gcLast, last); @@ -1142,16 +1245,28 @@ Object *readExpr(Interpreter *interp, FILE *fd) return NULL; else if (ch == '\'' || ch == ':') return readUnary(interp, fd, "quote"); + else if (ch == '`') + return readUnary(interp, fd, "quasiquote"); + else if (ch == ',') { + ch = streamPeek(interp, fd); + if (ch == '@') { + (void)addCharToBuf(interp, streamGetc(interp, fd)); + return readUnary(interp, fd, "splice-unquote"); + } + else + return readUnary(interp, fd, "unquote"); + } else if (ch == '"') return readString(interp, fd); else if (ch == '(') return readList(interp, fd); else if (isSymbolChar(ch) && (ch != '.' || isSymbolChar(streamPeek(interp, fd)))) { - (void)streamUngetc(interp, fd, ch); + if (ungetc(ch, fd) == EOF) + exception(interp, io_error, "readExpr: failed to ungetc, errno: %s", strerror(errno)); return readNumberOrSymbol(interp, fd); } else - exception(interp, invalid_read_syntax, "unexpected character, `%c'", ch); + exception(interp, invalid_read_syntax, "unexpected character: '%c'", ch); } } @@ -1169,10 +1284,10 @@ Object *primitiveRead(Interpreter *interp, Object **args, Object **env) { Object *eofv = nil; Object *stream = nil; - FILE *fd = interp->input; + FILE *fd = interp->input.fd; GC_CHECKPOINT; - if (*args != nil) { + if (FLISP_HAS_ARGS) { stream = (*args)->car; if (stream->type != type_stream) exceptionWithObject(interp, stream, invalid_value, "(read [fd ..]) - arg 1 expected %s, got: %s", type_stream->string, stream->type->string); @@ -1201,8 +1316,7 @@ Object *primitiveRead(Interpreter *interp, Object **args, Object **env) // Special forms handled by evalExpr. Must be in the same order as above. enum { PRIMITIVE_QUOTE, - PRIMITIVE_SETQ, - PRIMITIVE_DEFINE, + PRIMITIVE_BIND, PRIMITIVE_PROGN, PRIMITIVE_COND, PRIMITIVE_LAMBDA, @@ -1240,8 +1354,6 @@ Object *evalSetVar(Interpreter *interp, Object **args, Object **env, bool top) if (var->type != type_symbol) exceptionWithObject(interp, var, wrong_type_argument, "(setq/define name value) - name is not a symbol"); - /* Note: we want to check for all constants here */ - //if (var == nil || var == t) if (!gcCollectableObject(interp, var)) exceptionWithObject(interp, var, wrong_type_argument, "(setq/define name value) name is a constant and cannot be redefined"); @@ -1258,7 +1370,38 @@ Object *evalSetVar(Interpreter *interp, Object **args, Object **env, bool top) else return evalSetVar(interp, &(*gcRest)->cdr, gcEnv, top); } +/** (bind symbol object[ globalb]) - creates or finds symbol and set's its value + * + * @param symbol .. Symbol to find or create. + * @param object .. Value to bind to symbol. + * @param globalp .. If not nil create new objects in the root + * environment, else in the current environment. + * + * @returns value + * + * throws: wrong-type-argument + */ +Object *evalBind(Interpreter *interp, Object **args, Object **env) +{ + bool globalp = false; + CHECK_TYPE(FLISP_ARG_ONE, type_symbol, "(bind symbol object[ globalp]) - symbol"); + if (!gcCollectableObject(interp, FLISP_ARG_ONE)) + exceptionWithObject(interp, FLISP_ARG_ONE, wrong_type_argument, + "(bind symbol object[ globalp] - symbol: is a constant and cannot be redefined"); + if (FLISP_HAS_ARG_THREE) + globalp = (FLISP_ARG_THREE != nil); + + GC_CHECKPOINT; + GC_TRACE(gcEnv, *env); + GC_TRACE(gcVar, FLISP_ARG_ONE); + GC_TRACE(gcVal, FLISP_ARG_TWO); + *gcVal = evalExpr(interp, gcVal, gcEnv); + envSet(interp, gcVar, gcVal, gcEnv, globalp); + GC_RETURN(*gcVal); +} + +/** (progn[ ..]) => o: return last value of list */ Object *evalProgn(Interpreter *interp, Object **args, Object **env) { if (*args == nil) @@ -1394,35 +1537,40 @@ Object *evalList(Interpreter *interp, Object **args, Object **env) } } +/* + *Allocate a clone of the result object in the Lisp object storage + */ +Object *newResultObject(Interpreter *interp) +{ + GC_CHECKPOINT; + GC_TRACE(gcResult, interp->result); + GC_TRACE(gcError, interp->error); + GC_TRACE(gcObject, newCons(interp, gcResult, &nil)); + /* Note: newObjectFrom() for interp->message would cost an + * additional Object * variable here */ + GC_TRACE(gcMessage, newString(interp, interp->message.string)); + *gcObject = newCons(interp, gcMessage, gcObject); + GC_RETURN(newCons(interp, gcError, gcObject)); +} + Object *evalCatch(Interpreter *interp, Object **args, Object **env) { jmp_buf exceptionEnv, *prevEnv; - Object *object; prevEnv = interp->catch; interp->catch = &exceptionEnv; - interp->msg_buf[0] = '\0'; - interp->result = nil; + setInterpreterResult(interp, nil, nil, NULL); + GC_CHECKPOINT; if (setjmp(exceptionEnv)) { - fl_debug(interp, "catch: %s, '%s'", interp->result->string, interp->msg_buf); + fl_debug(interp, "catch:%s: '%s'\n", FLISP_RESULT_CODE(interp)->string, FLISP_RESULT_MESSAGE(interp)->string); } else { do { - interp->object = evalExpr(interp, &(*args)->car, env); + setInterpreterResult(interp, evalExpr(interp, &(*args)->car, env), nil, NULL); } while(0); } - interp->catch = prevEnv; - GC_CHECKPOINT; - object = newCons(interp, &interp->object, &nil); - GC_TRACE(gcObj, object); - object = newString(interp, interp->msg_buf); - GC_TRACE(gcMessage, object); - *gcObj = newCons(interp, gcMessage, gcObj); - object = interp->result; - *gcObj = newCons(interp, &object, gcObj); GC_RELEASE; - interp->object = *gcObj; - interp->result = nil; - return *gcObj; + interp->catch = prevEnv; + return newResultObject(interp); } @@ -1464,24 +1612,29 @@ Object *evalExpr(Interpreter *interp, Object ** object, Object **env) for (args = *gcArgs; args != nil; args = args->cdr, nArgs++) { if (args->type != type_cons) - exceptionWithObject(interp, args, wrong_type_argument, "(%s args) - args is not a list: arg %d", primitive->name, nArgs); + exceptionWithObject(interp, args, wrong_type_argument, + "(%s args) - args is not a list: arg %d", + primitive->name, nArgs); if (args->car->type == type_moved || args->cdr->type == type_moved) - exceptionWithObject(interp, args->car, gc_error, "(%s args) - arg %d is already disposed off", primitive->name, nArgs); + exceptionWithObject(interp, args->car, gc_error, + "(%s args) - arg %d is already disposed off", + primitive->name, nArgs); } if (nArgs < primitive->nMinArgs) - exceptionWithObject(interp, *gcFunc, wrong_num_of_arguments, "expects at least %d arguments", primitive->nMinArgs); + exceptionWithObject(interp, *gcFunc, wrong_number_of_arguments, + "expects at least %d arguments", primitive->nMinArgs); if (nArgs > primitive->nMaxArgs && primitive->nMaxArgs >= 0) - exceptionWithObject(interp, *gcFunc, wrong_num_of_arguments, "expects at most %d arguments", primitive->nMaxArgs); + exceptionWithObject(interp, *gcFunc, wrong_number_of_arguments, + "expects at most %d arguments", primitive->nMaxArgs); if (primitive->nMaxArgs < 0 && nArgs % -primitive->nMaxArgs) - exceptionWithObject(interp, *gcFunc, wrong_num_of_arguments, "expects a multiple of %d arguments", -primitive->nMaxArgs); + exceptionWithObject(interp, *gcFunc, wrong_number_of_arguments, + "expects a multiple of %d arguments", -primitive->nMaxArgs); switch ((uintptr_t)primitive->eval) { case PRIMITIVE_QUOTE: GC_RETURN((*gcArgs)->car); - case PRIMITIVE_SETQ: - GC_RETURN(evalSetVar(interp, gcArgs, gcEnv, true)); - case PRIMITIVE_DEFINE: - GC_RETURN(evalSetVar(interp, gcArgs, gcEnv, false)); + case PRIMITIVE_BIND: + GC_RETURN(evalBind(interp, gcArgs, gcEnv)); case PRIMITIVE_PROGN: *gcObject = evalProgn(interp, gcArgs, gcEnv); break; @@ -1506,6 +1659,14 @@ Object *evalExpr(Interpreter *interp, Object ** object, Object **env) (*flisp_object_type[primitive->type_check])->string, args->car->type->string ); +#if FLISP_TRACE + fl_debug(interp, "(%s", primitive->name); + for (args = *gcArgs; args != nil; args = args->cdr, nArgs++) { + fl_debug(interp, " "); + lisp_write_object(interp, interp->debug, args->car, true); + } + fl_debug(interp, ")\n"); +#endif GC_RETURN(primitive->eval(interp, gcArgs, gcEnv)); } } else { @@ -1553,9 +1714,8 @@ void writeString(Interpreter *interp, FILE *fd, char *str) { if (fd == NULL) return; - int len = strlen(str); - if(fprintf(fd, "%s", str) != len) - exception(interp, io_error, "failed to write %d files, errno: %d", len, errno); + if(fputs(str, fd) == EOF) + exception(interp, io_error, "failed to write string %s",strerror(errno)); } /** writeFmt - write printf formatted string to file descriptor * @@ -1580,7 +1740,7 @@ void writeFmt(Interpreter *interp, FILE *fd, char *format, ...) len = vfprintf(fd, format, args); va_end(args); if (len < 0) - exception(interp, io_error, "failed to fprintf, errno: %d", errno); + exception(interp, io_error, "writeFmt(): failed to fprintf, %s", strerror(errno)); } @@ -1607,13 +1767,16 @@ void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, bool reada writeFmt(interp, fd, "%g", object->number); #endif else if (object->type == type_symbol) - writeFmt(interp, fd, "%s", object->string); + writeString(interp, fd, object->string); else if (object->type == type_primitive) writeFmt(interp, fd, "#", object->primitive->name); else if (object->type == type_stream) - writeFmt(interp, fd, "#", (void *) object->fd, object->path->string); + writeFmt(interp, fd, "#", + (uintptr_t) object->fd, + object->path->string + ); else if (object->type == type_string) - if (!readably) writeFmt(interp, fd, "%s", object->string); else { + if (!readably) writeString(interp, fd, object->string); else { writeChar(interp, fd, '"'); char *string; for (string = object->string; *string; ++string) { @@ -1670,21 +1833,22 @@ void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, bool reada writeFmt(interp, fd, " - "); lisp_write_object(interp, fd, object->vals, readably); writeChar(interp, fd, '>'); - } else if (object->type == type_moved) - exception(interp, gc_error, "won't write a garbage collected item"); - else - exception(interp, gc_error, "unidentified object: %s", object->type->string); + } else if (object->type == type_moved) { + fl_debug(interp, " => "); + lisp_write_object(interp, fd, object->forward, readably); + } else + fl_fatal("lisp-write_error(): unidentifiable object", 66); fflush(fd); } -/** (write object [[key value] ..]) - write object +/** (write o[ p[ fd]]) - write object * - * @param object object to write. - * @param key :stream optional, use *value* as output stream. - * @param key :readably optional, if *value* not nil escape strings. + * @param o Object to write. + * @param p If not nil escape strings. + * @param fd Stream to write to, else output stream. * - * returns: object + * @returns: o * * throws: wrong-num-of-arguments, io-error, gc-error * @@ -1693,44 +1857,21 @@ void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, bool reada */ Object *primitiveWrite(Interpreter *interp, Object **args, Object **env) { - Object *stream = nil; bool readably = false; - Object *obj = (*args)->car; - FILE *fd; + FILE *fd = interp->output; - if ((*args)->cdr == nil) - goto write; - - Object *list = (*args)->cdr; - Object *key = nil; - Object *value = nil; - for (;list != nil; list = list->cdr) { - key = list->car; - if (key->type != type_symbol) - exceptionWithObject(interp, *args, wrong_num_of_arguments, "(write obj [[key val] ..]) - key is not a symbol"); - if (list->cdr == nil) - exceptionWithObject(interp, *args, wrong_num_of_arguments, "(write obj [[key val] ..]) - val is missing"); - list = list->cdr; - value = list->car; - if (!strcmp("stream", key->string)) { - if (value->type != type_stream) - exceptionWithObject(interp, *args, wrong_num_of_arguments, "(write obj [[key val] ..]) - value of key stream is not a stream"); - stream = value; - } else if (!strcmp("readably", key->string)) { - readably = (value != nil); - } else - exceptionWithObject(interp, *args, wrong_num_of_arguments, "(write obj [[key val] ..]) - unknown key: %s", key->string); - } -write: + if (FLISP_HAS_ARG_TWO) { + readably = (FLISP_ARG_TWO != nil); - if (stream != nil) - fd = stream->fd; - else if (interp->output != NULL) - fd = interp->output; - else - return obj; - lisp_write_object(interp, fd, obj, readably); - return obj; + if (FLISP_HAS_ARG_THREE) { + CHECK_TYPE(FLISP_ARG_THREE, type_stream, "(write o [p [fd]]) - fd"); + if (FLISP_ARG_THREE->fd == NULL) + exception(interp, invalid_value, "(write o[ p [fd]) - fd already closed"); + fd = FLISP_ARG_THREE->fd; + } + } + lisp_write_object(interp, fd, FLISP_ARG_ONE, readably); + return FLISP_ARG_ONE; } @@ -1800,7 +1941,7 @@ Object *primitiveCons(Interpreter *interp, Object **args, Object **env) // Introspection /////// Object *primitiveGc(Interpreter *interp, Object **args, Object **env) { - // Note: + // Note: we really want to return respective data gc(interp); return t; } @@ -1893,6 +2034,32 @@ Object *integerGreaterEqual(Interpreter *interp, Object **args, Object **env) return (FLISP_ARG_ONE->integer >= FLISP_ARG_TWO->integer) ? t : nil; } +// Integer bit operations ////// +Object *integerAnd(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer & FLISP_ARG_TWO->integer); +} +Object *integerOr(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer | FLISP_ARG_TWO->integer); +} +Object *integerXor(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer ^ FLISP_ARG_TWO->integer); +} +Object *integerShiftLeft(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer << FLISP_ARG_TWO->integer); +} +Object *integerShiftRight(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, FLISP_ARG_ONE->integer >> FLISP_ARG_TWO->integer); +} +Object *integerNot(Interpreter *interp, Object **args, Object **env) +{ + return newInteger(interp, ~FLISP_ARG_ONE->integer); +} + // STREAMS ////////////////////////////////////////////////// @@ -1993,7 +2160,7 @@ Object *file_fopen(Interpreter *interp, char *path, char* mode) { exception(interp, io_error, "failed to open I/O stream %ld for %s", d, c == '<' ? "reading" : "writing"); } else { if (NULL == (fd = fopen(path, mode))) - exception(interp, io_error, "failed to open file '%s' with mode '%s', errno: %d", path, mode, errno); + exception(interp, io_error, "failed to open file '%s' with mode '%s': %s", path, mode, strerror(errno)); } return newStreamObject(interp, fd, path); } @@ -2058,34 +2225,16 @@ Object *primitiveFclose(Interpreter *interp, Object**args, Object **env) { GC_CHECKPOINT; GC_TRACE(gcObject, (FLISP_ARG_ONE->fd == NULL) ? - nil : newInteger(interp, (int64_t)FLISP_ARG_ONE->fd)); + nil : newInteger(interp, (int64_t)fileno(FLISP_ARG_ONE->fd))); *gcObject = newCons(interp, gcObject, &nil); GC_TRACE(gcBuffer, (FLISP_ARG_ONE->buf == NULL) ? nil : newString(interp, FLISP_ARG_ONE->buf)); *gcObject = newCons(interp, gcBuffer, gcObject); GC_RETURN(newCons(interp, &(FLISP_ARG_ONE->path), gcObject)); } -#ifdef FLISP_FILE_EXTENSION -#include "file.c" -#endif - -/* OS interface */ - -Object *fl_system(Interpreter *interp, Object **args, Object **env) -{ - return newInteger(interp, system(FLISP_ARG_ONE->string)); -} - -Object *os_getenv(Interpreter *interp, Object **args, Object **env) -{ - char *e = getenv(FLISP_ARG_ONE->string); - if (e == NULL) return nil; - return newStringWithLength(interp, e, strlen(e)); -} - /* Strings */ -// (string-append s a) +// (string-append s a) Object *stringAppend(Interpreter *interp, Object **args, Object **env) { int len1 = strlen(FLISP_ARG_ONE->string); @@ -2102,50 +2251,59 @@ Object *stringAppend(Interpreter *interp, Object **args, Object **env) return str; } -// (substring ...) +/** (substring string [start [end]]) - return substring of string within range [start, end) + * + * @param string Input string + * @param start Start index, 0 based + * @param end End index, not included + * + * @return Substring of string starting from end until character + * end-1. Length of string is default for *end*, 0 is default for + * *start*. + */ Object *stringSubstring(Interpreter *interp, Object **args, Object **env) { int64_t start = 0, end, len; - if (FLISP_ARG_ONE->type != type_string) - exceptionWithObject(interp, FLISP_ARG_ONE, wrong_type_argument, "(substring str [start [end]]) - arg 1 expected %s, got: %s", type_string->string, FLISP_ARG_ONE->type->string); - len = strlen(FLISP_ARG_ONE->string); + CHECK_TYPE(FLISP_ARG_ONE, type_string, "(substring string [start [end]]) - string"); + len = strlen(FLISP_ARG_ONE->string); if (len == 0) return empty; - end = start + len; - if ((*args)->cdr != nil) { - CHECK_TYPE(FLISP_ARG_TWO, type_integer, "(substring str [start [end]]) - start"); + if (FLISP_HAS_ARG_TWO) { + CHECK_TYPE(FLISP_ARG_TWO, type_integer, "(substring string [start [end]]) - start"); start = (FLISP_ARG_TWO->integer); if (start < 0) start = end + start; if ((*args)->cdr->cdr != nil) { - CHECK_TYPE(FLISP_ARG_THREE, type_integer, "(substring str [start [end]]) - end"); + CHECK_TYPE(FLISP_ARG_THREE, type_integer, "(substring string [start [end]]) - end"); if (FLISP_ARG_THREE->integer < 0) end = end + FLISP_ARG_THREE->integer; else end = FLISP_ARG_THREE->integer; } } - if (start < 0 || start > len) - exceptionWithObject(interp, FLISP_ARG_TWO, range_error, "(substring str [start [end]]) - start out of range"); + exceptionWithObject(interp, FLISP_ARG_TWO, range_error, + "(substring string [start [end]]) - start out of range"); if (end < 0 || end > len) - exceptionWithObject(interp, FLISP_ARG_THREE, range_error, "(substring str [start [end]]) - end out of range"); + exceptionWithObject(interp, FLISP_ARG_THREE, range_error, + "(substring string [start [end]]) - end out of range"); if (start > end) - exceptionWithObject(interp, FLISP_ARG_TWO, range_error, "(substring str [start [end]]) - end > start"); + exceptionWithObject(interp, FLISP_ARG_TWO, range_error, + "(substring string [start [end]]) - end > start"); if (start == end) return empty; - char *sub = strdup(FLISP_ARG_ONE->string); int newlen = end - start; - - memcpy(sub, (FLISP_ARG_ONE->string + start), newlen+1); - *(sub + newlen + 1) = '\0'; - Object * new = newStringWithLength(interp, sub, newlen); - free(sub); + char *buf = strdup(FLISP_ARG_ONE->string); + if (buf == NULL) + fl_fatal("OOM allocating buffer for (substring)\n",67); + Object *new = newStringWithLength(interp, buf+start, newlen+1); + free(buf); + new->string[newlen] = '\0'; return new; } @@ -2168,7 +2326,7 @@ Object *stringLength(Interpreter *interp, Object **args, Object **env) Object *stringSearch(Interpreter *interp, Object **args, Object **env) { char *pos; - + pos = strstr(FLISP_ARG_TWO->string, FLISP_ARG_ONE->string); if (pos) return newInteger(interp, pos - FLISP_ARG_TWO->string); @@ -2189,11 +2347,35 @@ Object *asciiToString(Interpreter *interp, Object **args, Object **env) Object *asciiToInteger(Interpreter *interp, Object **args, Object **env) { if (strlen(FLISP_ARG_ONE->string) < 1) - exceptionWithObject(interp, FLISP_ARG_ONE, invalid_value, "(ascii->number string) - string is empty"); + exceptionWithObject(interp, FLISP_ARG_ONE, invalid_value, + "(ascii->number string) - string is empty"); return newInteger(interp, (int64_t)*FLISP_ARG_ONE->string); } +// Interpreter introspection and configuration + +/** (interp cmd[ arg..]) - query or set interpreter internals */ +Object *primitiveInterp(Interpreter *interp, Object **args, Object **env) +{ + CHECK_TYPE(FLISP_ARG_ONE, type_symbol, "(interp cmd[ arg..])"); + + if (!strcmp(FLISP_ARG_ONE->string, "version")) { + return newString(interp, FL_NAME " " FL_VERSION); + } + if (!strcmp(FLISP_ARG_ONE->string, "input")) { + if (FLISP_HAS_ARG_TWO) { + CHECK_TYPE(FLISP_ARG_TWO, type_stream, "(interp input[ fd] - fd"); + interp->input.fd = FLISP_ARG_TWO->fd; + interp->input.path = FLISP_ARG_TWO->path; + interp->input.buf = FLISP_ARG_TWO->buf; + interp->input.len = FLISP_ARG_TWO->size; + } + return &(interp->input); + } + exceptionWithObject(interp, FLISP_ARG_ONE, invalid_value, + "(flisp cmd[ arg..]) - unknown command"); +} #ifdef FLISP_FEMTO_EXTENSION #include "femto.primitives.c" @@ -2201,8 +2383,7 @@ Object *asciiToInteger(Interpreter *interp, Object **args, Object **env) Primitive primitives[] = { {"quote", 1, 1, 0, (LispEval) PRIMITIVE_QUOTE /* special form */ }, - {"setq", 0, -2, 0, (LispEval) PRIMITIVE_SETQ /* special form */ }, - {"define", 0, -2, 0, (LispEval) PRIMITIVE_DEFINE /* special form */ }, + {"bind", 2, 3, 0, (LispEval) PRIMITIVE_BIND /* special form */ }, {"progn", 0, -1, 0, (LispEval) PRIMITIVE_PROGN /* special form */ }, {"cond", 0, -1, 0, (LispEval) PRIMITIVE_COND /* special form */ }, {"lambda", 1, -1, 0, (LispEval) PRIMITIVE_LAMBDA /* special form */ }, @@ -2222,7 +2403,7 @@ Primitive primitives[] = { {"file-info", 1, 1, TYPE_STREAM, primitiveFinfo}, {"read", 0, 2, 0, primitiveRead}, {"eval", 1, 1, 0, primitiveEval}, - {"write", 1, -1, 0, primitiveWrite}, + {"write", 1, 3, 0, primitiveWrite}, #if DEBUG_GC {"gc", 0, 0, 0, primitiveGc}, {"gctrace", 0, 0, 0, primitiveGcTrace}, @@ -2241,16 +2422,21 @@ Primitive primitives[] = { {"i<=", 2, 2, TYPE_INTEGER, integerLessEqual}, {"i>", 2, 2, TYPE_INTEGER, integerGreater}, {"i>=", 2, 2, TYPE_INTEGER, integerGreaterEqual}, - {"string-equal", 2, 2, TYPE_STRING, stringEqual}, - {"string-length", 1, 1, TYPE_STRING, stringLength}, - {"string-append", 2, 2, TYPE_STRING, stringAppend}, - {"substring", 1, 3, 0, stringSubstring}, - {"string-search", 2, 2, TYPE_STRING, stringSearch}, + {"&", 2, 2, TYPE_INTEGER, integerAnd}, + {"|", 2, 2, TYPE_INTEGER, integerOr}, + {"^", 2, 2, TYPE_INTEGER, integerXor}, + {"<<", 2, 2, TYPE_INTEGER, integerShiftLeft}, + {">>", 2, 2, TYPE_INTEGER, integerShiftRight}, + {"~", 1, 1, TYPE_INTEGER, integerNot}, + {"string-equal", 2, 2, TYPE_STRING, stringEqual}, + {"string-length", 1, 1, TYPE_STRING, stringLength}, + {"string-append", 2, 2, TYPE_STRING, stringAppend}, + {"substring", 1, 3, 0, stringSubstring}, + {"string-search", 2, 2, TYPE_STRING, stringSearch}, {"ascii", 1, 1, TYPE_INTEGER, asciiToString}, - {"ascii->number", 1, 1, TYPE_STRING, asciiToInteger}, - {"os.getenv", 1, 1, TYPE_STRING, os_getenv}, - {"system", 1, 1, TYPE_STRING, fl_system}, - FLISP_REGISTER_FILE_EXTENSION + {"ascii->number", 1, 1, TYPE_STRING, asciiToInteger}, + {"interp", 1, -1, 0, primitiveInterp}, +// FLISP_REGISTER_FILE_EXTENSION #ifdef FLISP_FEMTO_EXTENSION #include "femto.register.c" #endif @@ -2261,15 +2447,13 @@ Primitive primitives[] = { void initRootEnv(Interpreter *interp) { - int i; + int i, nConstants; + Object *var, *val; - GC_CHECKPOINT; - GC_TRACE(gcEnv, newEnv(interp, &nil, &nil)); - - interp->global = *gcEnv; + interp->global = newEnv(interp, &nil, &nil); // add constants - int nConstants = sizeof(flisp_constants) / sizeof(flisp_constants[0]); + nConstants = sizeof(flisp_constants) / sizeof(flisp_constants[0]); for (i = 0; i < nConstants; i++) { (*flisp_constants[i].symbol)->type = type_symbol; envSet(interp, flisp_constants[i].symbol, flisp_constants[i].value, &interp->global, true); @@ -2284,34 +2468,37 @@ void initRootEnv(Interpreter *interp) #ifdef FLISP_DOUBLE_EXTENSION double_one->type = type_double; #endif - okObject->type = type_cons; - okObject->car = okObject->cdr = nil; - okMessage->type = type_cons; - okMessage->car = empty; - okMessage->cdr = okObject; - ok->type = type_cons; - ok->car = nil; - ok->cdr = okMessage; - + // add primitives - GC_TRACE(gcVar, nil); - GC_TRACE(gcVal, nil); int nPrimitives = sizeof(primitives) / sizeof(primitives[0]); for (i = 0; i < nPrimitives; ++i) { - *gcVar = newSymbol(interp, primitives[i].name); - *gcVal = newPrimitive(interp, &primitives[i]); + var = newSymbol(interp, primitives[i].name); + val = newPrimitive(interp, &primitives[i]); - envSet(interp, gcVar, gcVal, &interp->global, true); + envSet(interp, &var, &val, &interp->global, true); } - +#ifdef FLISP_DOUBLE_EXTENSION for (Primitive *entry = flisp_double_primitives; entry->name != NULL; entry++) { - *gcVar = newSymbol(interp, entry->name); - *gcVal = newPrimitive(interp, entry); + var = newSymbol(interp, entry->name); + val = newPrimitive(interp, entry); - envSet(interp, gcVar, gcVal, &interp->global, true); + envSet(interp, &var, &val, &interp->global, true); } - - GC_RELEASE; +#endif +#ifdef FLISP_FILE_EXTENSION + for (Constant *constant = flisp_file_constants; constant->symbol != NULL; constant++) { + (*constant->symbol)->type = type_symbol; + envSet(interp, constant->symbol, constant->value, &interp->global, true); + interp->symbols = newCons(interp, constant->symbol, &interp->symbols); + } + + for (Primitive *entry = flisp_file_primitives; entry->name != NULL; entry++) { + var = newSymbol(interp, entry->name); + val = newPrimitive(interp, entry); + + envSet(interp, &var, &val, &interp->global, true); + } +#endif } Memory *newMemory(size_t size) @@ -2319,7 +2506,7 @@ Memory *newMemory(size_t size) Memory *memory = malloc(sizeof(Memory)); if (!memory) return NULL; - memory->capacity = size/2; + memory->capacity = size; memory->fromOffset = 0; memory->toOffset = 0; memory->fromSpace = NULL; @@ -2334,7 +2521,6 @@ Memory *newMemory(size_t size) /** Initialize and return an fLisp interpreter. * - * @param size memory size for the Lisp objects. * @param argv null terminated array to arguments to be imported. * @param library_path path to Lisp library, aka 'script_dir'. * @param input open readable file descriptor for default input or NULL @@ -2349,10 +2535,12 @@ Memory *newMemory(size_t size) * */ Interpreter *lisp_new( - size_t size, char **argv, char *library_path, + char **argv, char *library_path, FILE *input, FILE *output, FILE* debug) { Interpreter *interp; + size_t count = 0; + char **s = argv; if (lisp_interpreters != NULL) return NULL; @@ -2360,53 +2548,39 @@ Interpreter *lisp_new( interp = malloc(sizeof(Interpreter)); if (interp == NULL) return NULL; - if (size/2 < FLISP_MIN_MEMORY) { - interp->result = invalid_value; - strncpy(interp->msg_buf, - "fLisp needs at least" CPP_STR(FLISP_MIN_MEMORY) "bytes to start up", sizeof(interp->msg_buf)); - return NULL; - } - + /* enable debug output */ interp->debug = debug; - Memory *memory = newMemory(size); + /* Account for the size of argv and library_path objects and their symbols */ + for (int i = 0; s[i]; count += objectSize(strlen(s[i++]))); + count += objectSize(strlen(library_path)); + count += 2*sizeof(Object); + fl_debug(interp, "lisp_new(): additional memory for argv and library path storage: %lu\n", (COUNTFMT) count); + Memory *memory = newMemory(FLISP_MIN_MEMORY+count+FLISP_INITIAL_MEMORY); if (memory == NULL) { - interp->result = out_of_memory; - strncpy(interp->msg_buf, - "failed to allocate memory for the interpreter", sizeof(interp->msg_buf)); + setInterpreterResult(interp, nil, out_of_memory, "failed to allocate memory for the interpreter"); return NULL; } interp->memory = memory; - interp->object = ok; - interp->msg_buf[0] = '\0'; - interp->result = nil; - - interp->catch = NULL; - + /* read buffer */ interp->buf = NULL; resetBuf(interp); - // dynamic gc trace stack - interp->gcTop = nil; + interp->catch = &interp->exceptionEnv; - /* gc setup */ - /* symbols */ + /* symbols */ Object *object; object = newCons(interp, &nil, &nil); object = newCons(interp, &t, &object); interp->symbols = object; - fl_debug(interp, "lisp_init: %lu/%lu bytes allocated before gc", interp->memory->fromOffset, interp->memory->capacity); - /* gc region start */ - - /* global environment */ - initRootEnv(interp); - - interp->catch = &interp->exceptionEnv; interp->next = interp; lisp_interpreters = interp; + /* global environment */ + initRootEnv(interp); + /* Add argv0 to the environment */ Object *var = newSymbol(interp, "argv0"); Object *val = newString(interp, *argv); @@ -2415,10 +2589,9 @@ Interpreter *lisp_new( /* Add argv to the environement */ var = newSymbol(interp, "argv"); val = nil; - Object **i; - for (i = &val; *++argv; i = &(*i)->cdr) { - *i = newCons(interp, &nil, &nil); - (*i)->car = newString(interp, *argv); + for (Object **j = &val; *++argv; j = &(*j)->cdr) { + *j = newCons(interp, &nil, &nil); + (*j)->car = newString(interp, *argv); } (void)envSet(interp, &var, &val, &interp->global, true); @@ -2428,12 +2601,16 @@ Interpreter *lisp_new( envSet(interp, &var, &val, &interp->global, true); /* input stream */ - if (input) { - interp->input = input; - val = newStreamObject(interp, input, "STDIN"); - var = newSymbol(interp, "*INPUT*"); - (void)envSet(interp, &var, &val, &interp->global, true); - } + var = newSymbol(interp, "*INPUT*"); + val = (interp) ? newStreamObject(interp, input, "STDIN") : nil; + var = newSymbol(interp, "*INPUT*"); + interp->input.type = type_stream; + interp->input.fd = input; + interp->input.path = var; + interp->input.buf = NULL; + interp->input.len = 0; + (void)envSet(interp, &var, &val, &interp->global, true); + /* output stream */ if (output) { interp->output = output; @@ -2441,7 +2618,10 @@ Interpreter *lisp_new( var = newSymbol(interp, "*OUTPUT*"); (void)envSet(interp, &var, &val, &interp->global, true); } -#if DEBUG_GC && DEBUG_GC_ALWAYS + fl_debug(interp, "lisp_init: %lu/%lu bytes allocated before gc\n", + (COUNTFMT) interp->memory->fromOffset, (COUNTFMT) interp->memory->capacity); + +#if DEBUG_GC_ALWAYS gc_always = true; #endif return interp; @@ -2454,20 +2634,11 @@ void lisp_destroy(Interpreter *interp) i->next = interp->next; i = NULL; -#if 0 if (interp->memory->fromSpace) - (void)munmap(interp->memory->fromSpace, interp->memory->capacity * 2); - // Note: we do not know which one it is, so we free both. + (void)munmap(interp->memory->fromSpace, interp->memory->capacity); + if (interp->memory->toSpace) - (void)munmap(interp->memory->toSpace, interp->memory->capacity * 2); -#else - if (interp->memory->fromSpace && interp->memory->toSpace) { - if (interp->memory->fromSpace < interp->memory->toSpace) - (void)munmap(interp->memory->fromSpace, interp->memory->capacity * 2); - else - (void)munmap(interp->memory->toSpace, interp->memory->capacity * 2); - } -#endif + (void)munmap(interp->memory->toSpace, interp->memory->capacity); if (interp->debug) fclose(interp->debug); @@ -2475,195 +2646,37 @@ void lisp_destroy(Interpreter *interp) free(interp); } -/** lisp_eval - protected evaluation of input stream - * - * @param interp fLisp interpreter - * @param stream open readable stream object - * @param gcRoots gc root object - * - */ -void lisp_eval(Interpreter *interp) -{ - if (interp->input == NULL) { - interp->result = invalid_value; - strncpy(interp->msg_buf, "no input stream to evaluate", sizeof(interp->msg_buf)); - interp->object = nil; - return; - } - - interp->result = nil; - interp->msg_buf[0] = '\0'; - - // start the garbage collector - interp->gcTop = nil; - GC_CHECKPOINT; - GC_TRACE(gcObject, nil); // will not be released at all - - for (;;) { - interp->result = nil; - interp->msg_buf[0] = '\0'; - switch (setjmp(*interp->catch)) { - case FLISP_OK: break; - case FLISP_RETURN: return; - default: - fl_debug(interp, "error: %s, '%s'", interp->result->string, interp->msg_buf); - GC_RELEASE; - return; - } - if ((*gcObject = readExpr(interp, interp->input)) == NULL) { - interp->result = nil; - interp->msg_buf[0] = '0'; - return; - } - lisp_write_object(interp, interp->debug, *gcObject, true); - writeChar(interp, interp->debug, '\n'); - *gcObject = evalExpr(interp, gcObject, &interp->global); - interp->object = *gcObject; - lisp_write_object(interp, interp->output, *gcObject, true); - writeChar(interp, interp->output, '\n'); - if (interp->output) fflush(interp->output); - } - longjmp(*interp->catch, FLISP_RETURN); - GC_RELEASE; // make the compiler happy -} - -/** lisp_write_error - format error message and write to file +/** lisp_write_error - write error message to file descriptor * * @param interp fLisp interpreter * @param fd open writable file descriptor * - * Formats the error message and inserts the error object if not nil, - * then writes it to the given file descriptor. + * Formats an error message from a (catch) result and writes it to the + * given file descriptor. If the error object is nil, it is not + * inserted. * - * It is an error to use an interpreter without error. */ void lisp_write_error(Interpreter *interp, FILE *fd) { - if (interp->object == nil) - fprintf(fd, "error: %s\n", interp->msg_buf); + if (FLISP_RESULT_OBJECT(interp) == nil) + fprintf(fd, "error: %s\n", FLISP_RESULT_MESSAGE(interp)->string); else { - fprintf(fd, "%s", "error: '"); - lisp_write_object(interp, fd, interp->object, true); - fprintf(fd, "', %s\n", interp->msg_buf); + fprintf(fd, "error: '"); + lisp_write_object(interp, fd, FLISP_RESULT_OBJECT(interp), true); + fprintf(fd, "', %s\n", FLISP_RESULT_MESSAGE(interp)->string); } fflush(fd); } -/** lisp_eval_string() - interpret a string in Lisp - * - * @param interp fLisp interpreter - * @param input string to evaluate - * - * Before calling `lisp_eval_string()` initialize: - * - * - interp->result is set to the result symbol of the evaluation, nil if succesful. - * - interp->object is set to the resulting object - * - * If an error occurs during evaluation: - * - * - interp->object is set to the object causing the exception, or nil. - * - interp->msg_buf is set to an error message. +/** (catch (eval (read f))) or (catch (eval (read))) * + * (eval (read f)) or (eval (read)) + * (eval . (read . (f . nil)) or + * (eval . (read . nil) */ -void lisp_eval_string(Interpreter *interp, char * input) -{ - FILE *fd, *prev; - - fl_debug(interp, "lisp_eval_string(\"%s\")", input); - - if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { - strncpy(interp->msg_buf, "failed to allocate input stream", sizeof(interp->msg_buf)); - goto io_error; - } - prev = interp->input; - interp->input = fd; - lisp_eval(interp); - interp->input = prev; - (void)fclose(fd); - if (interp->result == nil) { - fl_debug(interp, "lisp_eval_string() result: nil"); - lisp_write_object(interp, interp->debug, interp->object, true); - } - else - fl_debug(interp, "lisp_eval_string() result: error: %s", interp->msg_buf); - return; - -io_error: - interp->result = io_error; - interp->object = nil; - return; -} - - -void lisp_write_error2(Interpreter *interp, FILE *fd) -{ - fprintf(fd, "error: '"); - lisp_write_object(interp, fd, interp->object->cdr->cdr->car, true); - fprintf(fd, "', %s\n", interp->object->cdr->car->string); - fflush(fd); -} - -void lisp_eval2(Interpreter *interp) -{ - // reset the garbage collector - interp->gcTop = nil; - GC_CHECKPOINT; - GC_TRACE(gcObject, nil); - Primitive readPrimitive = { "read", 0, 2, 0, primitiveRead }; - Object *readObject = &(Object) { type_primitive, .primitive = &readPrimitive, .type_check = nil }; - Object *readInvocation = &(Object) { type_cons, .car = readObject, .cdr = nil }; - Object *readApply = &(Object) { type_cons, .car = readInvocation, .cdr = nil }; - - Object *okObject = &(Object) { type_cons, .car = nil, .cdr = nil }; - Object *okString = &(Object) { type_cons, .car = empty, .cdr = okObject }; - Object *result = &(Object) { type_cons, .car = nil, .cdr = okString }; - - for (;;) { - /* read */ - *gcObject = evalCatch(interp, &readApply, &interp->global); - if (interp->object->car == end_of_file) { - interp->object = result; - break; - } - if (interp->object->car != nil) - break; - /* eval */ - *gcObject = newCons(interp, &interp->object->cdr->cdr->car, &nil); - *gcObject = evalCatch(interp, gcObject, &interp->global); - if ((*gcObject)->car != nil) - break; - lisp_write_object(interp, interp->output, (*gcObject)->cdr->cdr->car, true); - writeChar(interp, interp->output, '\n'); - if (interp->output) fflush(interp->output); - result = *gcObject; - } - GC_RELEASE; -} -void lisp_eval_string2(Interpreter *interp, char *input) -{ - - FILE *fd, *prev; - fl_debug(interp, "lisp_eval_string2(\"%s\")", input); - - if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { - strncpy(interp->msg_buf, "failed to allocate input stream", sizeof(interp->msg_buf)); - interp->result = io_error; - interp->object = nil; - return; - } - prev = interp->input; - interp->input = fd; - - lisp_eval2(interp); - interp->input = prev; - (void)fclose(fd); -} - - -/** (catch (eval (read f))) - */ -void cerf(Interpreter *interp, FILE *fd) +Object *cerf(Interpreter *interp, FILE *fd) { + /* Note: find a way to not construct this all the time anew */ Primitive readPrimitive = { "read", 0, 2, 0, primitiveRead }; Primitive evalPrimitive = { "eval", 1, 1, 0, primitiveEval }; @@ -2674,48 +2687,74 @@ void cerf(Interpreter *interp, FILE *fd) if (fd == NULL) readCons.cdr = nil; Object readApply = (Object) { type_cons, .car = &readCons, .cdr = nil }; - + Object eval = (Object) { type_primitive, .primitive = &evalPrimitive, .type_check = nil }; Object evalCons = (Object) { type_cons, .car = &eval, .cdr = &readApply }; Object *evalApply = &(Object) { type_cons, .car = &evalCons, .cdr = nil }; - - (void) evalCatch(interp, &evalApply, &interp->global); -} -Object *openInputStreamError(void) -{ - Object *m = &(Object) { type_string, .string = "alloc stream failed" }; - Object *o = &(Object) { type_cons, .car = nil, .cdr = nil }; - o = &(Object) { type_cons, .car = m, .cdr = o }; - return &(Object) { type_cons, .car = io_error, .cdr = o }; + return evalCatch(interp, &evalApply, &interp->global); } -void lisp_eval3(Interpreter *interp, char *input) +/** lisp_eval() - interpret a string or file in Lisp + * + * @param interp fLisp interpreter + * @param input string to evaluate + * + * If input is NULL, the interpreters input stream is evaluated + * instead. + * + * After evaluation, the result of evaluation is available in + * interp->object. It is a (catch) result which is a three element + * list: + * + * (code message result) + * + * If evaluation was successful, code is nil and message is an empty + * string. Otherwise, code is an error symbol, message is a human + * readable error message and result the object causing the error. + * + * The following macros can be used to access the list elements: + * + * - FLISP_RESULT_CODE(INTERPRETER) + * - FLISP_RESULT_MESSAGE(INTERPRETER) + * - FLISP_RESULT_OBJECT(INTERPRETER) + * + */ +void lisp_eval(Interpreter *interp, char *input) { FILE *fd = NULL; - Object *result; - if (input != NULL) { - fl_debug(interp, "lisp_eval3(\"%s\")", input); + if (input == NULL) { + fl_debug(interp, "lisp_eval()\n"); + if (interp->input.fd == NULL) { + setInterpreterResult(interp, nil, invalid_value, "no input stream configured"); + return; + } + } else { + fl_debug(interp, "lisp_eval(\"%s\")\n", input); if (NULL == (fd = fmemopen(input, strlen(input), "r"))) { - interp->object = openInputStreamError(); + setInterpreterResult(interp, nil, io_error, + "fmemopen() for input string failed: %s", strerror(errno)); return; } } interp->gcTop = nil; - interp->object = result = ok; + GC_CHECKPOINT; + GC_TRACE(gcResult, nil); + Object *object; for (;;) { - cerf(interp, fd); - if (interp->object->car == end_of_file) { - interp->object = result; + object = cerf(interp, fd); + if (object->car == end_of_file) { + setInterpreterResult(interp, *gcResult, nil, NULL); break; } - if (interp->object->car != nil) + if (object->car != nil) break; - result = interp->object; - lisp_write_object(interp, interp->output, result->cdr->cdr->car, true); + lisp_write_object(interp, interp->output, object->cdr->cdr->car, true); writeChar(interp, interp->output, '\n'); + *gcResult = object->cdr->cdr->car; } + GC_RELEASE; if (interp->output) fflush(interp->output); if (fd) fclose(fd); } diff --git a/lisp.h b/lisp.h index 8710ecd..9e31b0a 100644 --- a/lisp.h +++ b/lisp.h @@ -11,13 +11,15 @@ #include #define FL_NAME "fLisp" -#define FL_VERSION "0.10" +#define FL_VERSION "0.13" -#define FL_INITFILE "flisp.rc" +#define FL_RCFILE "flisp.rc" #define FL_LIBDIR "/usr/local/share/flisp" /* minimal Lisp object space size */ -#define FLISP_MIN_MEMORY 26624UL /* currently ~26k */ +//#define FLISP_MIN_MEMORY 24576UL /* currently ~21k for flisp */ +#define FLISP_MIN_MEMORY 40960UL /* currently ~34k for femto */ +#define FLISP_MEMORY_INC_SIZE 8192UL /* Resize by this amount */ /* buffersize for Lisp eval input */ #define INPUT_FMT_BUFSIZ 2048 @@ -27,37 +29,14 @@ /* Debugging */ #define DEBUG_GC 0 #define DEBUG_GC_ALWAYS 0 +#define FLISP_TRACE 0 +#define FLISP_TRACK_GCTOP 0 /* Lisp objects */ typedef struct Object Object; typedef struct Interpreter Interpreter; typedef Object *(*LispEval) (Interpreter *, Object **, Object **); -/* Constants */ -/* Fundamentals */ -extern Object *nil; -extern Object *t; -/* Types */ -extern Object *type_integer; -extern Object *type_double; -extern Object *type_string; -extern Object *type_symbol; -extern Object *type_cons; -extern Object *type_lambda; -extern Object *type_macro; -extern Object *type_primitive; -extern Object *type_stream; -/* internal */ -extern Object *type_env; -extern Object *type_moved; -/* Exceptions */ -extern Object *end_of_file; -extern Object *range_error; -extern Object *wrong_type_argument; -extern Object *invalid_value; -extern Object *wrong_num_of_arguments; -extern Object *io_error; -extern Object *out_of_memory; typedef enum ObjectType { TYPE_MOVED, @@ -111,18 +90,19 @@ typedef struct Memory { } Memory; typedef struct Interpreter { - Object *object; /* result or error object */ - Object *result; /* result symbol */ - char msg_buf[WRITE_FMT_BUFSIZ]; /* error string */ /* private */ - FILE *input; /* default input stream object */ + Object *error; /* error code cons */ + struct { Object * type; size_t size; char string[WRITE_FMT_BUFSIZ]; } message; + Object *result; /* result or error object */ + + Object input; /* input stream object */ FILE *output; /* default output file descriptor */ - FILE *debug; /* debug stream */ + FILE *debug; /* debug file descriptor */ /* globals */ Object *symbols; /* symbols list */ - Object *global; /* global environment */ + Object *global; /* global environment */ /* GC */ Object *gcTop; /* dynamic gc trace stack */ Memory *memory; /* memory available for object @@ -140,14 +120,63 @@ typedef struct Interpreter { /*@null@*/extern Interpreter *lisp_interpreters; // PROGRAMMING INTERFACE //////////////////////////////////////////////// +/* Constants */ +/* Fundamentals */ +extern Object *nil; +extern Object *t; +/* Types */ +extern Object *type_integer; +extern Object *type_double; +extern Object *type_string; +extern Object *type_symbol; +extern Object *type_cons; +extern Object *type_lambda; +extern Object *type_macro; +extern Object *type_primitive; +extern Object *type_stream; +/* internal */ +extern Object *type_env; +extern Object *type_moved; +/* Exceptions */ +extern Object *end_of_file; +extern Object *range_error; +extern Object *wrong_type_argument; +extern Object *invalid_value; +extern Object *wrong_num_of_arguments; +extern Object *io_error; +extern Object *out_of_memory; +/* utility */ +extern Object *one; +extern Object *empty; + +/* "Object" type for initializing constants with long names. + * Note: currently wrong-number-of-arguments is the longest, if you + * need a longer put it here. + */ +typedef struct { Object *type; size_t size; char string[sizeof("wrong-number-of-arguments")]; } Symbol; -extern Object * newObject(Interpreter *, Object *); +extern Object *newObject(Interpreter *, Object *); extern Object *newObjectFrom(Interpreter *, Object **); extern Object *newInteger(Interpreter *, int64_t); -extern size_t addCharToBuf(Interpreter *, int); +extern Object *newStringWithLength(Interpreter *, char *, size_t); +extern Object *newString(Interpreter *, char *); +extern Object *newCons(Interpreter *, Object **, Object **); +extern Object *newSymbol(Interpreter *, char *); +extern Object *newStreamObject(Interpreter *, FILE *, char *); + +extern int streamGetc(Interpreter *interp, FILE *fd); extern void resetBuf(Interpreter *); -extern void exceptionWithObject(Interpreter *, Object *, Object *, char *, ...); -#define exception(interp, result, ...) exceptionWithObject(interp, nil, result, __VA_ARGS__) +extern size_t addCharToBuf(Interpreter *, int); + +extern void setInterpreterResult(Interpreter *, Object *, Object *, char *, ...); +#define exceptionWithObject(interp, object, error, ...) \ + do { \ + resetBuf(interp); \ + setInterpreterResult(interp, object, error, __VA_ARGS__); \ + longjmp(*interp->catch, 2); \ + } while(0) +#define exception(interp, error, ...) exceptionWithObject(interp, nil, error, __VA_ARGS__) + #define GC_PASTE1(name, id) name ## id #define GC_PASTE2(name, id) GC_PASTE1(name, id) #define GC_UNIQUE(name) GC_PASTE2(name, __LINE__) @@ -169,6 +198,7 @@ void fl_debug(Interpreter *, char *, ...); #define FLISP_ARG_TWO (*args)->cdr->car #define FLISP_ARG_THREE (*args)->cdr->cdr->car +#define FLISP_HAS_ARGS *args != nil #define FLISP_HAS_ARG_TWO ((*args)->cdr != nil) #define FLISP_HAS_ARG_THREE ((*args)->cdr->cdr != nil) @@ -178,27 +208,15 @@ void fl_debug(Interpreter *, char *, ...); SIGNATURE " expected %s, got: %s", TYPE->string, PARAM->type->string) // PUBLIC INTERFACE /////////////////////////////////////////////////////// -extern Interpreter *lisp_new(size_t, char**, char*, FILE*, FILE*, FILE*); +extern Interpreter *lisp_new(char **, char*, FILE*, FILE*, FILE*); extern void lisp_destroy(Interpreter *); -extern void lisp_eval(Interpreter *); -extern void lisp_eval_string(Interpreter *, char *); +extern void lisp_eval(Interpreter *, char *); extern void lisp_write_object(Interpreter *, FILE *, Object *, bool); extern void lisp_write_error(Interpreter *, FILE *); -extern void lisp_write_error2(Interpreter *, FILE *); -extern void lisp_eval2(Interpreter *); -extern void lisp_eval3(Interpreter *, char *); -extern void lisp_eval_string2(Interpreter *, char *); - -#ifdef FLISP_FILE_EXTENSION -#define FLISP_REGISTER_FILE_EXTENSION \ - {"fflush", 1, 1, TYPE_STREAM, primitiveFflush}, \ - {"ftell", 1, 1, TYPE_STREAM, primitiveFtell}, \ - {"fgetc", 1, 1, TYPE_STREAM, primitiveFgetc}, -#else -#define FLISP_REGISTER_FILE_EXTENSION -#endif - +#define FLISP_RESULT_CODE(INTERPRETER) INTERPRETER->error +#define FLISP_RESULT_MESSAGE(INTERPRETER) ((Object *)&INTERPRETER->message) +#define FLISP_RESULT_OBJECT(INTERPRETER) INTERPRETER->result #endif /* diff --git a/lisp/core.lsp b/lisp/core.lsp index d00a6a0..7f082f6 100644 --- a/lisp/core.lsp +++ b/lisp/core.lsp @@ -3,11 +3,23 @@ ;; Core fLisp extensions ;; -(setq list (lambda args args)) +(bind list (lambda args args) t) -(setq defmacro +(bind defmacro (macro (name params . body) - (list (quote setq) name (list (quote macro) params . body)))) + (list 'bind name (list (quote macro) params . body) 't) ) + t ) + +(defmacro setq args + (cond (args + (cond ((null (cdr args)) + (throw wrong-number-of-arguments "(setq [s v ..]) expects a multiple of 2 arguments") ) + ((null (cdr (cdr args))) + (list 'bind (car args) (car (cdr args)) t) ) + (t + (list 'progn + (list 'setq (car args) (car (cdr args))) + (cons 'setq (cdr (cdr args))) )))))) (defmacro defun (name params . body) (list (quote setq) name (list (quote lambda) params . body))) @@ -33,16 +45,50 @@ (defun cddr (l) (cdr (cdr l))) (defun caddr (l) (car (cdr (cdr l)))) -(defun number-to-string (num) +;;; https://www.scheme.com/tspl2d/objects.html#g2052 +(defun append lists + (let f ((ls nil) (lists lists)) + (cond + ((null lists) ls) + (t + (let g ((ls ls)) + (cond + ((null ls) (f (car lists) (cdr lists))) + (t + (cond ((not (consp ls)) + (throw invalid-value + (concat "(append lists) - list expected type-list, got " (type-of ls)) + ls))) + (cons (car ls) (g (cdr ls)))) )))))) + + +(defun fold-left (f i l) + (cond ((null l) i) + (t (fold-left f (f i (car l)) (cdr l))) )) + +(defun flip (func) (lambda (o1 o2) (func o2 o1))) +(defun reverse (l) (fold-left (flip cons) nil l)) + +(defun apply (f . args) (cond - ((numberp num) - (let ((f (open "" ">"))) - (write num :stream f) - (prog1 - (cadr (file-info f)) - (close f)))) - (t (throw wrong-type-argument - (concat "(number-to-string number) - number expected " type-integer " got: " (type-of num)))))) + ((null args) (f)) + (t + (let ((rev (reverse args))) + (cond + ((consp (car rev)) + ;; if last element is list splice it + (eval (cons f (append (reverse (cdr rev)) (car rev)))) ) + (t (f . args)) ))))) + +(defun print (o . fd) + (cond + ((null fd) (write o t)) + (t (write o t car fd)) )) + +(defun princ (o . fd) + (cond + ((null fd) (write o nil)) + (t (write o nil (car fd))) )) (defun string-to-number (string) (let ((f (open string "<")) (result nil)) @@ -63,10 +109,6 @@ (setq not null) -(defun fold-left (f i l) - (cond ((null l) i) - (t (fold-left f (f i (car l)) (cdr l))) )) - (defun length (o) (cond ((null o) 0) @@ -76,16 +118,19 @@ (t (throw wrong-type-argument "(length object) - expected type-cons or type-string" o)))) -(defun string (s) +(defun string (o) ;; Convert argument to string. ;; Common Lisp (cond - ((eq nil s) "") - ((numberp s) (number-to-string s)) - ((stringp s) s) - ((symbolp s) (symbol-name s)) - ((consp s) (string-append (string (car s)) (string (cdr s)))) - (t (throw wrong-type-argument "cannot convert to string" s)))) + ((eq nil o) "") + ((stringp o) o) + ((symbolp o) (symbol-name o)) + ((consp o) (string-append (string (car o)) (string (cdr o)))) + (t (let ((f (open "" ">"))) + (write o t f) + (prog1 + (cadr (file-info f)) + (close f) ))))) (defun concat args ;; Concatenate all arguments to a string. @@ -99,13 +144,12 @@ ;; If object o in list l return sublist of l starting with o, else nil. ;; Elisp (cond - ((eq nil o) nil) ((eq nil l) nil) ((eq o (car l)) l) (t (memq o (cdr l))))) -(defun map1 (func xs) - (cond (xs (cons (func (car xs)) (map1 func (cdr xs)))))) +(defun mapcar (func xs) + (cond (xs (cons (func (car xs)) (mapcar func (cdr xs)))))) ;;; Wrap all math to Integer operations (defun nfold (f i l); (3) (1 2 3) @@ -147,8 +191,8 @@ ;;; bindings: (car args) ;;; body: (cdr args) (cons ; apply - (cons 'lambda (cons (map1 car (car args)) (cdr args))) ; (lambda (names) body) - (map1 cadr (car args)))) ; (values) + (cons 'lambda (cons (mapcar car (car args)) (cdr args))) ; (lambda (names) body) + (mapcar cadr (car args)))) ; (values) (t (throw wrong-type-argument "let: first argument neither label nor binding" (car args))))) ((symbolp (car args)) ;;; label: (car args) @@ -156,9 +200,10 @@ ;;; body: (cddr args) (list (list 'lambda '() - (list 'define (car args) - (cons 'lambda (cons (map1 car (cadr args)) (cddr args)))) - (cons (car args) (map1 cadr (cadr args)))))) +;;; (list 'define (car args) + (list 'bind (car args) + (cons 'lambda (cons (mapcar car (cadr args)) (cddr args)))) + (cons (car args) (mapcar cadr (cadr args)))))) (t (throw wrong-type-argument "let: first argument neither label nor binding" (car args))))) (defun prog1 (arg . args) arg) diff --git a/lisp/flisp.lsp b/lisp/flisp.lsp index c5b0189..16013aa 100644 --- a/lisp/flisp.lsp +++ b/lisp/flisp.lsp @@ -4,7 +4,7 @@ (require 'core) -(defun listp (x) (cond ((null x)) ((consp x)))) +(defun listp (o) (cond ((null o)) ((consp o)))) (defmacro and args (cond @@ -12,8 +12,7 @@ ((null (cdr args)) (car args)) (t (list 'cond (list (car args) (cons 'and (cdr args))))))) -(defmacro or args - (cond (args (cons (quote cond) (map1 list args))))) +(defmacro or args (cons 'cond (mapcar list args))) (defun reduce (func seq start) (cond ((null seq) start) @@ -31,28 +30,37 @@ (defun min (n . args) (cond ((null (numberp n)) - (throw 'wrong-type-argument "not a number" n)) + (throw wrong-type-argument "not a number" n)) ((null args) n) (t (reduce (lambda (a b) (cond ((< a b) a) (t b))) args n)) )) -(defun nthcdr (n list) - (cond - ((> 0 n) (throw 'range-error "negativ index" n)) - ((= 0 n) list) - (t (nthcdr (- n 1) (cdr list))))) +(defun nthcdr (i l) + (cond + ((not (integerp i)) + (throw wrong-type-argument + (concat "(nthcdr i l) - i expected type-integer, got: " (type-of i)) + i)) + ((< i 0) (throw range-error "negative index" i)) + ((null l) nil) + ((= 0 i) l) + ((not (consp l)) + (throw wrong-type-argument + (concat "(nthcdr i l) - l expected type-cons, got: " (type-of l)) + l )) + (t (nthcdr (- i 1) (cdr l))))) (defun nth (n list) (car (nthcdr n list))) -(defun fold-right (f e l) +(defun fold-right (f o l) (cond - ((null l) e) - (t (f (car l) (fold-right f e (cdr l)))))) + ((null l) o) + (t (f (car l) (fold-right f o (cdr l)))))) -(defun unfold (func init pred) - (cond ((pred init) (cons init nil)) - (t (cons init (unfold func (func init) pred))))) +(defun unfold (func o p) + (cond ((p o) (cons o nil)) + (t (cons o (unfold func (func o) p))))) (defun iota (count . args) (let ( @@ -64,4 +72,20 @@ (pred (lambda (n) (= 0 count)))) (unfold func start pred)))) +;; +;; Commonly used Lisp functions which are not other wise used in the Femto libraries +;; +(defun atom (o) (null (consp o))) +(defun zerop (n) (= n 0)) + +(defmacro if args + (list 'cond (list (car args) (car (cdr args))) (cons 't (cdr (cdr args))))) + +(defun equal (o1 o2) + (or (and (atom o1) (atom o2) + (eq o1 o2)) + (and (consp o1) (consp o2) + (equal (car o1) (car o2)) + (equal (cdr o1) (cdr o2))))) + (provide 'flisp) diff --git a/lisp/prompt.lsp b/lisp/prompt.lsp index 41a0ab1..72089f1 100644 --- a/lisp/prompt.lsp +++ b/lisp/prompt.lsp @@ -5,7 +5,6 @@ ;; (require 'femto) -(require 'stdlib) ;; ;; set to empty diff --git a/lisp/startup.lsp b/lisp/startup.lsp index a768f94..218d8fe 100644 --- a/lisp/startup.lsp +++ b/lisp/startup.lsp @@ -4,19 +4,19 @@ (cond ((eq "*scratch*" (get-buffer-name)) (insert-string "\n\n\n\n") (insert-string " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n") - (insert-string " ;\n") - (insert-string " ;\n") - (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") (insert-string " ; / _| ___ _ __ ___ | |_ ___ \n") (insert-string " ; | |_ / _ \ '_ ` _ \| __/ _ \ \n") (insert-string " ; | _| __/ | | | | | || (_) | \n") (insert-string " ; |_| \___|_| |_| |_|\__\___/' \n") - (insert-string " ;\n") - (insert-string " ;\n") - (insert-string " ;\n") - (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") + (insert-string " ;\n") (insert-string " ; C-x h for help\n") - (insert-string " ;\n") + (insert-string " ;\n") (insert-string " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n\n\n") (insert-string " Tiny Emacs clone with Tiny-Lisp extension language\n ") (insert-string (get-version-string)) @@ -28,6 +28,8 @@ ((null opts)) ((consp opts) (cond + ((string-equal "-" (substring (car opts) 0 1)) + (throw wrong-type-argument "(getopts opts pos) - unknown option" (car opts)) ) ((eq "+" (car opts)) (getopts (cdr opts) 0)) ((eq "+" (substring (car opts) 0 1)) (getopts (cdr opts) (string-to-number (substring (car opts) 1)))) @@ -36,13 +38,23 @@ (cond ((> pos 0) (goto-line pos))) (getopts (cdr opts) 0)))) (t (throw wrong-type-argument "(getopts opts pos) - opts must be list")))) - + +;; Load and edit user specific config +(setq + config_dir ".config/femto" + config_file "femto.rc") + (defun confn(fn) - (concat ~ "/" config_dir "/" fn)) + (concat (getenv "HOME") "/" config_dir "/" fn)) (defun edit-config() (find-file (confn config_file))) +(defun log (level result . message) + (cond (result + (log-debug (concat level":"(car result)": "message" '"(caddr result)"' - "(cadr result)"\n")) ) + (t (log-debug (concat level": "message"\n"))) )) + (provide 'startup) ;; @@ -53,12 +65,16 @@ (require 'dired) (require 'grep) (require 'git) -(require 'oxo) + +(defun oxo () + ;; autoload info with c-x c-o + (require 'oxo) + (oxo) ) (defun show-info () ;; autoload info with c-x h (require 'info) - (show-info)) + (show-info) ) ;; ;; Key Bindings, setkey is used to bind keys to user defined functions in lisp @@ -85,29 +101,33 @@ (show-startup-message) ;; -;; this is used to set modes for different types of file when they get loaded +;; This is used to set modes for different types of file when they get loaded ;; (defun read-hook (s) (cond - ((string-contains "|c|h|cpp|" (get-buffer-file-extension)) (add-mode "cmode")) - ((string-contains "|rc|lsp|" (get-buffer-file-extension)) (add-mode "lispmode")) - ((string-contains "|py|" (get-buffer-file-extension)) (add-mode "python")))) - + ((string-search (get-buffer-file-extension) "|c|h|cpp|") (add-mode "cmode")) + ((string-search (get-buffer-file-extension) "|rc|lsp|") (add-mode "lispmode")) + ((string-search (get-buffer-file-extension) "|py|") (add-mode "python")))) -;; Load and edit user specific config -(setq - config_dir ".config/femto" - config_file "femto.rc") - -(setq rc (system (concat "test -f " (confn config_file)))) -(cond ((= 0 rc) (load (confn config_file)))) - - -;; mark the scratch buffer as unmodified, set to lispmode so that the comment comes up green +;; +;; Mark the scratch buffer as unmodified, set to lispmode so that the comment comes up green +;; (add-mode "lispmode") (delete-mode "modified") -;;(getopts argv 0) -(log-debug (concat "getopts: " (catch (getopts argv 0)))) - +;; +;; Try to load the user rc file +;; +(let ((rcfile (confn config_file)) (result nil)) + (setq result (catch (fstat rcfile))) + (cond ((car result) (log 'ERROR result "locating rc file")) + (t + (cond ((car (setq result (catch (load rcfile)))) + (log 'ERROR result "rc file not loaded")) + (t (log 'NOTICE nil "rc file '"rcfile"' loaded\n")) )))) +;; +;; Try to parse the commandline arguments +;; +(let ((result (catch (getopts argv 0)))) + (cond ((car result) (log 'ERROR result "parsing command line")))) diff --git a/lisp/stdlib.lsp b/lisp/stdlib.lsp deleted file mode 100644 index be48a9e..0000000 --- a/lisp/stdlib.lsp +++ /dev/null @@ -1,50 +0,0 @@ -;; Commonly used Lisp functions which are not used in the Femto libraries -;; leg20231203 -;; -;; Only uses core functions - -(defun atom (x) (null (consp x))) -(defun zerop (x) (= x 0)) - -(defmacro if args - (list 'cond (list (car args) (car (cdr args))) (cons 't (cdr (cdr args))))) - -(require 'flisp) -;; Note: not yet refactored to core functions -;; only do with unit tests -(defun equal (x y) - (or (and (atom x) (atom y) - (eq x y)) - (and (consp x) (consp y) - (equal (car x) (car y)) - (equal (cdr x) (cdr y))))) - -;; Note: to be enhanced -(defun _append (xs y) - (cond ((null xs) y) - (t (cons (car xs) (_append (cdr xs) y))))) - -(defun __append (xs y) - (cond ((null xs) y) - ((consp xs) - (cons (car xs) (_append (cdr xs) . y))) - (t (throw wrong-type-argument "(append arg args) - arg must be list" )))) - -(defun append args - (cond - ((null args) nil) - ((null (cdr args)) (car args)) - (t (__append (car args) (cdr args))))) - -(defun print (x . args) - (cond - ((null args) (write x :readably t)) - (t (write x :readably t :stream (car args))))) - -(defun princ (x . args) - (cond - ((null args) (write x :readably nil)) - (t (write x :readably nil :stream (car args))))) - - -(provide 'stdlib) diff --git a/lisp/testfunc.lsp b/lisp/testfunc.lsp index 169fc2f..8db6d3d 100644 --- a/lisp/testfunc.lsp +++ b/lisp/testfunc.lsp @@ -90,7 +90,7 @@ ;next-line ;number-to-string ;numberp -;os.getenv +;getenv ;other-window ;page-down ;page-up diff --git a/main.c b/main.c index 233a631..c3abd7c 100644 --- a/main.c +++ b/main.c @@ -36,13 +36,14 @@ void load_file(char *file) debug("failed to open file %s: %d", file, errno); return; } - interp->input = fd; + interp->input.fd = fd; interp->output = debug_fp; - lisp_eval(interp); - if (interp->result != nil) { - // Note: the error object can be printed with lisp_write_object - debug("failed to load file %s: %s\n", file, interp->msg_buf); + lisp_eval(interp, NULL); + if (FLISP_RESULT_CODE(interp) != nil) { + debug("failed to load file %s:\n", file); lisp_write_error(interp, debug_fp); + if (FLISP_RESULT_CODE(interp) == out_of_memory) + fatal("OOM, exiting.."); } if (fclose(fd)) debug("failed to close file %s\n", file); @@ -51,7 +52,7 @@ void load_file(char *file) int main(int argc, char **argv) { char *envv, *library_path, *init_file; - + batch_mode = ((envv=getenv("FEMTO_BATCH")) != NULL && strcmp(envv, "0")); debug_mode = ((envv=getenv("FEMTO_DEBUG")) != NULL && strcmp(envv, "0")); @@ -79,7 +80,7 @@ int main(int argc, char **argv) setup_keys(); /* Lisp interpreter */ - interp = lisp_new(FLISP_MEMORY_SIZE, argv, library_path, NULL, NULL, debug_fp); + interp = lisp_new(argv, library_path, NULL, NULL, debug_fp); if (interp == NULL) fatal("fLisp initialization failed"); @@ -149,16 +150,18 @@ char *eval_string(bool do_format, char *format, ...) prev = interp->output; // Note: save for double invocation with user defined functions. interp->output = open_memstream(&output, &len); - lisp_eval_string(interp, input); - if (interp->result == nil) - return output; + lisp_eval(interp, input); if (interp->output) fflush(interp->output); + if (FLISP_RESULT_CODE(interp) == nil) + return output; msg_lisp_err(interp); if (debug_mode) { lisp_write_error(interp, debug_fp); debug("=> %s\n", output); } + if (FLISP_RESULT_CODE(interp) == out_of_memory) + fatal("OOM, exiting.."); free_lisp_output(); return NULL; } diff --git a/makefile b/makefile index 3adb791..ef6d3c6 100644 --- a/makefile +++ b/makefile @@ -7,7 +7,7 @@ CPP = cpp #CPPFLAGS += -D_DEFAULT_SOURCE -D_BSD_SOURCE -DNDEBUG CPPFLAGS += -D_DEFAULT_SOURCE -D_BSD_SOURCE #CFLAGS += -O2 -std=c11 -Wall -pedantic -pedantic-errors -CFLAGS += -O0 -std=c11 -Wall -pedantic -pedantic-errors -g +CFLAGS += -O0 -std=c11 -Wall -pedantic -pedantic-errors -Werror=format-security -Wformat -g LD = cc LDFLAGS = LIBS = -lncursesw -lm @@ -28,9 +28,9 @@ INITFILE = $(SCRIPTDIR)/femto.rc OBJ = command.o display.o complete.o data.o gap.o key.o search.o \ buffer.o replace.o window.o undo.o funcmap.o utils.o hilite.o \ - femto_lisp.o double.o main.o + femto_lisp.o file.o double.o main.o -FLISP_OBJ = flisp.o lisp.o double.o +FLISP_OBJ = flisp.o lisp.o double.o file.o FLISP_LIBS = -lm BINARIES = femto flisp RC_FILES = femto.rc flisp.rc @@ -40,18 +40,22 @@ LISPFILES = femto.rc lisp/startup.lsp lisp/defmacro.lsp \ lisp/oxo.lsp lisp/flisp.lsp lisp/femto.lsp lisp/info.lsp \ lisp/string.lsp -FLISPFILES = flisp.rc lisp/flisp.lsp lisp/stdlib.lsp +FLISPFILES = flisp.rc lisp/flisp.lsp +FLISPSOURCES = lisp.c lisp.h double.c double.h file.c file.h DOCFILES = BUGS CHANGE.LOG.md README.md pdoc/flisp.html -MOREDOCS = README.html docs/flisp.md docs/femto.md +MOREDOCS = README.html docs/flisp.md docs/develop.md docs/femto.md \ + docs/editor.md +FLISP_DOCFILES = README.flisp.md docs/flisp.md pdoc/flisp.html \ + docs/develop.md pdoc/develop.html docs/editor.md \ + pdoc/editor.html -FLISP_DOCFILES = README.flisp.md docs/flisp.md pdoc/flisp.html - -.SUFFIXES: .rc .sht +.SUFFIXES: .rc .sht .md .html .sht.rc: ./sht $*.sht >$@ + # Artifacts all: femto @@ -82,7 +86,10 @@ femto: $(OBJ) femto.rc femto.rc: femto.sht lisp/core.lsp femto_lisp.o: lisp.c femto.register.c - $(CC) $(CPPFLAGS) $(CFLAGS) -D FLISP_FEMTO_EXTENSION -D FLISP_DOUBLE_EXTENSION -c lisp.c -o $@ + $(CC) $(CPPFLAGS) $(CFLAGS) -D FLISP_FEMTO_EXTENSION -D FLISP_FILE_EXTENSION -D FLISP_DOUBLE_EXTENSION -c lisp.c -o $@ + +file.o: file.c file.h lisp.h + $(CC) $(CPPFLAGS) $(CFLAGS) -D FLISP_DOUBLE_EXTENSION -c $< flisp: $(FLISP_OBJ) flisp.rc $(LD) $(LDFLAGS) -o $@ $(FLISP_OBJ) $(FLISP_LIBS) @@ -138,6 +145,12 @@ doc: $(MOREDOCS) docs/flisp.md: pdoc/flisp.html pdoc/h2m.lua pandoc -o $@ -t gfm -L pdoc/h2m.lua $< +docs/develop.md: pdoc/develop.html pdoc/h2m.lua + pandoc -o $@ -t gfm -L pdoc/h2m.lua $< + +docs/editor.md: pdoc/editor.html pdoc/h2m.lua + pandoc -o $@ -t gfm -L pdoc/h2m.lua $< + docs/femto.md: pdoc/femto.html pdoc/h2m.lua pandoc -o $@ -t gfm -L pdoc/h2m.lua $< @@ -159,20 +172,26 @@ flv: flisp FORCE frama-c: FORCE frama-c -c11 -cpp-extra-args="-I$(frama-c -print-path)/libc -I/usr/include -I." -kernel-msg-key pp -metrics *.c -measure: strip FORCE +measure: $(RC_FILES) $(BINARIES) strip FORCE + @ln -s femto.rc femto.lsp + @ln -s flisp.rc flisp.lsp @echo Total - @echo binsize: $$(set -- $$(ls -l femto); echo $$5) - @echo C-lines: $$(cat *.c *.h | wc -l) - @echo linecount: $$(cat *.c *.h $(LISPFILES) | wc -l) - @echo sloccount: $$(set -- $$(which sloccount >/dev/null && { sloccount *.c *.h $(LISPFILES) | grep ansic=; }); echo $$3) - @echo files: $$(ls *.c *.h $(LISPFILES) | wc -l) - @echo C-files: $$(ls *.c *.h | wc -l) + @echo "binsize: " $$(set -- $$(ls -l femto); echo $$5) + @echo "C/Lisp lines: " $$(cat *.c *.h | wc -l) / $$(cat $(LISPFILES) | wc -l) + @echo "Total lines: " $$(cat *.c *.h $(LISPFILES) | wc -l) + @echo "Total slocs: " $$(set -- $$(which sloccount >/dev/null && { sloccount *.c *.h femto.lsp $(LISPFILES) | grep ansic=; }); echo $$3) + @echo "C/Lisp files: " $$(ls *.c *.h | wc -l) / $$(echo $(LISPFILES) | wc -w) + @echo "Total files: " $$(ls *.c *.h $(LISPFILES) | wc -l) @echo Minimum - @echo flisp: $$(cat flisp.c | wc -l) - @echo flispsloc: $$(set -- $$(which sloccount >/dev/null && { sloccount flisp.c | grep ansic=; }); echo $$3) - @echo linecount: $$(cat *.c *.h $(LISPFILES) | wc -l) - @echo sloccount: $$(set -- $$(which sloccount >/dev/null && { sloccount *.c *.h *.rc $(LISPFILES) | grep ansic=; }); echo $$3) - @echo files: $$(ls *.c *.h $(LISPFILES) | wc -l) + @echo "binsize: " $$(set -- $$(ls -l flisp); echo $$5) + @echo "flisp: " $$(cat flisp.c | wc -l) + @echo "flispsloc: " $$(set -- $$(which sloccount >/dev/null && { sloccount flisp.c | grep ansic=; }); echo $$3) + @echo "C-lines: " $$(cat $(FLISPSOURCES) | wc -l) + @echo "Lisp-lines: " $$(cat $(FLISPFILES) | wc -l) + @echo "sloccount: " $$(set -- $$(which sloccount >/dev/null && { sloccount flisp.lsp $(FLISPSOURCES) $(FLISPFILES) | grep ansic=; }); echo $$3) + @echo "C-files: " $$(ls $(FLISPSOURCES) | wc -l) + @echo "Lisp-files: " $$(ls $(FLISPFILES) | wc -l) + @rm femto.lsp flisp.lsp run: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto @@ -180,9 +199,22 @@ run: femto FORCE splint: FORCE splint +posixlib -macrovarprefix "M_" *.c *.h -test: flisp femto FORCE - (cd test && SUMMARY=1 ./run) +test: flisp femto test/test.rc FORCE + @(cd test && ./test -as) + +# Exit 1 if any testsuite fails +check: flisp femto test/test.rc FORCE + @(cd test && ./test -sa | grep tests, | \ + while read RESULT; do \ + RESULT=$${RESULT#* tests, }; \ + RESULT=$${RESULT% failures*}; \ + [ "$$RESULT" = 0 ] || { echo failed >&2; exit 1; } \ + done ) +test/test.rc: test/test.sht lisp/core.lsp + + +# Manually test femto invocation and review syntax highlighting ftest: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto _no_file_ @@ -191,25 +223,21 @@ ftest: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto +8 lisp.c FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 ./femto +6 lisp/core.lsp -test_core: test/core.lsp flisp - <$< FLISPRC= FLISPLIB= ./flisp > test/core.now && sed 's/Stream 0x\(.\+\),/Stream /' test/core.now | diff -q - test/core.out -test/core.out: test/core.lsp flisp - <$< FLISPRC= FLISPLIB= ./flisp | sed 's/Stream 0x\(.\+\),/Stream /' > test/core.out - val: femto FORCE FEMTORC=femto.rc FEMTOLIB=lisp FEMTO_DEBUG=1 valgrind ./femto 2> val.log # Install/package -strip: femto FORCE - strip femto +strip: femto flisp FORCE + strip femto flisp clean: FORCE -$(RM) -f $(OBJ) $(FLISP_OBJ) $(BINARIES) $(RC_FILES) -$(RM) -rf doxygen -$(RM) -f $(MOREDOCS) - -$(RM) -f val.log debug.out f.log test/f.log + -$(RM) -f val.log debug.out f.log -$(RM) -rf debian/femto debian/files \ debian/femto.debhelper.log debian/femto.substvars + -$(RM) -f test/test.rc test/debug.out deb: FORCE dpkg-buildpackage -b -us -uc diff --git a/misc/ROADMAP.femto b/misc/ROADMAP.femto new file mode 100644 index 0000000..81ffd05 --- /dev/null +++ b/misc/ROADMAP.femto @@ -0,0 +1,31 @@ +-*- mode: markdown; fill-column: 80 -*- + +# Next + +- Fix file save bug by using + fmkdir. https://github.com/hughbarney/femto/issues/14 +- Make fLisp read from /dev/null to avoid: + https://github.com/hughbarney/femto/issues/10 +- Documentation + - https://github.com/hughbarney/femto/issues/40 + - https://github.com/hughbarney/femto/issues/39 + - https://github.com/hughbarney/femto/issues/37 + - https://github.com/hughbarney/femto/issues/36 +- Close: + - https://github.com/hughbarney/femto/issues/1 + +# Future +- Pipe a buffer through a shell command and read the output back into a + different buffer. +- Refactor include system + - rename main.c to femto.c + - rename header.h to femto.h +- Change eval_block to eval_region. +- Find out how to build on NetBSD: problem is ncurses libraries +- Improve/support batch mode: output = stdout. +- Implement per buffer keymaps. +- Write a test file for all lisp functions. + +# femto 2.24.2 + +- Make femto.rc use fstat instead of (system "test -f") diff --git a/misc/ROADMAP.flisp b/misc/ROADMAP.flisp new file mode 100644 index 0000000..253c9c5 --- /dev/null +++ b/misc/ROADMAP.flisp @@ -0,0 +1,97 @@ +-*- mode: markdown; fill-column: 80 -*- + +# ROADMAP + +## Next + +- Rename global argv to command-line-args, argv0 to invocation-name. + + +## Future + +- Implement `(flisp subcommand[arg..])` introspection and configuration command. + - (flisp version) => version string + - (flisp input[ fd]) + - (flisp output[ fd]) + - (flisp error[ fd]) + - (flisp debug[ fd]) + - (flisp types[ type..]) => list of types + - (flisp gc) => memory info +- Implement backquote and friends. + - The reader already implements '`', ',' and ',@' as `quasiquote`, `unquote` + and `splice-unquote`. +- Fix reduce, implement map, consider simplifying core functions and make them + n-ary in Lisp. +- Make extensions plugable. +- Cleanup cerf: not so easy to do. +- Add read and eval tracing. +- Hash + - Add new 'hash' field as uintptr_t to Lisp object struct type union. + - Initialize each string type object with a hash of 0. +- Dynamic types + - Make 'type' postfix of name instead of prefix. type-string -> string-type. + - Add Object * interp->types to interpreter struct and register types there. + - Use the hash of types for type checking. +- String size restriction + - Memory allocator restricts the size of string objects. + - Option to dynamically adjust or not. + - Default size = max input string + - Rationale: embedding, 32, 16, 8 bit versions +- posit's: https://en.wikipedia.org/wiki/Unum_(number_format) +- Size reduction: + - Make double extensions optional. + - Replace string-contains with string-search. + - Make file extension optional. + - (file-readable-p filename) in core to replace (fstat) in femto.rc/flisp.rc + - Reduce binary operators to 'and' and 'xor' and write needed rest in Lisp. +- Event based I/O + - Buffered I/O operations throw yield exception if buffers are full (w) /empty + (r). +- Test more then one interpreter. +- ? CSP between interpreters? + +## fLisp 0.13 +- Implemented interp introspection and configuration command with version and + input subcommands. +- Implemented simple repl in Lisp and minimized flisp.c +- Replace setq and define with bind in the core. setq is defined in core.lsp +- Moved append, fold-left, flip, reverse, apply, print, princ to core.lsp +- Renamed os.env to getenv and move to file extension. +- Unified stdlib into flisp.lsp (again). +- Moved (system) to file extension. + +## fLisp 0.12 + +- dynamic memory allocation. +- FLISP_RESULT macros have interp as parameter. +- chunk size and initial memory allocations tuned to femto. +- all memory allocation related Note's fixed. +- optional primitive trace mechanism. +- bitwise integer operations. +- file: feof, fgets, popen, pclose, fstat, mkdir; documentation. +- Poor man's unit test framework in Lisp. + +## fLisp 0.11 + +- Showcase lisp_eval2 with (catch (fread)) mechanism. +- string search +- string-to-number in Lisp by using (read f) from a memory stream. + +## fLisp 0.10 + +- double extension +- variadic multi-typed arithmetic +- (same) primitive, (eq) in Lisp +- fold, unfold, iota + +## fLisp 0.9 + +- core uses only 64 bit integers. +- string-search in core. +- type-of +- all type predicates except null and consp in Lisp. + +## fLisp 0.8 + +- error and object types are Lisp symbols instead of C-enums. + diff --git a/misc/ROADMAP.flisp.txt b/misc/ROADMAP.flisp.txt deleted file mode 100644 index ce74423..0000000 --- a/misc/ROADMAP.flisp.txt +++ /dev/null @@ -1,23 +0,0 @@ -+ Bump fLisp version: reason: error type symbols instead of result codes -+ Add error type symbols to the top level environment -+ Change to 64 bit integers -+ Implement type-of, curry and move all type predicates except null and consp from C to Lisp. -+ Add search to string library -+ implement fold -- Showcase lisp_eval2 with (catch (fread)) mechanism -- Implement fstat and improve femto.rc -- Implement mkdir and fix file save bug -- Move string-to-number to Lisp by using (read f) from a memory stream. -- Implement backquote and friends -- Fix reduce, implement map, consider simplifying core functions and make them n-ary in Lisp. -- Fix string library, -- Unify stdlib into flisp.lsp -- Implement simple repl in Lisp - - needs getline - - isatty() can set an 'interactive' flag -- rename global argv to command-line-args, argv0 to invocation-name -- rename os.env to getenv -- improve/support batch mode, start a test library -- make extensions plugable -- test more then one interpreter -- ? CSP between interpreters? diff --git a/pdoc/develop.html b/pdoc/develop.html new file mode 100644 index 0000000..6077e64 --- /dev/null +++ b/pdoc/develop.html @@ -0,0 +1,311 @@ + + + + fLisp Embedding and Development + + + + + + + +

fLisp Implementation Details

+ + fLisp Manual (Markdown) + +

Table of Contents

+
    +
  1. Embedding Overview
    2. +
  2. fLisp C Interface
    3. +
  3. Building Extensions
    4. +
+
  • Implementation Details +
      +
    1. Garbage Collection
      2. +
    2. Memory Usage
      3. +
    3. Future Directions
      4. +
    + + +

    Embedding fLisp

    +

    Embedding Overview

    + +

    + fLisp can be embedded into a C application. Two examples of embedding are the femto editor and the + simplistic flisp command line Lisp interpreter. +

    +

    + Currently embedding can only be done by extending the build system. Application specific binary Lisp extensions + are stored in separated C files and the interface code is conditionally included into the lisp.c + file. Three extensions are provided: the Femto extension which provides the editor functionality, the file + extension which provides access to the low level stream I/O functions and others and the double extensions which + provides double float arithmetic. +

    + fLisp exposes the following public interface functions: +

    +
    +
    lisp_new()
    Create a new interpreter.
    +
    lisp_destroy()
    Destroy an interpreter, releasing resources.
    +
    lisp_eval()
    Evaluate a string or the input stream until exhausted or error.
    +
    lisp_write_object()
    Format and write object to file descriptor.
    +
    lisp_write_error()
    +
    Format and write the error object and error message of an interpreter to a file descriptor.
    +
    +

    + Different flows of operation can be implemented. The femto editor initializes the interpreter without + input/output file descriptors and sends strings of Lisp commands to the interpreter, either when a key is pressed + or upon explicit request via the editor interface. +

    +

    + The flisp command line interpreter sets stdout as the default output file descriptors of + the fLisp interpreter and feeds it with strings of lines read from the terminal. If the standard input is + not a terminal stdin is set as the default input file descriptor and fLisp reads through it + until end of file. +

    +

    + After processing the input, the interpreter holds the results corresponding to + a catch result in its internal structure. They can be accessed with the + following C-macros: +

    +
    +
    error_type
    +
    FLISP_RESULT_CODE(interpreter)
    +
    message
    +
    FLISP_RESULT_MESSAGE(interpreter)
    +
    object
    +
    FLISP_RESULT_OBJECT(interpreter)
    +
    +

    + Check for (FLISP_RESULT_OBJECT(interpreter) != nil) to find out if the result is an error. Then check + for (FLISP_RESULT_OBJECT(interpreter) == out_of_memory) to see if a fatal condition occured. +

    +

    + On error use lisp_write_error() to write the standard error message to a file descriptor of choice, + or use the above C-macros and FLISP_ERROR_MESSAGE(interpreter)->string for executing a specific + action. +

    +

    + fLisp sends all output to the default output stream. If it is set to NULL on initialization, + output is suppressed altogether. +

    + +

    fLisp C Interface

    +
    +
    Interpreter *lisp_new(char **argv, char *library_path, FILE *input, + FILE *output, FILE* debug)
    +
    +

    + lisp_new() creates and initializes an fLisp interpreter and returns a pointer to + an Interpreter struct to be used in the other functions. The arguments to lisp_new() + are: +

    +
    +
    +
    argv
    +
    library_path
    +
    + The fLisp environment is initialized with this two argument to contain the following symbols: +
    +
    argv0
    The string stored in *argv[0], if any
    +
    argv
    The list of strings stored in argv
    +
    script_dir
    The string stored in library_path
    +
    +
    +
    input
    +
    + Default input stream. If input is set to NULL, the input stream has to be + specified for each invocation of lisp_eval(). +
    +
    output
    +
    + Default output stream. If output is set to NULL a memory stream is created at the + first invocation of the interpreter and set as the default output stream. +
    debug
    +
    Debug output stream. If set to NULL no debug information is generated.
    +
    +
    + +
    void lisp_destroy(Interpreter *interp)
    +
    Frees all resources used by the interpreter.
    + +
    + void lisp_eval(Interpreter *interp, char *string)
    +
    + If string is not NULL evaluates all Lisp expressions in string. +
    +
    + If string is NULL input from the file descriptor in the input field of + the fLisp interpreter interp is evaluated until end of file. +
    + +
    + If no memory can be allocated for the input string or the input file descriptor is NULL no Lisp + evaluation takes place and FLISP_RESULT_CODE field of the interpreter is set to an io-error. +
    +
    + void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, + bool readably) +
    +
    + Format object into a string and write it to stream. If readably is true, the + string can be read in by the interpreter and results in the same object. +
    +
    void lisp_write_error(Interpreter *interp, FILE *fd)
    +
    + Format the error object and the error message of the interpreter into a string and write it + to fd. The object is written with readably true. +
    +
    + +

    Note: currently only creating one interpreter has been tested.

    + +

    Building Extensions

    + +

    + An extensions has to create C functions with the + signature: Object *primitive(Interpreter *interp, Object **args, Object **env), + where primitive is a distinct name in C space. This function has to be added to the global + variable primitives in the following + format: {"name", argMin, argMax, type_check, primitive}. Here + name is a distinct name in Lisp space. +

    +

    + interp is the fLisp interpreter in which primitive is executed. + argMin is the minimum number of arguments, argMax is the maximum number of arguments allowed + for the function. If argMax is a negative number, arguments must be given in tuples + of argMax and the number of tuples is not restricted. +

    +

    + When type check is set to on of the TYPE_* C-macros the interpreter assures that all arguments are of + the given type and creates a standardized exception otherwise. When type check is set to 0 the + primitive has to take care of type checking by itself. The C-macro CHECK_TYPE helps with this. +

    +

    + When creating more then one new objects within a primitive, care has to be taken to register them with the garbage + collector. Registration is started with the + GC_CHECKPOINT CPP macro. GC_TRACE(name, value creates an object + variable name, sets it to value and registers it with the garbage collector. The + macro GC_RELEASE must be called to finalize the registration. The convenience + macro GC_RETURN(object) calls GC_RELEASE and returns object. +

    +

    + Some CPP macros are provided to simplify argument access and validation in primitives: +

    +
    +
    FLISP_HAS_ARGS
    +
    FLISP_HAS_ARG_TWO
    +
    FLISP_HAS_ARG_THREE
    +
    Evaluate to true if there are arguments or the respective argument is available.
    +
    FLISP_ARG_ONE
    +
    FLISP_ARG_TWO
    +
    FLISP_ARG_THREE
    +
    Evaluate to the respective argument.
    +
    CHECK_TYPE(argument, type, signature)
    +
    + Assures that the given argument is of the given type. type must be a type variable + like type_string. signature is the signature of the primitive followed + by  -  and the name of the argument to be type checked. This is used to form a + standardized wrong-type-argument error message. +
    +
    + +

    Implementation Details

    + +

    Garbage Collection

    +

    + fLisp implements Cheney's copying garbage collector, with which memory is divided into two equal + halves (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used + during garbage collection. The from-space part of the memory is also called the Lisp object space. +

    +

    + When garbage collection is performed, objects that are still in use (live) are copied from from-space to + to-space. To-space then becomes the new from-space and vice versa, thereby discarding all objects that have not + been copied. +

    +

    + Our garbage collector takes as input a list of root objects. Objects that can be reached by recursively traversing + this list are considered live and will be moved to to-space. When we move an object, we must also update its + pointer within the list to point to the objects new location in memory. +

    +

    + However, this implies that our interpreter cannot use raw pointers to objects in any function that might trigger + garbage collection (or risk causing a SEGV when accessing an object that has been moved). Instead, objects must be + added to the list and then only accessed through the pointer inside the list. +

    +

    + Thus, whenever we would have used a raw pointer to an object, we use a pointer to the pointer inside the list + instead: +

    + 
    +      function:              pointer to pointer inside list (Object **)
+      |
+      v
+      list of root objects:  pointer to object (Object *)
+      |
+      v
+      semi space:             object in memory
+
    +

    + GC_TRACE adds an object to the list and declares a variable which points to the objects + pointer inside the list. +

    +

    + GC_TRACE(gcX, X): add object X to the list and + declare Object **gcX to point to the pointer to X inside the list. +

    +

    + Information about the garbage collection process and memory status is written to the debug file descriptor. +

    +

    Memory Allocation

    +

    + Object allocation adjusts the size of the Lisp object space on demand: If after garbage collection the free space + is less then the required memory plus some reserved space for exception reporting, the memory is increased by a + multiple of the amount specified in the C-macro FLISP_MEMORY_INC, defined in lisp.h. The + multiple is calculated to hold at least the additional requested space. +

    + lisp_new() allocates FLISP_MIN_MEMORY, defined in lisp.h, and then + allocates all initial objects without taking care of garbage collection. Then it prints out the amount of Lisp + object space consumed to the debug file descriptor. For fLisp this is currently about 21 kB, + for femto about 34 kB. +

    +

    + In order to reduce garbage collection frequency, especially during startup, one can + set FLISP_INITIAL_MEMORY to a desired additional amount of memory to allocate on startup. +

    + Some other compile time adjustable limits in lisp.h: +

    +
    +
    Input buffer
    +
    + 2048, INPUT_FMT_BUFSIZ, size of the formatting buffer for lisp_eval() and for the + input buffer of (fgets). +
    +
    Output buffer
    2048, WRITE_FMT_BUFSIZ, size of the output and message formatting buffer.
    +
    +

    + fLisp can live with as little as 50k object memory up to startup. The Femto editor requires much more + memory because of the needs of the OXO game. +

    + +

    Future Directions

    +

    + Loops are availble via the labelled let macro and supported by iota. It could made easier, by any + combination of: +

    +
      +
    • loop/while/for macro
      • +
    • Demoing hand crafted loops including breaking with throw.
      • +
    +

    Implement backquote and friends.

    +

    Pluggable extensions.

    +

    Take away more things.

    + + + + + diff --git a/pdoc/editor.html b/pdoc/editor.html new file mode 100644 index 0000000..31b0681 --- /dev/null +++ b/pdoc/editor.html @@ -0,0 +1,400 @@ + + + + fLisp Femto Editor Extension + + + + + + + +

    fLisp Femto Editor Extension

    + + fLisp Manual (Markdown) + +

    Overview

    + +

    The editor extension introduces several types of objects:

    +
      +
    • Buffers hold text
      • +
    • Windows display buffer contents to the user
      • +
    • Keyboard Input allows the user to interact with buffers and windows
      • +
    • The Message Line gives feedback to the user
      • +
    • Several other function for operating system or user interaction
      • +
    +

    + Several Lisp libraries make use of the extensions primitives to provide advanced + functionality. +

    + +

    Table of Contents

    +
      +
    1. Overview
      2. +
    2. Table of Contents
      3. +
    3. Editor Extension
      4. +
        +
      1. Buffers
        2. +
          +
        1. Text manipulation
          2. +
        2. Selection
          3. +
        3. Cursor Movement
          4. +
        4. Buffer management
          5. +
        +
      2. User Interaction
        3. +
          +
        1. Window Handling"
          2. +
        2. Message Line
          3. +
        3. Keyboard Handling
          4. +
        4. Programming and System Interaction
          5. +
        +
      +
    4. Lisp Libraries
      5. +
        +
      1. femto +
      2. bufmenu Buffer Selection Menu
        3. +
      3. defmacro Editor Macros
        4. +
      4. dired Directory Navigation
        5. +
      5. info Builtin Help
        6. +
      6. git Git Repo Helper
        7. +
      7. grep File Content Search
        8. +
      8. oxo Tic-Tac-Toe Game
        9. +
      +
    + +

    Editor Extension

    + +

    Buffers

    + +

    + This section describes the buffer related functions added by Femto to fLisp. The description is separated in + function related to buffer management and text manipulation. Text manipulation always operates on + the current buffer. Buffer management creates, deletes buffers, or selects one of the existing buffers + as the current buffer. +

    + +

    Buffers store text and allow to manipulate it. A buffer has the following properties:

    +
    +
    name
    +
    + Buffers are identified by their name. If a buffer name is enclosed in *asterisks* the + buffer receives special treatment. +
    +
    text
    +
    zero or more characters.
    +
    point
    +
    + The position in the text where text manipulation takes place. The first position in the text is 0. Note: + in Emacs the first position is 1. +
    +
    mark
    +
    + An optional second position in the text. If the mark is set, the text between point + and mark is called the selection or region. +
    +
    filename
    +
    If set the buffer is associated with the respective file.
    +
    flags
    +
    + Different flags determine the behavior of the buffer. Editor specific + flags: special, modified. +
    +
    Mode flags determine the syntax highlighter mode: cmode and lispmode are + available. If none is set text mode is used for syntax hightlighting.
    +
    + +

    In the following, any mention to one of them refers to the respective current buffers property.

    + +
    Text manipulation
    + +
    +
    (insert-string string)
    +
    Inserts string before point. S: insert.
    +
    (insert-file-contents-literally string [flag])
    +
    + Inserts the file string after point. If flag is not nil the buffer is marked as not + modified. B +
    +
    +

    + Note: Currently the flag is forced to nil. The function should + return (filename count) but it returns a flag indicating if the operation + succeeded. +

    +
    +
    (erase-buffer)
    +
    Erases all text in the current buffer. C
    +
    (delete)
    +
    Deletes the character after point. S: delete-char
    +
    (backspace)
    +
    Deletes the character to the left of point. S: delete-backward-char
    +
    (get-char)
    +
    Returns the character at point. S: get-byte
    +
    (copy-region)
    +
    Copies region to the clipboard. S: copy-region-as-kill
    +
    (kill-region)
    +
    Deletes the text in the region and copies it to the clipboard. D
    +
    (yank)
    +
    Pastes the clipboard before point. C
    +
    + +
    Selection
    + +
    +
    (set-mark)
    +
    Sets mark to point. D
    +
    (get-mark)
    +
    Returns the position of mark, -1 if mark is unset. S: mark
    +
    (get-point)
    +
    Returns the position of point. S: point
    +
    (get-point-max)
    +
    Returns the maximum accessible value of point in the current buffer. S: point-max
    +
    (set-clipboard variable)
    +
    Sets clipboard to the contents of variable. S: gui-set-selection
    +
    (get-clipboard)
    +
    Returns the clipboard contents. S: gui-get-selection
    +
    + +
    Cursor Movement
    + +
    +
    (set-point number)
    +
    Sets the point to in the current buffer to the position number. S: goto-char
    +
    (goto-line number)
    +
    + Sets the point in the current buffer to the first character on line number. S: goto-line, not + an Elisp function. +
    +
    (search-forward string)
    +
    + Searches for string in the current buffer, starting from point forward. If string is found, sets the + point after the first occurrence of string and returns t, otherwise leaves point alone + and returns nil. D +
    +
    (search-backward string)
    +
    + Searches for string in the current buffer, starting from point backwards. If string is found, sets + the point before the first occurrence of string and returns t, otherwise leaves point + alone and returns nil. D +
    +
    (beginning-of-buffer)
    +
    + Sets the point in the current buffer to the first buffer position, leaving mark in its current + position. C +
    +
    (end-of-buffer)
    +
    + Sets the point in the current buffer to the last buffer position, leaving mark in its current position. C +
    +
    (beginning-of-line)
    +
    + Sets point before the first character of the current line, leaving mark in its current position. S: + move-beginning-of-line +
    +
    (end-of-line)
    +
    + Sets point after the last character of the current line, i.e. before the end-of-line character sequence, leaving + mark in its current position. S: move-end-of-line +
    +
    (forward-word)
    +
    + Moves the point in the current buffer forward before the first char of the next word. If there is no word left + the point is set to the end of the buffer. If the point is already at the start or within a word, the current + word is skipped. D: Note: Elisp moves to the end of the the next word. +
    +
    (backward-word)
    +
    + Moves the point in the current buffer backward after the last char of the previous word. If there is no word + left the point is set to the beginning of the buffer. If the point is already at the end or within a word, the + current word is skipped. D: Note: Elisp moves to the beginning of the previous word. +
    +
    (forward-char)
    +
    Moves the point in the current buffer one character forward, but not past the end of the buffer. C
    +
    (backward-char)
    +
    + Moves the point in the current buffer one character backward, but not before the end of the + buffer. C +
    +
    (forward-page)
    +
    + Moves the point of the current buffer to the beginning of the last visible line of the associated screen and + scrolls the screen up to show it as the first line. S: scroll-up +
    +
    (backward-page)
    +
    + Moves the point of the current buffer to the beginning of the first visible line of the associated screen and + scrolls the screen down to show it as the last line. S: scroll-down +
    +
    (next-line)
    +
    + Moves the point in the current buffer to the same character position in the next line, or to the end of the next + line if there are not enough characters. In the last line of the buffer moves the point to the end of the + buffer. C +
    +
    (previous-line)
    +
    + Moves the point in the current buffer to the same character position in the previous line, or to the end of the + previous line if there are not enough characters. In the first line of the buffer the point is not + moved. C +
    +
    + +
    Buffer management
    + +
    +
    (list-buffers)
    +
    Lists all the buffers in a buffer called *buffers*.
    +
    (get-buffer-count)
    +
    Returns the number of buffers, includes all special buffers and *buffers*.
    +
    (select-buffer string)
    +
    Makes the buffer named string the current buffer. Note: C to set-buffer in Elisp.
    +
    (rename-buffer string)
    +
    Rename the current buffer to string. C
    +
    (kill-buffer string)
    +
    Kill the buffer names string. Unsaved changes are discarded. C
    +
    (get-buffer-name)
    +
    Return the name of the current buffer. Note: C to buffer-name in Elisp.
    +
    (add-mode-global string)
    +
    Sets global mode string for all buffers. Currently the only global mode is undo.
    +
    (add-mode string)
    +
    Set a flag for the current buffer.
    +
    (delete-mode string)
    +
    Reset a flag for the current buffer.
    +
    (find-file string)
    +
    + Loads file with path string into a new buffer. After + loading (read-hook string) is called. C +
    +
    (save-buffer string)
    +
    Saves the buffer named string to disk. C
    +
    + +

    User Interaction

    + +

    + This section lists function related to window and message line manipulation, keyboard input and system + interaction. +

    + +
    Window Handling
    + +
    +
    (delete-other-windows)
    +
    Make current window the only window. C
    +
    (split-window)
    +
    Splits the current window. Creates a new window for the current buffer. C
    +
    (other-window)
    +
    + Moves the cursor to the next window down on the screen. Makes the buffer in that window the current + buffer. D +
    +
    +

    Note: Elisp other-window has a required parameter count, which specifies the number + of windows to move down or up. +

    +
    +
    (update-display)
    +
    Updates all modified windows.
    +
    (refresh)
    +
    Updates all windows by marking them modified and calling update-display.
    +
    + +
    Message Line
    +
    +
    (message string)
    +
    Displays string in the message line. D
    +
    (clear-message-line)
    +
    Displays the empty string in the message line.
    +
    (prompt prompt default)
    +
    + Displays prompt in the command line and sets default as initial value for the user + response. The user can edit the response. When hitting return, the final response is returned. +
    +
    (show-prompt prompt default)
    +
    + Displays prompt and default in the command line, but does not allow + editing. Returns t. +
    +
    (prompt-filename prompt)
    +
    + Displays prompt in the command line and allows to enter or search for a file name. Returns the + relative path to the selected file name or the response typed by the user. +
    +
    + +
    Keyboard Handling
    + +
    +
    (set-key key-name lisp-func)
    +
    Binds key key-name to the lisp function lisp-func.
    +
    (get-key-name)
    +
    Returns the name of the currently pressed key, eg: c-k for control-k.
    +
    (get-key-funcname)
    +
    Return the name of the function bound to the currently pressed key.
    +
    (execute-key)
    +
    Executes the function of the last bound key. Tbd. bound or pressed?
    +
    (describe-bindings)
    +
    + Creates a listing of all current key bindings, in a buffer named *help* and displays it in a new + window. C +
    +
    (describe-functions)
    +
    + Creates a listing of all functions bound to keys in a buffer named *help* and displays it in a new + window. +
    +
    (getch)
    +
    + Waits for a key to be pressed and returns the key as string. See + also get-key-name, get-key-funcname and execute-key. +
    +
    + +
    Programming and System Interaction
    + +
    +
    (exit)
    +
    Exit Femto without saving modified buffers.
    +
    (eval-block)
    +
    + Evaluates the region in the current buffer, inserts the result at point and returns + it. If mark in the current buffer is before point eval-block evaluates + this region and inserts the result at point. If point is + before mark eval-block does nothing but returning t. +
    +
    (log-message string)
    +
    Logs string to the *messages* buffer.
    +
    (log-debug string)
    +
    Logs string to the file debug.out.
    +
    (get-version-string)
    +
    Returns the complete version string of Femto, including the copyright.
    +
    + +

    Lisp Libraries

    +

    Tbd.: document the libraries.

    + +

    femto

    + +

    Femto editor specific functions.

    +

    + This library implements helper function required by the Femto editor. It is written only in fLisp + primitives and plus the flisp Library. +

    + +

    bufmenu Buffer Selection Menu

    +

    defmacro Editor Macros

    +

    dired Directory Navigation

    +

    info Builtin Help

    +

    git Git Repo Helper

    +

    grep File Content Search

    +

    oxo Tic-Tac-Toe Game

    + + + + + diff --git a/pdoc/flisp.html b/pdoc/flisp.html index 40eda79..e289442 100644 --- a/pdoc/flisp.html +++ b/pdoc/flisp.html @@ -21,20 +21,19 @@

    Introduction

    — Antoine de Saint-Exupery

    - fLisp is a tiny yet practical interpreter for a dialect of the Lisp programming language. It is used as - extension language for the Femto text editor. + fLisp is a tiny yet practical interpreter for a dialect of the Lisp programming language. It can be + embedded into other applications and is extensible via C libraries. fLisp is used as extension language for + the Femto text editor, see the editor extension + manual (Markdown) for details.

    - fLisp is hosted in the Femto Github repository, it is + fLisp is hosted in the Femto Github repository and released to the public domain.

    fLisp is a Lisp-1 interpreter with Scheme like lexical scoping, tailcall optimization and other Scheme - influences. -

    -

    - fLisp originates from Tiny-Lisp by matp (pre 2014), was - integrated into Femto by Hugh Barney (pre 2016) and compacted by - Georg Lehner in 2023. + influences. fLisp originates from Tiny-Lisp by matp (pre + 2014), was integrated into Femto by Hugh Barney (pre 2016) and + extended by Georg Lehner since 2023.

    This is a reference manual. If you want to learn about Lisp programming use other resources eg.

    - This manual refers to version 0.6 or later of fLisp. + This manual refers to version 0.13 or later of fLisp.

    Table of Contents

      @@ -67,48 +66,23 @@

      Table of Contents

    1. Input / Output and Others
    2. Object Operations
    3. Arithmetic Operations
      4. +
    4. Bitwise Integer Operations
    5. String Operations
    -
  • Double Extension
    • +
  • Extensions
    • +
      +
    1. File Extension
      2. +
    2. Double Extension
      3. +
  • Lisp Libraries
    1. Library Loading
    2. Core Library
    3. fLlisp Library
      4. -
    4. Standard Library
      5. -
    5. Femto Library
      6. -
    -
  • Editor Extension
    • -
      -
    1. Buffers
      2. -
        -
      1. Text manipulation
        2. -
      2. Selection
        3. -
      3. Cursor Movement
        4. -
      4. Buffer management
        5. -
      -
    2. User Interaction
      3. -
        -
      1. Window Handling"
        2. -
      2. Message Line
        3. -
      3. Keyboard Handling
        4. -
      4. Programming and System Interaction
        5. -
      -
    -
  • Embedding fLisp
    • -
      -
    1. Embedding Overview
      2. -
    2. fLisp C Interface
      3. -
    3. Building Extensions
      4. -
    -
  • Implementation Details
    • -
      -
    1. Garbage Collection
      2. -
    2. Memory Usage
      3. -
    3. Future Directions
    +
  • fLisp Embedding and Development (Markdown)
    • - +

    Notation Convention

    We use the following notation rule to describe the fLisp syntax:

    @@ -128,19 +102,19 @@

    Notation Convention

    syntactical elements.

    - Variables names convey the following context: + Variable names convey the following context:

    Lisp object of any type:
    object value o a b c
    Program elements:
    -
    params opt body expr pred
    +
    arg args params opt body expr pred p
    Integer:
    i j k
    Double:
    x y z
    Any numeric type:
    -
    num num1 num2
    +
    n n1 n2
    Symbol:
    symbol
    String:
    @@ -148,7 +122,9 @@

    Notation Convention

    List/Cons:
    cons l l1 l2 …
    Stream:
    -
    stream f
    +
    stream f fd
    +
    Function/lambda:
    +
    f

    fLisp fancies to converge towards Emacs and Common Lisp, but includes also Scheme functions. Function @@ -165,8 +141,9 @@

    Notation Convention

    Buggy/incompatible implementation.

    - By default compatibility with Common Lisp is annotated. The suffix e is used to indicate reference to Emacs - Lisp, s for Scheme. fLisp specific function are annotated with f. + Compatibility with Emacs is omitted. By default compatibility with Common Lisp is annotated. The suffix e + is used to indicate reference to Emacs Lisp, s for Scheme. fLisp specific function are + annotated with f.

    @@ -288,24 +265,10 @@

    Environments, Functions, Evaluation

    Error handling

    - Whenever fLisp encounters an error an exception is thrown. Exceptions have an error type symbol and a human - readable error message. fLisp does not implement stack backtracking. Exceptions are either caught on the top level - of an evaluation or by a catch statement. -

    -

    - In the flisp interpreter the error message is formated as error: message if - the error object is nil otherwise as error: 'object', message, - where object is the serialization of the object causing the error and message is the error - message. -

    -

    - When an exception occurs while calling lisp_eval() or lisp_eval_string() from C-code, - the object field of the interpreter is set to the object causing the error, the result - field is set to the error type symbol and the msg_buf field is set to the error message. -

    -

    - Exceptions can be thrown from within in Lisp code via the throw - function. + Whenever fLisp encounters an error an exception is thrown. Exceptions have an error type symbol a human + readable error message and the object in error, which is nil with generic errors. fLisp does + not implement stack backtracking. Exceptions are either caught on the top level of an evaluation or by + a catch statement.

    The following error type symbols are defined and used internally: @@ -323,7 +286,18 @@

    Error handling

  • out-of-memory
  • gc-error
    • - +

    + Exceptions can be thrown via the throw function. As long as applicable use + one of the existing error codes with throw. +

    +

    + fLisp outputs an error message formated as error: message if the error object + is nil otherwise as error: 'object', message, + where object is the serialization of the object causing the error. message is the error + message. +

    + +

    fLisp Primitives

    @@ -349,11 +323,13 @@

    Interpreter Operations

    no action the value of pred is returned, otherwise (progn action ..) is returned and no more clauses are evaluated. -
    (setq symbol value[ symbol value..])
    +
    (bind symbol value[ globalp) ⇒ value
    - Create or update named objects: If symbol is the name of an existing named object in the current or a - parent environment the named object is set to value, if no symbol with this name exists, a new one is - created in the top level environment. setq returns the last value. + Create or update symbol and bind it to value. Return value. First symbol is + looked up in the current environment, then recursively in the parent environments. If it is not found, it is + created in the current environment as long as globalp is nil or + omitted. If globalp is not nil symbol is always created in the global (top + level) environment.
    (define symbol value[ symbol value..]) Ss: define, let
    @@ -389,8 +365,8 @@

    Interpreter Operations

    Evaluates expr and returns a list with three elements:

    -
    result
    -
    0 on success or any other number indicating an error.
    +
    error_type
    +
    nil on success or an error type symbol.
    message
    A human readable error message.
    object
    The result of the the expression or the object in error.
    @@ -447,31 +423,16 @@

    Input / Output and Others

    read in object is returned. If end of file is reached, an exception is raised, unless eof-value is not nil. In that case eof-value is returned.
    -
    (write object[ keys..]] -
    -
    keys:
    -
    -
    -
    :stream stream
    -
    :readably flag
    -
    -
    +
    (write object[ readably[ fd]] → object
    - Formats object into a string and writes it to the default output stream. With - key :stream output is written to the given stream. With key :readable - not nil output is formatted in a way which which gives the same object when read again. + Formats object into a string and writes it to the default output stream. When readably is + not nil output is formatted in a way which which gives the same object when read again. When + stream fd is given output is written to the given stream else to the output stream. write returns the object.
    (eval object)
    Evaluates object and returns the result.
    -
    (system string)
    -
    - Executes the system(1) function - with string as parameter. -
    -
    (os.getenv string)
    -
    Returns the value of the environment variable named string.

    Object Operations

    @@ -523,6 +484,23 @@

    Arithmetic Operations

    +

    Bitwise Integer Operations

    + +
    +
    (& i j)
    +
    Returns the bitwise and operation on i and j.
    +
    (| i j)
    +
    Returns the bitwise or operation on i and j.
    +
    (^ i j)
    +
    Returns the bitwise xor operation on i and j.
    +
    (<< i j)
    +
    Returns i shift left by j bits.
    +
    (>> i j)
    +
    Returns i shift right by j bits.
    +
    (~ i)
    +
    Returns the bitwise negation of i.
    +
    +

    String Operations

    @@ -542,11 +520,6 @@

    String Operations

    Returns the position of needle if it is contained in haystack, otherwise nil. -
    (string-to-number string)
    -
    - Converts string into a corresponding integer object. String is interpreted as decimal based - integer. -
    (ascii integer)
    Converts integer into a string with one character, which corresponds to the ASCII @@ -560,6 +533,49 @@

    String Operations

    +

    File Extension

    + +

    Tbd. carry over comprehensive documentation from file.c

    +
    +
    (fflush[ stream])
    +
    Flush stream, output or all streams
    +
    (fseek stream offset[ relativep])
    +
    Seek position offset in stream or input. If offset is negative seek from end, + if relativep is not null seek from current position, be default seek from start
    +
    (ftell[ stream])
    +
    Return current position in stream or input.
    +
    (feof[ stream])
    +
    Return end-of-file if stream or input are exhausted, else nil
    +
    (fgetc[ stream])
    +
    Return the next character from stream or input.
    +
    (fungetc i[ stream])
    +
    ungetc() integer i as char to stream or input.
    +
    (fgets[ stream])
    +
    Read a line or up to INPUT_FMT_BUFSIZ from stream or input.
    +
    (fstat path[ linkp])
    +
    Get information about file at path.
    +
    (fttyp[ fd])
    +
    Return true if input or stream fd is associated with a TTY.
    +
    (fmkdir path[ mode])
    +
    Create directory at path with mode.
    +
    (popen line[ mode])
    +
    Run command line and read from/write to it
    +
    (pclose stream)
    +
    Close a stream opened with (popen)
    +
    (system string) ⇒ exit_code
    +
    + Execute string as command line of a system shell subpprocess according to + the system(1) and return the + shell exit_code as integer. +
    +
    (getenv name) ⇒ value
    +
    + Return the value of the environment variable name as string. If name does not exist + return nil. +
    +
    + +

    Double Extension

    @@ -598,12 +614,12 @@

    Library Loading

    variables:

    -
    Library path
    -
    femto: /usr/local/share/femto, FEMTOLIB
    -
    flisp: /usr/local/share/flisp, FLISPLIB
    Startup file
    femto: femto.rc, FEMTORC
    flisp: flisp.rc, FLISPRC
    +
    Library path
    +
    femto: /usr/local/share/femto, FEMTOLIB
    +
    flisp: /usr/local/share/flisp, FLISPLIB

    The library path is exposed to the Lisp interpreter as the variable script_dir. @@ -613,18 +629,38 @@

    Library Loading

    path conveniently and without repetition. The command to load the file example.lsp from the library is (require 'example).

    -

    Femto provides a set of libraries, some of them are required by the editor

    +

    fLisp provides the following set of libraries:

    +
    +
    core
    +
    + Integrated in the .rc files, always loaded. The core library implements the minimum required Lisp + features for loading libraries. +
    +
    flisp
    +
    + Implements expected standard Lisp functions and additions expected by femto and flisp. +
    +
    string
    String manipulation library.
    +
    -

    Core Library

    - This library is built into the startup file. + The Femto specific libraries are described together with + the editor (Markdown) extension.

    + +

    Core Library

    (list [element ..]) C
    Returns the list of all provided elements.
    (defmacro name params body) C
    (defun name params body) C
    Defines and returns a macro or function, respectively.
    +
    (setq symbol value[ symbol value..])
    +
    + Create or update named objects: If symbol is the name of an existing named object in the current or a + parent environment the named object is set to value, if no symbol with this name exists, a new one is + created in the top level environment. setq returns the last value. +
    (curry (func a))
    Returns a lambda with one parameter which returns (func a b). @@ -632,6 +668,7 @@

    Core Library

    (typep (type object)) C
    Returns true if object has type.
    (integerp object) C
    +
    (doublep object) C
    (stringp object) C
    (symbolp object) C
    (lamdap object) C
    @@ -639,28 +676,52 @@

    Core Library

    (streamp object) C
    Return t if object is of the respective type, otherwise nil.
    (numberp object) C
    +
    Return t if object is integer or double, otherwise nil.
    (cadr list) C
    Return the second element in list, (car (cdr list)).
    (cddr list) C
    Return all elements after the second one in list, (cdr (cdr list)).
    (caddr list) C
    Return the third element in list, (car (cdr (cdr list))).
    -
    (number-to-string number) C
    +
    (append [list ..][ a])
    +
    + Append all elements in all lists into a single list. If atom a is present, make it a + dotted list terminating with a. +
    +
    (fold-left func init list) Ss: fold-left
    +
    + Apply the binary function to start and the first element of list and then + recursively to the result of the previous invocation and the first element of the rest + of list. If list is empty return start. +
    +
    (flip func) f
    +
    Returns a lambda which calls binary func with it's two arguments reversed (flipped).
    +
    (reverse l)
    +
    Returns a list with all elements of l in reverse order
    +
    (apply f [arg ..][ l])
    +
    + If arg is a single list call lambda f with all its elements as parameters, else + call f with all args as parameters. If list l is present append all its + elements to the parameter list. +
    +
    (print o[ fd])
    +
    write object o :readably to stream fd or output.
    +
    (princ o[ fd])
    +
    write object o as is to stream fd or output.
    + +
    (string-to-number string)
    +
    + Converts string into a corresponding integer object. String is interpreted as decimal based + integer. +
    Converts integer into a string object.
    (eq a b)
    Returns t if a and b evaluate to the same object, number or string, nil otherwise.
    - -
    Synonym for integerp.
    (not object) C
    Logical inverse. In Lisp a synonym for null
    -
    (fold-left func init list) Ss: fold-left
    -
    - Apply the binary function to start and the first element of list and then - recursively to the result of the previous invocation and the first element of the rest of list. If list is empty return start. -
    (length obj) C
    Returns the length of obj if it is a string or a list, otherwise throws a type exception.
    (string arg) C
    @@ -672,14 +733,31 @@

    Core Library

    If arg is contained in list, returns the sub list of list starting with the first occurrence of arg, otherwise returns nil. -
    (map1 func list) S: mapcar
    -
    Apply func to each element in list and return a list of the results.
    -
    map1 is a specialized form of mapcar restricted to one list only.
    -
    nfold
    -
    coerce
    -
    coercec
    -
    fold-leftp
    -
    Helper functions for n-ary generic number type arithmetic. See below.
    +
    (mapcar func list) Se, Dc
    +
    Apply func to each element in list and return the list of results.
    +
    In Elisp func has to be quoted, in CL variadic func operates on a list of lists.
    +
    (nfold f i l)
    +
    + Number fold: left-folds binary function f on list l with initial + value i. Helper function for n-ary generic number type arithmetic. +
    +
    (coerce ifunc dfunc x y)
    +
    + If x and y are type-integer apply binary integer arithmetic + function ifunc to them and return the result. If any of them is type-double apply binary + double arithmethich function dfunc instead. Helper function for n-ary generic number type arithmetic. +
    +
    (coercec ifunc dfunc)
    +
    + Coerce curry: return a lambda coerceing parameters x and y and + applying ifunc or dfunc respectively. Helper function for n-ary generic number type arithmetic. +
    +
    (fold-leftp predicate start list)
    +
    + Predicate fold: fold-left binary function predicate to list with + initial value start. Returns t if list is empty. Helper functions for n-ary + generic number type comparison. +
    (let ((name value)[ (name value)..]) body) C
    Bind all names to the respective values then evaluate body.
    (let label((name value)[ (name value)..]) body) Cs
    @@ -752,9 +830,18 @@

    fLisp Library

    of commonly used functions.

    -
    listp
    -
    and
    -
    or
    +
    (listp o) D
    +
    Returns true if o is nil or a cons.
    +
    (and[ o..])
    +
    + Returns t or the last object o if none is given or all evaluate to non + nil, nil otherwise. +
    +
    (or[ o..])
    +
    + Returns nil if all objects o are nil, otherwise returns the first object + which evaluates to non nil. +
    (reduce func list start) D
    reduce applies the binary func to the first element of list @@ -765,629 +852,42 @@

    fLisp Library

    Since reduce is right associative and start is not optional, it differs significantly both from Common Lisp and Scheme.
    -
    max
    -
    min
    -
    nthcdr
    -
    nth
    -
    (fold-right func end list) Cs
    -
    (unfold func init pred) Cs
    -
    (iota count[ start[ step]]) Cs
    -
    - -

    Standard Library

    -

    - This library implements some Common Lisp functions, which are not used in the editor libraries. They are provided - for reference. -

    -
    -
    atom
    -
    zerop
    -
    if
    -
    equal
    -
    append
    -
    print
    -
    princ
    -
    - -

    Femto Library

    -

    - This library implements helper function required by the Femto editor. It is written only in Lisp idioms provided - by fLisp itself plus the fLisp Library. -

    - - -

    Editor Extension

    - -

    The editor extensions introduces several types of objects/functionality:

    -
      -
    • Buffers hold text
      • -
    • Windows display buffer contents to the user
      • -
    • Keyboard Input allows the user to interact with buffers and windows
      • -
    • The Message Line gives feedback to the user
      • -
    • Several other function for operating system or user interaction
      • -
    - -

    Buffers

    - -

    - This section describes the buffer related functions added by Femto to fLisp. The description is separated in - function related to buffer management and text manipulation. Text manipulation always operates on - the current buffer. Buffer management creates, deletes buffers, or selects one of the existing buffers - as the current buffer. -

    - -

    Buffers store text and allow to manipulate it. A buffer has the following properties:

    -
    -
    name
    -
    - Buffers are identified by their name. If a buffer name is enclosed in *asterisks* the - buffer receives special treatment. -
    -
    text
    -
    zero or more characters.
    -
    point
    -
    - The position in the text where text manipulation takes place. The first position in the text is 0. Note: - in Emacs the first position is 1. -
    -
    mark
    -
    - An optional second position in the text. If the mark is set, the text between point - and mark is called the selection or region. -
    -
    filename
    -
    If set the buffer is associated with the respective file.
    -
    flags
    -
    - Different flags determine the behavior of the buffer. Editor specific - flags: special, modified. -
    -
    Mode flags determine the syntax highlighter mode: cmode and lispmode are - available. If none is set text mode is used for syntax hightlighting.
    -
    - -

    In the following, any mention to one of them refers to the respective current buffers property.

    - -
    Text manipulation
    - -
    -
    (insert-string string)
    -
    Inserts string before point. S: insert.
    -
    (insert-file-contents-literally string [flag])
    +
    (max n[ n..])
    +
    (min n[ n..])
    +
    Return the biggest/smallest number of all given ns.
    +
    (nthcdr i l)
    +
    Return sub list of l starting from zero-based ith element to the last.
    +
    (nth i l)
    +
    Return zero-based ith element of list l
    +
    (fold-right f o l) Cs
    - Inserts the file string after point. If flag is not nil the buffer is marked as not - modified. B + Apply binary function f to last element of l and o, then recursively to the + previous element and the result.
    +
    (unfold f o p) Cs
    -

    - Note: Currently the flag is forced to nil. The function should - return (filename count) but it returns a flag indicating if the operation - succeeded. -

    + Create a list starting with o followed by the result of successive application of f + to o until applying p to the result is not nil anymore.
    -
    (erase-buffer)
    -
    Erases all text in the current buffer. C
    -
    (delete)
    -
    Deletes the character after point. S: delete-char
    -
    (backspace)
    -
    Deletes the character to the left of point. S: delete-backward-char
    -
    (get-char)
    -
    Returns the character at point. S: get-byte
    -
    (copy-region)
    -
    Copies region to the clipboard. S: copy-region-as-kill
    -
    (kill-region)
    -
    Deletes the text in the region and copies it to the clipboard. D
    -
    (yank)
    -
    Pastes the clipboard before point. C
    -
    - -
    Selection
    - -
    -
    (set-mark)
    -
    Sets mark to point. D
    -
    (get-mark)
    -
    Returns the position of mark, -1 if mark is unset. S: mark
    -
    (get-point)
    -
    Returns the position of point. S: point
    -
    (get-point-max)
    -
    Returns the maximum accessible value of point in the current buffer. S: point-max
    -
    (set-clipboard variable)
    -
    Sets clipboard to the contents of variable. S: gui-set-selection
    -
    (get-clipboard)
    -
    Returns the clipboard contents. S: gui-get-selection
    -
    - -
    Cursor Movement
    - -
    -
    (set-point number)
    -
    Sets the point to in the current buffer to the position number. S: goto-char
    -
    (goto-line number)
    -
    - Sets the point in the current buffer to the first character on line number. S: goto-line, not - an Elisp function. -
    -
    (search-forward string)
    -
    - Searches for string in the current buffer, starting from point forward. If string is found, sets the - point after the first occurrence of string and returns t, otherwise leaves point alone - and returns nil. D -
    -
    (search-backward string)
    -
    - Searches for string in the current buffer, starting from point backwards. If string is found, sets - the point before the first occurrence of string and returns t, otherwise leaves point - alone and returns nil. D -
    -
    (beginning-of-buffer)
    -
    - Sets the point in the current buffer to the first buffer position, leaving mark in its current - position. C -
    -
    (end-of-buffer)
    -
    - Sets the point in the current buffer to the last buffer position, leaving mark in its current position. C -
    -
    (beginning-of-line)
    -
    - Sets point before the first character of the current line, leaving mark in its current position. S: - move-beginning-of-line -
    -
    (end-of-line)
    -
    - Sets point after the last character of the current line, i.e. before the end-of-line character sequence, leaving - mark in its current position. S: move-end-of-line -
    -
    (forward-word)
    -
    - Moves the point in the current buffer forward before the first char of the next word. If there is no word left - the point is set to the end of the buffer. If the point is already at the start or within a word, the current - word is skipped. D: Note: Elisp moves to the end of the the next word. -
    -
    (backward-word)
    -
    - Moves the point in the current buffer backward after the last char of the previous word. If there is no word - left the point is set to the beginning of the buffer. If the point is already at the end or within a word, the - current word is skipped. D: Note: Elisp moves to the beginning of the previous word. -
    -
    (forward-char)
    -
    Moves the point in the current buffer one character forward, but not past the end of the buffer. C
    -
    (backward-char)
    -
    - Moves the point in the current buffer one character backward, but not before the end of the - buffer. C -
    -
    (forward-page)
    -
    - Moves the point of the current buffer to the beginning of the last visible line of the associated screen and - scrolls the screen up to show it as the first line. S: scroll-up -
    -
    (backward-page)
    -
    - Moves the point of the current buffer to the beginning of the first visible line of the associated screen and - scrolls the screen down to show it as the last line. S: scroll-down -
    -
    (next-line)
    -
    - Moves the point in the current buffer to the same character position in the next line, or to the end of the next - line if there are not enough characters. In the last line of the buffer moves the point to the end of the - buffer. C -
    -
    (previous-line)
    -
    - Moves the point in the current buffer to the same character position in the previous line, or to the end of the - previous line if there are not enough characters. In the first line of the buffer the point is not - moved. C -
    -
    - -
    Buffer management
    - -
    -
    (list-buffers)
    -
    Lists all the buffers in a buffer called *buffers*.
    -
    (get-buffer-count)
    -
    Returns the number of buffers, includes all special buffers and *buffers*.
    -
    (select-buffer string)
    -
    Makes the buffer named string the current buffer. Note: C to set-buffer in Elisp.
    -
    (rename-buffer string)
    -
    Rename the current buffer to string. C
    -
    (kill-buffer string)
    -
    Kill the buffer names string. Unsaved changes are discarded. C
    -
    (get-buffer-name)
    -
    Return the name of the current buffer. Note: C to buffer-name in Elisp.
    -
    (add-mode-global string)
    -
    Sets global mode string for all buffers. Currently the only global mode is undo.
    -
    (add-mode string)
    -
    Set a flag for the current buffer.
    -
    (delete-mode string)
    -
    Reset a flag for the current buffer.
    -
    (find-file string)
    -
    - Loads file with path string into a new buffer. After - loading (read-hook string) is called. C -
    -
    (save-buffer string)
    -
    Saves the buffer named string to disk. C
    -
    - -

    User Interaction

    - -

    - This section lists function related to window and message line manipulation, keyboard input and system - interaction. -

    - -
    Window Handling
    - -
    -
    (delete-other-windows)
    -
    Make current window the only window. C
    -
    (split-window)
    -
    Splits the current window. Creates a new window for the current buffer. C
    -
    (other-window)
    -
    - Moves the cursor to the next window down on the screen. Makes the buffer in that window the current - buffer. D -
    -
    -

    Note: Elisp other-window has a required parameter count, which specifies the number - of windows to move down or up. -

    -
    -
    (update-display)
    -
    Updates all modified windows.
    -
    (refresh)
    -
    Updates all windows by marking them modified and calling update-display.
    -
    - -
    Message Line
    -
    -
    (message string)
    -
    Displays string in the message line. D
    -
    (clear-message-line)
    -
    Displays the empty string in the message line.
    -
    (prompt prompt default)
    -
    - Displays prompt in the command line and sets default as initial value for the user - response. The user can edit the response. When hitting return, the final response is returned. -
    -
    (show-prompt prompt default)
    -
    - Displays prompt and default in the command line, but does not allow - editing. Returns t. -
    -
    (prompt-filename prompt)
    -
    - Displays prompt in the command line and allows to enter or search for a file name. Returns the - relative path to the selected file name or the response typed by the user. -
    -
    - -
    Keyboard Handling
    - -
    -
    (set-key key-name lisp-func)
    -
    Binds key key-name to the lisp function lisp-func.
    -
    (get-key-name)
    -
    Returns the name of the currently pressed key, eg: c-k for control-k.
    -
    (get-key-funcname)
    -
    Return the name of the function bound to the currently pressed key.
    -
    (execute-key)
    -
    Executes the function of the last bound key. Tbd. bound or pressed?
    -
    (describe-bindings)
    -
    - Creates a listing of all current key bindings, in a buffer named *help* and displays it in a new - window. C -
    -
    (describe-functions)
    -
    - Creates a listing of all functions bound to keys in a buffer named *help* and displays it in a new - window. -
    -
    (getch)
    -
    - Waits for a key to be pressed and returns the key as string. See - also get-key-name, get-key-funcname and execute-key. -
    -
    - -
    Programming and System Interaction
    - -
    -
    (exit)
    -
    Exit Femto without saving modified buffers.
    -
    (eval-block)
    -
    - Evaluates the region in the current buffer, inserts the result at point and returns - it. If mark in the current buffer is before point eval-block evaluates - this region and inserts the result at point. If point is - before mark eval-block does nothing but returning t. -
    -
    (log-message string)
    -
    Logs string to the *messages* buffer.
    -
    (log-debug string)
    -
    Logs string to the file debug.out.
    -
    (get-version-string)
    -
    Returns the complete version string of Femto, including the copyright.
    -
    - - -

    Embedding fLisp

    -

    Embedding Overview

    - -

    - fLisp can be embedded into a C application. Two examples of embedding are the `femto` editor and the simplistic - `flisp` command line Lisp interpreter. -

    -

    - Currently embedding can only be done by extending the build system. Application specific binary Lisp extensions - are stored in separated C files and the interface code is conditionally included into the lisp.c - file. Two extensions are provided: the Femto extension which provides the editor functionality and the file - extension which provides access to the low level stream I/O functions and adds some more. -

    - fLisp exposes the following public interface functions: -

    -
    -
    lisp_new()
    Create a new interpreter.
    -
    lisp_destroy()
    Destroy an interpreter, releasing resources.
    -
    lisp_eval()
    Evaluate input stream until exhausted or error.
    -
    lisp_eval_string()
    Evaluate given string until exhausted or error.
    -
    lisp_write_object()
    Format and write object to file descriptor.
    -
    lisp_write_error()
    -
    Format and write the error object and error message of an interpreter to a file descriptor.
    -
    -

    - Different flows of operation can be implemented. The Femto editor initializes the interpreter without input/output - file descriptors and sends strings of Lisp commands to the interpreter, either when a key is pressed or upon - explicit request via the editor interface. -

    -

    - The flisp command line interpreter sets stdout as the default output file descriptors of - the fLisp interpreter and feeds it with strings of lines read from the terminal. If the standard input is not a - terminal stdin is set as the default input file descriptor and fLisp reads it through until end of - file. -

    -

    - After processing the given input, the interpreter puts a pointer to the object which is the result of the last - evaluation into the object field of the interpreter structure. The result field is set - to the nil and the msg_buf field is set to the empty string. -

    -

    - fLisp sends all output to the default output stream. If NULL is given on initialization, output is - suppressed altogether. -

    - If an exception is thrown inside the Lisp interpreter an error message is formatted and copied to - the msg_buf buffer of the interpreter, A pointer to the object causing the error is set to - the object field. The result field is set to the respective error type symbol. -

    -

    - In this error state of the interpreter, the function lisp_write_error() can be used to - write a standardized error message including the error object to a file descriptor of choice -

    - -

    fLisp C Interface

    -
    -
    Interpreter *lisp_new(int size, char **argv, char - *library_path, FILE *input, FILE *output, FILE* debug)
    -
    -

    lisp_new() creates and initializes an fLisp interpreter. The initial environment contains the - following symbols: -

    -
    -
    argv0
    The string stored in *argv[0], if any
    -
    argv
    The list of strings stored in argv
    -
    script_dir
    The string stored in library_path
    -
    -

    A pointer to an Interpreter struct is returned, which is used to operate the interpreter.

    -
    -
    -

    - The other arguments to lisp_new() are: -

    -
    size
    -
    - Memory size to allocate for the Lisp objects. This is divided into two pages for garbage - collection. Only one page is used by the interpreter at any moment. -
    -
    input
    -
    - Default input stream. If input is set to NULL, the input stream has to be - specified for each invocation of lisp_eval(). -
    -
    output
    -
    - Default output stream. If output is set to NULL a memory stream is created at the - first invocation of the interpreter and set as the default output stream. -
    debug
    -
    Debug output stream. If set to NULL no debug information is generated.
    -
    -

    -
    - -
    void lisp_destroy(Interpreter *interp)
    -
    Frees all resources used by the interpreter.
    - -
    - void lisp_eval(Interpreter *interp) -
    -
    -

    - Evaluates the input file set in the input field of the fLisp interpreter interp until - end of file. If no input file is set, interp is set to a respective error state. -

    -
    -
    - void lisp_eval_string(Interpreter *interp, char *string) -
    -
    - Evaluates all Lisp expressions in string.
    -
    - void lisp_write_object(Interpreter *interp, FILE *fd, Object *object, - bool readably) -
    +
    (iota count[ start[ step]]) Cs
    - Format object into a string and write it to stream. If readably is true, the - string can be read in by the interpreter and results in the same object. + Create a list of count numbers starting with start or 0 if not given by + successively adding step or 1 if not given.
    -
    void lisp_write_error(Interpreter *interp, FILE *fd)
    +
    (atom o)
    +
    t if o is not a cons.
    +
    (zerop x)
    +
    t if number x is zero.
    +
    (if p then[ else)
    - Format the error object and the error message of the interpreter into a string and write it - to fd. The object is written with readably true. + Evaluate then if predicate p evaluates to not nil, else + evaluate else.
    -
    - -

    Note: currently only creating one interpreter has been tested.

    +
    (equal o1 o2)
    +
    Return nil if o1 and o2 are not isomorphic.
    -

    Building Extensions

    - -

    - An extensions has to create C functions with the - signature: Object *primitive(Interpreter *interp, Object **args, Object **env), - where primitive is a distinct name in C space. This function has to be added to the global - variable primitives in the following - format: {"name", argMin, argMax, primitive}. Here - name is a distinct name in Lisp space. -

    -

    - interp is the fLisp interpreter in which primitive is executed. - argMin is the minimum number of arguments, argMax is the maximum number of arguments allowed - for the function. If argMax is a negative number, arguments must be given in tuples - of argMax and the number of tuples is not restricted. -

    -

    - When creating more then one new objects within a primitive, care has to be taken to register them with the garbage - collector. Registration is started with the - GC_CHECKPOINT CPP macro. GC_TRACE(name, value creates an object - variable name, sets it to value and registers it with the garbage collector. The - macro GC_RELEASE must be called to finalize the registration. The convenience - macro GC_RETURN(object) calls GC_RELEASE and returns object. -

    -

    - Some CPP macros are provided to simplify argument validation in primitives, all of them receive - the name of the primitive as a parameter: -

    -
    -
    TWO_STRING_ARGS(name)
    -
    - Assures that the first two arguments are of type string. They are assigned to the Object * - variables first and second. -
    -
    ONE_STRING_ARG(name)
    -
    - Assures that the first argument is of type string. It is assigned to the Object * - variable arg. -
    -
    ONE_NUMBER_ARG(name)
    -
    - Assures that the first argument is of type number. It is assigned to the Object * - variable num. -
    -
    ONE_STREAM_ARG(name)
    -
    - Assures that the first argument is of type stream. It is assigned to the Object * - variable stream. -
    -
    - -

    Implementation Details

    - -

    Garbage Collection

    -

    - fLisp implements Cheney's copying garbage collector, with which memory is divided into two equal halves - (semi spaces): from- and to-space. From-space is where new objects are allocated, whereas to-space is used during - garbage collection. -

    -

    - When garbage collection is performed, objects that are still in use (live) are copied from from-space to - to-space. To-space then becomes the new from-space and vice versa, thereby discarding all objects that have not - been copied. -

    -

    - Our garbage collector takes as input a list of root objects. Objects that can be reached by recursively traversing - this list are considered live and will be moved to to-space. When we move an object, we must also update its - pointer within the list to point to the objects new location in memory. -

    -

    - However, this implies that our interpreter cannot use raw pointers to objects in any function that might trigger - garbage collection (or risk causing a SEGV when accessing an object that has been moved). Instead, objects must be - added to the list and then only accessed through the pointer inside the list. -

    -

    - Thus, whenever we would have used a raw pointer to an object, we use a pointer to the pointer inside the list - instead: -

    - 
    -      function:              pointer to pointer inside list (Object **)
-      |
-      v
-      list of root objects:  pointer to object (Object *)
-      |
-      v
-      semi space:             object in memory
-
    -

    - GC_TRACE adds an object to the list and declares a variable which points to the objects - pointer inside the list. -

    -

    - GC_TRACE(gcX, X): add object X to the list and - declare Object **gcX to point to the pointer to X inside the list. -

    -

    - Information about the garbage collection process and memory status is written to the debug file descriptor. -

    -

    Memory Usage

    -

    - Some compile time adjustable limits in lisp.h: -

    -
    -
    Input buffer
    2048, INPUT_FMT_BUFSIZ, size of the formatting buffer for lisp_eval().
    -
    Output buffer
    2048, WRITE_FMT_BUFSIZ, size of the output and message formatting buffer.
    -
    -

    - fLisp can live with as little as 300k object memory. The Femto editor requires 16M since the OXO game requires a lot of memory. -

    - -

    Future Directions

    -

    - The two memory pages should be separated and the second one should be allocated only during garbage collection. - When memory runs out, the garbage collection should be restarted with an increased capacity of the new page. -

    -

    - It is now possible to catch exceptions within Lisp code and exceptions return differentiated error codes and use - POSIX stream I/O. This, together with the (eval) primitive would allow to write the repl directly in - Lisp, and reading and eval'ing until no more incomplete - input result codes are returned. -

    -

    - Integer arithmetic would be sufficient for all current purposes and increase portability and speed while reducing - size. -

    -

    - The file extension only contains (fflush), (ftell) and (fgetc) and could - easily be extended into something useful. (fstat) would be most pressing for - improving femto.rc and flisp.rc. -

    -

    - The string library should implement Elisp substring to replace string.substring and a - simplified version of string-search without start index. -

    -

    - Implement (type object) returning symbols for each type in C and implement individual type - checking predicates in Lisp. -

    -

    - loop programming is availble via the labelled let macro. It could made easier, by any combination of: -

    -
      -
    • iota
      • -
    • loop/while/for macro
      • -
    • Demoing hand crafted loops including breaking with throw.
      • -
    diff --git a/style.md b/style.md index f66673c..6d17955 100644 --- a/style.md +++ b/style.md @@ -75,4 +75,8 @@ For Lisp files lean to Emacs Lisp formatting, specifically: - Indentation is two spaces. - Do not use tabs. -- Put trailing parentheses on a single line. +- Put trailing parentheses on a single line, separated by a single + space: + + (defun example () + (+ 3 4) ) diff --git a/test/1_primitives.test b/test/1_primitives.test index 4a9cb1d..214bb6a 100755 --- a/test/1_primitives.test +++ b/test/1_primitives.test @@ -1,10 +1,11 @@ -#!./run +#!./test # -*- mode: sh -*- +# # test executable and fLisp functionality # leg20231128: Femto export FLISPRC= -tap 150 +tap 175 [ -x ../femto ] ok femto-1 femto exists and is executable; @@ -12,7 +13,7 @@ ok femto-1 femto exists and is executable; (FEMTORC= FEMTO_BATCH=1 ../femto >/dev/null) ok femto-2 w/o femto.rc femto in batch mode succeds -(: | FEMTORC=- FEMTO_BATCH=1 ../femto >/dev/null) +(: | FEMTORC= FEMTO_BATCH=1 ../femto >/dev/null) ok femto-3 empty input succeeds [ -x ../flisp ] @@ -28,11 +29,26 @@ flisp_err; ok reader-1 incomplete sexp error msg IN='"' ERR='unexpected end of stream in string literal' flisp_err; ok reader-2 incomplete string error msg -IN='\\' OBJ="nil" ERR="unexpected character, \`'" +IN='}' OBJ="" ERR="unexpected character: '}'" flisp_err; ok reader-3 unexpected character error msg IN="0" OUT='0' -flisp_expr; ok reader-4 read number +flisp_expr; ok reader-4-1 read integer 0 + +IN="10" OUT='10' +flisp_expr; ok reader-4-2 read integer 10 + +IN="010" OUT='8' +flisp_expr; ok reader-4-3 read integer octal 10 is 8 + +IN="0x10" OUT='16' +flisp_expr; ok reader-4-4 read integer hex 10 is 16 + +IN=".1" OUT='0.1' +flisp_expr; ok reader-4-5 read double .1 is 0.1 + +IN="3.14" OUT='3.14' +flisp_expr; ok reader-4-6 read double 3.14 is 3.14 IN="t" OUT='t' flisp_expr; ok reader-5 read constant t @@ -74,27 +90,20 @@ flisp_err; ok reader-16 read list without end IN='(quote)' ERR='expects at least 1 arguments' OBJ='#' flisp_err; ok quote-1 w/o arg error message -IN="(setq var 'val)" OUT=val -flisp_expr; ok setq-1 assignment returns value - -IN="(setq var 'val) var" OUT="val" -flisp_expr 1; ok setq-2 var evaluates to val - -IN='(setq)' OUT=nil -flisp_expr; ok setq-3 no args evaluate to nil +IN="(bind var 'val)" OUT=val +flisp_expr; ok bind-2 assignment returns value -IN='(setq var1)' OBJ='#' ERR='expects a multiple of 2 arguments' -flisp_err; ok setq-4 one arg fails +IN="(bind var 'val) var" OUT="val" +flisp_expr 1; ok bind-3 var evaluates to val -EXPR="(setq var1 'val1 var2 'val2)" -IN="$EXPR" OUT=val2 -flisp_expr 1; ok setq-5 four args returns last value +IN='(bind var1)' OBJ='#' ERR='expects at least 2 arguments' +flisp_err; ok bind-4 one arg fails -IN="$EXPR var1" OUT=val1 -flisp_expr 1; ok setq-6 four args first var evaluates to first value +IN="(bind var1 3) ((lambda () (bind var1 2))) var1" OUT=3 +flisp_expr 1; ok setq-5 local bind does not set outer variable. -IN="$EXPR var2" OUT=val2 -flisp_expr 1; ok setq-7 four args second var evaluates to second value +IN="(bind var1 3) ((lambda () (bind var1 2 t))) var1" OUT=2 +flisp_expr 1; ok setq-4 global bind does not set outer variable. IN='(progn)' OUT=nil flisp_expr; ok progn-1 no args evaluate to nil @@ -179,6 +188,10 @@ flisp_expr; ok lambda-6 args nil nil IN='((lambda (a b) a b) 0 "a")' OUT='"a"' flisp_expr; ok lambda-7 apply return b string a +# Time for memory allocator test +#IN='(setq r (lambda args (r args))) (r)' OBJ='out of memory, 48 bytes' ERR='48 bytes' +#flisp_err 1; ok memory-1 exhausting memory exits with error code + # macro IN='(macro nil)' OUT='#' flisp_expr; ok macro-1 arg nil @@ -212,7 +225,7 @@ flisp_expr; ok catch-1_2 catch t IN='(catch (i+ 3 4))' OUT='(nil "" 7)' flisp_expr; ok catch-1_3 catch expr -IN='(catch (i/))' OUT='(wrong-num-of-arguments "expects at least 2 arguments" #)' +IN='(catch (i/))' OUT='(wrong-number-of-arguments "expects at least 2 arguments" #)' flisp_expr; ok catch-1_4 catch error # Primitives @@ -311,19 +324,19 @@ flisp_expr [ -e _file_ ]; ok open-1 create file rm -f _file_ -echo '(open "empty.lsp")' | $FLISP | grep -q "#" +RESULT=$(echo '(open "empty.lsp")' | $FLISP | grep -E '#') ok open-2 open file readonly -echo '(open "<0")' | $FLISP | grep -q "#" +RESULT=$(echo '(open "<0")' | $FLISP | grep -E "#") ok open-3 open readable file descriptor -echo '(open ">1")' | $FLISP | grep -q "#1>" +RESULT=$(echo '(open ">1")' | $FLISP | grep -E "#1>") ok open-4 open writeable file descriptor -echo '(open "any text" "<")' | $FLISP | grep -q "#" +RESULT=$(echo '(open "any text" "<")' | $FLISP | grep -E "#") ok open-5 open memory input stream -echo '(open "" ">")' | $FLISP | grep -q "#STRING>" +RESULT=$(echo '(open "" ">")' | $FLISP | grep -E "#STRING>") ok open-6 open memory output stream IN='(close (open "empty.lsp"))' OUT="0" @@ -338,10 +351,10 @@ flisp_expr; ok close-3 close memory input stream IN='(close (open "" ">"))' OUT="0" flisp_expr; ok close-4 close memory output stream -IN='(setq f (open "abc" "<")) (cons (car (file-info f)) (car (cdr (file-info f))))' OUT='("number' \# TODO false; ok os.getenv \# TODO # File extension -false; ok file extension \# TODO +false; ok fflush \# TODO +false; ok fseek \# TODO +false; ok ftell \# TODO +false; ok feof \# TODO +false; ok fgetc \# TODO +false; ok fungetc \# TODO +false; ok fgets \# TODO + +IN='(type-of (fstat "five_lines.txt"))' OUT='type-cons' +flisp_expr; ok file-fstat-1 existing file returns data + +IN='(fstat "_unknown_")' ERR='(fstat path[ linkp]): No such file or directory' OBJ='"_unknown_"' +flisp_err; ok file-fstat-1 existing file returns data + +IN='(fttyp (open "/dev/tty"))' OUT='t' +flisp_expr; ok file-fttyp-1 console is tty + +IN='(fttyp (open "answer" "<"))' OUT='nil' +flisp_expr; ok file-fttyp-2 + +false; ok fmkdir \# TODO +false; ok popen \# TODO +false; ok pclose \# TODO -# Femto editor extension +IN='(system "true")' OUT='0' +flisp_expr; ok file-system-1 shell command true returns successfully -false; ok femto editor extension \# TODO +IN='(system "/..,")' OUT=32512 +flisp_expr 2>/dev/null; ok file-system-2 not existing shell command fails +IN='(getenv "HOME")' OUT="\"$HOME\"" +flisp_expr; ok file-getenv-1 known variable returns value string -# Local Variables: -# mode: sh -# End: +IN='(getenv "?")' OUT=nil +flisp_expr; ok file-getenv-2 unknown variable returns nil diff --git a/test/2_core.test b/test/2_core.test index 5cf0e7a..5d3b367 100755 --- a/test/2_core.test +++ b/test/2_core.test @@ -1,10 +1,10 @@ -#!./run +#!./test # -*- mode: sh -*- # test the fLisp core library # leg20231129: Femto -export FLISPRC=../lisp/core.lsp +export FLISPRC=../flisp.rc -tap 88 +tap 115 # list IN='(list)' OUT=nil @@ -20,6 +20,28 @@ flisp_expr 1; ok list-3 two elements IN="(defmacro m (a b) (list 'list a b)) (m 1 2)" OUT='(1 2)' flisp_expr 1; ok defmacro-1 simple macroexpansion +IN="(setq var 'val)" OUT=val +flisp_expr 1; ok setq-1 assignment returns value + +IN="(setq var 'val) var" OUT="val" +flisp_expr 1; ok setq-2 var evaluates to val + +IN='(setq)' OUT=nil +flisp_expr 1; ok setq-3 no args evaluate to nil + +IN='(setq var1)' OBJ= ERR='(setq [s v ..]) expects a multiple of 2 arguments' +flisp_err 1; ok setq-4 one arg fails + +EXPR="(setq var1 'val1 var2 'val2)" +IN="$EXPR" OUT=val2 +flisp_expr 1; ok setq-5 four args returns last value + +IN="$EXPR var1" OUT=val1 +flisp_expr 1; ok setq-6 four args first var evaluates to first value + +IN="$EXPR var2" OUT=val2 +flisp_expr 1; ok setq-7 four args second var evaluates to second value + # defun IN="(defun f (a b) (list a b)) (f 1 2)" OUT='(1 2)' flisp_expr 1; ok defun-1 simple function invocation @@ -72,9 +94,12 @@ flisp_expr 1; ok streamp-2 streamp lambda is nil IN="(numberp 42)" OUT='t' flisp_expr 1; ok numberp-1 numberp number is t -IN="(numberp numberp)" OUT='nil' +IN="(numberp 3.7)" OUT='t' flisp_expr 1; ok numberp-2 numberp lambda is nil +IN="(numberp numberp)" OUT='nil' +flisp_expr 1; ok numberp-3 numberp lambda is nil + IN="(cadr '(a b c d))" OUT="b" flisp_expr 1; ok cadr1-1 cadr returns second element @@ -84,11 +109,50 @@ flisp_expr 1; ok cddr1-1 cddr returns list after second element IN="(caddr '(a b c d))" OUT="c" flisp_expr 1; ok caddr1-1 caddr returns third element -IN="(number-to-string 42)" OUT='"42"' -flisp_expr 1; ok number-to-string-1 42 is string 42 +# append +IN='(append)' OUT="nil" +flisp_expr 1; ok append-1 append nothing is nil + +IN='(append 1)' OUT="1" +flisp_expr 1; ok append-2 append atom is atom + +IN="(append '(1 2 3))" OUT="(1 2 3)" +flisp_expr 1; ok append-3 append list is list + +IN="(append '(1 2 3) 1)" OUT="(1 2 3 . 1)" +flisp_expr 1; ok append-4 append list atom is dotted list + +IN="(append '(1 2 3) '(a b c))" OUT="(1 2 3 a b c)" +flisp_expr 1; ok append-5 append list list is list -IN='(number-to-string "a")' ERR='(number-to-string number) - number expected type-integer got: type-string' OBJ= -flisp_err 1; ok number-to-string-2 not a number fails +IN="(append 1 1)" ERR="(append lists) - list expected type-list, got type-integer" OBJ= +flisp_err 1; ok append-6 append atom any errs + +IN="(fold-left + 1 nil)" OUT=1 +flisp_expr 1; ok fold-left-1 fold-left with empty list is init +IN="(fold-left + 1 '(2 3))" OUT=6 +flisp_expr 1; ok fold-left-2 fold-left with list folds + +IN="((flip -) 2 3)" OUT="1" +flisp_expr 1; ok flip-1 flip - on '2-3' is 1 + +IN="(reverse '(1 2 3))" OUT="(3 2 1)" +flisp_expr 1; ok reverse-1 reverse 1 2 3 is 3 2 1 + +IN="(apply +)" OUT="0" +flisp_expr 1; ok apply-1 apply n-ary + to nothing is 0 + +IN="(apply + 7)" OUT="7" +flisp_expr 1; ok apply-2 apply n-ary + to 7 is 7 + +IN="(apply + '(7 4))" OUT="11" +flisp_expr 1; ok apply-3 apply n-ary + to list 7 4 is 11 + +IN="(apply + 3 4 '(7 4))" OUT="18" +flisp_expr 1; ok apply-4 apply n-ary + to 3 4 and final list 7 4 is 18 + +false; ok print-1 \# TODO +false; ok princ-1 \# TODO IN='(string-to-number "42")' OUT='42' flisp_expr 1; ok string-to-number-1 string 42 is 42 @@ -133,11 +197,6 @@ flisp_expr 1; ok not-2 not nil is t IN="(not 1)" OUT="nil" flisp_expr 1; ok not-3 not number is nil -IN="(fold-left + 1 nil)" OUT=1 -flisp_expr 1; ok fold-left-1 fold-left with empty list is init -IN="(fold-left + 1 '(2 3))" OUT=6 -flisp_expr 1; ok fold-left-2 fold-left with list folds - IN="(length nil)" OUT="0" flisp_expr 1; ok length-1 length of nil is zero @@ -145,6 +204,69 @@ flisp_expr 1; ok length-1 length of nil is zero IN="(length '(a b c))" OUT="3" flisp_expr 1; ok length-2 length of triple list is three + +IN='(length "")' OUT="0" +flisp_expr 1; ok length-3 length of empty string is zero + +IN='(length "answer")' OUT="6" +flisp_expr 1; ok length-1 length of answer is six + +# string +IN="(string nil)" OUT='""' +flisp_expr 1; ok string-1 nil is empty string + +IN="(string 42)" OUT='"42"' +flisp_expr 1; ok string-2 42 is string 42 + +IN="(string +03)" OUT='"3"' +flisp_expr 1; ok string-3 octal number converts to number string + +IN='(string "a")' OUT='"a"' +flisp_expr 1; ok string-4 string returns itself + +IN="(string 'a)" OUT='"a"' +flisp_expr 1; ok string-5 symbols converts to its name + +IN="(string (cons 'a 2))" OUT='"a2"' +flisp_expr 1; ok string-6 cons converts to concatenated strings of elements + +IN="(string car)" OUT='"#"' +flisp_expr 1; ok string 7 primitive prints reader macro and name + +IN="(string (lambda (a b)))" OUT='"#"' +flisp_expr 1; ok string-8 lambda prints reader macro and parameters + +IN="(string (macro (a b)))" OUT='"#"' +flisp_expr 1; ok string-9 macro prints reader macro and parameters + +IN='(setq f (open "" "<"))(close f)(string f)' OUT='"#"' +flisp_expr 1; ok string-10 closed stream prints reader macro nil as fd and type + +# concat +IN="(concat 1 'a \"?\")" OUT='"1a?"' +flisp_expr 1; ok concat-1 simple string concatenation + +# memq +IN="(memq 'a (list 0 'a 3))" OUT="(a 3)" +flisp_expr 1; ok memq-1 find object in list + +IN='(memq '\''a '\''(1 '\''two 3))' OUT=nil +flisp_expr 1; ok memq-2 do not find object in list + +IN="(memq nil (list 0 nil 3))" OUT="(nil 3)" +flisp_expr 1; ok memq-3 find nil object in list + +IN="(defun incr (x) (+ x 1)) (mapcar incr '(1 2 3))" OUT="(2 3 4)" +flisp_expr 1; ok mapcar-1 mapcar incr elements in list + +IN="(mapcar / '())" OUT="nil" +flisp_expr 1; ok mapcar-2 mapcar does nothing on empty list + +true; ok nfold \# TODO is tested by dynamic typed arithmetic +true; ok coerce \# TODO is tested by dynamic typed arithmetic +true; ok coercec \# TODO is tested by dynamic typed arithmetic +true; ok fold-leftp \# TODO is tested by dynamic typed arithmetic + false; ok arith \# TODO test all of integer, double and misc arith. IN='(+)' OUT='0' flisp_expr 1; ok add-1 add nothing is 0 IN='(+ 42)' OUT='42' flisp_expr 1; ok add-2 add 42 is 42 @@ -175,53 +297,8 @@ IN='(% 11 6 3)' OUT='2' flisp_expr 1; ok mod-3 mod 11 6 3 is 2 # IN='(>= 7 7 7)' OUT='t' flisp_expr 1; ok greater-equal-3 greater-equal 7 7 7 is t # IN='(>= 7 7 6)' OUT='t' flisp_expr 1; ok greater-equal-4 greater-equal 7 7 6 is t -# string -IN="(string nil)" OUT='""' -flisp_expr 1; ok string-1 nil is empty string - -IN="(string +03)" OUT='"3"' -flisp_expr 1; ok string-2 number converts to number string - -IN='(string "a")' OUT='"a"' -flisp_expr 1; ok string-3 string returns itself - -IN="(string 'a)" OUT='"a"' -flisp_expr 1; ok string-4 symbols converts to its name - -IN="(string (cons 'a 2))" OUT='"a2"' -flisp_expr 1; ok string-5 cons converts to concatenated strings of elements - -IN="(string car)" OBJ='#' ERR="cannot convert to string" -flisp_err 1; ok string-6 lambda err\'s -false; ok string-7 macro errs \# TODO -false; ok string-8 stream errs \# TODO -# concat -IN="(concat 1 'a \"?\")" OUT='"1a?"' -flisp_expr 1; ok concat-1 simple string concatenation - -# memq -IN="(memq 'a (list 0 'a 3))" OUT="(a 3)" -flisp_expr 1; ok memq-1 find object in list - -IN='(memq '\''a '\''(1 '\''two 3))' OUT=nil -flisp_expr 1; ok memq-2 do not find object in list - - -IN="(defun incr (x) (+ x 1)) (map1 incr '(1 2 3))" OUT="(2 3 4)" -flisp_expr 1; ok map1-1 map1 incr elements in list - -IN="(map1 / '())" OUT="nil" -flisp_expr 1; ok map1-2 map1 does nothing on empty list - false; ok let-1 \# TODO -IN='(length "")' OUT="0" -flisp_expr 1; ok length-3 length of empty string is zero - -IN='(length "answer")' OUT="6" -flisp_expr 1; ok length-1 length of answer is six - - IN="(prog1 'answer)" OUT="answer" flisp_expr 1; ok prog1-1 prog1 single arg is arg @@ -257,15 +334,8 @@ flisp_err 1; ok require-1 requiring nothing errs IN="(require '_no_file)" OUT="nil" flisp_expr 1; ok require-2 requiring not existing features returns nil -IN="(require 'core)" OUT="(core) -core" -flisp_expr 2; ok require-3 requiring existing feature returns feature - -IN="(require 'flisp)" OUT="(core) -flisp" -flisp_expr 2; ok require-4 requiring new feature returns feature - +IN="(require 'core)" OUT="core" +flisp_expr 1; ok require-3 requiring existing feature returns feature -# Local Variables: -# mode: sh -# End: +IN="(require 'flisp)" OUT="flisp" +flisp_expr 1; ok require-4 requiring new feature returns feature diff --git a/test/3_flisp.test b/test/3_flisp.test index e014c30..b0a7b2c 100755 --- a/test/3_flisp.test +++ b/test/3_flisp.test @@ -1,9 +1,10 @@ -#!./run +#!./test# -*- mode: sh -*- # test the fLisp library # leg20231129: Femto -tap 56 -export FLISPRC=../lisp/core.lsp +tap 69 + +export FLISPRC=../flisp.rc flisplib() { IN="(require 'flisp) $IN" flisp_expr "$@"; } flisplib_err() { IN="(require 'flisp) $IN" flisp_err "$@"; } @@ -160,25 +161,41 @@ IN='(min 1 2 3)' OUT=1 flisplib 1; ok min-6 with more then two args IN='(nthcdr -1 nil)' -ERR="negativ index" +ERR="negative index" OBJ='-1' flisplib_err 1; ok nthcdr-1 negativ index fails IN="(nthcdr 0 '(a b c))" OUT='(a b c)' -flisplib 1; ok nthcdr-2 0 index yields list +flisplib 1; ok nthcdr-2 0 index is list IN="(nthcdr 2 '(a b c))" OUT='(c)' -flisplib 1; ok nthcdr-3 last index yields last element list +flisplib 1; ok nthcdr-3 last index is last element IN="(nthcdr 40 '(a b c))" OUT=nil -flisplib 1; ok nthcdr-4 index over length yields nil +flisplib 1; ok nthcdr-4 index over length is nil + +IN="(nthcdr 40 nil)" OUT=nil +flisplib 1; ok nthcdr-5 of nil is nil + +IN="(nthcdr 1 '(2 . 3))" OUT=3 +flisplib 1; ok nthcdr-6 of 1 of cons is cdr + +IN="(nthcdr null nil)" +ERR="(nthcdr i l) - i expected type-integer, got: type-primitive" +OBJ='#' +flisplib_err 1; ok nthcdr-7 wrong index type fails + +IN="(nthcdr 1 null)" +ERR="(nthcdr i l) - l expected type-cons, got: type-primitive" +OBJ='#' +flisplib_err 1; ok nthcdr-8 wrong list type fails IN="(nth 1 '(a b c))" OUT=b flisplib 1; ok nth-1 yields element false; ok foldr-1 \# TODO -false; ok unfold-1 \# TODO +true; ok unfold-1 \# TODO unfold is tested by its application in iota IN="(iota 5)" OUT="(0 1 2 3 4)" flisplib 1; ok iota-1 iota count gives count @@ -189,7 +206,31 @@ flisplib 1; ok iota-1 iota count start gives count from start IN="(iota 5 10 2)" OUT="(10 12 14 16 18)" flisplib 1; ok iota-1 iota count step gives count from start by step +# atom +IN='(atom 0)' OUT=t +flisplib 1; ok atom-1 number is atom + +IN='(atom "a")' OUT=t +flisplib 1; ok atom-2 string is atom + +IN="(atom 'symbol)" OUT=t +flisplib 1; ok atom-3 symbol is atom + +IN='(atom nil)' OUT=t +flisplib 1; ok atom-4 nil is atom + +IN="(atom '(0 'b))" OUT=nil +flisplib 1; ok atom-5 list is not atom + +# zerop +IN='(zerop 0)' OUT=t +flisplib 1; ok zerop-1 0 is zero + +IN='(zerop 1)' OUT=nil +flisplib 1; ok zerop-2 1 is not zero + +# if +false; ok if \# TODO -# Local Variables: -# mode: sh -# End: +# equal +false; ok equal \# TODO diff --git a/test/4_stdlib.test b/test/4_stdlib.test deleted file mode 100755 index c7c49d1..0000000 --- a/test/4_stdlib.test +++ /dev/null @@ -1,67 +0,0 @@ -#!./run -# test the Lisp standard library -# leg20231129 -tap 16 - -export FLISPRC=../lisp/core.lsp -# Note: nested requiring stopped working -stdlib() { IN="(require 'stdlib) $IN" flisp_expr "$@"; } -stdlib() { IN="(require 'flisp) (require 'stdlib) $IN" flisp_expr "$@"; } -stdlib_err() { IN="(require 'stdlib) $IN" flisp_err "$@"; } - -# atom -IN='(atom 0)' OUT=t -stdlib 1; ok atom-1 number is atom - -IN='(atom "a")' OUT=t -stdlib 1; ok atom-2 string is atom - -IN="(atom 'symbol)" OUT=t -stdlib 1; ok atom-3 symbol is atom - -IN='(atom nil)' OUT=t -stdlib 1; ok atom-4 nil is atom - -IN="(atom '(0 'b))" OUT=nil -stdlib 1; ok atom-5 list is not atom - -# zerop -IN='(zerop 0)' OUT=t -stdlib 1; ok zerop-1 0 is zero - -IN='(zerop 1)' OUT=nil -stdlib 1; ok zerop-2 1 is not zero - -# equal -true; ok equal \# TODO - -# append -IN='(append)' OUT="nil" -stdlib 1; ok append-1 append nothing is nil - -IN='(append 1)' OUT="1" -stdlib 1; ok append-2 append atom is atom - -IN="(append '(1 2 3))" OUT="(1 2 3)" -stdlib 1; ok append-3 append list is list - -IN="(append '(1 2 3) 1)" OUT="(1 2 3 . 1)" -stdlib 1; ok append-4 append list atom is dotted list - -IN="(append '(1 2 3) '(a b c))" OUT="(1 2 3 a b c)" -stdlib 1; ok append-5 append list list is list - -IN="(append 1 1)" ERR="(append arg args) - arg must be list" OBJ= -stdlib_err 1; ok append-6 append atom any errs - -# print -IN='(write "ans\\wer" :readably t)' OUT='"ans\\wer""ans\\wer"' -stdlib 1; ok print-1 write string escaped - -# princ -IN='(write "ans\\wer")' OUT='ans\wer"ans\\wer"' -stdlib 1; ok princ-1 write string unescaped - -# Local Variables: -# mode: sh -# End: diff --git a/test/6_string.test b/test/5_string.test similarity index 83% rename from test/6_string.test rename to test/5_string.test index f4212f0..f5c7b66 100755 --- a/test/6_string.test +++ b/test/5_string.test @@ -1,9 +1,9 @@ -#!./run +#!./test # -*- mode: sh -*- # test executable and fLisp functionality # leg20231128: Femto -export FLISPRC=../lisp/core.lsp +export FLISPRC=../flisp.rc tap 28 @@ -71,17 +71,17 @@ IN='(string-startswith "abcde" "cd")' OUT='nil' stringlib 1; ok string-startswith-4 string starts not with start string is nil -IN='(string-drop_first "")' OUT='""' -stringlib 1; ok string-drop_first-1 drop from empty string is empty string +IN='(string-shrink-right "")' OUT='""' +stringlib 1; ok string-shrink-right-1 drop from empty string is empty string -IN='(string-drop_first "abcde")' OUT='"bcde"' -stringlib 1; ok string-drop_first-2 drop from string is on char less +IN='(string-shrink-right "abcde")' OUT='"bcde"' +stringlib 1; ok string-shrink-right-2 drop from string is on char less -IN='(shrink "")' OUT='""' -stringlib 1; ok string-shrink-1 shrink from empty string is empty string +IN='(string-shrink-left "")' OUT='""' +stringlib 1; ok string-string-shrink-left-1 string-shrink-left from empty string is empty string -IN='(shrink "abcde")' OUT='"abcd"' -stringlib 1; ok string-shrink-2 shrink from string is on char less +IN='(string-shrink-left "abcde")' OUT='"abcd"' +stringlib 1; ok string-string-shrink-left-2 string-shrink-left from string is on char less IN='(string-contains "" "")' OUT='nil' stringlib 1; ok string-contains-1 emtpy string is not contained in empty string diff --git a/test/5_femto.test b/test/6_femto.test.disabled similarity index 75% rename from test/5_femto.test rename to test/6_femto.test.disabled index ff23efc..da60728 100755 --- a/test/5_femto.test +++ b/test/6_femto.test.disabled @@ -1,4 +1,11 @@ -#!./run +# Note: the femto library cannot be loaded into the flisp interpreter: +# We do not have the editor extension compiled in and the library is +# just to big. +# This file must be rewritten to use the *lisp* testmode. Anyway: +# The tests are only enumerated, but not written yet. + +#!./test# -*- mode: sh -*- +# # test the femto Lisp extensions # leg20231213 @@ -31,8 +38,3 @@ false; ok describe-key \# TODO false; ok find_end_p \# TODO false; ok find_start_p \# TODO false; ok find_and_eval_sexp \# TODO - - -# Local Variables: -# mode: sh -# End: diff --git a/test/7_dired.test b/test/7_dired.test old mode 100755 new mode 100644 index dab33e6..cd62476 --- a/test/7_dired.test +++ b/test/7_dired.test @@ -1,22 +1,11 @@ -#!./run -# test executable and dired functionality -# Created By Hugh Barney 24 August 2025 +;; -*- mode: lisp -*- -# we set the FLISPRC to dired.lsp, not sure ? -export FLISPRC=../lisp/dired.lsp +(require 'dired) -# The tap value should be set to the number of tests in the file -tap 2 - -# define sub functions to be used in this test file -stringlib() { IN="(require 'string) $IN" flisp_expr "$@"; } -stringlib_err() { IN="(require 'string) $IN" flisp_err "$@"; } - -# test 1 -IN='(de-dir-up "/home/hugh")' OUT='"/home"' -stringlib 1; ok de-dir-up-1 moves up 1 subdir - -# test 2, check that de-dir-up returns / when there is only 1 character in the path -IN='(de-dir-up "/")' OUT='"/"' -stringlib 2; ok de-dir-up-2 1 char path returns root +(defun de-up-dir-1 () + (eq (de-up-dir "/home/hugh") "/home")) +(tap-register "de-dir-up-1 moves up 1 subdir" de-up-dir-1) +(defun de-up-dir-2 () + (eq (de-up-dir "/") "/")) +(tap-register "de-up-dir-2 root returns root" de-up-dir-2) diff --git a/test/run b/test/run deleted file mode 100755 index a09991a..0000000 --- a/test/run +++ /dev/null @@ -1,99 +0,0 @@ -#!/bin/sh -# leg20231128 -# -# Poor mans unit test framework -# - -: ${VERBOSE:=} -FLISP=../flisp - - -[ "$1" = "-?" ] && { - cat <&1 | tail -n ${1:-5} |{ - read PRE REST - : $PRE - : $REST - MSG=${REST#*, } - [ "$OBJ" ] && { - EOBJ=${REST%%\',*} - EOBJ=${EOBJ#\'} - [ "$PRE" = "error:" -a "$MSG" = "$ERR" -a "$OBJ" = "$EOBJ" ] - RC=$? ERR= OBJ= - return $RC - } - [ "$PRE" = "error:" -a "$MSG" = "$ERR" ] - RC=$? PRE= OBJ= - return $RC - } -} - -femto_expr () { - [ "$( echo -n "$IN" | FEMTO_BATCH=1 FEMTORC=- FEMTOLIB=$FLISP ../femto | tail -n $(($1+3)) )" = "$OUT -t" ] -} -femto_err () { - [ "$( echo -n "$IN" | FEMTO_BATCH=1 FEMTORC=- FEMTOLIB=$FLISP ../femto | tail -n $(($1+3)) )" = "$OUT -nil" ] -} - -if [ "$SUMMARY" ]; then SUMMARY=./tapview; else SUMMARY=cat; fi - -for test; do ( - #mkdir -p tmp - #rm -rf tmp/* - - export FEMTOLIB=../lisp - export FLISPLIB=../lisp - echo testsuite: $test - [ "$VERBOSE" ] && set -x - . ./${test} | $SUMMARY - set +x -); done -#rm -rf tmp diff --git a/test/tap.lsp b/test/tap.lsp new file mode 100644 index 0000000..497dcd2 --- /dev/null +++ b/test/tap.lsp @@ -0,0 +1,35 @@ +;;; Poor mans unit test framework in Femto Lisp + +(require 'core) + +(setq reportFd (open ">3")) + +(defun pr args + (mapcar (lambda (o) (princ o reportFd)) args) + (princ "\n" reportFd)) + +;(defmacro test (comment . body) + ;;; Note: my macro skills fail on me again, this does not work + ;;; want: `(setq tests (cons (cons ,comment (lambda () ,body)) tests)) +; (list 'setq 'tests (list 'cons (list 'cons comment (list 'lambda '() body)) 'tests))) + +(defun tap-register (comment test) + (setq tests (cons (cons comment (lambda () (null (test)))) tests))) + +(defun ok (num test) + ;; Ok runs 'test' and prints out a TAP14 conform message + (let ((result (catch ((cdr test))))) + (cond ((car result) (pr "not ok " num " - " (car test) " test failed with '" (car result) ": " (cadr result))) + ((cond ((caddr result) (pr "not ok " num " - " (car test) " " (caddr result))) + ((pr "ok " num " - " (car test))))))) + (+ num 1)) + +(defun tap (suite) + (setq tests nil) + (let ((result (catch (load suite)))) + (cond ((car result) (pr "error: failed to load test suite" suite ":" (cadr result))) + (t + (pr "TAP version 14") + (pr "1.." (length (caddr result))) + (pr "# " suite) + (fold-left ok 1 (reverse tests)))))) diff --git a/test/test b/test/test new file mode 100755 index 0000000..6e57252 --- /dev/null +++ b/test/test @@ -0,0 +1,177 @@ +#!/bin/sh +# leg20231128 +# +# Poor mans unit test framework +# + +# Augmented for testing fLisp and femto +# +# fLisp is tested via the flisp command line interpreter, the femto +# editor extensions via the batch mode of femto. +# +# The test files must have an extension .test and the first line must +# indicate if the test is run with flisp or with femto: +# +# fLisp test files are written in POSIX shell and start with a hash: # +# femto test files are written in Lisp and start with a semicolon: ; +# +# In summary mode test output is filtered through ESR's tapview +# program, to get a progress indication and then a summary of +# successful, failed and skipped tests. +# +# Debugging of fLisp test files is done by setting the environment +# variable VERBOSE to 1. +# +# femto test files are run with FEMTO_DEBUG set, debug output is +# written to the file debug.out. +# +# Get information on how to run with the -? command line option. + +: ${VERBOSE:=} +: ${SUMMARY:=} +: ${TEST_ALL=} + +FLISP=../flisp +FLISP_DEBUG= +FEMTO_DEBUG= + +usage () { + cat <&1 | tail -n ${1:-5} |{ + read PRE REST + : $PRE + : $REST + MSG=${REST#*, } + [ "$OBJ" ] && { + EOBJ=${REST%%\',*} + EOBJ=${EOBJ#\'} + [ "$PRE" = "error:" -a "$MSG" = "$ERR" -a "$OBJ" = "$EOBJ" ] + RC=$? ERR= OBJ= + return $RC + } + [ "$PRE" = "error:" -a "$MSG" = "$ERR" ] + RC=$? PRE= OBJ= + return $RC + } +} + +test_femto () { + FEMTOLIB=../lisp FEMTORC=test.rc FEMTO_BATCH=1 ../femto "$@" 3>&1 +} + + +if [ "$SUMMARY" ]; then SUMMARY=./tapview; else SUMMARY=cat; fi + +[ "$TEST_ALL" = 1 ] && set -- *.test + +[ $# = 0 ] && { + echo "error: no test file(s) specified\n" + usage +} +echo $@ + +for test; do ( + #mkdir -p tmp + #rm -rf tmp/* + + echo testsuite: $test + + TEST_TYPE="$(head -1 $test)" + TEST_TYPE=${TEST_TYPE#*mode: } + TEST_TYPE=${TEST_TYPE% -\*-*} + case "$TEST_TYPE" in + lisp) + [ "$VERBOSE" ] && set -x + FEMTOLIB=../lisp FEMTORC=test.rc FEMTO_BATCH=1 \ + ../femto $test 3>&1 | $SUMMARY + ;; + sh) + export FLISPLIB=../lisp + [ "$VERBOSE" ] && set -x + . ./${test} | $SUMMARY + ;; + *) + echo error: cannot detect type of testsuite >&2 + exit 1 + ;; + esac + set +x +); done +#rm -rf tmp diff --git a/test/test.sht b/test/test.sht new file mode 100644 index 0000000..5c16da0 --- /dev/null +++ b/test/test.sht @@ -0,0 +1,30 @@ +;; -*-Lisp-*- +;; +;; flisp/femto test suite startup file + +$(cat lisp/core.lsp) + +(require 'flisp) + +(load "tap.lsp") ; poor mans test framework + +(defun usage () + (pr "test [testsuite ..] - run the named testsuites +test -a - run all testsuites +test [-?|-h|-help] - this help text")) + +(defun argv-opt (o) + (cond + ((null o)) + ((memq o '("-?" "-h" "--help")) (usage)) + ((tap o)))) + +(defun argv-parse (opts) + (cond + ((null opts)) + (t + (argv-opt (car opts)) + (argv-parse (cdr opts))))) + +(cond ((null argv) (usage)) + ((argv-parse argv))) diff --git a/undo.c b/undo.c index 72a62cf..7c7a708 100644 --- a/undo.c +++ b/undo.c @@ -467,11 +467,13 @@ void dump_undos(buffer_t *bp) remove_control_chars(buf1); safe_strncpy((char *)buf2, (char *)rep, 20); remove_control_chars(buf2); - sprintf(report_line, "%03d %6s %9ld %4d %s -> %s\n", ++count, get_undo_type_name(prev), prev->u_point, size, buf1, buf2); + sprintf(report_line, "%03d %6s %9"PRId64" %4d %s -> %s\n", + ++count, get_undo_type_name(prev), prev->u_point, size, buf1, buf2); } else { safe_strncpy((char *)buf1, (char *)str, 40); remove_control_chars(buf1); - sprintf(report_line, "%03d %6s %9ld %4d %s\n", ++count, get_undo_type_name(prev), prev->u_point, size, buf1); + sprintf(report_line, "%03d %6s %9"PRId64" %4d %s\n", + ++count, get_undo_type_name(prev), prev->u_point, size, buf1); } insert_string(report_line); diff --git a/utils.c b/utils.c index a2d7dc6..9bae636 100644 --- a/utils.c +++ b/utils.c @@ -6,10 +6,6 @@ #include #include "header.h" - -extern int errno; - - /* * Take a file name, and fabricate a buffer name. */