Просмотр исходного кода

renamed prog to begin and added basics for the manual

master
Felix Brendel 7 лет назад
Родитель
Сommit
5548192dc9
17 измененных файлов: 475 добавлений и 54 удалений
  1. +17
    -17
      bin/pre.slime
  2. +3
    -3
      bin/pre.slime.expanded
  3. +17
    -0
      manual/build.sh
  4. +67
    -0
      manual/manual.org
  5. Двоичные данные
     
  6. +195
    -0
      manual/manual.tex
  7. +3
    -3
      src/built_ins.cpp
  8. +50
    -12
      src/eval.cpp
  9. +3
    -0
      src/forward_decls.cpp
  10. +72
    -3
      src/io.cpp
  11. +3
    -0
      src/main.cpp
  12. +14
    -10
      src/parse.cpp
  13. +2
    -0
      src/slime.h
  14. +1
    -1
      src/structs.cpp
  15. +11
    -4
      src/testing.cpp
  16. +15
    -0
      src/visualization.cpp
  17. +2
    -1
      todo.org

+ 17
- 17
bin/pre.slime Просмотреть файл

@@ -1,20 +1,20 @@
(define-syntax (when condition :rest body) (define-syntax (when condition :rest body)
"Doc String for 'when'" "Doc String for 'when'"
`(if ,condition ,(pair prog body) nil))
`(if ,condition ,(pair begin body) nil))


(define-syntax (unless condition :rest body) (define-syntax (unless condition :rest body)
`(if ,condition nil ,(pair prog body)))
`(if ,condition nil ,(pair begin body)))


;; (define-syntax defun (name arguments :rest body) ;; (define-syntax defun (name arguments :rest body)
;; ;; (type-assert arguments :pair) ;; ;; (type-assert arguments :pair)
;; ;; `(define ,name (lambda ,arguments ,body)) ;; ;; `(define ,name (lambda ,arguments ,body))
;; ;; TODO(Felix: I think we do not need to wrap the body of the lamba ;; ;; TODO(Felix: I think we do not need to wrap the body of the lamba
;; ;; in a prog
;; ;; in a begin


;; ;; see if we have a docstring ;; ;; see if we have a docstring
;; (if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil))) ;; (if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
;; (list 'define name (list 'lambda arguments (first body) (pair 'prog (rest body))))
;; (list 'define name (list 'lambda arguments (pair 'prog body)))))
;; (list 'define name (list 'lambda arguments (first body) (pair 'begin (rest body))))
;; (list 'define name (list 'lambda arguments (pair 'begin body)))))




;; (define-syntax defspecial (name arguments :rest body) ;; (define-syntax defspecial (name arguments :rest body)
@@ -23,20 +23,20 @@


;; ;; see if we have a docstring ;; ;; see if we have a docstring
;; (if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil))) ;; (if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
;; (list 'define name (list 'special-lambda arguments (first body) (pair 'prog (rest body))))
;; (list 'define name (list 'special-lambda arguments (pair 'prog body)))))
;; (list 'define name (list 'special-lambda arguments (first body) (pair 'begin (rest body))))
;; (list 'define name (list 'special-lambda arguments (pair 'begin body)))))


;; (define (fib n)) ;; (define (fib n))
;; (define-syntax define (name :rest value) ;; (define-syntax define (name :rest value)
;; (print name) ;; (print name)
;; (print (type name)) ;; (print (type name))
;; (if (= (type name) :pair) ;; (if (= (type name) :pair)
;; (prog
;; (begin
;; ;; (print `(define ,(first name) ,`(pair lambda (pair (rest name) value)))) ;; ;; (print `(define ,(first name) ,`(pair lambda (pair (rest name) value))))
;; ;; (print rest) ;; ;; (print rest)
;; (print "\naa\n") ;; (print "\naa\n")
;; (list 'define (first name) (pair 'lambda (pair (rest name) value)))) ;; (list 'define (first name) (pair 'lambda (pair (rest name) value))))
;; (prog
;; (begin
;; ;; (print (pair 'define (pair name value))) ;; ;; (print (pair 'define (pair name value)))
;; (print "\nbb\n") ;; (print "\nbb\n")
;; (pair 'define (pair name value))))) ;; (pair 'define (pair name value)))))
@@ -47,12 +47,12 @@
(if (= nil clauses) (if (= nil clauses)
nil nil
(if (= (first (first clauses)) 'else) (if (= (first (first clauses)) 'else)
(prog
(begin
(if (not (= () (rest clauses))) (if (not (= () (rest clauses)))
(error "There are additional clauses after the else clause!") (error "There are additional clauses after the else clause!")
(pair 'prog (rest (first clauses)))))
(pair 'begin (rest (first clauses)))))
(list 'if (first (first clauses)) (list 'if (first (first clauses))
(pair 'prog (rest (first clauses)))
(pair 'begin (rest (first clauses)))
(rec (rest clauses)))))) (rec (rest clauses))))))
(rec clauses)) (rec clauses))


@@ -111,7 +111,7 @@ ithe sequence as arguemens."
"Extends a list with the given element, by putting it in "Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence." the (rest) of the last element of the sequence."
(if (pair? seq) (if (pair? seq)
(prog
(begin
(define e (end seq)) (define e (end seq))
(mutate e (pair (first e) elem)) (mutate e (pair (first e) elem))
seq) seq)
@@ -161,7 +161,7 @@ with (pair elem nil)."
;; (macro-define @op nil))) ;; (macro-define @op nil)))
;; (when @op ;; (when @op
;; (macro-define (eval @symbol) (eval @from)) ;; (macro-define (eval @symbol) (eval @from))
;; (eval (pair prog @for-body))
;; (eval (pair begin @for-body))
;; (eval (extend (list for @symbol (@op @from) @to) @for-body)))) ;; (eval (extend (list for @symbol (@op @from) @to) @for-body))))


(define (range :keys from :defaults-to 0 to) (define (range :keys from :defaults-to 0 to)
@@ -177,7 +177,7 @@ by the key 'from' and ends with the number defined in 'to'."
(define head result) (define head result)
(mutate from (increment from)) (mutate from (increment from))
(while (< from to) (while (< from to)
(prog
(begin
(mutate head (pair (first head) (pair (copy from) nil))) (mutate head (pair (first head) (pair (copy from) nil)))
(define head (rest head)) (define head (rest head))
(mutate from (increment from)))) (mutate from (increment from))))
@@ -233,8 +233,8 @@ separators between the arguments and what should be printed after the
las argument." las argument."
(define printf-quoted (special-lambda (:keys @sep @end :rest @args) (define printf-quoted (special-lambda (:keys @sep @end :rest @args)
(if (nil? @args) (if (nil? @args)
(prog (print (eval @end)) nil)
(prog
(begin (print (eval @end)) nil)
(begin
(print (first @args)) (print (first @args))
(unless (nil? (rest @args)) (unless (nil? (rest @args))
(print (eval @sep))) (print (eval @sep)))


+ 3
- 3
bin/pre.slime.expanded Просмотреть файл

@@ -24,7 +24,7 @@ ithe sequence as arguemens." (eval (pair fun seq)))
(define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq))) (define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq)))


(define (extend seq elem) "Extends a list with the given element, by putting it in (define (extend seq elem) "Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence." (if (pair? seq) (prog (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))
the (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))


(define (append seq elem) "Appends an element to a sequence, by extendeing the list (define (append seq elem) "Appends an element to a sequence, by extendeing the list
with (pair elem nil)." (extend seq (pair elem nil))) with (pair elem nil)." (extend seq (pair elem nil)))
@@ -39,7 +39,7 @@ with (pair elem nil)." (extend seq (pair elem nil)))
by the key 'from' and ends with the number defined in 'to'." (if (< from to) ([C-function] (pair from (range :from (+ 1.000000 from) :to to))) nil)) by the key 'from' and ends with the number defined in 'to'." (if (< from to) ([C-function] (pair from (range :from (+ 1.000000 from) :to to))) nil))


(define (range-while :keys from :defaults-to 0.000000 to) "Returns a sequence of numbers starting with the number defined (define (range-while :keys from :defaults-to 0.000000 to) "Returns a sequence of numbers starting with the number defined
by the key 'from' and ends with the number defined in 'to'." (define result (list (copy from))) (define head result) (mutate from (increment from)) (while (< from to) (prog (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (mutate from (increment from)))) result)
by the key 'from' and ends with the number defined in 'to'." (define result (list (copy from))) (define head result) (mutate from (increment from)) (while (< from to) (begin (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (mutate from (increment from)))) result)


(define (map fun seq) "Takes a function and a sequence as arguments and returns a new (define (map fun seq) "Takes a function and a sequence as arguments and returns a new
sequence which contains the results of using the first sequences sequence which contains the results of using the first sequences
@@ -67,5 +67,5 @@ added to a list, which in the end is returned." (if seq ([C-function] (if (fun (
" :rest args) "A wrapper for the built-in (print) that accepts a variable number " :rest args) "A wrapper for the built-in (print) that accepts a variable number
of arguments and also provides keywords for specifying the printed of arguments and also provides keywords for specifying the printed
separators between the arguments and what should be printed after the separators between the arguments and what should be printed after the
las argument." (define printf-quoted (special-lambda (:keys @sep @end :rest @args) (if (nil? @args) (prog (print (eval @end)) nil) (prog (print (first @args)) (if (nil? (rest @args)) nil ([C-function] (print (eval @sep)))) (eval (pair printf-quoted (extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))) (eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args))))
las argument." (define printf-quoted (special-lambda (:keys @sep @end :rest @args) (if (nil? @args) (begin (print (eval @end)) nil) (begin (print (first @args)) (if (nil? (rest @args)) nil ([C-function] (print (eval @sep)))) (eval (pair printf-quoted (extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))) (eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args))))



+ 17
- 0
manual/build.sh Просмотреть файл

@@ -0,0 +1,17 @@
echo ================================================
echo Starting Tex Export
echo ================================================

FILENAME=manual

emacsclient -c --frame-parameters="((visibility . nil))" \
-e "(progn (require 'org) (find-file-other-window \"$FILENAME.org\") (org-latex-export-to-latex) (save-buffers-kill-terminal))" || exit 1


echo ================================================
echo Tex Export Finished
echo ================================================


latexmk -Werror -pdf -shell-escape $FILENAME.tex || exit 1
latexmk -c $FILENAME.tex

+ 67
- 0
manual/manual.org Просмотреть файл

@@ -0,0 +1,67 @@
#+title: The Slime 1.0 Manual

{{{slime_header}}}
#+caption: Some text to illustrate
#+begin_src slime
(define (fib x)
(cond ((< x 1) 0)
((= x 1) 1)
(else (+ (fib (- x 1))
(fib (- x 2))))))

(print (if (> (fib 3) 1)
"Hello Felixses\n"
"Goodbye World\n"))

(fib 12)
#+end_src

#+RESULTS:
: => Hello Felixses
: 144.000000

{{{slime_header}}}
#+caption: Some text to illustrate
#+begin_src slime
;; Comment here
(print "String here")
(+ 1 2 3)
#+end_src

#+RESULTS:
: => String here6.000000

* meta :noexport:
# local variables:
# org-confirm-babel-evaluate: nil
# end:

#+author: Felix Brendel
#+mail: felix.brendel@airmail.cc
#+options: H:2

#+macro: slime_header (eval (concat "#+header: :exports both" "\n" "#+attr_latex: :options keywordstyle=\\color{slimeKeyword}, commentstyle=\\color{slimeComment}, stringstyle=\\color{slimeString}"))

#+latex_class:assign

#+latex_header: \usepackage[german]{babel}
#+latex_header: \definecolor{slimeKeyword}{HTML}{B58900}
#+latex_header: \definecolor{slimeString}{HTML}{2AA198}
#+latex_header: \definecolor{slimeComment}{HTML}{839496}


#+latex_header: \lstdefinelanguage{slime}
#+latex_header: {
#+latex_header: % list of keywords
#+latex_header: morekeywords={
#+latex_header: print,
#+latex_header: if,
#+latex_header: define,
#+latex_header: cond
#+latex_header: },
#+latex_header: basicstyle=\ttfamily\small,
#+latex_header: showstringspaces=false,
#+latex_header: sensitive=true, % keywords are not case-sensitive
#+latex_header: morecomment=[l]{;}, % l is for line comment
#+latex_header: morestring=[b]" % defines that strings are enclosed in double quotes
#+latex_header: }

Двоичные данные
Просмотреть файл


+ 195
- 0
manual/manual.tex Просмотреть файл

@@ -0,0 +1,195 @@
% Created 2019-05-15 Mi 01:07
% Intended LaTeX compiler: pdflatex
\documentclass{article}
\usepackage{amsmath,amsfonts,stmaryrd,amssymb}
\usepackage{enumerate}
\usepackage[ruled]{algorithm2e}
\usepackage[framemethod=tikz]{mdframed}
\usepackage{listings}
\usepackage{inconsolata}
\usepackage[footnote]{snotez}

\usepackage{geometry}

\geometry{
paper=a4paper,
top=40pt,
bottom=3cm,
left=30pt,
textwidth=417pt,
headheight=14pt,
marginparsep=20pt,
marginparwidth=100pt,
footskip=30pt,
headsep=0cm,
}


\usepackage[utf8]{inputenc}
\usepackage{sansmathfonts}
\usepackage[T1]{fontenc}
\renewcommand*\familydefault{\sfdefault}
\mdfdefinestyle{commandline}{
leftmargin=10pt,
rightmargin=10pt,
innerleftmargin=15pt,
middlelinecolor=black!50!white,
middlelinewidth=2pt,
frametitlerule=false,
backgroundcolor=black!5!white,
frametitle={Commandline},
frametitlefont={\normalfont\sffamily\color{white}\hspace{-1em}},
frametitlebackgroundcolor=black!50!white,
nobreak,
}


\newenvironment{commandline}{
\medskip
\begin{mdframed}[style=commandline]
}{
\end{mdframed}
\medskip
}


\mdfdefinestyle{question}{
innertopmargin=1.2\baselineskip,
innerbottommargin=0.8\baselineskip,
roundcorner=5pt,
nobreak,
singleextra={
\draw(P-|O)node[xshift=1em,anchor=west,fill=white,draw,rounded corners=5pt]{
Question \theQuestion\questionTitle};
},
}

\newcounter{Question}


\newenvironment{question}[1][\unskip]{
\bigskip
\stepcounter{Question}
\newcommand{\questionTitle}{~#1}
\begin{mdframed}[style=question]
}{
\end{mdframed}
\medskip
}



\mdfdefinestyle{warning}{
topline=false, bottomline=false,
leftline=false, rightline=false,
nobreak,
singleextra={
\draw(P-|O)++(-0.5em,0)node(tmp1){};
\draw(P-|O)++(0.5em,0)node(tmp2){};
\fill[black,rotate around={45:(P-|O)}](tmp1)rectangle(tmp2);
\node at(P-|O){\color{white}\scriptsize\bf !};
\draw[very thick](P-|O)++(0,-1em)--(O);
}
}


\newenvironment{warning}[1][Attention:]{
\medskip
\begin{mdframed}[style=warning]
\noindent{\textbf{#1}}
}{
\end{mdframed}
}



\mdfdefinestyle{info}{
topline=false, bottomline=false,
leftline=false, rightline=false,
nobreak,
singleextra={
\fill[black](P-|O)circle[radius=0.4em];
\node at(P-|O){\color{white}\scriptsize\bf i};
\draw[very thick](P-|O)++(0,-0.8em)--(O);
}
}

\newenvironment{info}[1][Info:]{
\medskip
\begin{mdframed}[style=info]
\noindent{\textbf{#1}}
}{
\end{mdframed}
}
\usepackage[utf8]{inputenc}
\usepackage[T1]{fontenc}
\usepackage{fixltx2e}
\usepackage{graphicx}
\usepackage{grffile}
\usepackage{longtable}
\usepackage{wrapfig}
\usepackage{rotating}
\usepackage[normalem]{ulem}
\usepackage{amsmath}
\usepackage{textcomp}
\usepackage{amssymb}
\usepackage{capt-of}
\usepackage[german, english]{babel}
\definecolor{slimeKeyword}{HTML}{B58900}
\definecolor{slimeString}{HTML}{2AA198}
\definecolor{slimeComment}{HTML}{839496}
\lstdefinelanguage{slime}
{
% list of keywords
morekeywords={
print,
if,
define,
cond
},
basicstyle=\ttfamily\small,
showstringspaces=false,
sensitive=true, % keywords are not case-sensitive
morecomment=[l]{;}, % l is for line comment
morestring=[b]" % defines that strings are enclosed in double quotes
}
\author{Felix Brendel}
\date{\today}
\title{The Slime 1.0 Manual}
\begin{document}

\maketitle
\tableofcontents

\lstset{language=slime,label= ,caption={Some text to illustrate},captionpos=t,numbers=none,keywordstyle=\color{slimeKeyword}, commentstyle=\color{slimeComment}, stringstyle=\color{slimeString}}
\begin{lstlisting}
(define (fib x)
(cond ((< x 1) 0)
((= x 1) 1)
(else (+ (fib (- x 1))
(fib (- x 2))))))

(print (if (> (fib 3) 1)
"Hello Felixses\n"
"Goodbye World\n"))

(fib 12)
\end{lstlisting}

\begin{verbatim}
=> Hello Felixses
144.000000
\end{verbatim}


\lstset{language=slime,label= ,caption={Some text to illustrate},captionpos=t,numbers=none,keywordstyle=\color{slimeKeyword}, commentstyle=\color{slimeComment}, stringstyle=\color{slimeString}}
\begin{lstlisting}
;; Comment here
(print "String here")
(+ 1 2 3)
\end{lstlisting}

\begin{verbatim}
=> String here6.000000
\end{verbatim}
\end{document}

+ 3
- 3
src/built_ins.cpp Просмотреть файл

@@ -113,9 +113,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
} }


// we are now in the function body, just wrap it in an // we are now in the function body, just wrap it in an
// implicit prog
// implicit begin
try ret->value.function.body = Memory::create_lisp_object_pair( try ret->value.function.body = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("prog"),
Memory::get_or_create_lisp_object_symbol("begin"),
arguments); arguments);




@@ -617,7 +617,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
}); });




defun("prog", cLambda {
defun("begin", cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);


if (evaluated_arguments == Memory::nil) if (evaluated_arguments == Memory::nil)


+ 50
- 12
src/eval.cpp Просмотреть файл

@@ -152,7 +152,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
} }


/* /*
(prog
(begin
(define type--before type) (define type--before type)
(define type (define type
(lambda (e) (lambda (e)
@@ -436,11 +436,23 @@ proc interprete_file (char* file_name) -> Lisp_Object* {
try user_env = Memory::create_child_environment(root_env); try user_env = Memory::create_child_environment(root_env);
Parser::environment_for_macros = user_env; Parser::environment_for_macros = user_env;


// char* file_content;
// try file_content = read_entire_file(file_name);
// save the current working directory
char cwd[1024];
getcwd(cwd, 1024);

// get the direction of the exe
char* exe_path = exe_dir();

// switch to the exe directory for loading pre.slime
chdir(exe_path);
free(exe_path);


built_in_import(Memory::create_string("pre.slime"), user_env); built_in_import(Memory::create_string("pre.slime"), user_env);



// switch back to the users directory
chdir(cwd);

Lisp_Object* result; Lisp_Object* result;
result = built_in_load(Memory::create_string(file_name), user_env); result = built_in_load(Memory::create_string(file_name), user_env);


@@ -450,10 +462,11 @@ proc interprete_file (char* file_name) -> Lisp_Object* {
return nullptr; return nullptr;
} }


print(result);
return result; return result;
} }


proc interprete_stdin() -> void {
proc interprete_stdin(bool is_emacs_repl = false) -> void {
Memory::init(4096 * 256, 1024, 4096 * 256); Memory::init(4096 * 256, 1024, 4096 * 256);
Environment* root_env = Globals::root_environment; Environment* root_env = Globals::root_environment;
Environment* user_env = Memory::create_child_environment(root_env); Environment* user_env = Memory::create_child_environment(root_env);
@@ -463,14 +476,29 @@ proc interprete_stdin() -> void {
return; return;
} }


// save the current working directory
char cwd[1024];
getcwd(cwd, 1024);

// get the direction of the exe
char* exe_path = exe_dir();

// switch to the exe directory for loading pre.slime
chdir(exe_path);
free(exe_path);

built_in_import(Memory::create_string("pre.slime"), user_env);


// switch back to the users directory
chdir(cwd);

Parser::environment_for_macros = user_env; Parser::environment_for_macros = user_env;


printf("Welcome to the lispy interpreter.\n"); printf("Welcome to the lispy interpreter.\n");


char* line; char* line;


built_in_import(Memory::create_string("pre.slime"), user_env);

if (Globals::error) { if (Globals::error) {
log_error(); log_error();
delete_error(); delete_error();
@@ -478,7 +506,7 @@ proc interprete_stdin() -> void {


Lisp_Object* parsed, * evaluated; Lisp_Object* parsed, * evaluated;
while (true) { while (true) {
printf(">");
printf("> ");
line = read_expression(); line = read_expression();
defer { defer {
free(line); free(line);
@@ -490,12 +518,22 @@ proc interprete_stdin() -> void {
continue; continue;
} }
evaluated = eval_expr(parsed, user_env); evaluated = eval_expr(parsed, user_env);
if (Globals::error) {
log_error();
delete_error();
continue;
if (is_emacs_repl) {
if (Globals::error) {
printf("((error \"%s\"))", &Globals::error->message->data);
} else {
printf("((result \"");
print(evaluated);
printf("\"))");
}
} else {
if (Globals::error) {
log_error();
delete_error();
continue;
}
print(evaluated);
} }
print(evaluated);
printf("\n"); printf("\n");
} }
} }

+ 3
- 0
src/forward_decls.cpp Просмотреть файл

@@ -25,6 +25,9 @@ namespace Memory {


namespace Parser { namespace Parser {
extern String* standard_in; extern String* standard_in;
extern String* parser_file;
extern int parser_line;
extern int parser_col;
} }


namespace Globals { namespace Globals {


+ 72
- 3
src/io.cpp Просмотреть файл

@@ -63,15 +63,22 @@ proc unescape_string(char* in) -> bool {
case 'x': case 'x':
case 'X': case 'X':
if (!isxdigit(p[1]) || !isxdigit(p[2])) { if (!isxdigit(p[1]) || !isxdigit(p[2])) {
int_err = "Invalid character on hexadecimal escape.";
create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. "
"(Invalid character on hexadecimal escape at char %d)",
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in);
} else { } else {
*out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2])); *out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2]));
p += 3; p += 3;
} }
break; break;
default: default:
int_err = "Unexpected '\\' with no escape sequence.";
break;
create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. "
"(Unexpected '\\' with no escape sequence at char %d)",
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in);
} }
} }
} }
@@ -309,3 +316,65 @@ proc log_error() -> void {
print_error_location(); print_error_location();
puts(console_normal); puts(console_normal);
} }

char* exe_dir() {
size_t size = 512, i, n;
char *path, *temp;

while (1) {
ssize_t used;

path = (char*)malloc(size);
if (!path) {
errno = ENOMEM;
return NULL;
}

used = readlink("/proc/self/exe", path, size);

if (used == -1) {
const int saved_errno = errno;
free(path);
errno = saved_errno;
return NULL;
} else
if (used < 1) {
free(path);
errno = EIO;
return NULL;
}

if ((size_t)used >= size) {
free(path);
size = (size | 2047) + 2049;
continue;
}

size = (size_t)used;
break;
}

/* Find final slash. */
n = 0;
for (i = 0; i < size; i++)
if (path[i] == '/')
n = i;

/* Optimize allocated size,
ensuring there is room for
a final slash and a
string-terminating '\0', */
temp = path;
path = (char*)realloc(temp, n + 2);
if (!path) {
free(temp);
errno = ENOMEM;
return NULL;
}

/* and properly trim and terminate the path string. */
path[n+0] = '/';
path[n+1] = '\0';

return path;
}

+ 3
- 0
src/main.cpp Просмотреть файл

@@ -1,9 +1,12 @@
#include "slime.h" #include "slime.h"


int main(int argc, char* argv[]) { int main(int argc, char* argv[]) {

if (argc > 1) { if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) { if (Slime::string_equal(argv[1], "--run-tests")) {
return Slime::run_all_tests() ? 0 : 1; return Slime::run_all_tests() ? 0 : 1;
} else if (Slime::string_equal(argv[1], "--run-as-emacs-repl")) {
Slime::interprete_stdin(true);
} }


Slime::interprete_file(argv[1]); Slime::interprete_file(argv[1]);


+ 14
- 10
src/parse.cpp Просмотреть файл

@@ -161,21 +161,25 @@ namespace Parser {


// okay so the first letter was not actually closing the string... // okay so the first letter was not actually closing the string...
int string_length = 0; int string_length = 0;
while (text[*index_in_text+string_length] != '"' ||
text[*index_in_text+string_length] == '\\')
bool escaping = false;
while (!(text[*index_in_text+string_length] == '"' && !escaping))
{ {
if (escaping)
escaping = false;
else
if (text[*index_in_text+string_length] == '\\')
escaping = true;

++string_length; ++string_length;
} }


// we found the end of the string // we found the end of the string
text[*index_in_text+string_length] = '\0'; text[*index_in_text+string_length] = '\0';


if (!unescape_string(text+(*index_in_text))) {
create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped.",
text+(*index_in_text), parser_file, parser_line, parser_col);
return nullptr;
}
// NOTE(Felix): Tactic: Through unescaping the string will
// only get shorter, so we replace it inplace and later jump
// to the original end of the string.
try unescape_string(text+(*index_in_text));


String* string = Memory::create_string("", string_length); String* string = Memory::create_string("", string_length);


@@ -415,9 +419,9 @@ namespace Parser {
} }


// we are now in the function body, just wrap it in an // we are now in the function body, just wrap it in an
// implicit prog
// implicit begin
try macro->value.function.body = Memory::create_lisp_object_pair( try macro->value.function.body = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("prog"),
Memory::get_or_create_lisp_object_symbol("begin"),
body); body);


// macro->value.function = function; // macro->value.function = function;


+ 2
- 0
src/slime.h Просмотреть файл

@@ -2,6 +2,8 @@


#define _CRT_SECURE_NO_WARNINGS #define _CRT_SECURE_NO_WARNINGS
#define _CRT_SECURE_NO_DEPRECATE #define _CRT_SECURE_NO_DEPRECATE
#include <stdlib.h>
#include <unistd.h>
#include <stdio.h> #include <stdio.h>
#include <time.h> #include <time.h>
#include <string.h> #include <string.h>


+ 1
- 1
src/structs.cpp Просмотреть файл

@@ -98,7 +98,7 @@ struct Function {
Keyword_Arguments* keyword_arguments; Keyword_Arguments* keyword_arguments;
// rest_argument will be nullptr if no rest argument is declared // rest_argument will be nullptr if no rest argument is declared
String* rest_argument; String* rest_argument;
Lisp_Object* body; // implicit prog
Lisp_Object* body; // implicit begin
Environment* parent_environment; // we are doing closures now!! Environment* parent_environment; // we are doing closures now!!
}; };




+ 11
- 4
src/testing.cpp Просмотреть файл

@@ -493,7 +493,7 @@ proc test_built_in_type() -> testresult {
try env = Memory::create_built_ins_environment(); try env = Memory::create_built_ins_environment();


// normal type testing // normal type testing
char exp_string1[] = "(prog (define a 10)(type a))";
char exp_string1[] = "(begin (define a 10)(type a))";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, env); Lisp_Object* result = eval_expr(expression, env);


@@ -503,7 +503,7 @@ proc test_built_in_type() -> testresult {
assert_equal_string(result->value.symbol.identifier, "number"); assert_equal_string(result->value.symbol.identifier, "number");


// setting user type // setting user type
char exp_string2[] = "(prog (set-type a :my-type)(type a))";
char exp_string2[] = "(begin (set-type a :my-type)(type a))";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, env); result = eval_expr(expression, env);


@@ -513,7 +513,7 @@ proc test_built_in_type() -> testresult {
assert_equal_string(result->value.symbol.identifier, "my-type"); assert_equal_string(result->value.symbol.identifier, "my-type");


// trying to set invalid user type // trying to set invalid user type
char exp_string3[] = "(prog (set-type a \"wrong tpye\")(type a))";
char exp_string3[] = "(begin (set-type a \"wrong tpye\")(type a))";
expression = Parser::parse_single_expression(exp_string3); expression = Parser::parse_single_expression(exp_string3);


without_logging { without_logging {
@@ -524,7 +524,7 @@ proc test_built_in_type() -> testresult {
delete_error(); delete_error();


// deleting user type // deleting user type
char exp_string4[] = "(prog (delete-type a)(type a))";
char exp_string4[] = "(begin (delete-type a)(type a))";
expression = Parser::parse_single_expression(exp_string4); expression = Parser::parse_single_expression(exp_string4);
result = eval_expr(expression, env); result = eval_expr(expression, env);


@@ -598,6 +598,13 @@ proc run_all_tests() -> bool {
Memory::init(4096 * 2000, 1024, 4096 * 16); Memory::init(4096 * 2000, 1024, 4096 * 16);
Parser::environment_for_macros = Globals::root_environment; Parser::environment_for_macros = Globals::root_environment;


// get the direction of the exe
char* exe_path = exe_dir();

// switch to the exe directory for loading pre.slime
chdir(exe_path);
free(exe_path);

bool result = true; bool result = true;


printf("-- Util --\n"); printf("-- Util --\n");


+ 15
- 0
src/visualization.cpp Просмотреть файл

@@ -1,4 +1,19 @@
proc visualize_lisp_machine() -> void { proc visualize_lisp_machine() -> void {

// save the current working directory
char cwd[1024];
getcwd(cwd, 1024);
// get the direction of the exe
char* exe_path = exe_dir();
// switch to the exe directory for loading pre.slime
chdir(exe_path);
free(exe_path);

defer {
// switch back to the users directory
chdir(cwd);
};

struct Drawn_Area { struct Drawn_Area {
int x; int x;
int y; int y;


+ 2
- 1
todo.org Просмотреть файл

@@ -1,6 +1,7 @@
* TODO rename slime to plisk * TODO rename slime to plisk
* TODO go through sicp and use the examples as test files * TODO go through sicp and use the examples as test files
* TODO test macro expanding to macro * TODO test macro expanding to macro
* TODO create global environment- and callstack
* TODO BUG 1: eval dot notation * TODO BUG 1: eval dot notation
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(eval `(+ . ,(list 1 2 3))) (eval `(+ . ,(list 1 2 3)))
@@ -10,7 +11,7 @@


* TODO BUG 2: eval dot notation * TODO BUG 2: eval dot notation
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
(prog
(begin
(define a (list 1 2 3)) (define a (list 1 2 3))
(eval `(+ . ,a))) (eval `(+ . ,a)))
;; should output 6 ;; should output 6


Загрузка…
Отмена
Сохранить