| @@ -1,20 +1,20 @@ | |||
| (define-syntax (when condition :rest body) | |||
| "Doc String for 'when'" | |||
| `(if ,condition ,(pair prog body) nil)) | |||
| `(if ,condition ,(pair begin body) nil)) | |||
| (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) | |||
| ;; ;; (type-assert arguments :pair) | |||
| ;; ;; `(define ,name (lambda ,arguments ,body)) | |||
| ;; ;; 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 | |||
| ;; (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) | |||
| @@ -23,20 +23,20 @@ | |||
| ;; ;; see if we have a docstring | |||
| ;; (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-syntax define (name :rest value) | |||
| ;; (print name) | |||
| ;; (print (type name)) | |||
| ;; (if (= (type name) :pair) | |||
| ;; (prog | |||
| ;; (begin | |||
| ;; ;; (print `(define ,(first name) ,`(pair lambda (pair (rest name) value)))) | |||
| ;; ;; (print rest) | |||
| ;; (print "\naa\n") | |||
| ;; (list 'define (first name) (pair 'lambda (pair (rest name) value)))) | |||
| ;; (prog | |||
| ;; (begin | |||
| ;; ;; (print (pair 'define (pair name value))) | |||
| ;; (print "\nbb\n") | |||
| ;; (pair 'define (pair name value))))) | |||
| @@ -47,12 +47,12 @@ | |||
| (if (= nil clauses) | |||
| nil | |||
| (if (= (first (first clauses)) 'else) | |||
| (prog | |||
| (begin | |||
| (if (not (= () (rest clauses))) | |||
| (error "There are additional clauses after the else clause!") | |||
| (pair 'prog (rest (first clauses))))) | |||
| (pair 'begin (rest (first clauses))))) | |||
| (list 'if (first (first clauses)) | |||
| (pair 'prog (rest (first clauses))) | |||
| (pair 'begin (rest (first clauses))) | |||
| (rec (rest clauses)))))) | |||
| (rec clauses)) | |||
| @@ -111,7 +111,7 @@ ithe sequence as arguemens." | |||
| "Extends a list with the given element, by putting it in | |||
| the (rest) of the last element of the sequence." | |||
| (if (pair? seq) | |||
| (prog | |||
| (begin | |||
| (define e (end seq)) | |||
| (mutate e (pair (first e) elem)) | |||
| seq) | |||
| @@ -161,7 +161,7 @@ with (pair elem nil)." | |||
| ;; (macro-define @op nil))) | |||
| ;; (when @op | |||
| ;; (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)))) | |||
| (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) | |||
| (mutate from (increment from)) | |||
| (while (< from to) | |||
| (prog | |||
| (begin | |||
| (mutate head (pair (first head) (pair (copy from) nil))) | |||
| (define head (rest head)) | |||
| (mutate from (increment from)))) | |||
| @@ -233,8 +233,8 @@ 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 | |||
| (begin (print (eval @end)) nil) | |||
| (begin | |||
| (print (first @args)) | |||
| (unless (nil? (rest @args)) | |||
| (print (eval @sep))) | |||
| @@ -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 (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 | |||
| 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)) | |||
| (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 | |||
| 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 | |||
| of arguments and also provides keywords for specifying the printed | |||
| 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)))) | |||
| @@ -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 | |||
| @@ -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: } | |||
| @@ -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} | |||
| @@ -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 | |||
| // implicit prog | |||
| // implicit begin | |||
| 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); | |||
| @@ -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); | |||
| if (evaluated_arguments == Memory::nil) | |||
| @@ -152,7 +152,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||
| } | |||
| /* | |||
| (prog | |||
| (begin | |||
| (define type--before type) | |||
| (define type | |||
| (lambda (e) | |||
| @@ -436,11 +436,23 @@ proc interprete_file (char* file_name) -> Lisp_Object* { | |||
| try user_env = Memory::create_child_environment(root_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); | |||
| // switch back to the users directory | |||
| chdir(cwd); | |||
| Lisp_Object* result; | |||
| 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; | |||
| } | |||
| print(result); | |||
| return result; | |||
| } | |||
| proc interprete_stdin() -> void { | |||
| proc interprete_stdin(bool is_emacs_repl = false) -> void { | |||
| Memory::init(4096 * 256, 1024, 4096 * 256); | |||
| Environment* root_env = Globals::root_environment; | |||
| Environment* user_env = Memory::create_child_environment(root_env); | |||
| @@ -463,14 +476,29 @@ proc interprete_stdin() -> void { | |||
| 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; | |||
| printf("Welcome to the lispy interpreter.\n"); | |||
| char* line; | |||
| built_in_import(Memory::create_string("pre.slime"), user_env); | |||
| if (Globals::error) { | |||
| log_error(); | |||
| delete_error(); | |||
| @@ -478,7 +506,7 @@ proc interprete_stdin() -> void { | |||
| Lisp_Object* parsed, * evaluated; | |||
| while (true) { | |||
| printf(">"); | |||
| printf("> "); | |||
| line = read_expression(); | |||
| defer { | |||
| free(line); | |||
| @@ -490,12 +518,22 @@ proc interprete_stdin() -> void { | |||
| continue; | |||
| } | |||
| 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"); | |||
| } | |||
| } | |||
| @@ -25,6 +25,9 @@ namespace Memory { | |||
| namespace Parser { | |||
| extern String* standard_in; | |||
| extern String* parser_file; | |||
| extern int parser_line; | |||
| extern int parser_col; | |||
| } | |||
| namespace Globals { | |||
| @@ -63,15 +63,22 @@ proc unescape_string(char* in) -> bool { | |||
| case 'x': | |||
| case 'X': | |||
| 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 { | |||
| *out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2])); | |||
| p += 3; | |||
| } | |||
| break; | |||
| 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(); | |||
| 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; | |||
| } | |||
| @@ -1,9 +1,12 @@ | |||
| #include "slime.h" | |||
| int main(int argc, char* argv[]) { | |||
| if (argc > 1) { | |||
| if (Slime::string_equal(argv[1], "--run-tests")) { | |||
| 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]); | |||
| @@ -161,21 +161,25 @@ namespace Parser { | |||
| // okay so the first letter was not actually closing the string... | |||
| 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; | |||
| } | |||
| // we found the end of the string | |||
| 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); | |||
| @@ -415,9 +419,9 @@ namespace Parser { | |||
| } | |||
| // 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( | |||
| Memory::get_or_create_lisp_object_symbol("prog"), | |||
| Memory::get_or_create_lisp_object_symbol("begin"), | |||
| body); | |||
| // macro->value.function = function; | |||
| @@ -2,6 +2,8 @@ | |||
| #define _CRT_SECURE_NO_WARNINGS | |||
| #define _CRT_SECURE_NO_DEPRECATE | |||
| #include <stdlib.h> | |||
| #include <unistd.h> | |||
| #include <stdio.h> | |||
| #include <time.h> | |||
| #include <string.h> | |||
| @@ -98,7 +98,7 @@ struct Function { | |||
| Keyword_Arguments* keyword_arguments; | |||
| // rest_argument will be nullptr if no rest argument is declared | |||
| String* rest_argument; | |||
| Lisp_Object* body; // implicit prog | |||
| Lisp_Object* body; // implicit begin | |||
| Environment* parent_environment; // we are doing closures now!! | |||
| }; | |||
| @@ -493,7 +493,7 @@ proc test_built_in_type() -> testresult { | |||
| try env = Memory::create_built_ins_environment(); | |||
| // 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* result = eval_expr(expression, env); | |||
| @@ -503,7 +503,7 @@ proc test_built_in_type() -> testresult { | |||
| assert_equal_string(result->value.symbol.identifier, "number"); | |||
| // 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); | |||
| result = eval_expr(expression, env); | |||
| @@ -513,7 +513,7 @@ proc test_built_in_type() -> testresult { | |||
| assert_equal_string(result->value.symbol.identifier, "my-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); | |||
| without_logging { | |||
| @@ -524,7 +524,7 @@ proc test_built_in_type() -> testresult { | |||
| delete_error(); | |||
| // 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); | |||
| result = eval_expr(expression, env); | |||
| @@ -598,6 +598,13 @@ proc run_all_tests() -> bool { | |||
| Memory::init(4096 * 2000, 1024, 4096 * 16); | |||
| 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; | |||
| printf("-- Util --\n"); | |||
| @@ -1,4 +1,19 @@ | |||
| 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 { | |||
| int x; | |||
| int y; | |||
| @@ -1,6 +1,7 @@ | |||
| * TODO rename slime to plisk | |||
| * TODO go through sicp and use the examples as test files | |||
| * TODO test macro expanding to macro | |||
| * TODO create global environment- and callstack | |||
| * TODO BUG 1: eval dot notation | |||
| #+BEGIN_SRC lisp | |||
| (eval `(+ . ,(list 1 2 3))) | |||
| @@ -10,7 +11,7 @@ | |||
| * TODO BUG 2: eval dot notation | |||
| #+BEGIN_SRC lisp | |||
| (prog | |||
| (begin | |||
| (define a (list 1 2 3)) | |||
| (eval `(+ . ,a))) | |||
| ;; should output 6 | |||