This commit is contained in:
Arthur Barraux
@@ -1,9 +1,8 @@
|
||||
name: CMake Build and Deploy
|
||||
name: Build project
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: ["main"]
|
||||
pull_request:
|
||||
|
||||
jobs:
|
||||
build:
|
||||
@@ -12,14 +11,19 @@ jobs:
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
tokens: ${{ secrets.GITEA_TOKEN }}
|
||||
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
sudo apt-get update
|
||||
sudo apt-get install -y cmake build-essential
|
||||
sudo apt-get install -y meson ninja-build gcc
|
||||
|
||||
- name: Configure Meson
|
||||
run: meson setup build
|
||||
|
||||
- name: Build project
|
||||
run: cmake --build build -- -j$(nproc)
|
||||
run: meson compile -C build
|
||||
|
||||
- name: Run tests
|
||||
run: ctest --test-dir build || true
|
||||
|
||||
+2
-3
@@ -1,4 +1,3 @@
|
||||
tmp/*
|
||||
bin/*
|
||||
doc/*
|
||||
build/*
|
||||
doc/*
|
||||
beluga.wiki/*
|
||||
|
||||
@@ -1,3 +0,0 @@
|
||||
[submodule "blisp"]
|
||||
path = blisp
|
||||
url = https://homelinuxserver.ddns.net/git/arthur/blisp.git
|
||||
@@ -1,60 +0,0 @@
|
||||
# Specify the minimum version of CMake required
|
||||
cmake_minimum_required(VERSION 3.10)
|
||||
|
||||
# Define the project name and the programming language (C)
|
||||
project(Beluga)
|
||||
|
||||
# Set the C standard (optional)
|
||||
set(CMAKE_C_STANDARD 99)
|
||||
|
||||
set(CMAKE_C_COMPILER clang)
|
||||
|
||||
# Add the header files directory to the include path
|
||||
include_directories(include)
|
||||
include_directories(blisp/include)
|
||||
|
||||
# Add the source files for the project
|
||||
set(SRCS
|
||||
main.c
|
||||
src/append_buffer.c
|
||||
src/file_io.c
|
||||
src/input.c
|
||||
src/row_op.c
|
||||
src/editor_op.c
|
||||
src/init.c
|
||||
src/output.c
|
||||
src/terminal.c
|
||||
src/builtins.c
|
||||
blisp/src/config_tools.c
|
||||
blisp/src/data.c
|
||||
blisp/src/lexer.c
|
||||
blisp/src/parser.c)
|
||||
|
||||
find_package(Doxygen)
|
||||
if(DOXYGEN_FOUND)
|
||||
# set input and output for doxygen
|
||||
set(DOXYGEN_OUT ${CMAKE_CURRENT_SOURCE_DIR}/Doxyfile)
|
||||
|
||||
add_custom_target(
|
||||
doc_doxygen ALL
|
||||
COMMAND ${DOXYGEN_EXECUTABLE} ${DOXYGEN_OUT}
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
COMMENT "Generating documentation with Doxygen"
|
||||
VERBATIM)
|
||||
else(DOXYGEN_FOUND)
|
||||
message("Doxygen not found")
|
||||
endif(DOXYGEN_FOUND)
|
||||
|
||||
# we default to Release build type
|
||||
if(NOT CMAKE_BUILD_TYPE)
|
||||
set(CMAKE_BUILD_TYPE "Release")
|
||||
endif()
|
||||
|
||||
set(CMAKE_C_FLAGS "-Wall -Wextra")
|
||||
set(CMAKE_C_FLAGS_DEBUG "-g")
|
||||
|
||||
# Create an executable target with the specified source files
|
||||
add_executable(beluga ${SRCS})
|
||||
|
||||
# Optionally, you can set the output directory for the executable
|
||||
set_target_properties(beluga PROPERTIES RUNTIME_OUTPUT_DIRECTORY bin)
|
||||
@@ -0,0 +1,43 @@
|
||||
**#%#*****###%**
|
||||
*##+--------------------=##*
|
||||
#*=----------------------------=*#*
|
||||
#*------------------------------------*#
|
||||
%+----------------------------------------=#*
|
||||
#+---------------------------------------------##
|
||||
*#-------------------------------------------------=##
|
||||
*#----------------------------------------------------:-##
|
||||
#----------------------------------------------------------##
|
||||
#=--------------------------------------------------------------##
|
||||
+--------------------------+@#-%*-----------------------------------#*
|
||||
+--------------------------%@@@@#-------------------------------------** BELUGA - VERSION 1.1
|
||||
*-=-------------------------#@@*---------------------------------------=%
|
||||
%*#==--------------------------------------------------------------------+# ----- KEY-BINDS -----
|
||||
*%%=-=--------------------------------------------------------------------=# CTRL-q leave
|
||||
%=--------------------------------------------------------------------------#* CTRL-s save
|
||||
%-----------------------------------------------------------------------------** CTRL-o open-file
|
||||
*+--=---===----=---------------=*-----------------------------------------------**
|
||||
#--=## *#%#*+==----==+**+----------------------= ***=---------------------%
|
||||
*%**=-----------==== ==---------------------------------=+#+-----------------=#
|
||||
*%=----------------------------------------------------------=#*---------------#
|
||||
##=----------------------------------=------------------------+%=------------+#
|
||||
#%+---------------------------------=*------------------------+%------------#
|
||||
*#%*=-------------=-----------------#-------------------------#+----------#
|
||||
**#%#*******+=======-------------#=------------------------#----------#
|
||||
#===#*=======------------------#*----=-----------=--=##*-----------#
|
||||
-====##=------------------------*%+------------=*#+=====----------#
|
||||
--=====+#*=----------------------=-=+*#####***+=======-----------=*
|
||||
%------=====*%*=-------------------------========-----------------+*
|
||||
*-=--------====%%###+=--------------------------=-----------------#
|
||||
#-----------=% +*##%%%%%%@@%%%%####*==---------------------**
|
||||
%=-------#* #%*=-----------------+#
|
||||
*%+--=## ##=-----------------=#*
|
||||
** #+----=-------------------#*
|
||||
%+----------------------------#*
|
||||
*%-------------==----------------+#
|
||||
##--------------==------------------#
|
||||
*#--------------===%-----------------=%
|
||||
##---------------=-##*-----------------+#
|
||||
*#---------------==#+=#%-----------------%
|
||||
*%---------------+# %*---------------#*
|
||||
*#------------=+#* #%*=-----------#*
|
||||
#****##****** *#%%##+=----%
|
||||
-1
Submodule blisp deleted from 04464ec2e7
@@ -1,21 +0,0 @@
|
||||
// Configuration file
|
||||
|
||||
,map-key("ARROW-UP" %move-cursor-up)
|
||||
,map-key("ARROW-DOWN" %move-cursor-down)
|
||||
,map-key("ARROW-RIGHT" %move-cursor-right)
|
||||
,map-key("ARROW-LEFT" %move-cursor-left)
|
||||
,map-key("PAGE-UP" %move-cursor-page-up)
|
||||
,map-key("PAGE-DOWN" %move-cursor-page-down)
|
||||
,map-key("DEL_KEY" %delete-next-char)
|
||||
,map-key("BACKSPACE" %delete-previous-char)
|
||||
,map-key("ENTER" %editor-insert-new-line)
|
||||
,map-key("CTRL-s" %editor-save)
|
||||
,map-key("CTRL-q" %editor-quit)
|
||||
,map-key("CTRL-a" %move-cursor-beg-line)
|
||||
,map-key("CTRL-z" %move-cursor-end-line)
|
||||
,map-key("CTRL-f o" %open-file)
|
||||
,map-key("CTRL-w s h" %window-split-horizontal)
|
||||
,map-key("CTRL-w s v" %window-split-vertical)
|
||||
|
||||
,define(theme "dark")
|
||||
,define(auto-save true)
|
||||
@@ -0,0 +1,34 @@
|
||||
;; MACROS
|
||||
|
||||
(define TAB-LENGTH 4)
|
||||
(define QUIT-TIMES 1)
|
||||
|
||||
;; FUNCTIONS
|
||||
|
||||
(define editor-delete-next-char (lambda () (
|
||||
(move-cursor "right")
|
||||
(editor-delete-previous-char)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
;; KEY MAPPING
|
||||
|
||||
(map-key "CTRL-q" editor-quit)
|
||||
(map-key "CTRL-s" editor-save)
|
||||
(map-key "ARROW-UP" '(move-cursor "up"))
|
||||
(map-key "ARROW-DOWN" '(move-cursor "down"))
|
||||
(map-key "ARROW-RIGHT" '(move-cursor "right"))
|
||||
(map-key "ARROW-LEFT" '(move-cursor "left"))
|
||||
(map-key "ENTER" editor-insert-new-line)
|
||||
(map-key "CTRL-a" move-cursor-beg-line)
|
||||
(map-key "CTRL-e" move-cursor-end-line)
|
||||
(map-key "BACKSPACE" editor-delete-previous-char)
|
||||
(map-key "DEL" editor-delete-next-char)
|
||||
(map-key "PAGE-UP" move-cursor-page-up)
|
||||
(map-key "PAGE-DOWN" move-cursor-page-down)
|
||||
(map-key "CTRL-o" editor-open-file)
|
||||
|
||||
|
||||
|
||||
+21
-29
@@ -1,40 +1,32 @@
|
||||
#ifndef BUILTINS_H_
|
||||
#define BUILTINS_H_
|
||||
|
||||
#include "../blisp/include/config_tools.h"
|
||||
#include "../include/editor_op.h"
|
||||
#include "../include/file_io.h"
|
||||
#include "../include/output.h"
|
||||
#include "../include/input.h"
|
||||
#include "data.h"
|
||||
#include "file_io.h"
|
||||
#include "../lisp-interpreter/dist/lisp.h"
|
||||
|
||||
// Function pointer type for commands
|
||||
typedef void (*command_func_t)(struct editorConfig *E);
|
||||
Lisp moveCursor(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
// Structure to hold function mappings
|
||||
typedef struct {
|
||||
const char *name;
|
||||
command_func_t func;
|
||||
} function_entry_t;
|
||||
Lisp mapKey(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
// Function registry
|
||||
void registerBuiltin(char * key_sequence, LispCFunc f);
|
||||
|
||||
void init_function_registry(void);
|
||||
int register_function(const char *name, command_func_t func);
|
||||
command_func_t find_function(const char *name);
|
||||
int execute_command(const char *name, struct editorConfig *E);
|
||||
Lisp editorQuit(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
void moveCursorBeginLine(struct editorConfig *E);
|
||||
void moveCursorEndLine(struct editorConfig *E);
|
||||
void editorQuit(struct editorConfig *E);
|
||||
Lisp l_editorSave(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
void editorMoveCursorUp(struct editorConfig *E);
|
||||
void editorMoveCursorDown(struct editorConfig *E);
|
||||
void editorMoveCursorLeft(struct editorConfig *E);
|
||||
void editorMoveCursorRight(struct editorConfig *E);
|
||||
void deleteNextChar(struct editorConfig *E);
|
||||
void editorMoveCursorPageUp(struct editorConfig *E);
|
||||
void editorMoveCursorPageDown(struct editorConfig *E);
|
||||
Lisp l_editorInsertNewLine(Lisp args, LispError* e, LispContext ctx);
|
||||
|
||||
Lisp moveCursorBeginLine(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
Lisp moveCursorEndLine(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
Lisp deletePreviousChar(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
Lisp editorMoveCursorPageUp(Lisp args, LispError* e, LispContext ctx);
|
||||
|
||||
Lisp editorMoveCursorPageDown(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
Lisp editorOpenFile(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
Lisp editorPrintC(Lisp args, LispError *e, LispContext ctx);
|
||||
|
||||
#endif
|
||||
|
||||
+35
-9
@@ -1,9 +1,11 @@
|
||||
#ifndef DATA_H_
|
||||
#define DATA_H_
|
||||
|
||||
#include <stdio.h>
|
||||
#include <termios.h>
|
||||
#include <time.h>
|
||||
#include "../blisp/include/data.h"
|
||||
|
||||
#include "../lisp-interpreter/dist/lisp.h"
|
||||
|
||||
/**
|
||||
* \struct erow
|
||||
@@ -18,6 +20,23 @@ typedef struct erow {
|
||||
char *render; /**< The actual line we will print */
|
||||
} erow;
|
||||
|
||||
enum editorStatus_e {
|
||||
IDLE,
|
||||
READ_ONLY,
|
||||
READ_AND_WRITE,
|
||||
};
|
||||
|
||||
struct const_t {
|
||||
int TAB_LENGTH;
|
||||
int QUIT_TIMES;
|
||||
};
|
||||
|
||||
struct keyBind_t {
|
||||
char *key_sequence;
|
||||
Lisp command;
|
||||
|
||||
};
|
||||
|
||||
/**
|
||||
* \struct editorConfig
|
||||
* \brief Containing our editor state.
|
||||
@@ -32,12 +51,24 @@ struct editorConfig {
|
||||
int numrows; /**< Number of rows contained */
|
||||
erow *row; /**< Store all the rows printed */
|
||||
int dirty;
|
||||
int quit_times;
|
||||
char *filename;
|
||||
enum editorStatus_e state;
|
||||
char status_msg[80];
|
||||
time_t status_msg_time;
|
||||
struct termios orig_termios; /**< Terminal communication interface */
|
||||
config_t *config;
|
||||
|
||||
struct const_t constantes;
|
||||
int quit_times_buffer;
|
||||
|
||||
FILE *fd_init_file;
|
||||
Lisp env;
|
||||
LispContext ctx; /** Lisp context */
|
||||
Lisp ctx_data; /** Lisp data context */
|
||||
LispError ctx_error; /** Lisp ctx error */
|
||||
|
||||
struct keyBind_t* key_binds;
|
||||
int number_of_keybinds;
|
||||
|
||||
};
|
||||
|
||||
/**
|
||||
@@ -50,12 +81,7 @@ struct abuf {
|
||||
int len; /**< Length of the text */
|
||||
};
|
||||
|
||||
// Enhanced key sequence handling for multi-key bindings like "CTRL-f o"
|
||||
typedef struct {
|
||||
char sequence[64];
|
||||
int sequence_len;
|
||||
int last_key_time; // You might want to add timing if needed
|
||||
} key_sequence_t;
|
||||
extern struct editorConfig E;
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
+1
-3
@@ -24,8 +24,6 @@ enum editorKey {
|
||||
|
||||
#define ABUF_INIT {NULL, 0}
|
||||
|
||||
#define BELUGA_VERSION "1.0"
|
||||
#define TAB_LENGTH 2
|
||||
#define QUIT_TIMES 1
|
||||
#define BELUGA_VERSION "1.1"
|
||||
|
||||
#endif // DEFINE_H_
|
||||
|
||||
+3
-3
@@ -2,10 +2,10 @@
|
||||
#define EDITOR_OP_H_
|
||||
|
||||
#include "data.h"
|
||||
void editorInsertChar(struct editorConfig *E, int c);
|
||||
void editorInsertChar(int c);
|
||||
|
||||
void editorInsertNewLine(struct editorConfig *E);
|
||||
void editorInsertNewLine();
|
||||
|
||||
void editorDelChar(struct editorConfig *E);
|
||||
void editorDelChar();
|
||||
|
||||
#endif // EDITOR_OP_H_
|
||||
|
||||
+6
-3
@@ -8,10 +8,13 @@
|
||||
#include <stdlib.h>
|
||||
#include <sys/types.h>
|
||||
|
||||
char *editorRowsToString(struct editorConfig *E, int *buffer_len);
|
||||
char *editorRowsToString(int *buffer_len);
|
||||
|
||||
void editorOpen(struct editorConfig *E, char *filename);
|
||||
|
||||
void editorSave(struct editorConfig *E);
|
||||
void editorCloseFile(void);
|
||||
|
||||
void editorOpen(char *filename);
|
||||
|
||||
void editorSave();
|
||||
|
||||
#endif // FILE_IO_H_
|
||||
|
||||
+4
-6
@@ -1,20 +1,18 @@
|
||||
#ifndef INIT_H_
|
||||
#define INIT_H_
|
||||
|
||||
#include "builtins.h"
|
||||
#include "data.h"
|
||||
#include "terminal.h"
|
||||
#include "builtins.h"
|
||||
#include "../blisp/include/config_tools.h"
|
||||
#include <stdio.h>
|
||||
|
||||
|
||||
void getConfig();
|
||||
|
||||
/**
|
||||
* \fn void initEditor()
|
||||
* \brief Job's function is to initialize all the fields of editorConfig.
|
||||
* */
|
||||
|
||||
void initEditor(struct editorConfig *E);
|
||||
void initBuiltins();
|
||||
|
||||
void initEditor();
|
||||
|
||||
#endif // INIT_H_
|
||||
|
||||
+5
-8
@@ -6,7 +6,6 @@
|
||||
#include "output.h"
|
||||
#include "terminal.h"
|
||||
#include "builtins.h"
|
||||
#include "../blisp/include/config_tools.h"
|
||||
#include <unistd.h>
|
||||
|
||||
// KEYS keycode
|
||||
@@ -21,21 +20,19 @@
|
||||
// END \x1b[4~ || <esc>[8~ || <esc>[F || <esc>OF
|
||||
// DELETE \x1b[3~
|
||||
|
||||
char *editorPrompt(char *prompt);
|
||||
|
||||
char *key_to_string(int key);
|
||||
|
||||
int execute_key_binding(config_t *config, const char *key_combo, void *context);
|
||||
void editorMoveCursor(int key);
|
||||
|
||||
int handle_key_sequence(struct editorConfig *E, int key);
|
||||
|
||||
char *editorPrompt(struct editorConfig *E, char *prompt);
|
||||
|
||||
void editorMoveCursor(struct editorConfig *E, int key);
|
||||
int executeKeyBind(char *key_sequence);
|
||||
|
||||
/**
|
||||
* \fn void editorProcessKeypress()
|
||||
* \brief Get the last key input and do the proper action.
|
||||
*/
|
||||
|
||||
void editorProcessKeypress(struct editorConfig *E);
|
||||
void editorProcessKeypress();
|
||||
|
||||
#endif // INPUT_H_
|
||||
|
||||
+6
-6
@@ -13,16 +13,16 @@
|
||||
* \brief Draws left rows of the editor.
|
||||
*/
|
||||
|
||||
void editorDrawRows(struct editorConfig *E, struct abuf *ab);
|
||||
void editorDrawRows(struct abuf *ab);
|
||||
|
||||
void editorRefreshScreen(struct editorConfig *E);
|
||||
void editorRefreshScreen();
|
||||
|
||||
void editorScroll(struct editorConfig *E);
|
||||
void editorScroll();
|
||||
|
||||
void editorDrawStatusBar(struct editorConfig *E, struct abuf *ab);
|
||||
void editorDrawStatusBar(struct abuf *ab);
|
||||
|
||||
void editorDrawMessageBar(struct editorConfig *E, struct abuf *ab);
|
||||
void editorDrawMessageBar(struct abuf *ab);
|
||||
|
||||
void editorSetStatusMessage(struct editorConfig *E, const char *fmt, ...);
|
||||
void editorSetStatusMessage(const char *fmt, ...);
|
||||
|
||||
#endif // OUTPUT_H_
|
||||
|
||||
+5
-8
@@ -12,19 +12,16 @@ int editorRowCxToRx(erow *row, int cursor_x);
|
||||
|
||||
void editorUpdateRow(erow *row);
|
||||
|
||||
void editorInsertRow(struct editorConfig *E, int at, char *s, size_t len);
|
||||
void editorInsertRow(int at, char *s, size_t len);
|
||||
|
||||
void editorFreeRow(erow *row);
|
||||
|
||||
void editorDelRow(struct editorConfig *E, int at);
|
||||
void editorDelRow(int at);
|
||||
|
||||
void editorRowInsertChar(struct editorConfig *E, erow *row, int at, int c);
|
||||
void editorRowInsertChar(erow *row, int at, int c);
|
||||
|
||||
void editorRowAppendString(struct editorConfig *E, erow *row, char *s,
|
||||
size_t len);
|
||||
void editorRowAppendString(erow *row, char *s, size_t len);
|
||||
|
||||
void editorRowDelchar(struct editorConfig *E, erow *row, int at);
|
||||
|
||||
void log_string(char * string);
|
||||
void editorRowDelchar(erow *row, int at);
|
||||
|
||||
#endif // ROW_OP_H_
|
||||
|
||||
+2
-2
@@ -21,9 +21,9 @@
|
||||
|
||||
void die(const char *s);
|
||||
|
||||
void disableRawMode(struct editorConfig *E);
|
||||
void disableRawMode();
|
||||
|
||||
void enableRawMode(struct editorConfig *E);
|
||||
void enableRawMode();
|
||||
|
||||
int editorReadKey();
|
||||
|
||||
|
||||
@@ -0,0 +1,27 @@
|
||||
*.out
|
||||
/lisp
|
||||
*.exe
|
||||
*.stackdump
|
||||
temp/
|
||||
/printer
|
||||
/sample
|
||||
|
||||
|
||||
# Xcode
|
||||
.DS_Store
|
||||
build/
|
||||
*.pbxuser
|
||||
!default.pbxuser
|
||||
*.mode1v3
|
||||
!default.mode1v3
|
||||
*.mode2v3
|
||||
!default.mode2v3
|
||||
*.perspectivev3
|
||||
!default.perspectivev3
|
||||
*.xcworkspace
|
||||
!default.xcworkspace
|
||||
xcuserdata
|
||||
profile
|
||||
*.moved-aside
|
||||
DerivedData
|
||||
.idea/
|
||||
@@ -0,0 +1,64 @@
|
||||
# Internals
|
||||
|
||||
Technical design decisions and tricks.
|
||||
|
||||
|
||||
## Memory
|
||||
|
||||
We do not use tagged pointers, for simplicity and portability.
|
||||
`Lisp` objects are fairly large due to alignment requirements (16 bytes).
|
||||
However, they are usually only stored in this form when interacting
|
||||
in the C stack. In data structures, we prefer to store `LispVal` (8 bytes)
|
||||
and pack the types in with the block info.
|
||||
|
||||
All allocations are aligned to `sizeof(LispVal)` to avoid unaligned access.
|
||||
|
||||
- [Chicken representation](http://www.more-magic.net/posts/internals-data-representation.html)
|
||||
|
||||
## Garbage Collection
|
||||
|
||||
The choice to use explicit, rather than automatic garbage collection, was made so that the interpreter does not need to keep track of every lisp object on the stack, only the most important objects.
|
||||
If garbage collection was allowed to trigger at any time in the middle of a C function call, then the interpreter would need to be able to "see" all the lisp values on the call stack, in order to prevent them from being collected. Providing this feature would make integrating with C code much more complicated and conflict with the project's goal of being easily embeddable.
|
||||
|
||||
This means that when `lisp_collect` is called, all lisp values which are not reachable from the global environment or the function's parameters become invalidated. Be conscious of when and where you call the garbage collector.
|
||||
|
||||
An alternative solution is used in [Lua][lua-memory].
|
||||
|
||||
The interpreter uses the [Cheney algorithim][cheney-mta] for garbage collection. Memory is allocated in fixed size pages. When an allocation is request and the current page does not have enough space remaining, a new page will be allocated to fulfill the allocation. So, allocations will continue to use up more memory until garbage collection.
|
||||
Note that tail call recursion will not overflow the stack, but will use additional memory for each function call.
|
||||
|
||||
[cheney-mta]: https://en.wikipedia.org/wiki/Cheney%27s_algorithm
|
||||
[mta-info]: http://home.pipeline.com/~hbaker1/CheneyMTA.html
|
||||
[lua-memory]: https://www.lua.org/pil/24.2.html
|
||||
[gc-internals]: http://www.more-magic.net/posts/internals-gc.html
|
||||
|
||||
## General design
|
||||
|
||||
- [Lysp][lysp]
|
||||
- [Lispy][lispy]
|
||||
|
||||
[lysp]: http://piumarta.com/software/lysp/
|
||||
[lispy]: http://norvig.com/lispy.html
|
||||
|
||||
|
||||
## Environments/Tables
|
||||
|
||||
Tables are only resized at garbage collect time.
|
||||
This leads us to linked list-chaining as opposed to open addresing
|
||||
because linked list chaining can scale infinitely while
|
||||
waiting for garbage collection.
|
||||
|
||||
- [SICP][sicp-environments]
|
||||
- [MIT][environment-objects]
|
||||
|
||||
[sicp-environments]: https://mitpress.mit.edu/sicp/full-text/book/book-Z-H-21.html#%_sec_3.2
|
||||
[environment-objects]: https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_14.html
|
||||
|
||||
What is the cost of a helper (nested) function?
|
||||
It must allocate a new lambda, but it doesn't have to read/expand it again.
|
||||
|
||||
## Symbols
|
||||
|
||||
- Reference counting symbol table? - http://sandbox.mc.edu/~bennet/cs404/ex/lisprcnt.html
|
||||
|
||||
|
||||
@@ -0,0 +1,26 @@
|
||||
CFLAGS = -Idist/ -Wall -pedantic -Wstrict-prototypes -O3
|
||||
LDLIBS = -lm
|
||||
CC=cc
|
||||
|
||||
all: lisp printer sample
|
||||
|
||||
clean:
|
||||
rm -f lisp
|
||||
rm -f printer
|
||||
rm -f sample
|
||||
rm -f dist/lisp_lib.h
|
||||
|
||||
lisp: repl.c dist/lisp.h dist/lisp_lib.h
|
||||
${CC} repl.c -o $@ ${CFLAGS} ${LDLIBS}
|
||||
|
||||
printer: printer.c dist/lisp.h
|
||||
${CC} printer.c -o $@ ${CFLAGS} ${LDLIBS}
|
||||
|
||||
sample: sample.c dist/lisp.h dist/lisp_lib.h
|
||||
${CC} sample.c -o $@ ${CFLAGS} ${LDLIBS}
|
||||
|
||||
dist/lisp_lib.h: stdlib/lib.h stdlib/lib.c
|
||||
cd stdlib; ./concat.sh > ../$@;
|
||||
|
||||
|
||||
.PHONY: all clean
|
||||
@@ -0,0 +1,207 @@
|
||||
|
||||
Lisp Interpreter
|
||||
================
|
||||
|
||||
> Any sufficiently complicated C or Fortran program contains an ad hoc, informally-specified, bug-ridden, slow implementation of half of Common Lisp. -- Philip Greenspun
|
||||
|
||||
An embeddable lisp/scheme interpreter written in C.
|
||||
It includes a subset of R5RS with some extensions from MIT Scheme.
|
||||
|
||||
I created this while reading [SICP](https://github.com/justinmeiners/sicp-excercises) to improve my knowledge of lisp
|
||||
and to make an implementation that allows me to easily add scripting to my own programs.
|
||||
|
||||
### Philosophy
|
||||
|
||||
- **Simple**: This project doesn't aim to be optimal, or fully standards compliant.
|
||||
It is just a robust foundation for scripting.
|
||||
It is implemented as a recursive AST walker on the C stack.
|
||||
|
||||
If you need more try [s7](https://ccrma.stanford.edu/software/snd/snd/s7.html) or [chicken](https://www.call-cc.org)
|
||||
|
||||
- **Unintrusive**: Just copy in the header file. Turn on and off major features with build macros. It should be portable between major platforms.
|
||||
|
||||
- **Unsurprising**: You should be able to read the source code and understand how it works.
|
||||
The C API should work how you expect.
|
||||
|
||||
- **First class data**: Lisp s-expressions are undervalued as an alternative to JSON or XML.
|
||||
Preprocessor flags can remove most scheme features if you just want to read s-expressions
|
||||
and manipulate them in C.
|
||||
|
||||
### Features
|
||||
|
||||
- C99, no dependencies, two files.
|
||||
- Core lisp language `if`, `let`, `do`, `lambda`, `cons`, `eval`, etc.
|
||||
- Subset of scheme R5RS library: lists, vectors, hash tables, integers, real numbers, characters, strings, and integers.
|
||||
- Common lisp goodies: unhygenic macros (`define-macro`), `push`, `dotimes`.
|
||||
- Easy to integrate C functions.
|
||||
- Exact [garbage collection](#garbage-collection) with explicit invocation.
|
||||
- REPL command line tool.
|
||||
- Efficient parsing and manipulation of large data files.
|
||||
|
||||
### Non-Features
|
||||
|
||||
- Compiler or VM.
|
||||
- Full numeric tower.
|
||||
- Full call/cc. This only supports simple stack jumps.
|
||||
- syntax rules.
|
||||
- UNIX system interface/IO library.
|
||||
|
||||
### Examples
|
||||
|
||||
### Interactive programming with Read, eval, print loop.
|
||||
```bash
|
||||
$ ./lisp
|
||||
> (define (sqr x) (* x x)))
|
||||
> (define length 40)
|
||||
> (define area 0)
|
||||
> (set! area (sqr length))
|
||||
1600
|
||||
```
|
||||
|
||||
### Quickstart
|
||||
|
||||
```c
|
||||
LispContext ctx = lisp_init();
|
||||
lisp_load_lib(ctx);
|
||||
|
||||
LispError error;
|
||||
Lisp program = lisp_read("(+ 1 2)", &error, ctx);
|
||||
Lisp result = lisp_eval(program, &error, ctx);
|
||||
|
||||
if (error != LISP_ERROR_NONE)
|
||||
lisp_print(result); ; => 3
|
||||
|
||||
lisp_shutdown(ctx);
|
||||
```
|
||||
|
||||
### Loading Data
|
||||
|
||||
Lisp s-expressions can be used as a lightweight substitute to JSON or XML.
|
||||
Looking up keys which are reused is even more efficient due to symbol comparison.
|
||||
|
||||
JSON
|
||||
```json
|
||||
{
|
||||
"name" : "Bob Jones",
|
||||
"age" : 54,
|
||||
"city" : "SLC",
|
||||
}
|
||||
```
|
||||
|
||||
Lisp
|
||||
```scheme
|
||||
#((name . "Bob Jones")
|
||||
(age . 54)
|
||||
(city . "SLC"))
|
||||
```
|
||||
Loading the structure in C.
|
||||
|
||||
```c
|
||||
LispContext ctx = lisp_init();
|
||||
// load lisp structure
|
||||
Lisp data = lisp_read_file(file, ctx);
|
||||
// get value for age
|
||||
Lisp age_entry = lisp_avector_ref(data, lisp_make_symbol("AGE", ctx), ctx);
|
||||
// ...
|
||||
lisp_shutdown(ctx);
|
||||
```
|
||||
|
||||
### Calling C functions
|
||||
|
||||
C functions can be used to extend the interpreter, or call into C code.
|
||||
|
||||
```c
|
||||
Lisp integer_range(Lisp args, LispError* e, LispContext ctx)
|
||||
{
|
||||
// first argument
|
||||
LispInt start = lisp_int(lisp_car(args));
|
||||
args = lisp_cdr(args);
|
||||
// second argument
|
||||
LispInt end = lisp_int(lisp_car(args));
|
||||
|
||||
if (end < start)
|
||||
{
|
||||
*e = LISP_ERROR_OUT_OF_BOUNDS;
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
LispInt n = end - start;
|
||||
Lisp numbers = lisp_make_vector(n, ctx);
|
||||
|
||||
for (LispInt i = 0; i < n; ++i)
|
||||
lisp_vector_set(numbers, i, lisp_make_int(start + i));
|
||||
|
||||
return numbers;
|
||||
}
|
||||
// ...
|
||||
|
||||
// wrap in Lisp object
|
||||
Lisp func = lisp_make_func(integers_in_range);
|
||||
|
||||
// add to enviornment with symbol INTEGER-RANGE
|
||||
Lisp env = lisp_env_global(ctx);
|
||||
lisp_env_define(env, lisp_make_symbol("INTEGER-RANGE", ctx), func, ctx);
|
||||
```
|
||||
|
||||
In Lisp
|
||||
```scheme
|
||||
(integer-range 5 15)
|
||||
; => #(5 6 7 8 9 10 11 12 13 14)
|
||||
```
|
||||
Constants can also be stored in the environment in a similar fashion.
|
||||
|
||||
```c
|
||||
Lisp pi = lisp_make_real(3.141592);
|
||||
lisp_env_define(env, lisp_make_symbol("PI", ctx), pi, ctx);
|
||||
```
|
||||
### Macros
|
||||
|
||||
Common Lisp style (`defmacro`) is available with the name `define-macro`.
|
||||
|
||||
(define-macro nil! (lambda (x)
|
||||
`(set! ,x '()))
|
||||
|
||||
### Garbage Collection
|
||||
|
||||
Garbage is only collected if it is explicitly told to.
|
||||
You can invoke the garbage collector in C:
|
||||
|
||||
lisp_collect(ctx);
|
||||
|
||||
OR in lisp code:
|
||||
|
||||
(gc-flip)
|
||||
|
||||
Note that whenever a collect is issued
|
||||
ANY `Lisp` value in `C`which is not accessible
|
||||
through the global environment may become invalid.
|
||||
Be careful what variables you hold onto in C.
|
||||
|
||||
Don't call `eval` in a custom defined C function unless you know what you are doing.
|
||||
|
||||
See [internals](INTERNALS.md) for more details.
|
||||
|
||||
## Documentation
|
||||
|
||||
For the language refer to [MIT Scheme](https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_toc.html)
|
||||
with the understanding that not everything is missing.
|
||||
If we do implement a feature that MIT scheme has, we will try to follow their specificaiton.
|
||||
|
||||
For the C API refer to the header and sample programs (`repl.c`, `printer.c`).
|
||||
|
||||
## Project License
|
||||
|
||||
Copyright (c) 2020 Justin Meiners
|
||||
|
||||
Permission to use, copy, modify, and distribute this software for any
|
||||
purpose with or without fee is hereby granted, provided that the above
|
||||
copyright notice and this permission notice appear in all copies.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
|
||||
Vendored
+3215
File diff suppressed because it is too large
Load Diff
Vendored
+2180
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,24 @@
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LISP_IMPLEMENTATION
|
||||
#include "lisp.h"
|
||||
|
||||
int main(int argc, const char* argv[])
|
||||
{
|
||||
LispContext ctx = lisp_init();
|
||||
LispError error;
|
||||
Lisp data = lisp_read_file(stdin, &error, ctx);
|
||||
|
||||
if (error != LISP_ERROR_NONE)
|
||||
{
|
||||
fprintf(stderr, "error: %s\n", lisp_error_string(error));
|
||||
}
|
||||
data = lisp_collect(data, ctx);
|
||||
lisp_printf(stdout, data);
|
||||
|
||||
lisp_shutdown(ctx);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -0,0 +1,163 @@
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
#include <string.h>
|
||||
|
||||
// Disable asserts?
|
||||
// #define NDEBUG
|
||||
|
||||
//#define LISP_DEBUG
|
||||
|
||||
#define LISP_IMPLEMENTATION
|
||||
#include "lisp.h"
|
||||
#include "lisp_lib.h"
|
||||
|
||||
#define LINE_MAX 4096
|
||||
|
||||
static Lisp sch_load(Lisp args, LispError* e, LispContext ctx)
|
||||
{
|
||||
Lisp path = lisp_car(args);
|
||||
Lisp result = lisp_read_path(lisp_string(path), e, ctx);
|
||||
if (*e != LISP_ERROR_NONE) return lisp_null();
|
||||
return lisp_eval(result, e, ctx);
|
||||
}
|
||||
|
||||
int main(int argc, const char* argv[])
|
||||
{
|
||||
const char* file_path = NULL;
|
||||
int run_script = 0;
|
||||
int verbose;
|
||||
#ifdef LISP_DEBUG
|
||||
verbose = 1;
|
||||
#else
|
||||
verbose = 0;
|
||||
#endif
|
||||
|
||||
for (int i = 1; i < argc; ++i)
|
||||
{
|
||||
if (strcmp(argv[i], "--load") == 0)
|
||||
{
|
||||
file_path = argv[i + 1];
|
||||
}
|
||||
if (strcmp(argv[i], "--script") == 0)
|
||||
{
|
||||
file_path = argv[i + 1];
|
||||
run_script = 1;
|
||||
}
|
||||
}
|
||||
|
||||
//LispContext ctx = lisp_init();
|
||||
LispContext ctx = lisp_init_with_lib();
|
||||
lisp_env_define(
|
||||
lisp_cdr(lisp_env(ctx)),
|
||||
lisp_make_symbol("LOAD", ctx),
|
||||
lisp_make_func(sch_load),
|
||||
ctx
|
||||
);
|
||||
|
||||
// Load as a macro is called "include" and can be used to load files containing macros.
|
||||
lisp_table_set(
|
||||
lisp_macro_table(ctx),
|
||||
lisp_make_symbol("INCLUDE", ctx),
|
||||
lisp_make_func(sch_load),
|
||||
ctx
|
||||
);
|
||||
|
||||
clock_t start_time, end_time;
|
||||
|
||||
if (file_path)
|
||||
{
|
||||
if (verbose)
|
||||
{
|
||||
printf("loading: %s\n", file_path);
|
||||
}
|
||||
|
||||
start_time = clock();
|
||||
|
||||
LispError error;
|
||||
Lisp l = lisp_read_path(file_path, &error, ctx);
|
||||
|
||||
if (error != LISP_ERROR_NONE)
|
||||
{
|
||||
fprintf(stderr, "%s. %s\n", file_path, lisp_error_string(error));
|
||||
}
|
||||
|
||||
end_time = clock();
|
||||
|
||||
if (verbose)
|
||||
printf("read (us): %lu\n", 1000000 * (end_time - start_time) / CLOCKS_PER_SEC);
|
||||
|
||||
start_time = clock();
|
||||
|
||||
Lisp code = lisp_macroexpand(l, &error, ctx);
|
||||
|
||||
if (error != LISP_ERROR_NONE)
|
||||
{
|
||||
fprintf(stderr, "%s\n", lisp_error_string(error));
|
||||
exit(1);
|
||||
}
|
||||
|
||||
|
||||
end_time = clock();
|
||||
|
||||
if (verbose)
|
||||
printf("expand (us): %lu\n", 1000000 * (end_time - start_time) / CLOCKS_PER_SEC);
|
||||
|
||||
|
||||
start_time = clock();
|
||||
lisp_eval(code, &error, ctx);
|
||||
end_time = clock();
|
||||
|
||||
if (error != LISP_ERROR_NONE)
|
||||
{
|
||||
fprintf(stderr, "%s\n", lisp_error_string(error));
|
||||
exit(1);
|
||||
}
|
||||
|
||||
lisp_collect(lisp_null(), ctx);
|
||||
|
||||
if (verbose)
|
||||
printf("eval (us): %lu\n", 1000000 * (end_time - start_time) / CLOCKS_PER_SEC);
|
||||
}
|
||||
|
||||
if (!run_script)
|
||||
{
|
||||
// REPL
|
||||
while (!feof(stdin))
|
||||
{
|
||||
printf("> ");
|
||||
char line[LINE_MAX];
|
||||
if (!fgets(line, LINE_MAX, stdin)) break;
|
||||
|
||||
clock_t start_time = clock();
|
||||
LispError error;
|
||||
Lisp code = lisp_read(line, &error, ctx);
|
||||
|
||||
if (error != LISP_ERROR_NONE)
|
||||
{
|
||||
fprintf(stderr, "%s\n", lisp_error_string(error));
|
||||
continue;
|
||||
}
|
||||
|
||||
Lisp l = lisp_eval(code, &error, ctx);
|
||||
clock_t end_time = clock();
|
||||
|
||||
if (error != LISP_ERROR_NONE)
|
||||
{
|
||||
fprintf(stderr, "%s\n", lisp_error_string(error));
|
||||
}
|
||||
|
||||
lisp_printf(stdout, l);
|
||||
printf("\n");
|
||||
|
||||
lisp_collect(lisp_null(), ctx);
|
||||
|
||||
if (verbose)
|
||||
printf("(us): %lu\n", 1000000 * (end_time - start_time) / CLOCKS_PER_SEC);
|
||||
}
|
||||
}
|
||||
|
||||
lisp_shutdown(ctx);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
Executable
+57
@@ -0,0 +1,57 @@
|
||||
#!/bin/sh
|
||||
|
||||
PASS=1
|
||||
|
||||
cd tests/code
|
||||
|
||||
for FILE in *.scm
|
||||
do
|
||||
echo "$FILE"
|
||||
../../lisp --script "$FILE"
|
||||
RESULT=$?
|
||||
|
||||
printf "\n"
|
||||
if [ $RESULT = "0" ]
|
||||
then
|
||||
echo "FINISHED $FILE"
|
||||
else
|
||||
echo "*FAILED* $FILE"
|
||||
PASS=0
|
||||
fi
|
||||
printf "\n"
|
||||
done
|
||||
|
||||
cd ../
|
||||
cd data
|
||||
|
||||
( ./test.sh )
|
||||
RESULT=$?
|
||||
|
||||
if [ $RESULT = "0" ]
|
||||
then
|
||||
echo "FINISHED data test"
|
||||
else
|
||||
echo "*FAILED* data test"
|
||||
PASS=0
|
||||
fi
|
||||
|
||||
cd ../
|
||||
cd printer
|
||||
|
||||
( ./test.sh )
|
||||
RESULT=$?
|
||||
|
||||
if [ $RESULT = "0" ]
|
||||
then
|
||||
echo "FINISHED printer test"
|
||||
else
|
||||
echo "*FAILED* printer test"
|
||||
PASS=0
|
||||
fi
|
||||
|
||||
if [ $PASS = "0" ]
|
||||
then
|
||||
echo "**TESTS FAILED**"
|
||||
else
|
||||
echo "**TESTS PASSED**"
|
||||
fi
|
||||
@@ -0,0 +1,55 @@
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LISP_IMPLEMENTATION
|
||||
#include "lisp.h"
|
||||
#include "lisp_lib.h"
|
||||
|
||||
Lisp integer_range(Lisp args, LispError* e, LispContext ctx)
|
||||
{
|
||||
// first argument
|
||||
LispInt start = lisp_int(lisp_car(args));
|
||||
args = lisp_cdr(args);
|
||||
// second argument
|
||||
LispInt end = lisp_int(lisp_car(args));
|
||||
|
||||
if (end < start)
|
||||
{
|
||||
*e = LISP_ERROR_OUT_OF_BOUNDS;
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
LispInt n = end - start;
|
||||
Lisp numbers = lisp_make_vector(n, ctx);
|
||||
|
||||
for (LispInt i = 0; i < n; ++i)
|
||||
lisp_vector_set(numbers, i, lisp_make_int(start + i));
|
||||
|
||||
return numbers;
|
||||
}
|
||||
|
||||
int main(int argc, const char* argv[])
|
||||
{
|
||||
LispContext ctx = lisp_init();
|
||||
lisp_lib_load(ctx);
|
||||
|
||||
// wrap in Lisp object
|
||||
Lisp func = lisp_make_func(integer_range);
|
||||
|
||||
// add to enviornment with symbol INTEGER-RANGE
|
||||
Lisp env = lisp_env(ctx);
|
||||
lisp_env_define(env, lisp_make_symbol("INTEGER-RANGE", ctx), func, ctx);
|
||||
Lisp pi = lisp_make_real(3.141592);
|
||||
lisp_env_define(env, lisp_make_symbol("PI", ctx), pi, ctx);
|
||||
|
||||
LispError e;
|
||||
Lisp result = lisp_eval(lisp_read("(INTEGER-RANGE 5 15)", &e, ctx), &e, ctx);
|
||||
lisp_printf(stdout, result);
|
||||
|
||||
if (e != LISP_ERROR_NONE) fprintf(stderr, "error: %s\n", lisp_error_string(e));
|
||||
|
||||
lisp_shutdown(ctx);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -0,0 +1,90 @@
|
||||
(define-macro lambda (/\_ args
|
||||
(if (pair? args)
|
||||
(if (pair? (cdr args))
|
||||
(if (pair? (cdr (cdr args)))
|
||||
`(/\_ ,(car args) ,(cons 'BEGIN (cdr args)))
|
||||
`(/\_ ,(car args) ,(car (cdr args))))
|
||||
(syntax-error "lambda missing body expressions: (lambda (args) body)"))
|
||||
(syntax-error "lambda missing argument: (lambda (args) body)"))))
|
||||
|
||||
(define-macro set! (lambda (var x)
|
||||
(begin
|
||||
(if (not (symbol? var)) (syntax-error "set! not a variable"))
|
||||
`(_SET! ,var ,x))))
|
||||
|
||||
(define-macro define
|
||||
(lambda (var . exprs)
|
||||
(if (symbol? var)
|
||||
(if (pair? (cdr exprs))
|
||||
(syntax-error "define: (define var x)")
|
||||
`(_DEF ,var ,(car exprs)))
|
||||
(if (pair? var)
|
||||
`(_DEF ,(car var)
|
||||
(LAMBDA ,(cdr var)
|
||||
,(if (null? (cdr exprs)) (car exprs) (cons 'BEGIN exprs))))
|
||||
(syntax-error "define: not a symbol") ))))
|
||||
|
||||
(define (first x) (car x))
|
||||
(define (second x) (car (cdr x)))
|
||||
(define (third x) (car (cdr (cdr x))))
|
||||
|
||||
(define (some? pred l)
|
||||
(if (null? l) #f
|
||||
(if (pred (car l)) #t
|
||||
(some? pred (cdr l)))))
|
||||
|
||||
(define (_map1-helper proc l result)
|
||||
(if (null? l)
|
||||
(reverse! result)
|
||||
(_map1-helper proc
|
||||
(cdr l)
|
||||
(cons (proc (car l)) result))))
|
||||
|
||||
(define (map1 proc l) (_map1-helper proc l '()))
|
||||
|
||||
(define (for-each1 proc l)
|
||||
(if (null? l) '()
|
||||
(begin (proc (car l)) (for-each1 proc (cdr l )))))
|
||||
|
||||
(define (reverse! l) (append-reverse! l '()))
|
||||
(define (reverse l) (reverse! (list-copy l)))
|
||||
|
||||
(define (last-pair x)
|
||||
(if (pair? (cdr x))
|
||||
(last-pair (cdr x)) x))
|
||||
|
||||
(define (list-tail x k)
|
||||
(if (zero? k) x
|
||||
(list-tail (cdr x) (- k 1))))
|
||||
|
||||
(define (fold-left op acc lst)
|
||||
(if (null? lst) acc
|
||||
(fold-left op (op acc (car lst)) (cdr lst))))
|
||||
|
||||
(define (_expand-shorthand-body path)
|
||||
(if (null? path) (cons 'pair '())
|
||||
(list (if (char=? (car path) #\A)
|
||||
(cons 'CAR (_expand-shorthand-body (cdr path)))))))
|
||||
|
||||
(define (_expand-shorthand text)
|
||||
(cons 'DEFINE (cons (list (string->symbol (string-append "C" text "R")) 'pair)
|
||||
(_expand-shorthand-body (string->list text)))))
|
||||
|
||||
(define-macro _shorthand-accessors (lambda args (cons 'BEGIN (map1 _expand-shorthand args))))
|
||||
|
||||
(define (vector . args) (list->vector args))
|
||||
|
||||
(define (vector-copy v) (subvector v 0 (vector-length v)))
|
||||
(define (vector-head v end) (subvector v 0 end))
|
||||
(define (vector-tail v start) (subvector v start (vector-length v)))
|
||||
|
||||
(define (string . chars) (list->string chars))
|
||||
|
||||
(define (string>=? a b) (not (string<? a b)))
|
||||
(define (string>? a b) (string<? b a))
|
||||
(define (string<=? a b) (not (string<? b a)))
|
||||
|
||||
(define (string-copy s) (substring s 0 (string-length v)))
|
||||
(define (string-head s end) (subvector s 0 end))
|
||||
(define (string-tail s start) (subvector s start (string-length v)))
|
||||
|
||||
@@ -0,0 +1,78 @@
|
||||
(define (_make-lambda args body)
|
||||
(list 'LAMBDA args (if (null? (cdr body)) (car body) (cons 'BEGIN body))))
|
||||
|
||||
|
||||
; (LET <name> ((<var0> <expr0>) ... (<varN> <expr1>)) <body0> ... <bodyN>)
|
||||
; => ((LAMBDA (<var0> ... <varN>) (BEGIN <body0> ... <bodyN>)) <expr0> ... <expr1>)
|
||||
; => named
|
||||
; ((lambda ()
|
||||
; (define <name> (LAMBDA (<var0> ... <varN>) (BEGIN <body0> ... <bodyN>)))
|
||||
; (<name> <expr0> ... <exprN>)))
|
||||
|
||||
(define (_check-binding-list bindings)
|
||||
(for-each1 (lambda (entry)
|
||||
(if (not (pair? entry)) (syntax-error "bad let binding" entry))
|
||||
(if (not (symbol? (first entry))) (syntax-error "let entry missing symbol" entry))) bindings))
|
||||
|
||||
(define (_let->combination var bindings body)
|
||||
(_check-binding-list bindings)
|
||||
(define body-func (_make-lambda (map1 (lambda (entry) (first entry)) bindings) body))
|
||||
(define initial-args (map1 (lambda (entry) (second entry)) bindings))
|
||||
(if (null? var)
|
||||
(cons body-func initial-args)
|
||||
(list (_make-lambda '() (list (list 'DEFINE var body-func) (cons var initial-args))))))
|
||||
|
||||
(define-macro let (lambda args
|
||||
(if (pair? (first args))
|
||||
(_let->combination '() (car args) (cdr args))
|
||||
(_let->combination (first args) (second args) (cdr (cdr args))))))
|
||||
|
||||
(define (_let*-helper bindings body)
|
||||
(if (null? bindings) (if (null? (cdr body)) (car body) (cons 'BEGIN body))
|
||||
(list 'LET (list (car bindings)) (_let*-helper (cdr bindings) body))))
|
||||
|
||||
(define-macro let* (lambda (bindings . body)
|
||||
(_check-binding-list bindings)
|
||||
(_let*-helper bindings body)))
|
||||
|
||||
(define-macro letrec (lambda (bindings . body)
|
||||
(_check-binding-list bindings)
|
||||
(cons (_make-lambda (map1 (lambda (entry) (first entry)) bindings)
|
||||
(append (map1 (lambda (entry) (list 'SET! (first entry) (second entry)))
|
||||
bindings) body))
|
||||
(map1 (lambda (entry) '()) bindings))))
|
||||
|
||||
|
||||
; (COND (<pred0> <expr0>)
|
||||
; (<pred1> <expr1>)
|
||||
; ...
|
||||
; (else <expr-1>))
|
||||
; =>
|
||||
; (IF <pred0> <expr0>
|
||||
; (if <pred1> <expr1>
|
||||
; ....
|
||||
; (if <predN> <exprN> <expr-1>)) ... )
|
||||
|
||||
|
||||
(define (_cond-check-clauses clauses)
|
||||
(for-each1 (lambda (clause)
|
||||
(if (not (pair? clause)) (syntax-error "cond: invalid clause"))
|
||||
(if (null? (cdr clause)) (syntax-error "cond: clause missing expression")))
|
||||
clauses))
|
||||
|
||||
(define (_cond-helper clauses)
|
||||
(if (null? clauses) '()
|
||||
(if (eq? (car (car clauses)) 'ELSE)
|
||||
(cons 'BEGIN (cdr (car clauses)))
|
||||
(list 'IF
|
||||
(car (car clauses))
|
||||
(cons 'BEGIN (cdr (car clauses)))
|
||||
(_cond-helper (cdr clauses))))))
|
||||
|
||||
(define-macro cond (lambda clauses
|
||||
(begin
|
||||
(_cond-check-clauses clauses)
|
||||
(_cond-helper clauses))))
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,75 @@
|
||||
(_shorthand-accessors "AA" "DD" "AD" "DA" "AAA" "AAD" "ADA" "DAA" "ADD" "DAD" "DDA" "DDD")
|
||||
|
||||
(define (_and-helper preds)
|
||||
(cond ((null? preds) #t)
|
||||
((null? (cdr preds)) (car preds))
|
||||
(else
|
||||
`(IF ,(car preds) ,(_and-helper (cdr preds)) #f))))
|
||||
(define-macro and (lambda preds (_and-helper preds)))
|
||||
|
||||
(define (_or-helper preds var)
|
||||
(cond ((null? preds) #f)
|
||||
((null? (cdr preds)) (car preds))
|
||||
(else
|
||||
`(BEGIN (SET! ,var ,(car preds))
|
||||
(IF ,var ,var ,(_or-helper (cdr preds) var))))))
|
||||
|
||||
(define-macro or (lambda preds
|
||||
(let ((var (gensym)))
|
||||
`(LET ((,var '())) ,(_or-helper preds var)))))
|
||||
|
||||
(define-macro case (lambda (key . clauses)
|
||||
(let ((expr (gensym)))
|
||||
`(LET ((,expr ,key))
|
||||
,(cons 'COND (map1 (lambda (entry)
|
||||
(cons (if (pair? (car entry))
|
||||
`(MEMV ,expr (quote ,(car entry)))
|
||||
(car entry))
|
||||
(cdr entry))) clauses))))))
|
||||
|
||||
(define-macro push
|
||||
(lambda (v l)
|
||||
`(begin (set! ,l (cons ,v ,l)) ,l)))
|
||||
|
||||
; (DO ((<var0> <init0> <step0>) ...) (<test> <result>) <body>)
|
||||
(define-macro do
|
||||
(lambda (vars loop-check . loops)
|
||||
(let ( (names '()) (inits '()) (steps '()) (f (gensym)) )
|
||||
(for-each1 (lambda (var)
|
||||
(push (car var) names)
|
||||
(set! var (cdr var))
|
||||
(push (car var) inits)
|
||||
(set! var (cdr var))
|
||||
(push (car var) steps)) vars)
|
||||
`((LAMBDA ()
|
||||
(DEFINE ,f (LAMBDA ,names
|
||||
(IF ,(car loop-check)
|
||||
,(if (pair? (cdr loop-check)) (car (cdr loop-check)) '())
|
||||
,(cons 'BEGIN (append loops (list (cons f steps)))) )))
|
||||
,(cons f inits)
|
||||
)) )))
|
||||
|
||||
(define-macro dotimes
|
||||
(lambda (form body)
|
||||
(apply (lambda (i n . result)
|
||||
`(DO ((,i 0 (+ ,i 1)))
|
||||
((>= ,i ,n) ,(if (null? result) result (car result)) )
|
||||
,body)
|
||||
) form)))
|
||||
|
||||
(define-macro swap!
|
||||
(lambda (x y)
|
||||
(let ((temp (gensym)))
|
||||
`(LET ((,temp ,x))
|
||||
(SET! ,temp ,x)
|
||||
(SET! ,x ,y)
|
||||
(SET! ,y ,temp)))))
|
||||
|
||||
(define-macro inc! ; CL incf
|
||||
(lambda (x)
|
||||
`(SET! ,x (+ ,x 1))))
|
||||
|
||||
(define-macro dec! ; CL decf
|
||||
(lambda (x)
|
||||
`(SET! ,x (- ,x 1))))
|
||||
|
||||
@@ -0,0 +1,35 @@
|
||||
(define (number? x) (real? x))
|
||||
(define (odd? x) (not (even? x)))
|
||||
(define (inexact? x) (not (exact? x)))
|
||||
(define (zero? x) (= x 0))
|
||||
(define (positive? x) (>= x 0))
|
||||
(define (negative? x) (< x 0))
|
||||
|
||||
(define (>= a b) (not (< a b)))
|
||||
(define (> a b) (< b a))
|
||||
(define (<= a b) (not (< b a)))
|
||||
|
||||
(define (max . ls)
|
||||
(fold-left (lambda (m x)
|
||||
(if (> x m)
|
||||
x
|
||||
m)) (car ls) (cdr ls)))
|
||||
|
||||
(define (min . ls)
|
||||
(fold-left (lambda (m x)
|
||||
(if (< x m)
|
||||
x
|
||||
m)) (car ls) (cdr ls)))
|
||||
|
||||
(define (_gcd-helper a b)
|
||||
(if (= b 0) a (_gcd-helper b (modulo a b))))
|
||||
|
||||
(define (gcd . args)
|
||||
(if (null? args) 0
|
||||
(_gcd-helper (car args) (car (cdr args)))))
|
||||
|
||||
(define (lcm . args)
|
||||
(if (null? args) 1
|
||||
(abs (* (/ (car args) (apply gcd args))
|
||||
(apply * (cdr args))))))
|
||||
|
||||
@@ -0,0 +1,133 @@
|
||||
(define (map proc . rest)
|
||||
(define (helper lists result)
|
||||
(if (some? null? lists)
|
||||
(reverse! result)
|
||||
(helper (map1 cdr lists)
|
||||
(cons (apply proc (map1 car lists)) result))))
|
||||
(helper rest '()))
|
||||
|
||||
(define (for-each proc . rest)
|
||||
(define (helper lists)
|
||||
(if (some? null? lists)
|
||||
'()
|
||||
(begin
|
||||
(apply proc (map1 car lists))
|
||||
(helper (map1 cdr lists)))))
|
||||
(helper rest))
|
||||
|
||||
(define (filter pred l)
|
||||
(define (helper l result)
|
||||
(cond ((null? l) result)
|
||||
((pred (car l))
|
||||
(helper (cdr l) (cons (car l) result)))
|
||||
(else
|
||||
(helper (cdr l) result))))
|
||||
(reverse! (helper l '())))
|
||||
|
||||
(define (reduce op default lst)
|
||||
(if (null? lst)
|
||||
default
|
||||
(fold-left op (car lst) (cdr lst))))
|
||||
|
||||
(define (alist->hash-table alist)
|
||||
(define h (make-hash-table))
|
||||
(for-each1 (lambda (pair)
|
||||
(hash-table-set! h (car pair) (cdr pair))) alist)
|
||||
h)
|
||||
|
||||
(define (_assoc key list eq?)
|
||||
(if (null? list) #f
|
||||
(let ((pair (car list)))
|
||||
(if (and (pair? pair) (eq? key (car pair)))
|
||||
pair
|
||||
(_assoc key (cdr list) eq?)))))
|
||||
|
||||
(define (assoc key list) (_assoc key list equal?))
|
||||
(define (assq key list) (_assoc key list eq?))
|
||||
(define (assv key list) (_assoc key list eqv?))
|
||||
|
||||
(define (_member x list eq?)
|
||||
(cond ((null? list) #f)
|
||||
((eq? (car list) x) list)
|
||||
(else (_member x (cdr list) eq?))))
|
||||
|
||||
(define (member x list) (_member x list equal?))
|
||||
(define (memq x list) (_member x list eq?))
|
||||
(define (memv x list) (_member x list eqv?))
|
||||
|
||||
(define (make-initialized-vector l fn)
|
||||
(let ((v (make-vector l '())))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((>= i l) v)
|
||||
(vector-set! v i (fn i)))))
|
||||
|
||||
(define (vector-map fn v)
|
||||
(make-initialized-vector
|
||||
(vector-length v)
|
||||
(lambda (i) (fn (vector-ref v i)))))
|
||||
|
||||
(define (vector-binary-search v key< unwrap-key key)
|
||||
(define (helper low high mid)
|
||||
(if (<= (- high low) 1)
|
||||
(if (key< (unwrap-key (vector-ref v low)) key) #f (vector-ref v low))
|
||||
(begin
|
||||
(set! mid (+ low (quotient (- high low) 2)))
|
||||
(if (key< key (unwrap-key (vector-ref v mid)))
|
||||
(helper low mid 0)
|
||||
(helper mid high 0)))))
|
||||
(helper 0 (vector-length v) 0))
|
||||
|
||||
|
||||
(define (_insertsort v lo hi op)
|
||||
(if (= (- hi lo) 0)
|
||||
v
|
||||
(do ((i (+ lo 1) (+ i 1)))
|
||||
((= i hi) v)
|
||||
|
||||
(define x (vector-ref v i))
|
||||
|
||||
(do ((j i (- j 1)))
|
||||
((or
|
||||
(= j lo)
|
||||
(not (op x (vector-ref v (- j 1)))))
|
||||
(vector-set! v j x))
|
||||
|
||||
(vector-set! v j (vector-ref v (- j 1))))) ))
|
||||
|
||||
(define (_quicksort-partition v lo hi op)
|
||||
(let ((pivot (vector-ref v (+ lo (/ (- hi lo) 2))))
|
||||
(i (- lo 1))
|
||||
(j (+ hi 1)))
|
||||
(do ()
|
||||
((>= i j) j)
|
||||
|
||||
(set! i (+ i 1))
|
||||
(do ()
|
||||
((not (op (vector-ref v i) pivot)) '())
|
||||
(set! i (+ i 1)))
|
||||
|
||||
(set! j (- j 1))
|
||||
(do ()
|
||||
((not (op pivot (vector-ref v j))) '())
|
||||
(set! j (- j 1)))
|
||||
|
||||
(if (< i j) (vector-swap! v i j))
|
||||
)))
|
||||
|
||||
(define (_quicksort-vector v lo hi threshold op)
|
||||
(if (and (>= lo 0) (>= hi 0) (< lo hi) (> (- hi lo) threshold))
|
||||
(let ((p (_quicksort-partition v lo hi op)))
|
||||
(_quicksort-vector v lo p threshold op)
|
||||
(_quicksort-vector v (+ p 1) hi threshold op))))
|
||||
|
||||
(define (sort! v op)
|
||||
; quicksort down to a certain level of recursion and
|
||||
; then use insertion sort to finalize.
|
||||
(_quicksort-vector v 0 (- (vector-length v) 1) 16 op)
|
||||
(_insertsort v 0 (vector-length v) op)
|
||||
v)
|
||||
|
||||
(define (sort list cmp) (vector->list (sort! (list->vector list) cmp)))
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,58 @@
|
||||
|
||||
(define-macro delay (lambda (expr)
|
||||
`(make-promise ,(cons 'LAMBDA
|
||||
(cons '()
|
||||
(cons expr '()))))))
|
||||
|
||||
(define (force promise)
|
||||
(if (not (promise-forced? promise))
|
||||
(_promise-store! promise ((_promise-procedure promise))))
|
||||
(promise-value promise))
|
||||
|
||||
(define-macro cons-stream (lambda (x expr) `(cons ,x (delay ,expr))))
|
||||
|
||||
(define (stream-car stream) (car stream))
|
||||
(define (stream-cdr stream) (force (cdr stream)))
|
||||
|
||||
(define (stream-pair? x)
|
||||
(and (pair? x) (promise? (cdr x))))
|
||||
|
||||
(define (stream-null? stream) (null? stream))
|
||||
|
||||
(define (stream->list-helper stream result)
|
||||
(if (stream-null? stream)
|
||||
(reverse! result)
|
||||
(stream->list-helper
|
||||
(force (cdr stream))
|
||||
(cons (car stream) result))))
|
||||
|
||||
(define (stream->list stream)
|
||||
(stream->list-helper stream '()))
|
||||
|
||||
(define (list->stream list)
|
||||
(if (null? list)
|
||||
'()
|
||||
(cons-stream (car list) (list->stream (cdr list)))))
|
||||
|
||||
(define (stream . args) (list->stream args))
|
||||
|
||||
(define (stream-head-helper stream k result)
|
||||
(if (= k 0)
|
||||
(reverse! result)
|
||||
(stream-head-helper (force (cdr stream)) (- k 1) (cons (car stream) result))))
|
||||
|
||||
(define (stream-head stream k)
|
||||
(stream-head-helper stream k '()))
|
||||
|
||||
(define (stream-tail stream k)
|
||||
(if (= k 0)
|
||||
stream
|
||||
(stream-tail (stream-cdr stream) (- k 1))))
|
||||
|
||||
(define (stream-filter pred stream)
|
||||
(cond ((stream-null? stream) the-empty-stream)
|
||||
((pred (stream-car stream))
|
||||
(cons-stream (stream-car stream)
|
||||
(stream-filter pred
|
||||
(stream-cdr stream))))
|
||||
(else (stream-filter pred (stream-cdr stream)))))
|
||||
@@ -0,0 +1,63 @@
|
||||
(define (char>=? a b) (not (char<? a b)))
|
||||
(define (char>? a b) (char<? b a))
|
||||
(define (char<=? a b) (not (char<? b a)))
|
||||
|
||||
(define (char-ci=? a b) (char=? (char-downcase a) (char-downcase b)))
|
||||
(define (char-ci<? a b) (char<? (char-downcase a) (char-downcase b)))
|
||||
|
||||
(define (char-ci>=? a b) (not (char-ci<? a b)))
|
||||
(define (char-ci>? a b) (char-ci<? b a))
|
||||
(define (char-ci<=? a b) (not (char-ci<? b a)))
|
||||
|
||||
(define (char-lower-case? c)
|
||||
(and (>= (char->integer c) (char->integer #\a))
|
||||
(<= (char->integer c) (char->integer #\z))))
|
||||
|
||||
(define (char-upper-case? c)
|
||||
(and (>= (char->integer c) (char->integer #\A))
|
||||
(<= (char->integer c) (char->integer #\Z))))
|
||||
|
||||
(define (procedure? p) (or (compiled-procedure? p) (compound-procedure? p)))
|
||||
|
||||
(define (current-input-port) _current-input-port)
|
||||
(define (current-output-port) _current-output-port)
|
||||
|
||||
(define (read . args)
|
||||
(_read (if (null? args)
|
||||
(current-input-port)
|
||||
(car args))))
|
||||
|
||||
(define (write obj . args)
|
||||
(_write obj (if (null? args)
|
||||
(current-output-port)
|
||||
(car args))))
|
||||
|
||||
(define (display obj . args)
|
||||
(_display obj (if (null? args)
|
||||
(current-output-port)
|
||||
(car args))))
|
||||
|
||||
|
||||
(define (write-char obj . args)
|
||||
(_write-char obj (if (null? args)
|
||||
(current-output-port)
|
||||
(car args))))
|
||||
|
||||
(define (flush-output-port . args)
|
||||
(_flush-output-port (if (null? args)
|
||||
(current-output-port)
|
||||
(car args))))
|
||||
|
||||
|
||||
(define (newline) (write-char #\newline))
|
||||
|
||||
(define-macro assert (lambda (body)
|
||||
`(if ,body '()
|
||||
(begin
|
||||
(display (quote ,body))
|
||||
(error " assert failed")))))
|
||||
|
||||
(define-macro ==> (lambda (test expected)
|
||||
`(assert (equal? ,test (quote ,expected))) ))
|
||||
|
||||
|
||||
Executable
+20
@@ -0,0 +1,20 @@
|
||||
#!/bin/bash
|
||||
|
||||
SRC=*.scm
|
||||
|
||||
cat lib.h
|
||||
|
||||
echo "// Generated from scheme source."
|
||||
echo "#ifdef LISP_IMPLEMENTATION"
|
||||
|
||||
for FILE in $SRC
|
||||
do
|
||||
echo "static const char* lib_$(basename $FILE .scm)_src_ = "
|
||||
cat $FILE | ./text2c.sh
|
||||
echo ";"
|
||||
echo ""
|
||||
done
|
||||
|
||||
cat lib.c
|
||||
|
||||
echo "#endif"
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,31 @@
|
||||
/*
|
||||
Created by: Justin Meiners
|
||||
Repo; https://github.com/justinmeiners/lisp-interpreter
|
||||
License: MIT (See end if file)
|
||||
|
||||
This file contains the scheme standard library.
|
||||
See lisp.h for insructions.
|
||||
*/
|
||||
|
||||
#ifndef LISP_LIB_H
|
||||
#define LISP_LIB_H
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdint.h>
|
||||
|
||||
void lisp_lib_load(LispContext ctx);
|
||||
|
||||
// convenience for init and load
|
||||
LispContext lisp_init_with_lib(void);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
Executable
+9
@@ -0,0 +1,9 @@
|
||||
#!/bin/bash
|
||||
|
||||
read -r -d '' content
|
||||
content=${content//'\'/'\\'}
|
||||
content=${content//$'\t'/'\t'}
|
||||
content=${content//$'\n'/$' \\n\\\n'}
|
||||
content=${content//$'\r'/'\r'}
|
||||
content=${content//'"'/'\"'}
|
||||
echo -n "\"$content\""
|
||||
@@ -0,0 +1,78 @@
|
||||
; a1 a2 ... an
|
||||
|
||||
; We must end up with n multiplications of three numbers.
|
||||
; Each one must have a distinct ai in the middle.
|
||||
; (* aj ai ak) where j < i and i < k.
|
||||
|
||||
; The neighboring elements are determined by the order of selection,
|
||||
; so we can just look at the order of select elements. This is all the permutations
|
||||
; of i in [1...n] so n! total possibilites.
|
||||
|
||||
; However, this also tells us how to estimate.
|
||||
|
||||
|
||||
(defun smallest-index (array)
|
||||
"requires: array is non-empty"
|
||||
(prog ((smallest 0)
|
||||
(i 0)
|
||||
(N (length array)))
|
||||
loop
|
||||
(when (>= i N)
|
||||
(return smallest))
|
||||
(when (< (aref array i) (aref array smallest))
|
||||
(setf smallest i))
|
||||
(incf i)
|
||||
(go loop)))
|
||||
|
||||
(defun ref (array i)
|
||||
(if (or (< i 0) (>= i (length array)))
|
||||
1
|
||||
(aref array i)))
|
||||
|
||||
(defun estimate (array)
|
||||
(if (= (length array) 1)
|
||||
(aref array 0)
|
||||
(let ((i (smallest-index array)))
|
||||
(+
|
||||
(*
|
||||
(ref array i)
|
||||
(ref array (- i 1))
|
||||
(ref array (+ i 1)))
|
||||
|
||||
(estimate (concatenate 'vector
|
||||
(subseq array 0 i)
|
||||
(subseq array (+ i 1))))))))
|
||||
|
||||
(defun upper-bound (array)
|
||||
(loop for i from 0 below (length array) sum
|
||||
(* (reduce #'max (subseq array 0 i) :initial-value 1)
|
||||
(aref array i)
|
||||
(reduce #'max (subseq array (+ i 1)) :initial-value 1))))
|
||||
|
||||
(defun upper-bound2 (array)
|
||||
(let ((N (length array))
|
||||
(x (reduce #'max array)))
|
||||
(+ (* (- N 2) (* x x x))
|
||||
(* (* x x))
|
||||
(* x))
|
||||
))
|
||||
|
||||
(defun lower-bound2 (array)
|
||||
(let ((N (length array))
|
||||
(x (reduce #'min array)))
|
||||
(+ (* (- N 2) (* x x x))
|
||||
(* (* x x))
|
||||
(* x))))
|
||||
|
||||
|
||||
|
||||
|
||||
(print (estimate #(5 3 2 8)))
|
||||
(print (estimate #(10 10 10 10 10 10)))
|
||||
|
||||
;(print (upper-bound #(5 3 2 8)))
|
||||
|
||||
|
||||
|
||||
;(print (lower-bound2 #(10 10 10 10 10 10)))
|
||||
;(print (upper-bound2 #(10 10 10 10 10 10)))
|
||||
@@ -0,0 +1,34 @@
|
||||
; Find the largest palindrome made from the product of two 3-digit numbers.
|
||||
|
||||
; could be 6 digits
|
||||
; 10^3 = 1,000 possible palindromes
|
||||
; or 5 digits
|
||||
; 10^3 = 1,000 possible palindromes
|
||||
|
||||
; 2,000 total
|
||||
|
||||
(define (palindrome? n)
|
||||
(define (check i str)
|
||||
(if (> (* i 2) (string-length str))
|
||||
#t
|
||||
(if (eq? (string-ref str i)
|
||||
(string-ref str (- (string-length str) (+ i 1))))
|
||||
(check (+ i 1) str)
|
||||
#f)))
|
||||
(check 0 (number->string n)))
|
||||
|
||||
(define nums '())
|
||||
|
||||
|
||||
(do ((i 100 (+ i 1)))
|
||||
((> i 999) 'done)
|
||||
(do ((j 100 (+ j 1)))
|
||||
((> j 999) 'done)
|
||||
(let ((n (* i j)))
|
||||
(if (>= n 100000)
|
||||
(if (palindrome? n)
|
||||
(push n nums)
|
||||
)))))
|
||||
|
||||
(display (reduce max 0 nums))
|
||||
|
||||
@@ -0,0 +1,47 @@
|
||||
|
||||
|
||||
(define large-num (string-append
|
||||
"73167176531330624919225119674426574742355349194934"
|
||||
"96983520312774506326239578318016984801869478851843"
|
||||
"85861560789112949495459501737958331952853208805511"
|
||||
"12540698747158523863050715693290963295227443043557"
|
||||
"66896648950445244523161731856403098711121722383113"
|
||||
"62229893423380308135336276614282806444486645238749"
|
||||
"30358907296290491560440772390713810515859307960866"
|
||||
"70172427121883998797908792274921901699720888093776"
|
||||
"65727333001053367881220235421809751254540594752243"
|
||||
"52584907711670556013604839586446706324415722155397"
|
||||
"53697817977846174064955149290862569321978468622482"
|
||||
"83972241375657056057490261407972968652414535100474"
|
||||
"82166370484403199890008895243450658541227588666881"
|
||||
"16427171479924442928230863465674813919123162824586"
|
||||
"17866458359124566529476545682848912883142607690042"
|
||||
"24219022671055626321111109370544217506941658960408"
|
||||
"07198403850962455444362981230987879927244284909188"
|
||||
"84580156166097919133875499200524063689912560717606"
|
||||
"05886116467109405077541002256983155200055935729725"
|
||||
"71636269561882670428252483600823257530420752963450"))
|
||||
|
||||
(define width 13)
|
||||
|
||||
(define (char->number c)
|
||||
(if (char-numeric? c)
|
||||
(- (char->integer c) (char->integer #\0))
|
||||
-1))
|
||||
|
||||
(define (substring->numbers subs)
|
||||
(map char->number (string->list subs)))
|
||||
|
||||
(define (iter i largest)
|
||||
(if (>= (+ i width) (string-length large-num))
|
||||
largest
|
||||
(let* ((sub (substring large-num i (+ i width)))
|
||||
(set (substring->numbers sub))
|
||||
(product (apply * set)))
|
||||
(if (> product (car largest))
|
||||
(iter (+ i 1) (cons product set))
|
||||
(iter (+ i 1) largest)))))
|
||||
|
||||
(display (iter 0 '(-1 . '())))
|
||||
|
||||
|
||||
@@ -0,0 +1,56 @@
|
||||
|
||||
; add a test for every bug that is incountered
|
||||
; to avoid recreating it in the future
|
||||
|
||||
; test basic vector creation and operations
|
||||
(define v #(1 2 3 4 5 6 7 8 9 10))
|
||||
|
||||
(define (sum-to-n n) (/ (* n (+ n 1)) 2))
|
||||
|
||||
(define (sum-vector v)
|
||||
(define (iter sum i)
|
||||
(if (= i (vector-length v))
|
||||
sum
|
||||
(iter (+ sum (vector-ref v i)) (+ i 1))))
|
||||
(iter 0 0))
|
||||
|
||||
(display "Sum to 10: ")
|
||||
(display (sum-vector v))
|
||||
(newline)
|
||||
(assert (= (sum-to-n 10) (sum-vector v)))
|
||||
|
||||
; procedures with no arguments don't expand properly
|
||||
|
||||
(define (hello-world) (display "hello world") (newline))
|
||||
(hello-world)
|
||||
|
||||
; vector and list assoc
|
||||
|
||||
(assert
|
||||
(= (do ((i 1 (+ i 1)) (n 0 n))
|
||||
((> i 10) n)
|
||||
(set! n (+ i n)))
|
||||
(* 5 11)))
|
||||
|
||||
|
||||
(let ((sym (gensym)))
|
||||
(assert (eq? sym sym)))
|
||||
|
||||
(assert (equal? (cons 2000 1) (cons 2000 1)))
|
||||
|
||||
(assert (equal? "apple" "apple"))
|
||||
(assert (not (eq? 'DEFINE 'DEFINE-MACRO)))
|
||||
|
||||
(define (scope-test var)
|
||||
(let ((var "dog"))
|
||||
(==> var "dog"))
|
||||
(==> var "cat"))
|
||||
(scope-test "cat")
|
||||
|
||||
(define (scope-test-named var)
|
||||
(let block-name ((var "dog"))
|
||||
(==> var "dog"))
|
||||
(==> var "cat"))
|
||||
(scope-test-named "cat")
|
||||
|
||||
|
||||
@@ -0,0 +1,59 @@
|
||||
; PROBLEW
|
||||
; W - maximum bag weight
|
||||
; {m_1, m_2, ... m_n} = item weights
|
||||
; {v_1, v_2, ... v_n} = item values
|
||||
|
||||
; want to choose a subset I so that
|
||||
; sum m_i <= W
|
||||
; and
|
||||
; sum v_i is maximized
|
||||
; In other words, if we choose another subset J
|
||||
; then sum v_j <= sum v_i
|
||||
|
||||
|
||||
(define (rand-item max-weight max-cost)
|
||||
(cons (random max-weight)
|
||||
(random max-cost)))
|
||||
|
||||
(define (build-items n)
|
||||
(if (= n 0)
|
||||
'()
|
||||
(cons (rand-item 100 100)
|
||||
(build-items (- n 1)))))
|
||||
;(random-seed! (GET-UNIVERSAL-TIME))
|
||||
;(define items (build-items 10))
|
||||
|
||||
|
||||
(define items '((23 . 505) (26 . 352) (18 . 220) (32 . 354) (27 . 414) (29 . 498) (26 . 545) (30 . 473) (27 . 543)))
|
||||
|
||||
(define (knapsack remaining items)
|
||||
(if (or (null? items) (<= remaining 0))
|
||||
0
|
||||
(let ((weight (car (car items)))
|
||||
(val (cdr (car items))))
|
||||
(max
|
||||
(if (>= (- remaining weight) 0)
|
||||
(+ val (knapsack (- remaining weight) (cdr items)))
|
||||
0)
|
||||
(knapsack remaining (cdr items))))))
|
||||
|
||||
(display (knapsack 67 items))
|
||||
|
||||
(assert (= (knapsack 67 items) 1270))
|
||||
|
||||
|
||||
; https://en.wikipedia.org/wiki/Levenshtein_distance
|
||||
(define (edit-distance-list a b eq?)
|
||||
(cond ((null? a) (length b))
|
||||
((null? b) (length a))
|
||||
(else (min
|
||||
(+ 1 (edit-distance-list (cdr a) b eq?)) ; insert
|
||||
(+ 1 (edit-distance-list a (cdr b) eq?)) ; delete
|
||||
(+
|
||||
(if (eq? (car a) (car b)) 0 1) ; replace if needed
|
||||
(edit-distance-list (cdr a) (cdr b) eq?))))))
|
||||
|
||||
(define (edit-distance a b)
|
||||
(edit-distance-list (string->list a) (string->list b) char=?))
|
||||
|
||||
(==> (edit-distance "kitten" "sitting") 3)
|
||||
@@ -0,0 +1,5 @@
|
||||
(load "include/draw-tree.scm")
|
||||
|
||||
(dt '(a b c (d e f (g . h))))
|
||||
|
||||
(dt '((a) (b . c) (d e)))
|
||||
@@ -0,0 +1,93 @@
|
||||
; copy examples from MIT scheme documentation and add related ones.
|
||||
|
||||
; Conditionals
|
||||
; https://www.gnu.org/software/mit-scheme/documentation/stable/mit-scheme-ref/Conditionals.html
|
||||
|
||||
(assert (and (= 2 2) (> 2 1)))
|
||||
(assert (and))
|
||||
(==> (and 3 2) 2)
|
||||
(==> (and 1 2 'c '(f g)) (f g))
|
||||
(==> (or #f #\a #f) #\a)
|
||||
(==> (or (memq 'b '(a b c)) (/ 3 0)) (b c))
|
||||
|
||||
(define (bit-type x)
|
||||
(cond ((= x 0) 'OFF)
|
||||
((= x 1) 'ON)
|
||||
(else 'UNKNOWN)))
|
||||
|
||||
(==> (bit-type 0) OFF)
|
||||
(==> (bit-type 1) ON)
|
||||
(==> (bit-type 25) UNKNOWN)
|
||||
|
||||
; https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_13.html
|
||||
|
||||
; Universl Time https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Universal-Time.html
|
||||
(assert (integer? (get-universal-time)))
|
||||
|
||||
; https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Procedure-Operations.html#Procedure-Operations
|
||||
(assert (procedure? (lambda (x) x)))
|
||||
(assert (compound-procedure? (lambda (x) x)))
|
||||
(assert (not (compiled-procedure? (lambda (x) x))))
|
||||
(assert (not (procedure? 3)))
|
||||
(assert (= 18 (apply + (list 3 4 5 6))))
|
||||
(assert (compiled-procedure? eval))
|
||||
|
||||
(let ((x "hello")
|
||||
(y "world"))
|
||||
(==> (string-append x y) "helloworld"))
|
||||
|
||||
(let* ((x 2)
|
||||
(y (+ x 1)))
|
||||
(==> (+ x y) 5))
|
||||
|
||||
(do ((i 0 (+ i 1)))
|
||||
((>= i 10))
|
||||
(assert (>= i 0))
|
||||
(display i))
|
||||
|
||||
(==> (eval '(+ 2 2)) 4)
|
||||
(==> (eval '(+ 2 2) (interaction-environment)) 4)
|
||||
|
||||
(assert (scheme-report-environment 5))
|
||||
|
||||
(assert (case (+ 2 3)
|
||||
((2) #f)
|
||||
((1 5) #t)))
|
||||
|
||||
(assert (case 7
|
||||
((2) #f)
|
||||
((1 5) #f)
|
||||
(else #t)))
|
||||
|
||||
|
||||
(assert (case 2
|
||||
((2) #t)
|
||||
((1 5) #f)
|
||||
(else #f)))
|
||||
|
||||
|
||||
(assert (letrec ((even?
|
||||
(lambda (n)
|
||||
(if (zero? n)
|
||||
#t
|
||||
(odd? (- n 1)))))
|
||||
(odd?
|
||||
(lambda (n)
|
||||
(if (zero? n)
|
||||
#f
|
||||
(even? (- n 1))))))
|
||||
(even? 88)))
|
||||
|
||||
|
||||
(let ((x 0))
|
||||
(inc! x)
|
||||
(==> x 1)
|
||||
(dec! x)
|
||||
(==> x 0))
|
||||
|
||||
|
||||
(let ((x 'A) (y 'B))
|
||||
(swap! x y)
|
||||
(==> x B)
|
||||
(==> y A))
|
||||
|
||||
@@ -0,0 +1,37 @@
|
||||
|
||||
(let ((y "happy days")
|
||||
(z #(1 2 3)))
|
||||
(gc-flip)
|
||||
(assert (string=? y "happy days"))
|
||||
(assert (equal? z (vector 1 2 3))))
|
||||
|
||||
(let ((x 'HELLO)
|
||||
(v #( HELLO ) ))
|
||||
(display v)
|
||||
(assert (eq? x (vector-ref v 0)))
|
||||
(gc-flip)
|
||||
(assert (eq? x (vector-ref v 0))))
|
||||
|
||||
(define counter 500)
|
||||
(define big-vector '())
|
||||
|
||||
(define (basic-loop)
|
||||
(begin
|
||||
(set! big-vector (make-vector 200 0))
|
||||
(set! counter (- counter 1))
|
||||
(vector-fill! big-vector counter)
|
||||
(gc-flip)
|
||||
(assert (= (vector-ref big-vector 3) counter))
|
||||
(if (> counter 0)
|
||||
(basic-loop)
|
||||
'())
|
||||
) )
|
||||
|
||||
|
||||
(basic-loop)
|
||||
|
||||
(==> (call/cc (lambda (throw) (define x '(1 2 3)) (gc-flip) (throw x))) (1 2 3))
|
||||
|
||||
(print-gc-statistics)
|
||||
|
||||
|
||||
@@ -0,0 +1,29 @@
|
||||
|
||||
(define h (make-hash-table))
|
||||
|
||||
(assert (hash-table? h))
|
||||
(hash-table-set! h 2000 1)
|
||||
|
||||
(assert (equal? (list (cons 2000 1)) (hash-table->alist h)))
|
||||
|
||||
(hash-table-set! h 2001 2)
|
||||
|
||||
(assert (equal? -1 (hash-table-ref h 3000 -1)))
|
||||
(assert (equal? 1 (hash-table-ref h 2000 -1)))
|
||||
(assert (equal? 2 (hash-table-ref h 2001 -1)))
|
||||
|
||||
(define h2 (alist->hash-table (hash-table->alist h)))
|
||||
|
||||
(assert (equal? -1 (hash-table-ref h2 3000 -1)))
|
||||
(assert (equal? 1 (hash-table-ref h2 2000 -1)))
|
||||
(assert (equal? 2 (hash-table-ref h2 2001 -1)))
|
||||
|
||||
|
||||
(define h3 (alist->hash-table '((APPLE . "apple") (PEAR . "pear") (BANANA . "banana"))))
|
||||
|
||||
|
||||
(assert (equal? "apple" (hash-table-ref h3 'APPLE)))
|
||||
(assert (equal? "pear" (hash-table-ref h3 'PEAR)))
|
||||
(assert (equal? '() (hash-table-ref h3 'HASH)))
|
||||
|
||||
|
||||
@@ -0,0 +1,160 @@
|
||||
; Scheme 9 from Empty Space, Function Library
|
||||
; By Nils M Holm, 2009-2012
|
||||
; Placed in the Public Domain
|
||||
;
|
||||
; (draw-tree object) ==> unspecific
|
||||
; (dt) ==> unspecific
|
||||
;
|
||||
; Print a tree structure resembling a Scheme datum. Each cons
|
||||
; cell is represented by [o|o] with lines leading to their car
|
||||
; and cdr parts. Conses with a cdr value of () are represented
|
||||
; by [o|/].
|
||||
;
|
||||
; DT is an abbrevation for DRAW-TREE.
|
||||
;
|
||||
; (Example): (draw-tree '((a) (b . c) (d e))) ==> unspecific
|
||||
;
|
||||
; Output: [o|o]---[o|o]---[o|/]
|
||||
; | | |
|
||||
; [o|/] | [o|o]---[o|/]
|
||||
; | | | |
|
||||
; a | d e
|
||||
; |
|
||||
; [o|o]--- c
|
||||
; |
|
||||
; b
|
||||
|
||||
(define (draw-tree n)
|
||||
|
||||
(define *nothing* (cons 'N '()))
|
||||
|
||||
(define *visited* (cons 'V '()))
|
||||
|
||||
(define (empty? x) (eq? x *nothing*))
|
||||
|
||||
(define (visited? x) (eq? (car x) *visited*))
|
||||
|
||||
(define (mark-visited x) (cons *visited* x))
|
||||
|
||||
(define (members-of x) (cdr x))
|
||||
|
||||
(define (done? x)
|
||||
(and (pair? x)
|
||||
(visited? x)
|
||||
(null? (cdr x))))
|
||||
|
||||
(define (draw-fixed-string s)
|
||||
(let* ((b (make-string 8 #\space))
|
||||
(k (string-length s))
|
||||
(s (if (> k 7) (substring s 0 7) s))
|
||||
(s (if (< k 3) (string-append " " s) s))
|
||||
(k (string-length s)))
|
||||
(display (string-append s (substring b 0 (- 8 k))))))
|
||||
|
||||
(define (draw-atom n)
|
||||
(cond ((null? n)
|
||||
(draw-fixed-string "()"))
|
||||
((symbol? n)
|
||||
(draw-fixed-string (symbol->string n)))
|
||||
((number? n)
|
||||
(draw-fixed-string (number->string n)))
|
||||
((string? n)
|
||||
(draw-fixed-string (string-append "\"" n "\"")))
|
||||
((char? n)
|
||||
(draw-fixed-string (string-append "#\\" (string n))))
|
||||
((eq? n #t)
|
||||
(draw-fixed-string "#t"))
|
||||
((eq? n #f)
|
||||
(draw-fixed-string "#f"))
|
||||
(else
|
||||
(error "draw-atom: unknown type" n))))
|
||||
|
||||
(define (draw-conses n)
|
||||
(let draw-conses ((n n)
|
||||
(r '()))
|
||||
(cond ((not (pair? n))
|
||||
(draw-atom n)
|
||||
(reverse! r))
|
||||
((null? (cdr n))
|
||||
(display "[o|/]")
|
||||
(reverse! (cons (car n) r)))
|
||||
(else
|
||||
(display "[o|o]---")
|
||||
(draw-conses (cdr n) (cons (car n) r))))))
|
||||
|
||||
(define (draw-bars n)
|
||||
(let draw-bars ((n (members-of n)))
|
||||
(cond ((not (pair? n)) '())
|
||||
((empty? (car n))
|
||||
(draw-fixed-string "")
|
||||
(draw-bars (cdr n)))
|
||||
((and (pair? (car n))
|
||||
(visited? (car n)))
|
||||
(draw-bars (members-of (car n)))
|
||||
(draw-bars (cdr n)))
|
||||
(else
|
||||
(draw-fixed-string "|")
|
||||
(draw-bars (cdr n))))))
|
||||
|
||||
(define (skip-empty n)
|
||||
(if (and (pair? n)
|
||||
(or (empty? (car n))
|
||||
(done? (car n))))
|
||||
(skip-empty (cdr n))
|
||||
n))
|
||||
|
||||
(define (remove-trailing-nothing n)
|
||||
(reverse (skip-empty (reverse n))))
|
||||
|
||||
(define (all-vertical? n)
|
||||
(or (not (pair? n))
|
||||
(and (null? (cdr n))
|
||||
(all-vertical? (car n)))))
|
||||
|
||||
(define (draw-members n)
|
||||
(let draw-members ((n (members-of n))
|
||||
(r '()))
|
||||
(cond ((not (pair? n))
|
||||
(mark-visited
|
||||
(remove-trailing-nothing
|
||||
(reverse r))))
|
||||
((empty? (car n))
|
||||
(draw-fixed-string "")
|
||||
(draw-members (cdr n)
|
||||
(cons *nothing* r)))
|
||||
((not (pair? (car n)))
|
||||
(draw-atom (car n))
|
||||
(draw-members (cdr n)
|
||||
(cons *nothing* r)))
|
||||
((null? (cdr n))
|
||||
(draw-members (cdr n)
|
||||
(cons (draw-final (car n)) r)))
|
||||
((all-vertical? (car n))
|
||||
(draw-fixed-string "[o|/]")
|
||||
(draw-members (cdr n)
|
||||
(cons (caar n) r)))
|
||||
(else
|
||||
(draw-fixed-string "|")
|
||||
(draw-members (cdr n)
|
||||
(cons (car n) r))))))
|
||||
|
||||
(define (draw-final n)
|
||||
(cond ((not (pair? n))
|
||||
(draw-atom n)
|
||||
*nothing*)
|
||||
((visited? n)
|
||||
(draw-members n))
|
||||
(else
|
||||
(mark-visited (draw-conses n)))))
|
||||
|
||||
(if (not (pair? n))
|
||||
(draw-atom n)
|
||||
(let draw-tree ((n (mark-visited (draw-conses n))))
|
||||
(if (not (done? n))
|
||||
(begin (newline)
|
||||
(draw-bars n)
|
||||
(newline)
|
||||
(draw-tree (draw-members n))))))
|
||||
(newline))
|
||||
|
||||
(define dt draw-tree)
|
||||
@@ -0,0 +1,283 @@
|
||||
; Scheme 9 from Empty Space, Function Library
|
||||
; By Nils M Holm, 1998-2009
|
||||
; Placed in the Public Domain
|
||||
;
|
||||
; (prolog list1 list2) ==> list
|
||||
; (new-database!) ==> unspecific
|
||||
; (fact! list) ==> unspecific
|
||||
; (predicate! list1 list2 ...) ==> unspecific
|
||||
; (query list) ==> list
|
||||
;
|
||||
; (load-from-library "prolog.scm")
|
||||
;
|
||||
; This is a tiny PROLOG interpreter that is based on an even
|
||||
; tinier PROLOG interpreter written in MACLISP by Ken Kahn.
|
||||
;
|
||||
; The PROLOG procedures takes a query LIST1 and a database
|
||||
; LIST2 as arguments, attempts to prove LIST1 in LIST2, and
|
||||
; returns the result(s).
|
||||
|
||||
; NEW-DATABASE! sets up a fresh PROLOG database (thereby
|
||||
; deleting any existing one).
|
||||
;
|
||||
; FACT! adds a new fact to the database.
|
||||
;
|
||||
; PREDICATE! adds a predicate with the head LIST1 and the
|
||||
; clauses LIST2 ... to the database.
|
||||
;
|
||||
; QUERY attempts to prove LIST1. It returns a list of results.
|
||||
; An empty list indicates that LIST1 could not be proven.
|
||||
;
|
||||
; See "prolog-test.scm" for an example program.
|
||||
;
|
||||
; The following macros add some syntactic sugar for interactive
|
||||
; use; they allows you to write, for instance, (! (man socrates))
|
||||
; instead of (fact! '(man socrates)).
|
||||
;
|
||||
; (! fact) ==> unspecific
|
||||
; (:- list1 list2 ...) ==> unspecific
|
||||
; (? query) ==> unspecific
|
||||
;
|
||||
; The following special predicates are implemented in the
|
||||
; interpreter: (== A B) returns a new environment if A can be
|
||||
; unified with B, else NO. (Dif A B) returns NO if A can be
|
||||
; unified with B, else YES (use only at the end of a clause!)
|
||||
;
|
||||
; Example: (begin (! (man socrates))
|
||||
; (:- (mortal ?x)
|
||||
; (man ?x))
|
||||
; (query '(mortal ?who))) ==> (((who . socrates)))
|
||||
|
||||
(define *prolog-database* '())
|
||||
|
||||
(define (prolog q db)
|
||||
|
||||
(define empty-env '((())))
|
||||
|
||||
(define top-scope "")
|
||||
|
||||
(define true '(()))
|
||||
|
||||
(define false '())
|
||||
|
||||
(define (unique a)
|
||||
(letrec
|
||||
((unique2
|
||||
(lambda (a r)
|
||||
(cond ((null? a)
|
||||
(reverse! r))
|
||||
((member (car a) r)
|
||||
(unique2 (cdr a) r))
|
||||
(else
|
||||
(unique2 (cdr a)
|
||||
(cons (car a) r)))))))
|
||||
(unique2 a '())))
|
||||
|
||||
(define (variable? x)
|
||||
(and (symbol? x)
|
||||
(char=? #\? (string-ref (symbol->string x) 0))))
|
||||
|
||||
(define (internal? x)
|
||||
(and (symbol? x)
|
||||
(char=? #\: (string-ref (symbol->string x) 0))))
|
||||
|
||||
(define (anonymous? x)
|
||||
(eq? '_ x))
|
||||
|
||||
(define (extend n v env)
|
||||
(cons (cons n v) env))
|
||||
|
||||
(define (new-scope env id)
|
||||
(cond ((variable? env)
|
||||
(string->symbol
|
||||
(string-append (symbol->string env) id)))
|
||||
((pair? env)
|
||||
(cons (new-scope (car env) id)
|
||||
(new-scope (cdr env) id)))
|
||||
(else
|
||||
env)))
|
||||
|
||||
(define (new-env-id x)
|
||||
(string-append ";" x))
|
||||
|
||||
(define (value-of x env)
|
||||
(if (variable? x)
|
||||
(let ((v (assq x env)))
|
||||
(if v
|
||||
(value-of (cdr v) env)
|
||||
x))
|
||||
x))
|
||||
|
||||
(define (unify x y env)
|
||||
(let ((x (value-of x env))
|
||||
(y (value-of y env)))
|
||||
(cond ((variable? x) (extend x y env))
|
||||
((variable? y) (extend y x env))
|
||||
((or (anonymous? x)
|
||||
(anonymous? y))
|
||||
env)
|
||||
((and (pair? x)
|
||||
(pair? y))
|
||||
(let ((new (unify (car x) (car y) env)))
|
||||
(and new (unify (cdr x) (cdr y) new))))
|
||||
((eq? x y) env)
|
||||
(else #f))))
|
||||
|
||||
(define (check-args g n)
|
||||
(if (not (= n (length g)))
|
||||
(error "wrong number of arguments" g)))
|
||||
|
||||
(define (goal-unify rules goals env id result)
|
||||
(check-args (car goals) 3)
|
||||
(let* ((this-goal (car goals))
|
||||
(new-env (unify (cadr this-goal) (caddr this-goal) env)))
|
||||
(if new-env
|
||||
(let ((r (prove (cdr goals)
|
||||
new-env
|
||||
(new-env-id id))))
|
||||
(try-rules (cdr rules) goals env id (append result r)))
|
||||
(try-rules (cdr rules) goals env id result))))
|
||||
|
||||
(define (goal-dif rules goals env id result)
|
||||
(check-args (car goals) 3)
|
||||
(let* ((this-goal (car goals))
|
||||
(new-env (unify (cadr this-goal) (caddr this-goal) env)))
|
||||
(if (not new-env)
|
||||
(let ((r (prove (cdr goals)
|
||||
env
|
||||
(new-env-id id))))
|
||||
(try-rules (cdr rules) goals env id (append result r)))
|
||||
false)))
|
||||
|
||||
(define (goal* rules goals env id result)
|
||||
(let* ((this-rule (new-scope (car rules) id))
|
||||
(new-env (unify (car goals) (car this-rule) env)))
|
||||
(if new-env
|
||||
(let ((r (prove (append (cdr this-rule) (cdr goals))
|
||||
new-env
|
||||
(new-env-id id))))
|
||||
(try-rules (cdr rules) goals env id (append result r)))
|
||||
(try-rules (cdr rules) goals env id result))))
|
||||
|
||||
(define (try-rules rules goals env id result)
|
||||
(if (null? rules)
|
||||
result
|
||||
(case (caar goals)
|
||||
((==) (goal-unify rules goals env id result))
|
||||
((dif) (goal-dif rules goals env id result))
|
||||
(else (goal* rules goals env id result)))))
|
||||
|
||||
(define (list-env env)
|
||||
(letrec
|
||||
((this-id caar)
|
||||
(scope-id caddr)
|
||||
(top-level?
|
||||
(lambda (x)
|
||||
(not (memv #\; (string->list (symbol->string x))))))
|
||||
(var-name
|
||||
(lambda (x)
|
||||
(let* ((s (symbol->string x))
|
||||
(k (string-length s)))
|
||||
(let loop ((i 0))
|
||||
(if (or (>= i k)
|
||||
(char=? #\; (string-ref s i)))
|
||||
(string->symbol (substring s 1 i))
|
||||
(loop (+ 1 i)))))))
|
||||
(list-env2
|
||||
(lambda (e r)
|
||||
(cond ((null? (cdr e))
|
||||
(list r))
|
||||
((top-level? (this-id e))
|
||||
(list-env2 (cdr e)
|
||||
(extend (var-name (this-id e))
|
||||
(value-of (this-id e) env)
|
||||
r)))
|
||||
(else
|
||||
(list-env2 (cdr e) r))))))
|
||||
|
||||
(list-env2 env '())))
|
||||
|
||||
; version without memoization
|
||||
(define (prove goals env id)
|
||||
(if (null? goals)
|
||||
(list-env env)
|
||||
(try-rules db goals env id '())))
|
||||
|
||||
;(define proven (make-hash-table))
|
||||
|
||||
;(define (prove goals env id)
|
||||
; (if (null? goals)
|
||||
; (list-env env)
|
||||
; (let* ((k (append goals env))
|
||||
; (v (hash-table-ref proven k #f)))
|
||||
; (if v
|
||||
; (car v)
|
||||
; (let ((v (try-rules db goals env id '())))
|
||||
; (hash-table-set! proven k v)
|
||||
; v)))))
|
||||
|
||||
(define (any? p a)
|
||||
(cond ((null? a) #f)
|
||||
((p (car a)) #t)
|
||||
(else (any? p (cdr a)))))
|
||||
|
||||
(define (cleanup env)
|
||||
(apply append
|
||||
(map (lambda (frame)
|
||||
(if (or (any? (lambda (x) (variable? (cdr x))) frame)
|
||||
(any? (lambda (x) (internal? (cdr x))) frame))
|
||||
'()
|
||||
(list frame)))
|
||||
env)))
|
||||
|
||||
(cleanup (unique (prove (new-scope q top-scope)
|
||||
empty-env
|
||||
(new-env-id top-scope)))))
|
||||
|
||||
(define (new-database!)
|
||||
(set! *prolog-database* '()))
|
||||
|
||||
(define (update! x)
|
||||
(set! *prolog-database*
|
||||
(cons x *prolog-database*)))
|
||||
|
||||
(define (fact! x)
|
||||
(let ((update! update!))
|
||||
(update! (list x))))
|
||||
|
||||
(define (predicate! head . clause*)
|
||||
(let ((update! update!))
|
||||
(update! (cons head clause*))))
|
||||
|
||||
(define (query . q)
|
||||
(prolog q (reverse *prolog-database*)))
|
||||
|
||||
(define (print-frames env)
|
||||
(cond ((equal? '(()) env)
|
||||
(display "yes")
|
||||
(newline))
|
||||
((equal? '() env)
|
||||
(display "no")
|
||||
(newline))
|
||||
(else
|
||||
(for-each (lambda (frame)
|
||||
(for-each (lambda (b)
|
||||
(display (car b))
|
||||
(display " = ")
|
||||
(display (cdr b))
|
||||
(display "; "))
|
||||
frame)
|
||||
(newline))
|
||||
env))))
|
||||
|
||||
(define-macro ! (lambda (fact) `(fact! (quote ,fact))))
|
||||
(define-macro :- (lambda args
|
||||
(cons 'PREDICATE! (map1 (lambda (entry) `(quote ,entry)) args))))
|
||||
(define-macro ? (lambda args
|
||||
(list 'PRINT-FRAMES
|
||||
(cons 'QUERY (map1 (lambda (entry) `(quote ,entry)) args)))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,69 @@
|
||||
(assert '())
|
||||
|
||||
(==> (cons 'a (cons 'b (cons 'c '()))) (a b c))
|
||||
(==> (car (cons 1 2)) 1)
|
||||
(==> (cdr (cons 1 2)) 2)
|
||||
(==> (car (list 1 2)) 1)
|
||||
(==> (cdr (list 1 2)) (2))
|
||||
|
||||
(define test-pair (cons 1 2))
|
||||
(set-car! test-pair 3)
|
||||
(set-cdr! test-pair 4)
|
||||
(==> test-pair (3 . 4))
|
||||
|
||||
(==> (reverse '(a b c)) (c b a))
|
||||
|
||||
; https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_8.html
|
||||
(assert (pair? '(a . b)))
|
||||
(assert (pair? '(a b c)))
|
||||
|
||||
(assert (not (pair? '())))
|
||||
(assert (not (pair? '#(a b))))
|
||||
|
||||
(assert (= (length '(a b c)) 3))
|
||||
(assert (= (length '()) 0))
|
||||
|
||||
(assert (not (null? '(a b c))))
|
||||
(assert (null? '()))
|
||||
|
||||
(assert (eq? (list-ref '(a b c d) 2) 'c))
|
||||
|
||||
(==> (append '(a) '(b c d)) (a b c d))
|
||||
(==> (sort '(1 4 2 6 3) <) (1 2 3 4 6))
|
||||
(==> (make-list 4 1) (1 1 1 1))
|
||||
|
||||
(==> (memq 'a '(a b c)) (a b c))
|
||||
(==> (memq 'b '(a b c)) (b c))
|
||||
(==> (memq 'a '(b c d)) #f)
|
||||
|
||||
(==> (member (list 'a) '(b (a) c)) ((a) c))
|
||||
(==> (member 'a '(b (a) c)) #f)
|
||||
|
||||
(assert (= (apply + (list 3 4 5 6)) 18))
|
||||
|
||||
(==> (append-reverse! '("y" "x" "w") '("z")) ("w" "x" "y" "z"))
|
||||
|
||||
; Association lists
|
||||
(define list-map '((bob . 1) (john . 2) (dan . 3) (alice . 4)))
|
||||
|
||||
(assert (= (cdr (assoc 'john list-map)) 2))
|
||||
(assert (= (cdr (assoc 'alice list-map)) 4))
|
||||
(assert (not (assoc 'bad-key list-map)))
|
||||
|
||||
(assert (= (cdr (assq 'john list-map)) 2))
|
||||
(assert (= (cdr (assq 'alice list-map)) 4))
|
||||
(assert (not (assq 'bad-key list-map)))
|
||||
|
||||
(assert (list? '(1 2)))
|
||||
(assert (not (list? (cons 1 2))))
|
||||
|
||||
|
||||
(==> (reduce + 0 '(1 2 3 4)) 10)
|
||||
(==> (reduce + 0 '(1 2)) 3)
|
||||
(==> (reduce + 0 '()) 0)
|
||||
(==> (reduce list '() '(1 2 3 4)) (((1 2) 3) 4))
|
||||
|
||||
|
||||
(==> (fold-left + 0 '(1 2 3 4)) 10)
|
||||
(==> (fold-left list '() '(1 2 3 4)) ((((() 1) 2) 3) 4))
|
||||
|
||||
@@ -0,0 +1,33 @@
|
||||
|
||||
; QUASIQUOTE
|
||||
(assert (equal? `(1 2 3) '(1 2 3)))
|
||||
|
||||
(let ((x 1))
|
||||
(assert (equal? `(,x 2 3) '(1 2 3))))
|
||||
|
||||
(let ((x 'a))
|
||||
(assert (equal? `(,x x ,x) '(a x a))))
|
||||
|
||||
|
||||
; nil! macro
|
||||
(define-macro nil! (lambda (x)
|
||||
`(set! ,x '())))
|
||||
|
||||
(define x 3)
|
||||
(assert (= x 3))
|
||||
(nil! x)
|
||||
(assert (null? x))
|
||||
|
||||
; ntimes macro
|
||||
|
||||
(define-macro ntimes (lambda (n . body)
|
||||
(let ((i (gensym)))
|
||||
(cons 'DO (cons `((,i 0 (+ ,i 1)))
|
||||
(cons `((>= ,i ,n) '()) body))
|
||||
))))
|
||||
|
||||
(define x 0)
|
||||
(ntimes 10 (set! x (+ x 1)))
|
||||
(assert (= x 10))
|
||||
|
||||
|
||||
@@ -0,0 +1,71 @@
|
||||
; From Peter Norvig's Lispy tests
|
||||
; http://norvig.com/lispy2.html
|
||||
|
||||
(define x 3)
|
||||
(assert (= x 3))
|
||||
(assert (= (+ x x) 6))
|
||||
(assert (= (begin (define x 1) (set! x (+ x 1)) (+ x 1)) 3))
|
||||
(assert (= ((lambda (x) (+ x x)) 5) 10))
|
||||
(define twice (lambda (x) (* 2 x)))
|
||||
(assert (= (twice 5) 10))
|
||||
(define compose (lambda (f g) (lambda (x) (f (g x)))))
|
||||
(assert (= (car ((compose list twice) 5)) 10))
|
||||
(define repeat (lambda (f) (compose f f)))
|
||||
(assert (= ((repeat twice) 5) 20))
|
||||
(assert (= ((repeat (repeat twice)) 5) 80))
|
||||
(define fact (lambda (n) (if (< n 2) 1 (* n (fact (- n 1))))))
|
||||
(assert (= (fact 3) 6))
|
||||
(define abs (lambda (n) ((if (> n 0) + -) 0 n)))
|
||||
|
||||
(assert (= (car (list (abs -3) (abs 0) (abs 3))) 3))
|
||||
|
||||
(define combine (lambda (f)
|
||||
(lambda (x y)
|
||||
(if (null? x) (quote ())
|
||||
(f (list (car x) (car y))
|
||||
((combine f) (cdr x) (cdr y)))))))
|
||||
|
||||
(define zip (combine cons))
|
||||
(assert (= (car (cdr (assoc 3 (zip (list 1 2 3 4) (list 5 6 7 8))))) 7))
|
||||
|
||||
(define riff-shuffle (lambda (deck) (begin
|
||||
(define take (lambda (n seq) (if (< n 1) (quote ()) (cons (car seq) (take (- n 1) (cdr seq))))))
|
||||
(define drop (lambda (n seq) (if (< n 1) seq (drop (- n 1) (cdr seq)))))
|
||||
(define mid (lambda (seq) (/ (length seq) 2)))
|
||||
((combine append) (take (mid deck) deck) (drop (mid deck) deck)))))
|
||||
|
||||
(display (riff-shuffle (list 1 2 3 4 5 6 7 8)))
|
||||
(newline)
|
||||
(display ((repeat riff-shuffle) (list 1 2 3 4 5 6 7 8)))
|
||||
(newline)
|
||||
(display (riff-shuffle (riff-shuffle (riff-shuffle (list 1 2 3 4 5 6 7 8)))))
|
||||
(newline)
|
||||
|
||||
(define fabs (lambda (n) ((if (> n 0.0) + -) 0.0 n)))
|
||||
|
||||
(define (newton guess function derivative epsilon)
|
||||
(define guess2 (- guess (/ (function guess) (derivative guess))))
|
||||
(if (< (fabs (- guess guess2)) epsilon) guess2
|
||||
(newton guess2 function derivative epsilon)))
|
||||
|
||||
(define (square-root a)
|
||||
(newton 1.0 (lambda (x) (- (* x x) a)) (lambda (x) (* 2.0 x)) 0.0001))
|
||||
|
||||
(display "sqrt(2)=")
|
||||
(display (square-root 2.0))
|
||||
(newline)
|
||||
|
||||
(display "sqrt(200)=")
|
||||
(display (square-root 200.0))
|
||||
(newline)
|
||||
|
||||
(==> (call/cc (lambda (throw) (+ 5 (* 10 (throw 1))))) 1)
|
||||
(==> (call/cc (lambda (throw) (+ 5 (* 10 1)))) 15)
|
||||
|
||||
(==> (call/cc (lambda (throw) (+ 5 (* 10 (call/cc (lambda (escape) (* 100 (escape 3)))))))) 35)
|
||||
(==> (call/cc (lambda (throw) (+ 5 (* 10 (call/cc (lambda (escape) (* 100 (throw 3)))))))) 3)
|
||||
(==> (call/cc (lambda (throw) (+ 5 (* 10 (call/cc (lambda (escape) (* 100 1))))))) 1005)
|
||||
|
||||
(==> (let ((a 1) (b 2)) (+ a b)) 3)
|
||||
|
||||
|
||||
@@ -0,0 +1,82 @@
|
||||
(==> (+ 2 2) 4)
|
||||
(==> (+ (* 2 100) (* 1 10)) 210)
|
||||
|
||||
(==> (if (> 6 5) (+ 1 1) (+ 2 2)) 2)
|
||||
(==> (if (< 6 5) (+ 1 1) (+ 2 2)) 4)
|
||||
|
||||
(==> (gcd 32 -36) 4)
|
||||
(==> (gcd 4 3) 1)
|
||||
(==> (gcd) 0)
|
||||
|
||||
|
||||
(==> (lcm 32 -36) 288)
|
||||
(assert (exact? (lcm 32 -36)))
|
||||
(assert (inexact? (lcm 32.0 -36)))
|
||||
|
||||
(==> (lcm) 1)
|
||||
|
||||
(==> (abs -1) 1)
|
||||
(==> (map + '(1 1 1) '(2 2 2)) (3 3 3))
|
||||
(==> (map abs '(-1 -2 3)) (1 2 3))
|
||||
(==> (vector-map abs #(-1 -2 3)) #(1 2 3))
|
||||
|
||||
|
||||
(==> (- 1) -1)
|
||||
(==> (- 436) -436)
|
||||
(==> (- -7) 7)
|
||||
|
||||
(assert (integer? 3))
|
||||
(assert (real? 3))
|
||||
|
||||
(assert (real? 3.5))
|
||||
(assert (not (integer? 3.5)))
|
||||
|
||||
(assert (< 3 4))
|
||||
(assert (> 4 3))
|
||||
(assert (>= 4 3))
|
||||
(assert (<= 3 4))
|
||||
(assert (<= 1 1))
|
||||
(assert (< -5 5))
|
||||
(assert (not (> 3 4)))
|
||||
|
||||
(assert (= (modulo -13 4) 3))
|
||||
(assert (= (remainder -13 4) -1))
|
||||
|
||||
|
||||
(assert (= (remainder 13 -4) 1))
|
||||
|
||||
(assert (even? 2))
|
||||
(assert (not (odd? 2)))
|
||||
(assert (odd? 3))
|
||||
(assert (odd? 7))
|
||||
(assert (not (odd? 4)))
|
||||
|
||||
(assert (exact? (+ 1 2 3)))
|
||||
(assert (inexact? (+ 1 2.5 3)))
|
||||
(assert (inexact? (+ 1.3 2 3)))
|
||||
|
||||
(assert (exact? (* 1 2 3)))
|
||||
(assert (inexact? (* 1 2.5 3)))
|
||||
(assert (inexact? (* 1.3 2 3)))
|
||||
|
||||
(assert (exact? (- 1 2)))
|
||||
(assert (inexact? (- 1 2.5)))
|
||||
(assert (inexact? (- 1.3 2)))
|
||||
|
||||
(assert (exact? (expt 3 3)))
|
||||
(==> (expt 3 3) 27)
|
||||
|
||||
(assert (inexact? (expt 3 2.5)))
|
||||
|
||||
(==> (magnitude 13) 13)
|
||||
(==> (magnitude -13) 13)
|
||||
|
||||
(==> (floor 0.87) 0)
|
||||
(==> (ceiling 0.87) 1)
|
||||
(==> (round 0.87) 1)
|
||||
|
||||
(assert (< (- (abs (atan 0)) (/ 3.141592 4)) 0.001))
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,21 @@
|
||||
(define (brute max-length set)
|
||||
(define (permute n)
|
||||
(define str (make-string n))
|
||||
(define (iter d)
|
||||
(if (= d n)
|
||||
(begin
|
||||
(display str)
|
||||
(display " "))
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i (string-length set)) 'done)
|
||||
(begin
|
||||
(string-set! str d (string-ref set i))
|
||||
(iter (+ d 1))))))
|
||||
(iter 0))
|
||||
|
||||
(do ((len 0 (+ len 1)))
|
||||
((> len max-length) 'done)
|
||||
(permute len)))
|
||||
|
||||
(brute 4 "abcd")
|
||||
(newline)
|
||||
@@ -0,0 +1,5 @@
|
||||
(include "include/prolog.scm")
|
||||
|
||||
(! (man socrates))
|
||||
(:- (mortal ?x) (man ?x))
|
||||
(? (mortal ?who))
|
||||
@@ -0,0 +1,158 @@
|
||||
|
||||
; A collection of SICP excercises
|
||||
; these are all my solutions from reading
|
||||
; the book
|
||||
|
||||
; 1.01 - basic expressions
|
||||
(assert (= (+ (* 2 4) (- 4 6)) 6))
|
||||
(define a 3)
|
||||
(define b (+ a 1))
|
||||
(assert (= (+ a b (* a b)) 19))
|
||||
|
||||
|
||||
(assert (= (if (and (> b a) (< b (* a b)))
|
||||
b
|
||||
a) 4))
|
||||
|
||||
(assert (= (cond ((= a 4) 6)
|
||||
((= b 4) (+ 6 7 a))
|
||||
(else 25)) 16))
|
||||
|
||||
(assert (= (+ 2 (if (> b a) b a )) 6))
|
||||
|
||||
(assert (= (* (cond ((> a b) a)
|
||||
((< a b) b)
|
||||
(else -1))
|
||||
(+ a 1)) 16))
|
||||
|
||||
; 1.03 - largest squares
|
||||
(define (sqr x) (* x x))
|
||||
|
||||
(define (largest-squares x y z)
|
||||
(cond ((and (< z x) (< z y)) (+ (sqr x) (sqr y)))
|
||||
((and (< y x) (> y z)) (+ (sqr x) (sqr z)))
|
||||
(else (+ (sqr y) (sqr z)))
|
||||
))
|
||||
|
||||
(assert (= (largest-squares 3 4 5) (+ 25 16)))
|
||||
(assert (= (largest-squares 3 5 4) (+ 25 16)))
|
||||
|
||||
; 1.14 change counter
|
||||
(define (count-change amount) (cc amount 5))
|
||||
|
||||
(define (cc amount kinds-of-coins)
|
||||
(cond ((= amount 0) 1)
|
||||
((or (< amount 0) (= kinds-of-coins 0)) 0)
|
||||
(else (+ (cc amount
|
||||
(- kinds-of-coins 1))
|
||||
(cc (- amount
|
||||
(first-denomination kinds-of-coins))
|
||||
kinds-of-coins)))))
|
||||
|
||||
(define (first-denomination kinds-of-coins)
|
||||
(cond ((= kinds-of-coins 1) 1)
|
||||
((= kinds-of-coins 2) 5)
|
||||
((= kinds-of-coins 3) 10)
|
||||
((= kinds-of-coins 4) 25)
|
||||
((= kinds-of-coins 5) 50)))
|
||||
|
||||
(display "counting change: ")
|
||||
(display (count-change 75))
|
||||
(newline)
|
||||
|
||||
; 1.16 - fast powers
|
||||
(define (exp-fast b n) (exp-iter b n 1))
|
||||
|
||||
(define (exp-iter b n product)
|
||||
(cond ((= n 0) product)
|
||||
; b^n = (b^2) n/2
|
||||
((even? n) (exp-iter (* b b) (/ n 2) product))
|
||||
; b^n = b * b^n-1
|
||||
(else (exp-iter b (- n 1) (* product b)))))
|
||||
|
||||
(assert (= (exp-fast 5 4) 625))
|
||||
(assert (= (exp-fast 2 8) 256))
|
||||
|
||||
; 1.17 - fast multiply
|
||||
|
||||
(define (double a) (+ a a))
|
||||
(define (halve a) (/ a 2))
|
||||
|
||||
(define (fast-mul a b) (fast-mul-iter a b 0))
|
||||
|
||||
(define (fast-mul-iter a b sum)
|
||||
(cond ((= b 0) sum)
|
||||
((even? b) (fast-mul-iter (double a) (halve b) sum))
|
||||
(else (fast-mul-iter a (- b 1) (+ sum a)))))
|
||||
|
||||
(assert (= (fast-mul 3 4) 12))
|
||||
(assert (= (fast-mul 100 10) 1000))
|
||||
|
||||
; 1.19 fibonacci
|
||||
|
||||
(define (fib-helper n a b p q)
|
||||
(cond
|
||||
((= n 0) b)
|
||||
((even? n) (fib-helper (/ n 2)
|
||||
a
|
||||
b
|
||||
(+ (* p p) (* q q))
|
||||
(+ (* 2 q p) (* q q ))
|
||||
))
|
||||
|
||||
(else
|
||||
(fib-helper
|
||||
(- n 1)
|
||||
(+ (* b q) (* a q) (* a p))
|
||||
(+ (* b p) (* a q))
|
||||
p
|
||||
q))))
|
||||
|
||||
(define (fib n)
|
||||
(fib-helper n 1 0 0 1))
|
||||
|
||||
(assert (= (fib 5) 5))
|
||||
(assert (= (fib 7) 13))
|
||||
(assert (= (fib 8) 21))
|
||||
|
||||
; 2.21 - square list
|
||||
|
||||
(define (square-list items)
|
||||
(if (null? items)
|
||||
items
|
||||
(cons (* (car items) (car items)) (square-list (cdr items)))))
|
||||
|
||||
(define (square-list2 items)
|
||||
(map (lambda (x) (* x x)) items))
|
||||
|
||||
(display (square-list (list 1 2 3 4)))
|
||||
(newline)
|
||||
(display (square-list2 (list 4 5 6 7)))
|
||||
|
||||
; bank accounts
|
||||
(define (make-account val)
|
||||
(lambda (action)
|
||||
(if (eq? action 'deposit)
|
||||
(lambda (n) (set! val (+ val n)))
|
||||
(lambda (n) (set! val (- val n))))))
|
||||
|
||||
(define justin (make-account 100))
|
||||
(define ryan (make-account 200))
|
||||
((justin 'deposit) 20)
|
||||
((ryan 'withdraw) 20)
|
||||
|
||||
(gc-flip)
|
||||
|
||||
(assert (= ((justin 'withdraw) 0) 120))
|
||||
(assert (= ((ryan 'deposity) 0) 180))
|
||||
|
||||
; and or expansion
|
||||
(let ((a 1))
|
||||
(if (and (= a 0) (garbage here))
|
||||
(assert 0)
|
||||
'pass)
|
||||
|
||||
(if (or (= a 1) (garbage here))
|
||||
'pass
|
||||
(assert 0)))
|
||||
|
||||
@@ -0,0 +1,32 @@
|
||||
(==> (force (delay (+ 1 2))) 3)
|
||||
|
||||
(==> (let ((p (delay (+ 1 2))))
|
||||
(list (force p) (force p))) (3 3))
|
||||
|
||||
(assert (promise? (delay (+ 1 2))))
|
||||
|
||||
|
||||
; promises computed at most once
|
||||
(define count 0)
|
||||
|
||||
(define p
|
||||
(delay
|
||||
(begin
|
||||
(set! count (+ count 1))
|
||||
(* x 3))))
|
||||
|
||||
(define x 5)
|
||||
|
||||
(==> count 0)
|
||||
(assert (promise? p))
|
||||
(==> (force p) 15)
|
||||
(assert (promise? p))
|
||||
(==> count 1)
|
||||
(==> (force p) 15)
|
||||
(==> count 1)
|
||||
|
||||
|
||||
(define (integers-starting-from n)
|
||||
(cons-stream n (integers-starting-from (+ n 1))))
|
||||
|
||||
(assert (equal? (stream-head (integers-starting-from 0) 5) '(0 1 2 3 4)))
|
||||
@@ -0,0 +1,60 @@
|
||||
; https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_7.html
|
||||
|
||||
; TODO: add characters to reader
|
||||
(==> (make-string 10 #\x) "xxxxxxxxxx")
|
||||
|
||||
(assert (string? "Hi"))
|
||||
(assert (not (string? 'Hi)))
|
||||
|
||||
(==> (string-length "") 0)
|
||||
(==> (string-length "The length") 10)
|
||||
|
||||
(assert (string=? "PIE" "PIE"))
|
||||
(assert (not (string=? "PIE" "pie")))
|
||||
|
||||
(==> (list->string (string->list "hello 123")) "hello 123")
|
||||
(==> (string->list (list->string '(#\A #\B #\3))) (#\A #\B #\3))
|
||||
|
||||
|
||||
; https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Symbols.html
|
||||
(assert (symbol? 'foo))
|
||||
(assert (symbol? (car '(a b))))
|
||||
(assert (not (symbol? "bar")))
|
||||
|
||||
(assert (eq? 'foo (string->symbol "FOO")))
|
||||
(assert (string=? "FLYING-FISH" (symbol->string 'flying-fish)))
|
||||
|
||||
; specials
|
||||
(==> (string-length "\\") 1)
|
||||
(==> (string-length "\t") 1)
|
||||
(==> (string-length "\n") 1)
|
||||
(==> (string-length "\f") 1)
|
||||
(==> (string-length "\"") 1)
|
||||
|
||||
(display "Hello\nworld!")
|
||||
|
||||
(==> (string->number (number->string 279)) 279)
|
||||
(==> (number->string (string->number "279")) "279")
|
||||
(==> (string->number (number->string 0.5)) 0.5)
|
||||
|
||||
(assert (symbol<? 'A 'B))
|
||||
(assert (not (symbol<? 'WALK 'DOG)))
|
||||
|
||||
(==> (- (char->integer #\c) (char->integer #\a)) 2)
|
||||
|
||||
(==> (string-ref "abc" 0) #\a)
|
||||
(==> (string-ref "abc" 2) #\c)
|
||||
(==> (string #\a #\b) "ab")
|
||||
(==> (string) "")
|
||||
|
||||
(assert (char<? #\a #\b))
|
||||
(assert (char<=? #\a #\a))
|
||||
|
||||
(assert (char-lower-case? #\a))
|
||||
(assert (not (char-lower-case? #\A)))
|
||||
|
||||
(assert (not (char-upper-case? #\c)))
|
||||
(assert (char-upper-case? #\C))
|
||||
|
||||
(assert (char-ci=? #\a #\A))
|
||||
(assert (char-ci<? #\A #\b))
|
||||
@@ -0,0 +1,75 @@
|
||||
(define v #(1 2 3))
|
||||
(vector-swap! v 0 2)
|
||||
(assert (= 3 (vector-ref v 0)))
|
||||
(assert (= 1 (vector-ref v 2)))
|
||||
|
||||
(define (vec-sorted? v op)
|
||||
; "if x and y are any two adjacent elements in the result,
|
||||
; where x precedes y, it is the case that (procedure y x) ==> #f"
|
||||
; https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_8.html#SEC72
|
||||
|
||||
(or (< (vector-length v) 2)
|
||||
(and (not (op (vector-ref v 1) (vector-ref v 0)))
|
||||
(vec-sorted? (vector-tail v 1) op))))
|
||||
|
||||
; First make sure our sorted checker works
|
||||
(assert (vec-sorted? #(1 2 2 4 5 6) <))
|
||||
(assert (vec-sorted? #(1) <))
|
||||
(assert (vec-sorted? #(1 2) <))
|
||||
(assert (vec-sorted? #(7 6 5 4 3 2 1) >))
|
||||
(assert (not (vec-sorted? #(2 1) <)))
|
||||
(assert (not (vec-sorted? #(1 2 3 4 4 3) <)))
|
||||
(assert (not (vec-sorted? #(1 2 3 2 4 5) <)))
|
||||
|
||||
; Now test the sort function
|
||||
(assert (vec-sorted? (sort! #(1) <) <))
|
||||
(assert (vec-sorted? (sort! #(2 1) <) <))
|
||||
(assert (vec-sorted? (sort! #(1 2 3) <) <))
|
||||
(assert (vec-sorted? (sort! #(3 8 1 7 2 9 4 5) <) <))
|
||||
(assert (vec-sorted? (sort! #(1 2 3 4 5 6 7 8) <) <))
|
||||
(assert (vec-sorted? (sort! #(3 8 1 7 2 9 4 5) >) >))
|
||||
(assert (vec-sorted? (sort! #(1 2 3 4 5 6 7 8) >) >))
|
||||
(assert (vec-sorted? (sort! #(92 59 30 57 74 78 43 33 77 10 78 83 76 49 42 94 82 70 15 11 90 86 44 70 39 64 69 30 59 95 15 79 13 54 98 82 42 96 79 17 56 93 20 1 84 72 75 19 74 43) >) >))
|
||||
(assert (vec-sorted? (sort! #(92 59 30 57 74 78 43 33 77 10 78 83 76 49 42 94 82 70 15 11 90 86 44 70 39 64 69 30 59 95 15 79 13 54 98 82 42 96 79 17 56 93 20 1 84 72 75 19 74 43) <) <))
|
||||
(assert (vec-sorted? (sort! #(3 8 1 7 2 9 4 5) <) <))
|
||||
|
||||
; Try other data types
|
||||
(assert (vec-sorted? (sort! #(#\C #\B #\A #\D) char<?) char<?))
|
||||
|
||||
; Converting between lists and vectors
|
||||
;https://www.gnu.org/software/mit-scheme/documentation/stable/mit-scheme-ref/Construction-of-Vectors.html
|
||||
(==> (vector 'a 'b 'c) #(A B C))
|
||||
(==> (list->vector '(dididit dah)) #(dididit dah))
|
||||
|
||||
|
||||
; Binary search
|
||||
(assert (= (vector-binary-search #(1 2 3 4 5) < (lambda (x) x) 3) 3))
|
||||
(assert (not (vector-binary-search #(1 2 2 4 5) < (lambda (x) x) 3)))
|
||||
|
||||
(define v (vector 1 1 2))
|
||||
(vector-fill! v 3)
|
||||
(==> v #(3 3 3))
|
||||
|
||||
(==> (make-initialized-vector 5 (lambda (x) (* x x))) #(0 1 4 9 16))
|
||||
(==> (vector-head #(1 2 3) 2) #(1 2))
|
||||
|
||||
; Issues parsing large vector
|
||||
(define big-v #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200))
|
||||
|
||||
(==> (vector-length big-v) 200)
|
||||
|
||||
; Subvector
|
||||
(==> (subvector #(1 2 3 4) 1 4) #(2 3 4))
|
||||
(==> (subvector #(1 2 3 4) 0 2) #(1 2))
|
||||
(==> (subvector #(A 1 A 1 A 1 A 1) 1 3) #(1 A))
|
||||
|
||||
; Association
|
||||
(define avector #((bob . 1) (john . 2) (dan . 3) (alice . 4)))
|
||||
|
||||
(assert (= (cdr (vector-assq 'john avector)) 2))
|
||||
(assert (= (cdr (vector-assq 'alice avector)) 4))
|
||||
(assert (not (vector-assq 'bad-key avector)))
|
||||
|
||||
|
||||
(sort! (make-initialized-vector 10000 (lambda (x) (random 1000000))) <)
|
||||
|
||||
@@ -0,0 +1,20 @@
|
||||
; try this one with read
|
||||
(let* ((file (open-input-file "big_data_gen.sexpr"))
|
||||
(data (read file)))
|
||||
(gc-flip)
|
||||
(print-gc-statistics)
|
||||
(newline)
|
||||
(display "records: ")
|
||||
(display (length data))
|
||||
(newline)
|
||||
(let ((record (car data)))
|
||||
(assert (= (cdr (vector-assq 'index record)) 0))
|
||||
(assert (eq? (cdr (vector-assq 'isActive record)) 'False))
|
||||
(assert (= (cdr (vector-assq 'age record)) 21)))
|
||||
|
||||
(close-input-port file))
|
||||
|
||||
(display "done")
|
||||
(newline)
|
||||
|
||||
|
||||
@@ -0,0 +1,12 @@
|
||||
; canada
|
||||
(let ((data (read)))
|
||||
(gc-flip)
|
||||
(print-gc-statistics)
|
||||
(newline)
|
||||
(display "records: ")
|
||||
(display (vector-length data)))
|
||||
|
||||
(gc-flip)
|
||||
(print-gc-statistics)
|
||||
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because it is too large
Load Diff
File diff suppressed because one or more lines are too long
@@ -0,0 +1,38 @@
|
||||
import json
|
||||
import sys
|
||||
import itertools
|
||||
|
||||
json_data = json.load(sys.stdin)
|
||||
|
||||
def lisp_dump(data):
|
||||
if isinstance(data, int):
|
||||
return str(data)
|
||||
elif isinstance(data, float):
|
||||
return str(data)
|
||||
elif isinstance(data, str):
|
||||
escaped_string = data.encode("unicode_escape").decode("utf-8")
|
||||
return "\"" + escaped_string + "\""
|
||||
elif isinstance(data, list):
|
||||
result = "("
|
||||
for i, item in enumerate(data):
|
||||
result += lisp_dump(item)
|
||||
if i + 1 < len(data):
|
||||
result += " "
|
||||
result += ")"
|
||||
return result
|
||||
elif isinstance(data, dict):
|
||||
result = "#("
|
||||
i = 0
|
||||
for key, item in data.items():
|
||||
result += "(%s . %s)" % (key, lisp_dump(item))
|
||||
if i + 1 < len(data):
|
||||
result += " "
|
||||
i += 1
|
||||
result += ")"
|
||||
return result
|
||||
else:
|
||||
print("error")
|
||||
print(type(data))
|
||||
|
||||
print(lisp_dump(json_data))
|
||||
|
||||
Executable
+4
@@ -0,0 +1,4 @@
|
||||
#!/bin/sh
|
||||
|
||||
../../lisp --script big_data1.scm
|
||||
cat big_data_canada.sexpr | ../../lisp --script big_data2.scm
|
||||
@@ -0,0 +1,81 @@
|
||||
|
||||
(define (quasiquote-helper tail x)
|
||||
(cond ((null? x) (reverse! tail))
|
||||
((not (pair? x)) (list 'QUOTE x))
|
||||
((eq? 'UNQUOTE (car x)) (car (cdr x)))
|
||||
((eq? 'UNQUOTESPLICE (car x)) (error "invalid place"))
|
||||
((and (pair? (car x))
|
||||
(eq? (car (car x)) 'UNQUOTESPLICE))
|
||||
|
||||
(quasiquote-helper (reverse-append! (car (cdr (car x))) tail) (cdr x))
|
||||
)
|
||||
(else
|
||||
(quasiquote-helper (cons (quasiquote-helper '() (car x)) tail)
|
||||
(cdr x)))
|
||||
|
||||
))
|
||||
|
||||
(define-macro quasiquote
|
||||
(lambda (x)
|
||||
(display x)
|
||||
(newline)
|
||||
(quasiquote-helper '() x)
|
||||
))
|
||||
|
||||
|
||||
(display (macroexpand '`(1 ,x 3)))
|
||||
(newline)
|
||||
;(display (macroexpand '`(1 ,@(2 2) 3)))
|
||||
|
||||
|
||||
|
||||
(define-macro do2
|
||||
(lambda (vars loop-check loop)
|
||||
(let ((names '())
|
||||
(inits '())
|
||||
(steps '())
|
||||
(func (gensym)))
|
||||
|
||||
(for-each (lambda (var)
|
||||
(push (car var) names)
|
||||
(set! var (cdr var))
|
||||
(push (car var) inits)
|
||||
(set! var (cdr var))
|
||||
(push (car var) steps))
|
||||
vars)
|
||||
|
||||
(display loop-check)
|
||||
(newline)
|
||||
|
||||
`((lambda (,func)
|
||||
(begin
|
||||
(set! ,func (lambda ,names
|
||||
(if ,(car loop-check)
|
||||
,(car (cdr loop-check))
|
||||
,(cons 'BEGIN (list loop (cons func steps)))
|
||||
)))
|
||||
,(cons func inits)
|
||||
)) '())
|
||||
)))
|
||||
|
||||
(display (macroexpand '(do2 ((i 0 (+ i 1)))
|
||||
((> i 0) 'done)
|
||||
'())))
|
||||
|
||||
(newline)
|
||||
(newline)
|
||||
|
||||
|
||||
(define-macro let2 (lambda (def-list . body)
|
||||
(cons `(lambda
|
||||
,(map1 (lambda (entry) (car entry)) def-list '())
|
||||
,(cons 'BEGIN body))
|
||||
(map1 (lambda (entry) (car (cdr entry))) def-list '())) ))
|
||||
|
||||
(display (macroexpand
|
||||
'(let2 ((x 1) (y 2)) (set! x (+ x y)) x)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,2 @@
|
||||
temp1.scm
|
||||
temp2.scm
|
||||
@@ -0,0 +1,19 @@
|
||||
(book
|
||||
(author "ARISTOTLE")
|
||||
(title "Categories")
|
||||
(year -350)
|
||||
(tags #(philosophy logic definitions substance))
|
||||
(lines
|
||||
"Things are said to be named \"equivocally\" when, though they have a common name, the definition corresponding with the name differs for each."
|
||||
"Thus, a real man and a figure in a picture can both lay claim to the name \"animal\"; yet these are equivocally so named, for, though they have a common name, the definition corresponding with the name differs for each"
|
||||
"For should any one define in what sense each is an animal, his definition in the one case will be appropriate to that case only.\n"
|
||||
"On the other hand, things are said to be named \"univocally\" which have both the name and the definition answering to the name in common"
|
||||
"A man and an ox are both \"animal\", and these are univocally so named, inasmuch as not only the name, but also the definition, is the same in both cases:"
|
||||
"for if a man should state in what sense each is an animal, the statement in the one case would be identical with that in the other.\n"
|
||||
|
||||
"Things are said to be named \"derivatively\", which derive their name from some other name, but differ from it in termination."
|
||||
"Thus the grammarian derives his name from the word \"grammar\", and the courageous man from the word \"courage\"."
|
||||
))
|
||||
|
||||
(alphabet #\a #\b #\c #\d #\e)
|
||||
(nums 0.0 0.25 0.5 0.75 1.0)
|
||||
Executable
+14
@@ -0,0 +1,14 @@
|
||||
#!/bin/sh
|
||||
|
||||
# make sure reader and writer work and are compatible.
|
||||
|
||||
# 1. load s expresion, print it out.
|
||||
cat sample.scm | ../../printer > temp1.scm
|
||||
|
||||
# 2. load the output, print it out again.
|
||||
cat temp1.scm | ../../printer > temp2.scm
|
||||
|
||||
# 3. ensure both outputs match
|
||||
cmp temp1.scm temp2.scm
|
||||
|
||||
|
||||
@@ -6,6 +6,7 @@
|
||||
*/
|
||||
|
||||
#include <unistd.h>
|
||||
|
||||
#define _DEFAULT_SOURCE
|
||||
#define _BSD_SOURCE
|
||||
#define _GNU_SOURCE
|
||||
@@ -17,18 +18,25 @@
|
||||
#include "include/output.h"
|
||||
#include "include/terminal.h"
|
||||
|
||||
struct editorConfig E;
|
||||
|
||||
int main(int argc, char *argv[]) {
|
||||
static struct editorConfig E;
|
||||
enableRawMode(&E);
|
||||
initEditor(&E);
|
||||
|
||||
enableRawMode();
|
||||
initEditor();
|
||||
if (argc >= 2) {
|
||||
editorOpen(&E, argv[1]);
|
||||
E.state = READ_AND_WRITE;
|
||||
editorOpen(argv[1]);
|
||||
} else {
|
||||
editorOpen("assets/beluga.txt");
|
||||
}
|
||||
editorSetStatusMessage(&E, "HELP: Ctrl-S = save | Ctrl-Q = quit");
|
||||
|
||||
editorSetStatusMessage("HELP: Ctrl-S = save | Ctrl-Q = quit");
|
||||
|
||||
|
||||
while (1) {
|
||||
editorRefreshScreen(&E);
|
||||
editorProcessKeypress(&E);
|
||||
editorRefreshScreen();
|
||||
editorProcessKeypress();
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
+33
@@ -0,0 +1,33 @@
|
||||
project('beluga', 'c',
|
||||
version : '1.1',
|
||||
default_options : [
|
||||
'c_std=none',
|
||||
]
|
||||
)
|
||||
|
||||
cc = meson.get_compiler('c')
|
||||
m = cc.find_library('m', required: false)
|
||||
|
||||
# Include directory
|
||||
inc_dir = include_directories('include', 'lisp-interpreter/dist')
|
||||
|
||||
# Source files
|
||||
src_files = files(
|
||||
'main.c',
|
||||
'src/append_buffer.c',
|
||||
'src/editor_op.c',
|
||||
'src/file_io.c',
|
||||
'src/init.c',
|
||||
'src/input.c',
|
||||
'src/output.c',
|
||||
'src/row_op.c',
|
||||
'src/terminal.c',
|
||||
'src/builtins.c',
|
||||
)
|
||||
|
||||
# Executable
|
||||
executable('beluga',
|
||||
src_files,
|
||||
include_directories : inc_dir,
|
||||
dependencies: [m]
|
||||
)
|
||||
@@ -1,5 +1,7 @@
|
||||
#include "../include/append_buffer.h"
|
||||
|
||||
extern struct editorConfig E;
|
||||
|
||||
void abAppend(struct abuf *ab, const char *s, int len) {
|
||||
char *new = realloc(ab->b, ab->len + len);
|
||||
|
||||
|
||||
+103
-93
@@ -1,131 +1,141 @@
|
||||
|
||||
// function_registry.c
|
||||
#include "../include/builtins.h"
|
||||
#include "../include/define.h"
|
||||
#include "../include/input.h"
|
||||
#include "../include/file_io.h"
|
||||
#include "../include/editor_op.h"
|
||||
#include "../include/data.h"
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
// Static array to hold function mappings
|
||||
function_entry_t function_registry[256];
|
||||
int registry_count = 0;
|
||||
Lisp mapKey(Lisp args, LispError *e, LispContext ctx) {
|
||||
const char *key_sequence = lisp_string(lisp_car(args));
|
||||
args = lisp_cdr(args);
|
||||
// second argument
|
||||
Lisp func = lisp_car(args);
|
||||
|
||||
// Initialize the function registry
|
||||
void init_function_registry(void) {
|
||||
register_function("editor-save", editorSave);
|
||||
register_function("move-cursor-beg-line", moveCursorBeginLine);
|
||||
register_function("move-cursor-end-line", moveCursorEndLine);
|
||||
register_function("editor-quit", editorQuit);
|
||||
register_function("move-cursor-up", editorMoveCursorUp);
|
||||
register_function("move-cursor-down", editorMoveCursorDown);
|
||||
register_function("move-cursor-right", editorMoveCursorRight);
|
||||
register_function("move-cursor-left", editorMoveCursorLeft);
|
||||
register_function("move-cursor-page-up", editorMoveCursorPageUp);
|
||||
register_function("move-cursor-page-down", editorMoveCursorPageDown);
|
||||
register_function("delete-previous-char", editorDelChar);
|
||||
register_function("delete-next-char", deleteNextChar);
|
||||
register_function("editor-insert-new-line", editorInsertNewLine);
|
||||
E.key_binds =
|
||||
(struct keyBind_t *)realloc(E.key_binds, ++E.number_of_keybinds * sizeof(struct keyBind_t));
|
||||
E.key_binds[E.number_of_keybinds - 1].key_sequence = (char *) malloc(50 * sizeof(char));
|
||||
|
||||
strncpy(E.key_binds[E.number_of_keybinds - 1].key_sequence, key_sequence, 50);
|
||||
|
||||
E.key_binds[E.number_of_keybinds - 1].command = func;
|
||||
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
// Register a function with a name
|
||||
int register_function(const char *name, command_func_t func) {
|
||||
if (registry_count >= 256) {
|
||||
return -1; // Registry full
|
||||
Lisp moveCursor(Lisp args, LispError *e, LispContext ctx) {
|
||||
fprintf(stderr, "Cursor is moving\n");
|
||||
const char *direction = lisp_string(lisp_car(args));
|
||||
switch (direction[0]) {
|
||||
case 'u':
|
||||
editorMoveCursor(ARROW_UP);
|
||||
break;
|
||||
case 'd':
|
||||
editorMoveCursor(ARROW_DOWN);
|
||||
break;
|
||||
case 'r':
|
||||
editorMoveCursor(ARROW_RIGHT);
|
||||
break;
|
||||
case 'l':
|
||||
editorMoveCursor(ARROW_LEFT);
|
||||
break;
|
||||
}
|
||||
|
||||
function_registry[registry_count].name = strdup(name);
|
||||
function_registry[registry_count].func = func;
|
||||
registry_count++;
|
||||
return 0;
|
||||
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
// Find a function by name
|
||||
command_func_t find_function(const char *name) {
|
||||
log_string("registry :");
|
||||
char *tmp = malloc(3 * sizeof(char));
|
||||
sprintf(tmp, "%d\n", registry_count);
|
||||
log_string(tmp);
|
||||
for (int i = 0; i < registry_count; i++) {
|
||||
if (strcmp(function_registry[i].name, name) == 0) {
|
||||
return function_registry[i].func;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
// Execute a command by name
|
||||
int execute_command(const char *name, struct editorConfig *E) {
|
||||
log_string(name);
|
||||
command_func_t func = find_function(name);
|
||||
if (func) {
|
||||
func(E);
|
||||
return 0;
|
||||
}
|
||||
log_string("Unknown command: \n");
|
||||
return -1;
|
||||
}
|
||||
|
||||
// Builtins tools
|
||||
|
||||
void moveCursorBeginLine(struct editorConfig *E) { E->cursor_x = 0; }
|
||||
|
||||
void moveCursorEndLine(struct editorConfig *E) {
|
||||
if (E->cursor_y < E->numrows) {
|
||||
E->cursor_x = E->row[E->cursor_y].size;
|
||||
}
|
||||
}
|
||||
|
||||
void editorQuit(struct editorConfig *E) {
|
||||
log_string("time to quit\n");
|
||||
if (E->dirty && E->quit_times > 0) {
|
||||
editorSetStatusMessage(E,
|
||||
"WARNING! Changes hasn't been saved. Press Ctrl-Q "
|
||||
Lisp editorQuit(Lisp args, LispError* e, LispContext ctx) {
|
||||
if (E.dirty && E.quit_times_buffer > 0) {
|
||||
editorSetStatusMessage("WARNING! Changes hasn't been saved. Press Ctrl-Q "
|
||||
"another time to quit.");
|
||||
--E->quit_times;
|
||||
return;
|
||||
--E.quit_times_buffer;
|
||||
return lisp_null();
|
||||
}
|
||||
write(STDOUT_FILENO, "\x1b[2J", 4);
|
||||
write(STDOUT_FILENO, CURSOR_TOP_LEFT, 3);
|
||||
disableRawMode(E);
|
||||
disableRawMode();
|
||||
exit(0);
|
||||
|
||||
return lisp_null();
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
void editorMoveCursorUp(struct editorConfig *E) {
|
||||
editorMoveCursor(E, ARROW_UP);
|
||||
Lisp l_editorSave(Lisp args, LispError* e, LispContext ctx) {
|
||||
|
||||
editorSave();
|
||||
|
||||
return lisp_null();
|
||||
|
||||
|
||||
}
|
||||
|
||||
void editorMoveCursorDown(struct editorConfig *E) {
|
||||
editorMoveCursor(E, ARROW_DOWN);
|
||||
Lisp l_editorInsertNewLine(Lisp args, LispError* e, LispContext ctx) {
|
||||
|
||||
editorInsertNewLine();
|
||||
|
||||
return lisp_null();
|
||||
|
||||
|
||||
}
|
||||
|
||||
void editorMoveCursorRight(struct editorConfig *E) {
|
||||
editorMoveCursor(E, ARROW_RIGHT);
|
||||
Lisp moveCursorBeginLine(Lisp args, LispError *e, LispContext ctx) {
|
||||
E.cursor_x = 0;
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
void editorMoveCursorLeft(struct editorConfig *E) {
|
||||
editorMoveCursor(E, ARROW_LEFT);
|
||||
Lisp moveCursorEndLine(Lisp args, LispError* e, LispContext ctx) {
|
||||
if (E.cursor_y < E.numrows) {
|
||||
E.cursor_x = E.row[E.cursor_y].size;
|
||||
}
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
void deleteNextChar(struct editorConfig *E) {
|
||||
editorMoveCursorRight(E);
|
||||
editorDelChar(E);
|
||||
|
||||
Lisp deletePreviousChar(Lisp args, LispError* e, LispContext ctx) {
|
||||
editorDelChar();
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
void editorMoveCursorPageUp(struct editorConfig *E) {
|
||||
E->cursor_y = E->row_offset;
|
||||
int times = E->screenrows;
|
||||
Lisp editorMoveCursorPageUp(Lisp args, LispError* e, LispContext ctx) {
|
||||
E.cursor_y = E.row_offset;
|
||||
int times = E.screenrows;
|
||||
while (--times) {
|
||||
editorMoveCursor(E, ARROW_UP);
|
||||
editorMoveCursor(ARROW_UP);
|
||||
}
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
void editorMoveCursorPageDown(struct editorConfig *E) {
|
||||
E->cursor_y = E->row_offset + E->screenrows - 1;
|
||||
if (E->cursor_y > E->numrows) {
|
||||
E->cursor_y = E->numrows;
|
||||
Lisp editorMoveCursorPageDown(Lisp args, LispError* e, LispContext ctx) {
|
||||
E.cursor_y = E.row_offset + E.screenrows - 1;
|
||||
if (E.cursor_y > E.numrows) {
|
||||
E.cursor_y = E.numrows;
|
||||
}
|
||||
int times = E->screenrows;
|
||||
int times = E.screenrows;
|
||||
while (--times) {
|
||||
editorMoveCursor(E, ARROW_DOWN);
|
||||
editorMoveCursor(ARROW_DOWN);
|
||||
}
|
||||
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
Lisp editorOpenFile(Lisp args, LispError *e, LispContext ctx) {
|
||||
char *filename = editorPrompt("Path : %s");
|
||||
if (filename)
|
||||
editorOpen(filename);
|
||||
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
|
||||
Lisp editorPrintC(Lisp args, LispError *e, LispContext ctx) {
|
||||
char c = lisp_char(lisp_car(args));
|
||||
editorInsertChar(c);
|
||||
return lisp_null();
|
||||
}
|
||||
|
||||
|
||||
+30
-26
@@ -1,44 +1,48 @@
|
||||
#include "../include/editor_op.h"
|
||||
#include "../include/row_op.h"
|
||||
#include "data.h"
|
||||
|
||||
void editorInsertChar(struct editorConfig *E, int c) {
|
||||
if (E->cursor_y == E->numrows) {
|
||||
editorInsertRow(E, E->numrows, "", 0);
|
||||
}
|
||||
editorRowInsertChar(E, &E->row[E->cursor_y], E->cursor_x, c);
|
||||
E->cursor_x++;
|
||||
|
||||
extern struct editorConfig E;
|
||||
|
||||
void editorInsertChar(int c) {
|
||||
if (E.cursor_y == E.numrows) {
|
||||
editorInsertRow(E.numrows, "", 0);
|
||||
}
|
||||
editorRowInsertChar(&E.row[E.cursor_y], E.cursor_x, c);
|
||||
E.cursor_x++;
|
||||
}
|
||||
|
||||
void editorInsertNewLine(struct editorConfig *E) {
|
||||
void editorInsertNewLine() {
|
||||
erow *row;
|
||||
if (!E->cursor_x) {
|
||||
editorInsertRow(E, E->cursor_y, "", 0);
|
||||
if (!E.cursor_x) {
|
||||
editorInsertRow(E.cursor_y, "", 0);
|
||||
} else {
|
||||
row = &E->row[E->cursor_y];
|
||||
editorInsertRow(E, E->cursor_y + 1, &row->chars[E->cursor_x],
|
||||
row->size - E->cursor_x);
|
||||
row = &E->row[E->cursor_y];
|
||||
row->size = E->cursor_x;
|
||||
row = &E.row[E.cursor_y];
|
||||
editorInsertRow(E.cursor_y + 1, &row->chars[E.cursor_x],
|
||||
row->size - E.cursor_x);
|
||||
row = &E.row[E.cursor_y];
|
||||
row->size = E.cursor_x;
|
||||
row->chars[row->size] = '\0';
|
||||
editorUpdateRow(row);
|
||||
}
|
||||
++E->cursor_y;
|
||||
E->cursor_x = 0;
|
||||
++E.cursor_y;
|
||||
E.cursor_x = 0;
|
||||
}
|
||||
|
||||
void editorDelChar(struct editorConfig *E) {
|
||||
void editorDelChar() {
|
||||
erow *row;
|
||||
if (E->cursor_y == E->numrows || !(E->cursor_x || E->cursor_y)) {
|
||||
if (E.cursor_y == E.numrows || !(E.cursor_x || E.cursor_y)) {
|
||||
return;
|
||||
}
|
||||
row = &E->row[E->cursor_y];
|
||||
if (E->cursor_x > 0) {
|
||||
editorRowDelchar(E, row, E->cursor_x - 1);
|
||||
--E->cursor_x;
|
||||
row = &E.row[E.cursor_y];
|
||||
if (E.cursor_x > 0) {
|
||||
editorRowDelchar(row, E.cursor_x - 1);
|
||||
--E.cursor_x;
|
||||
} else {
|
||||
E->cursor_x = E->row[E->cursor_y - 1].size;
|
||||
editorRowAppendString(E, &E->row[E->cursor_y - 1], row->chars, row->size);
|
||||
editorDelRow(E, E->cursor_y);
|
||||
--E->cursor_y;
|
||||
E.cursor_x = E.row[E.cursor_y - 1].size;
|
||||
editorRowAppendString(&E.row[E.cursor_y - 1], row->chars, row->size);
|
||||
editorDelRow(E.cursor_y);
|
||||
--E.cursor_y;
|
||||
}
|
||||
}
|
||||
|
||||
+93
-71
@@ -1,6 +1,7 @@
|
||||
#include "../include/file_io.h"
|
||||
#include "../include/input.h"
|
||||
#include "../include/output.h"
|
||||
#include "data.h"
|
||||
#include <fcntl.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
@@ -8,84 +9,105 @@
|
||||
#include <time.h>
|
||||
#include <unistd.h>
|
||||
|
||||
char *editorRowsToString(struct editorConfig *E, int *buffer_len) {
|
||||
int tot_len = 0;
|
||||
int j;
|
||||
char *buf;
|
||||
char *p;
|
||||
extern char *strdup(const char *);
|
||||
extern ssize_t getline(char **restrict lineptr, size_t *restrict n,
|
||||
FILE *restrict stream);
|
||||
extern int ftruncate(int fd, off_t length);
|
||||
extern struct editorConfig E;
|
||||
|
||||
for (j = 0; j < E->numrows; ++j) {
|
||||
tot_len += E->row[j].size + 1;
|
||||
}
|
||||
*buffer_len = tot_len;
|
||||
buf = malloc(tot_len);
|
||||
p = buf;
|
||||
for (j = 0; j < E->numrows; ++j) {
|
||||
memcpy(p, E->row[j].chars, E->row[j].size);
|
||||
p += E->row[j].size;
|
||||
*p = '\n';
|
||||
p++;
|
||||
}
|
||||
char *editorRowsToString(int *buffer_len) {
|
||||
int tot_len = 0;
|
||||
int j;
|
||||
char *buf;
|
||||
char *p;
|
||||
|
||||
return buf;
|
||||
for (j = 0; j < E.numrows; ++j) {
|
||||
tot_len += E.row[j].size + 1;
|
||||
}
|
||||
*buffer_len = tot_len;
|
||||
buf = malloc(tot_len);
|
||||
p = buf;
|
||||
for (j = 0; j < E.numrows; ++j) {
|
||||
memcpy(p, E.row[j].chars, E.row[j].size);
|
||||
p += E.row[j].size;
|
||||
*p = '\n';
|
||||
p++;
|
||||
}
|
||||
|
||||
return buf;
|
||||
}
|
||||
|
||||
void editorOpen(struct editorConfig *E, char *filename) {
|
||||
/**
|
||||
\function void editorOpen(struct editorConfig *E, char *filename)
|
||||
\brief Open filename on editor stream. Throw fopen error if file doesn't
|
||||
exist.
|
||||
*/
|
||||
FILE *fp;
|
||||
|
||||
free(E->filename);
|
||||
E->filename = strdup(filename);
|
||||
|
||||
fp = fopen(filename, "r");
|
||||
if (!fp)
|
||||
die("fopen");
|
||||
|
||||
char *line = NULL;
|
||||
size_t line_cap = 0;
|
||||
ssize_t line_len;
|
||||
|
||||
while ((line_len = getline(&line, &line_cap, fp)) != -1) {
|
||||
while (line_len > 0 &&
|
||||
(line[line_len - 1] == '\n' || line[line_len - 1] == '\r')) {
|
||||
--line_len;
|
||||
}
|
||||
editorInsertRow(E, E->numrows, line, line_len);
|
||||
}
|
||||
free(line);
|
||||
fclose(fp);
|
||||
E->dirty = 0;
|
||||
void editorCloseFile(void) {
|
||||
E.cursor_x = 0;
|
||||
E.cursor_y = 0;
|
||||
E.rx = 0;
|
||||
E.row_offset = 0;
|
||||
E.col_offset = 0;
|
||||
E.numrows = 0;
|
||||
E.row = NULL;
|
||||
E.dirty = 0;
|
||||
E.filename = NULL;
|
||||
E.status_msg[0] = '\0';
|
||||
E.status_msg_time = 0;
|
||||
}
|
||||
|
||||
void editorSave(struct editorConfig *E) {
|
||||
int len;
|
||||
char *buf;
|
||||
int fd;
|
||||
if (E->filename == NULL) {
|
||||
E->filename = editorPrompt(E, "Save as: %s (ESC to cancel)");
|
||||
if (E->filename == NULL) {
|
||||
editorSetStatusMessage(E, "Save aborted");
|
||||
return;
|
||||
void editorOpen(char *filename) {
|
||||
FILE *fp;
|
||||
|
||||
// Test if a file is already open
|
||||
if (E.filename != NULL) {
|
||||
editorCloseFile();
|
||||
E.state = READ_AND_WRITE;
|
||||
}
|
||||
}
|
||||
buf = editorRowsToString(E, &len);
|
||||
fd = open(E->filename, O_RDWR | O_CREAT, 0644);
|
||||
if (fd != -1) {
|
||||
if (ftruncate(fd, len) != -1) {
|
||||
if (write(fd, buf, len) == len) {
|
||||
|
||||
free(E.filename);
|
||||
E.filename = strdup(filename);
|
||||
|
||||
fp = fopen(filename, "a+");
|
||||
if (!fp)
|
||||
die("fopen");
|
||||
|
||||
char *line = NULL;
|
||||
size_t line_cap = 0;
|
||||
ssize_t line_len;
|
||||
|
||||
while ((line_len = getline(&line, &line_cap, fp)) != -1) {
|
||||
while (line_len > 0 &&
|
||||
(line[line_len - 1] == '\n' || line[line_len - 1] == '\r')) {
|
||||
--line_len;
|
||||
}
|
||||
editorInsertRow(E.numrows, line, line_len);
|
||||
}
|
||||
free(line);
|
||||
fclose(fp);
|
||||
E.dirty = 0;
|
||||
}
|
||||
|
||||
void editorSave() {
|
||||
int len;
|
||||
char *buf;
|
||||
int fd;
|
||||
if (E.filename == NULL) {
|
||||
E.filename = editorPrompt("Save as: %s (ESC to cancel)");
|
||||
if (E.filename == NULL) {
|
||||
editorSetStatusMessage("Save aborted");
|
||||
return;
|
||||
}
|
||||
}
|
||||
buf = editorRowsToString(&len);
|
||||
fd = open(E.filename, O_RDWR | O_CREAT, 0644);
|
||||
if (fd != -1) {
|
||||
if (ftruncate(fd, len) != -1) {
|
||||
if (write(fd, buf, len) == len) {
|
||||
close(fd);
|
||||
free(buf);
|
||||
E.dirty = 0;
|
||||
editorSetStatusMessage("%d bytes written to disk", len);
|
||||
return;
|
||||
}
|
||||
}
|
||||
close(fd);
|
||||
free(buf);
|
||||
E->dirty = 0;
|
||||
editorSetStatusMessage(E, "%d bytes written to disk", len);
|
||||
return;
|
||||
}
|
||||
}
|
||||
close(fd);
|
||||
}
|
||||
free(buf);
|
||||
editorSetStatusMessage(E, "Can't save! I/O error: %s", strerror(errno));
|
||||
free(buf);
|
||||
editorSetStatusMessage("Can't save! I/O error: %s", strerror(errno));
|
||||
}
|
||||
|
||||
+75
-19
@@ -1,27 +1,83 @@
|
||||
#include "../include/init.h"
|
||||
#include "../include/data.h"
|
||||
#include "../include/terminal.h"
|
||||
#include "../include/builtins.h"
|
||||
#include <stdio.h>
|
||||
|
||||
void initEditor(struct editorConfig *E) {
|
||||
E->cursor_x = 0;
|
||||
E->cursor_y = 0;
|
||||
E->rx = 0;
|
||||
E->row_offset = 0;
|
||||
E->col_offset = 0;
|
||||
E->numrows = 0;
|
||||
E->row = NULL;
|
||||
E->dirty = 0;
|
||||
E->quit_times = QUIT_TIMES;
|
||||
E->filename = NULL;
|
||||
E->status_msg[0] = '\0';
|
||||
E->status_msg_time = 0;
|
||||
if (getWindowSize(&E->screenrows, &E->screencols) == -1) {
|
||||
#define LISP_IMPLEMENTATION
|
||||
#include "../lisp-interpreter/dist/lisp.h"
|
||||
#include "../lisp-interpreter/dist/lisp_lib.h"
|
||||
|
||||
extern struct editorConfig;
|
||||
|
||||
|
||||
void registerBuiltin(char *key_sequence, LispCFunc f) {
|
||||
lisp_env_define(E.ctx.p->env, lisp_make_symbol(key_sequence, E.ctx),
|
||||
lisp_make_func(f), E.ctx);
|
||||
|
||||
}
|
||||
|
||||
void initBuiltins() {
|
||||
// move cursor
|
||||
registerBuiltin("MOVE-CURSOR", moveCursor);
|
||||
registerBuiltin("MAP-KEY", mapKey);
|
||||
registerBuiltin("EDITOR-QUIT", editorQuit);
|
||||
registerBuiltin("EDITOR-SAVE", l_editorSave);
|
||||
registerBuiltin("EDITOR-INSERT-NEW-LINE", l_editorInsertNewLine);
|
||||
registerBuiltin("MOVE-CURSOR-BEG-LINE", moveCursorBeginLine);
|
||||
registerBuiltin("MOVE-CURSOR-END-LINE", moveCursorEndLine);
|
||||
registerBuiltin("EDITOR-DELETE-PREVIOUS-CHAR", deletePreviousChar);
|
||||
registerBuiltin("MOVE-CURSOR-PAGE-UP", editorMoveCursorPageUp);
|
||||
registerBuiltin("MOVE-CURSOR-PAGE-DOWN", editorMoveCursorPageDown);
|
||||
registerBuiltin("EDITOR-OPEN-FILE", editorOpenFile);
|
||||
registerBuiltin("EDITOR-INSERT-CHAR", editorPrintC);
|
||||
}
|
||||
|
||||
void initEditor() {
|
||||
E.cursor_x = 0;
|
||||
E.cursor_y = 0;
|
||||
E.rx = 0;
|
||||
E.row_offset = 0;
|
||||
E.col_offset = 0;
|
||||
E.numrows = 0;
|
||||
E.row = NULL;
|
||||
E.dirty = 0;
|
||||
E.filename = NULL;
|
||||
E.state = READ_ONLY;
|
||||
E.status_msg[0] = '\0';
|
||||
E.status_msg_time = 0;
|
||||
if (getWindowSize(&E.screenrows, &E.screencols) == -1) {
|
||||
die("getWindowSize");
|
||||
}
|
||||
E->screenrows -= 2;
|
||||
E.screenrows -= 2;
|
||||
|
||||
E->config = config_create();
|
||||
config_parse_file(E->config, "../config/init.bl");
|
||||
E.number_of_keybinds = 0;
|
||||
|
||||
config_print_all(E->config);
|
||||
|
||||
E.fd_init_file = fopen("config/init.lisp", "r");
|
||||
E.ctx = lisp_init();
|
||||
E.env = lisp_env(E.ctx);
|
||||
lisp_lib_load(E.ctx);
|
||||
// Init builtins lisp functions
|
||||
initBuiltins();
|
||||
|
||||
init_function_registry();
|
||||
// Read config file
|
||||
E.ctx_data = lisp_read_file(E.fd_init_file, &E.ctx_error, E.ctx);
|
||||
if (E.ctx_error != LISP_ERROR_NONE) {
|
||||
die("init failed");
|
||||
}
|
||||
lisp_eval(E.ctx_data, &E.ctx_error, E.ctx);
|
||||
|
||||
// To modify
|
||||
|
||||
E.constantes.TAB_LENGTH =
|
||||
(int)lisp_eval(lisp_read("TAB-LENGTH", &E.ctx_error, E.ctx), &E.ctx_error,
|
||||
E.ctx)
|
||||
.val.int_val;
|
||||
E.constantes.QUIT_TIMES =
|
||||
(int)lisp_eval(lisp_read("QUIT-TIMES", &E.ctx_error, E.ctx), &E.ctx_error,
|
||||
E.ctx)
|
||||
.val.int_val;
|
||||
|
||||
E.quit_times_buffer = E.constantes.QUIT_TIMES;
|
||||
}
|
||||
|
||||
+89
-130
@@ -1,18 +1,60 @@
|
||||
#include "../include/input.h"
|
||||
#include "../include/editor_op.h"
|
||||
#include "../include/output.h"
|
||||
#include "../include/define.h"
|
||||
#include <ctype.h>
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
|
||||
extern struct editorConfig E;
|
||||
|
||||
/**
|
||||
* \fn char * editorPrompt(struct editorConfig *E, char *prompt)
|
||||
* \brief Return user input in a prompt when enter is hit. */
|
||||
|
||||
char *editorPrompt(char *prompt) {
|
||||
size_t buf_size = 128;
|
||||
char *buf = malloc(buf_size);
|
||||
size_t buf_len = 0;
|
||||
int c = 0;
|
||||
buf[0] = '\0';
|
||||
|
||||
while (1) {
|
||||
editorSetStatusMessage(prompt, buf);
|
||||
editorRefreshScreen();
|
||||
c = editorReadKey();
|
||||
if (c == DEL_KEY || c == CTRL_KEY('h') || c == BACKSPACE) {
|
||||
if (buf_len != 0) {
|
||||
buf[--buf_len] = '\0';
|
||||
}
|
||||
} else if (c == ESCAPE) {
|
||||
editorSetStatusMessage("");
|
||||
free(buf);
|
||||
return NULL;
|
||||
} else if (c == '\r') {
|
||||
if (buf_len != 0) {
|
||||
editorSetStatusMessage("");
|
||||
return buf;
|
||||
}
|
||||
} else if (!iscntrl(c) && c < 128) {
|
||||
if (buf_len == buf_size - 1) {
|
||||
buf_size *= 2;
|
||||
buf = realloc(buf, buf_size);
|
||||
}
|
||||
buf[buf_len++] = c;
|
||||
buf[buf_len] = '\0';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
char *key_to_string(int key) {
|
||||
static char key_str[32];
|
||||
|
||||
char * tmp = malloc(10 * sizeof(char));
|
||||
sprintf(tmp, "%d\n", key);
|
||||
log_string(tmp);
|
||||
char tmp[10];
|
||||
sprintf(tmp, "%d", key);
|
||||
|
||||
|
||||
// First test enter key
|
||||
@@ -37,12 +79,15 @@ char *key_to_string(int key) {
|
||||
break;
|
||||
case PAGE_UP:
|
||||
strcpy(key_str, "PAGE-UP");
|
||||
fprintf(stderr, "pagr up\n");
|
||||
break;
|
||||
case PAGE_DOWN:
|
||||
strcpy(key_str, "PAGE-DOWN");
|
||||
break;
|
||||
case DEL_KEY:
|
||||
fprintf(stderr, "delete key\n");
|
||||
strcpy(key_str, "DEL");
|
||||
|
||||
break;
|
||||
case BACKSPACE:
|
||||
strcpy(key_str, "BACKSPACE");
|
||||
@@ -71,154 +116,68 @@ char *key_to_string(int key) {
|
||||
return key_str;
|
||||
}
|
||||
|
||||
char *editorPrompt(struct editorConfig *E, char *prompt) {
|
||||
size_t buf_size = 128;
|
||||
char *buf = malloc(buf_size);
|
||||
size_t buf_len = 0;
|
||||
int c = 0;
|
||||
buf[0] = '\0';
|
||||
|
||||
while (1) {
|
||||
editorSetStatusMessage(E, prompt, buf);
|
||||
editorRefreshScreen(E);
|
||||
c = editorReadKey();
|
||||
if (c == DEL_KEY || c == CTRL_KEY('h') || c == BACKSPACE) {
|
||||
if (buf_len != 0) {
|
||||
buf[--buf_len] = '\0';
|
||||
}
|
||||
} else if (c == ESCAPE) {
|
||||
fprintf(stderr, "escape");
|
||||
editorSetStatusMessage(E, "");
|
||||
free(buf);
|
||||
return NULL;
|
||||
} else if (c == '\r') {
|
||||
if (buf_len != 0) {
|
||||
editorSetStatusMessage(E, "");
|
||||
return buf;
|
||||
}
|
||||
} else if (!iscntrl(c) && c < 128) {
|
||||
if (buf_len == buf_size - 1) {
|
||||
buf_size *= 2;
|
||||
buf = realloc(buf, buf_size);
|
||||
}
|
||||
buf[buf_len++] = c;
|
||||
buf[buf_len] = '\0';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void editorMoveCursor(struct editorConfig *E, int key) {
|
||||
erow *row = (E->cursor_y >= E->numrows) ? NULL : &E->row[E->cursor_y];
|
||||
void editorMoveCursor(int key) {
|
||||
erow *row = (E.cursor_y >= E.numrows) ? NULL : &E.row[E.cursor_y];
|
||||
int row_len;
|
||||
char *sequence = key_to_string(key);
|
||||
switch (key) {
|
||||
case ARROW_RIGHT:
|
||||
if (row && E->cursor_x < row->size) {
|
||||
++E->cursor_x;
|
||||
} else if (row && E->cursor_x == row->size) {
|
||||
E->cursor_y++;
|
||||
E->cursor_x = 0;
|
||||
if (row && E.cursor_x < row->size) {
|
||||
++E.cursor_x;
|
||||
} else if (row && E.cursor_x == row->size) {
|
||||
E.cursor_y++;
|
||||
E.cursor_x = 0;
|
||||
}
|
||||
break;
|
||||
case ARROW_DOWN:
|
||||
if (E->cursor_y < E->numrows) {
|
||||
++E->cursor_y;
|
||||
if (E.cursor_y < E.numrows) {
|
||||
++E.cursor_y;
|
||||
}
|
||||
break;
|
||||
case ARROW_UP:
|
||||
if (E->cursor_y != 0) {
|
||||
--E->cursor_y;
|
||||
if (E.cursor_y != 0) {
|
||||
--E.cursor_y;
|
||||
}
|
||||
break;
|
||||
case ARROW_LEFT:
|
||||
if (E->cursor_x != 0) {
|
||||
--E->cursor_x;
|
||||
} else if (E->cursor_y > 0) {
|
||||
--E->cursor_y;
|
||||
E->cursor_x = E->row[E->cursor_y].size;
|
||||
if (E.cursor_x != 0) {
|
||||
--E.cursor_x;
|
||||
} else if (E.cursor_y > 0) {
|
||||
--E.cursor_y;
|
||||
E.cursor_x = E.row[E.cursor_y].size;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
row = (E->cursor_y >= E->numrows) ? NULL : &E->row[E->cursor_y];
|
||||
row = (E.cursor_y >= E.numrows) ? NULL : &E.row[E.cursor_y];
|
||||
row_len = row ? row->size : 0;
|
||||
if (E->cursor_x > row_len) {
|
||||
E->cursor_x = row_len;
|
||||
if (E.cursor_x > row_len) {
|
||||
E.cursor_x = row_len;
|
||||
}
|
||||
}
|
||||
|
||||
key_sequence_t current_sequence = {0};
|
||||
|
||||
int handle_key_sequence(struct editorConfig *E, int key) {
|
||||
char *key_str = key_to_string(key);
|
||||
|
||||
log_string(key_str);
|
||||
|
||||
// Add current key to sequence
|
||||
if (current_sequence.sequence_len > 0) {
|
||||
strcat(current_sequence.sequence, " ");
|
||||
}
|
||||
strcat(current_sequence.sequence, key_str);
|
||||
current_sequence.sequence_len++;
|
||||
|
||||
// Check if this sequence matches any binding
|
||||
const char *command =
|
||||
config_get_key_mapping(E->config, current_sequence.sequence);
|
||||
if (command) {
|
||||
log_string("Command found\n");
|
||||
// Found a complete binding - execute it
|
||||
execute_key_binding(E->config, current_sequence.sequence, E);
|
||||
|
||||
// Reset sequence
|
||||
memset(¤t_sequence, 0, sizeof(current_sequence));
|
||||
return 1; // Handled
|
||||
}
|
||||
|
||||
// Check if this could be the start of a longer sequence
|
||||
// (This is a simple check - you might want to make it more sophisticated)
|
||||
int potential_match = 0;
|
||||
// You'd implement a function to check for partial matches here
|
||||
|
||||
if (!potential_match) {
|
||||
// No potential matches, reset sequence and handle as single key
|
||||
memset(¤t_sequence, 0, sizeof(current_sequence));
|
||||
return 0; // Not handled
|
||||
}
|
||||
|
||||
return 1; // Waiting for more keys in sequence
|
||||
}
|
||||
|
||||
int execute_key_binding(config_t *config, const char *key_combo,
|
||||
void *context) {
|
||||
const char *command = config_get_key_mapping(config, key_combo);
|
||||
if (!command) {
|
||||
log_string("No mapping found for key combination: ");
|
||||
log_string(key_combo);
|
||||
log_string("\n");
|
||||
return -1;
|
||||
}
|
||||
|
||||
// Remove the '%' prefix if present
|
||||
const char *func_name = command;
|
||||
if (command[0] == '%') {
|
||||
func_name = command + 1;
|
||||
}
|
||||
|
||||
return execute_command(func_name, context);
|
||||
}
|
||||
|
||||
void editorProcessKeypress(struct editorConfig *E) {
|
||||
static int quit_times = QUIT_TIMES;
|
||||
int c = editorReadKey();
|
||||
|
||||
if (E->config) {
|
||||
if (handle_key_sequence(E, c)) {
|
||||
quit_times = QUIT_TIMES;
|
||||
return; // Key was handled by config system
|
||||
int executeKeyBind(char *key_sequence) {
|
||||
int i;
|
||||
for (i = 0; i < E.number_of_keybinds; ++i) {
|
||||
if (!strcmp(key_sequence, E.key_binds[i].key_sequence)) {
|
||||
|
||||
fprintf(stderr, "lisp function %s\n", key_sequence);
|
||||
// It's a symbol, create a function call
|
||||
lisp_eval(lisp_cons(E.key_binds[i].command, lisp_null(), E.ctx),
|
||||
&E.ctx_error, E.ctx);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
editorInsertChar(E, c);
|
||||
// reset quit times
|
||||
E->quit_times = QUIT_TIMES;
|
||||
return 0;
|
||||
}
|
||||
|
||||
void editorProcessKeypress() {
|
||||
int c = editorReadKey();
|
||||
|
||||
if (executeKeyBind(key_to_string(c))) {
|
||||
return;
|
||||
}
|
||||
editorInsertChar(c);
|
||||
E.quit_times_buffer = E.constantes.QUIT_TIMES;
|
||||
|
||||
}
|
||||
|
||||
+50
-48
@@ -4,24 +4,26 @@
|
||||
#include <string.h>
|
||||
#include <time.h>
|
||||
|
||||
void editorDrawRows(struct editorConfig *E, struct abuf *ab) {
|
||||
extern struct editorConfig E;
|
||||
|
||||
void editorDrawRows(struct abuf *ab) {
|
||||
int y;
|
||||
char welcome[80];
|
||||
int welcome_len;
|
||||
int padding;
|
||||
int len;
|
||||
int file_row;
|
||||
for (y = 0; y < E->screenrows; ++y) {
|
||||
file_row = y + E->row_offset;
|
||||
if (file_row >= E->numrows) {
|
||||
if (E->numrows == 0 && y == E->screenrows / 3) {
|
||||
for (y = 0; y < E.screenrows; ++y) {
|
||||
file_row = y + E.row_offset;
|
||||
if (file_row >= E.numrows) {
|
||||
if (E.numrows == 0 && y == E.screenrows / 3) {
|
||||
welcome_len =
|
||||
snprintf(welcome, sizeof(welcome),
|
||||
"Beluga text editor -- version %s", BELUGA_VERSION);
|
||||
if (welcome_len > E->screencols) {
|
||||
welcome_len = E->screencols;
|
||||
if (welcome_len > E.screencols) {
|
||||
welcome_len = E.screencols;
|
||||
}
|
||||
padding = (E->screencols - welcome_len) / 2;
|
||||
padding = (E.screencols - welcome_len) / 2;
|
||||
if (padding) {
|
||||
abAppend(ab, "~", 1);
|
||||
--padding;
|
||||
@@ -34,54 +36,54 @@ void editorDrawRows(struct editorConfig *E, struct abuf *ab) {
|
||||
abAppend(ab, "~", 1);
|
||||
}
|
||||
} else {
|
||||
len = E->row[file_row].rsize - E->col_offset;
|
||||
len = E.row[file_row].rsize - E.col_offset;
|
||||
if (len < 0)
|
||||
len = 0;
|
||||
if (len > E->screencols)
|
||||
len = E->screencols;
|
||||
abAppend(ab, &E->row[file_row].render[E->col_offset], len);
|
||||
if (len > E.screencols)
|
||||
len = E.screencols;
|
||||
abAppend(ab, &E.row[file_row].render[E.col_offset], len);
|
||||
}
|
||||
abAppend(ab, ERASE_END_LINE, 3);
|
||||
abAppend(ab, "\r\n", 2);
|
||||
}
|
||||
}
|
||||
|
||||
void editorScroll(struct editorConfig *E) {
|
||||
E->rx = E->cursor_x;
|
||||
if (E->cursor_y < E->numrows) {
|
||||
E->rx = editorRowCxToRx(&E->row[E->cursor_y], E->cursor_x);
|
||||
void editorScroll() {
|
||||
E.rx = E.cursor_x;
|
||||
if (E.cursor_y < E.numrows) {
|
||||
E.rx = editorRowCxToRx(&E.row[E.cursor_y], E.cursor_x);
|
||||
}
|
||||
|
||||
if (E->cursor_y < E->row_offset) {
|
||||
E->row_offset = E->cursor_y;
|
||||
if (E.cursor_y < E.row_offset) {
|
||||
E.row_offset = E.cursor_y;
|
||||
}
|
||||
if (E->cursor_y >= E->row_offset + E->screenrows) {
|
||||
E->row_offset = E->cursor_y - E->screenrows + 1;
|
||||
if (E.cursor_y >= E.row_offset + E.screenrows) {
|
||||
E.row_offset = E.cursor_y - E.screenrows + 1;
|
||||
}
|
||||
if (E->rx < E->col_offset) {
|
||||
E->col_offset = E->rx;
|
||||
if (E.rx < E.col_offset) {
|
||||
E.col_offset = E.rx;
|
||||
}
|
||||
if (E->rx >= E->col_offset + E->screencols) {
|
||||
E->col_offset = E->rx - E->screencols + 1;
|
||||
if (E.rx >= E.col_offset + E.screencols) {
|
||||
E.col_offset = E.rx - E.screencols + 1;
|
||||
}
|
||||
}
|
||||
|
||||
void editorDrawStatusBar(struct editorConfig *E, struct abuf *ab) {
|
||||
void editorDrawStatusBar(struct abuf *ab) {
|
||||
int len, render_len;
|
||||
char status[80], render_status[80];
|
||||
|
||||
abAppend(ab, "\x1b[7m", 4); // inverting colors
|
||||
len = snprintf(status, sizeof(status), "%.20s - %d lines%s",
|
||||
E->filename ? E->filename : "[No Name]", E->numrows,
|
||||
E->dirty ? "*" : "");
|
||||
E.filename ? E.filename : "[No Name]", E.numrows,
|
||||
E.dirty ? "*" : "");
|
||||
render_len = snprintf(render_status, sizeof(render_status), "%d/%d",
|
||||
E->cursor_y + 1, E->numrows);
|
||||
if (len > E->screencols) {
|
||||
len = E->screencols;
|
||||
E.cursor_y + 1, E.numrows);
|
||||
if (len > E.screencols) {
|
||||
len = E.screencols;
|
||||
}
|
||||
abAppend(ab, status, len);
|
||||
while (len < E->screencols) {
|
||||
if (E->screencols - len == render_len) {
|
||||
while (len < E.screencols) {
|
||||
if (E.screencols - len == render_len) {
|
||||
abAppend(ab, render_status, render_len);
|
||||
break;
|
||||
} else {
|
||||
@@ -93,31 +95,31 @@ void editorDrawStatusBar(struct editorConfig *E, struct abuf *ab) {
|
||||
abAppend(ab, "\r\n", 2);
|
||||
}
|
||||
|
||||
void editorDrawMessageBar(struct editorConfig *E, struct abuf *ab) {
|
||||
int msg_len = strlen(E->status_msg);
|
||||
void editorDrawMessageBar(struct abuf *ab) {
|
||||
int msg_len = strlen(E.status_msg);
|
||||
abAppend(ab, ERASE_END_LINE, 3);
|
||||
if (msg_len > E->screencols) {
|
||||
msg_len = E->screencols;
|
||||
if (msg_len > E.screencols) {
|
||||
msg_len = E.screencols;
|
||||
}
|
||||
if (msg_len && time(NULL) - E->status_msg_time < 5) {
|
||||
abAppend(ab, E->status_msg, msg_len);
|
||||
if (msg_len && time(NULL) - E.status_msg_time < 5) {
|
||||
abAppend(ab, E.status_msg, msg_len);
|
||||
}
|
||||
}
|
||||
|
||||
void editorRefreshScreen(struct editorConfig *E) {
|
||||
editorScroll(E);
|
||||
void editorRefreshScreen() {
|
||||
editorScroll();
|
||||
struct abuf ab = ABUF_INIT;
|
||||
char buf[32];
|
||||
|
||||
abAppend(&ab, HIDE_CURSOR, 6);
|
||||
abAppend(&ab, CURSOR_TOP_LEFT, 3);
|
||||
|
||||
editorDrawRows(E, &ab);
|
||||
editorDrawStatusBar(E, &ab);
|
||||
editorDrawMessageBar(E, &ab);
|
||||
editorDrawRows(&ab);
|
||||
editorDrawStatusBar(&ab);
|
||||
editorDrawMessageBar(&ab);
|
||||
|
||||
snprintf(buf, sizeof(buf), "\x1b[%d;%dH", (E->cursor_y - E->row_offset) + 1,
|
||||
(E->rx - E->col_offset) + 1);
|
||||
snprintf(buf, sizeof(buf), "\x1b[%d;%dH", (E.cursor_y - E.row_offset) + 1,
|
||||
(E.rx - E.col_offset) + 1);
|
||||
abAppend(&ab, buf, strlen(buf));
|
||||
|
||||
abAppend(&ab, SHOW_CURSOR, 6);
|
||||
@@ -126,10 +128,10 @@ void editorRefreshScreen(struct editorConfig *E) {
|
||||
abFree(&ab);
|
||||
}
|
||||
|
||||
void editorSetStatusMessage(struct editorConfig *E, const char *fmt, ...) {
|
||||
void editorSetStatusMessage(const char *fmt, ...) {
|
||||
va_list ap;
|
||||
va_start(ap, fmt);
|
||||
vsnprintf(E->status_msg, sizeof(E->status_msg), fmt, ap);
|
||||
vsnprintf(E.status_msg, sizeof(E.status_msg), fmt, ap);
|
||||
va_end(ap);
|
||||
E->status_msg_time = time(NULL);
|
||||
E.status_msg_time = time(NULL);
|
||||
}
|
||||
|
||||
+39
-38
@@ -1,15 +1,18 @@
|
||||
#include "../include/row_op.h"
|
||||
#include "data.h"
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <time.h>
|
||||
|
||||
extern struct editorConfig E;
|
||||
|
||||
int editorRowCxToRx(erow *row, int cursor_x) {
|
||||
int render_x = 0;
|
||||
int i;
|
||||
for (i = 0; i < cursor_x; ++i) {
|
||||
if (row->chars[i] == '\t') {
|
||||
render_x += (TAB_LENGTH - 1) - (render_x % TAB_LENGTH);
|
||||
render_x += (E.constantes.TAB_LENGTH - 1) - (render_x % E.constantes.TAB_LENGTH);
|
||||
}
|
||||
render_x++;
|
||||
}
|
||||
@@ -33,8 +36,8 @@ void editorUpdateRow(erow *row) {
|
||||
}
|
||||
|
||||
free(row->render);
|
||||
row->render = malloc(row->size + tabs * (TAB_LENGTH - 1) +
|
||||
1); /**< Tabs needs TAB_LENGTH chars so TAB_LENGTH - 1
|
||||
row->render = malloc(row->size + tabs * (E.constantes.TAB_LENGTH - 1) +
|
||||
1); /**< Tabs needs E.constantes.TAB_LENGTH chars so E.constantes.TAB_LENGTH - 1
|
||||
more than the first already counted. */
|
||||
|
||||
// end of counting
|
||||
@@ -42,7 +45,7 @@ void editorUpdateRow(erow *row) {
|
||||
for (i = 0; i < row->size; ++i) {
|
||||
if (row->chars[i] == '\t') {
|
||||
row->render[i_render++] = ' ';
|
||||
while (i_render % TAB_LENGTH) {
|
||||
while (i_render % E.constantes.TAB_LENGTH) {
|
||||
row->render[i_render++] =
|
||||
' '; /**< Addind the right amount of spaces for tabs */
|
||||
}
|
||||
@@ -54,25 +57,29 @@ void editorUpdateRow(erow *row) {
|
||||
row->rsize = i_render;
|
||||
}
|
||||
|
||||
void editorInsertRow(struct editorConfig *E, int at, char *s, size_t len) {
|
||||
if (at < 0 || at > E->numrows) {
|
||||
void editorInsertRow(int at, char *s, size_t len) {
|
||||
if (at < 0 || at > E.numrows) {
|
||||
|
||||
return;
|
||||
}
|
||||
erow *tmp = (erow *)realloc(E.row, sizeof(erow) * (E.numrows + 1));
|
||||
if (!tmp) {
|
||||
return;
|
||||
}
|
||||
E.row = tmp;
|
||||
memmove(&E.row[at + 1], &E.row[at], sizeof(erow) * (E.numrows - at));
|
||||
|
||||
E->row = realloc(E->row, sizeof(erow) * (E->numrows + 1));
|
||||
memmove(&E->row[at + 1], &E->row[at], sizeof(erow) * (E->numrows - at));
|
||||
E.row[at].size = len;
|
||||
E.row[at].chars = malloc(len + 1);
|
||||
memcpy(E.row[at].chars, s, len);
|
||||
E.row[at].chars[len] = '\0';
|
||||
|
||||
E->row[at].size = len;
|
||||
E->row[at].chars = malloc(len + 1);
|
||||
memcpy(E->row[at].chars, s, len);
|
||||
E->row[at].chars[len] = '\0';
|
||||
E.row[at].rsize = 0;
|
||||
E.row[at].render = NULL;
|
||||
editorUpdateRow(&E.row[at]);
|
||||
|
||||
E->row[at].rsize = 0;
|
||||
E->row[at].render = NULL;
|
||||
editorUpdateRow(&E->row[at]);
|
||||
|
||||
++E->numrows;
|
||||
++E->dirty;
|
||||
++E.numrows;
|
||||
++E.dirty;
|
||||
}
|
||||
|
||||
void editorFreeRow(erow *row) {
|
||||
@@ -80,21 +87,23 @@ void editorFreeRow(erow *row) {
|
||||
free(row->chars);
|
||||
}
|
||||
|
||||
void editorDelRow(struct editorConfig *E, int at) {
|
||||
if (at < 0 || at >= E->numrows) {
|
||||
void editorDelRow(int at) {
|
||||
if (at < 0 || at >= E.numrows) {
|
||||
return;
|
||||
}
|
||||
editorFreeRow(&E->row[at]);
|
||||
memmove(&E->row[at], &E->row[at + 1], sizeof(erow) * (E->numrows - at - 1));
|
||||
--E->numrows;
|
||||
++E->dirty;
|
||||
editorFreeRow(&E.row[at]);
|
||||
memmove(&E.row[at], &E.row[at + 1], sizeof(erow) * (E.numrows - at - 1));
|
||||
--E.numrows;
|
||||
++E.dirty;
|
||||
}
|
||||
|
||||
/**
|
||||
* \fn editorRowInsertChar(erow *row, int at, int c)
|
||||
* \param at Index of where we want to insert the char */
|
||||
|
||||
void editorRowInsertChar(struct editorConfig *E, erow *row, int at, int c) {
|
||||
void editorRowInsertChar(erow *row, int at, int c) {
|
||||
if (E.state == READ_ONLY)
|
||||
return;
|
||||
if (at < 0 || at > row->size) {
|
||||
at = row->size;
|
||||
}
|
||||
@@ -103,17 +112,16 @@ void editorRowInsertChar(struct editorConfig *E, erow *row, int at, int c) {
|
||||
++row->size;
|
||||
row->chars[at] = c;
|
||||
editorUpdateRow(row);
|
||||
++E->dirty;
|
||||
++E.dirty;
|
||||
}
|
||||
|
||||
void editorRowAppendString(struct editorConfig *E, erow *row, char *s,
|
||||
size_t len) {
|
||||
void editorRowAppendString(erow *row, char *s, size_t len) {
|
||||
row->chars = realloc(row->chars, row->size + len + 1);
|
||||
memcpy(&row->chars[row->size], s, len);
|
||||
row->size += len;
|
||||
row->chars[row->size] = '\0';
|
||||
editorUpdateRow(row);
|
||||
++E->dirty;
|
||||
++E.dirty;
|
||||
}
|
||||
|
||||
/**
|
||||
@@ -121,19 +129,12 @@ void editorRowAppendString(struct editorConfig *E, erow *row, char *s,
|
||||
* \brief Delete the a char at the chosen position on the given row
|
||||
* \param at Index of the char to delete
|
||||
* \param row Row on operation is made */
|
||||
void editorRowDelchar(struct editorConfig *E, erow *row, int at) {
|
||||
void editorRowDelchar(erow *row, int at) {
|
||||
if (at < 0 || at >= row->size) {
|
||||
return;
|
||||
}
|
||||
memmove(&row->chars[at], &row->chars[at + 1], row->size - at);
|
||||
--row->size;
|
||||
editorUpdateRow(row);
|
||||
++E->dirty;
|
||||
++E.dirty;
|
||||
}
|
||||
|
||||
void log_string(char * string){
|
||||
FILE * fd = fopen("tmp/log.txt", "a");
|
||||
fprintf(fd, "%s\n", string);
|
||||
fclose(fd);
|
||||
}
|
||||
|
||||
|
||||
+9
-10
@@ -1,28 +1,28 @@
|
||||
#include "../include/terminal.h"
|
||||
#include "../include/data.h"
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
void die(const char *s) {
|
||||
write(STDOUT_FILENO, "\x1b[2J", 4);
|
||||
write(STDOUT_FILENO, CURSOR_TOP_LEFT, 3);
|
||||
|
||||
lisp_shutdown(E.ctx);
|
||||
perror(s);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
void disableRawMode(struct editorConfig *E) {
|
||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &E->orig_termios) == -1) {
|
||||
free(E);
|
||||
void disableRawMode() {
|
||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &E.orig_termios) == -1) {
|
||||
die("tcsetattr");
|
||||
}
|
||||
}
|
||||
|
||||
void enableRawMode(struct editorConfig *E) {
|
||||
if (tcgetattr(STDIN_FILENO, &E->orig_termios) == -1) {
|
||||
void enableRawMode() {
|
||||
if (tcgetattr(STDIN_FILENO, &E.orig_termios) == -1) {
|
||||
die("tcgetattr");
|
||||
}
|
||||
|
||||
struct termios raw = E->orig_termios;
|
||||
struct termios raw = E.orig_termios;
|
||||
raw.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
|
||||
raw.c_oflag &= ~(OPOST);
|
||||
raw.c_cflag |= (CS8);
|
||||
@@ -31,7 +31,7 @@ void enableRawMode(struct editorConfig *E) {
|
||||
raw.c_cc[VTIME] = 1;
|
||||
|
||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &raw) == -1) {
|
||||
die("tcsetattr");
|
||||
die("tcgetattr");
|
||||
}
|
||||
}
|
||||
|
||||
@@ -45,7 +45,6 @@ int editorReadKey() {
|
||||
}
|
||||
}
|
||||
|
||||
fprintf(stderr, "%X (%c)\n", c, c);
|
||||
if (c == '\x1b') {
|
||||
if (read(STDIN_FILENO, &seq[0], 1) != 1 ||
|
||||
read(STDIN_FILENO, &seq[1], 1) != 1) {
|
||||
|
||||
Reference in New Issue
Block a user