├── .gitignore ├── LICENSE ├── Makefile.in ├── README.md ├── autogen.sh ├── configure.ac ├── examples ├── maze.jl ├── perf.jl ├── sort.jl └── test.jl ├── jl.h ├── jl.map └── src ├── jl-context.c ├── jl-context.h ├── jl-func.c ├── jl-func.h ├── jl-scope.c ├── jl-scope.h ├── jl-value.c ├── jl-value.h ├── jl.c └── jli.c /.gitignore: -------------------------------------------------------------------------------- 1 | jli 2 | libjl.a 3 | libjl.so 4 | src/*.o 5 | Makefile 6 | autom4te.cache 7 | config.h 8 | config.h.in 9 | config.h.in~ 10 | config.log 11 | config.rpath 12 | config.status 13 | configure 14 | install-sh 15 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Copyright (c) Joe Wingbermuehle 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | - Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | 11 | - Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /Makefile.in: -------------------------------------------------------------------------------- 1 | 2 | CC = @CC@ 3 | CFLAGS = @CFLAGS@ 4 | CPPFLAGS = @CPPFLAGS@ 5 | LDFLAGS = @LDFLAGS@ 6 | BINDIR = $(DESTDIR)@BINDIR@ 7 | LIBDIR = $(DESTDIR)@LIBDIR@ 8 | 9 | JLOBJS = \ 10 | src/jl.o src/jl-context.o src/jl-func.o src/jl-scope.o src/jl-value.o 11 | 12 | REPLOBJS = src/jli.o libjl.a 13 | 14 | .SUFFIXES: .o .h .c 15 | 16 | all: jli libjl.a libjl.so 17 | 18 | install: all 19 | install -d $(BINDIR) 20 | install -d $(LIBDIR) 21 | install jli $(BINDIR)/jl 22 | install libjl.a $(LIBDIR)/libjl.a 23 | install libjl.so $(LIBDIR)/libjl.so 24 | 25 | install-strip: install 26 | strip $(BINDIR)/jli 27 | 28 | jli: $(REPLOBJS) 29 | $(CC) $(LDFLAGS) $(REPLOBJS) -o jli 30 | 31 | libjl.so: $(JLOBJS) 32 | $(CC) $(LDFLAGS) -shared $(JLOBJS) -o libjl.so 33 | 34 | libjl.a: $(JLOBJS) 35 | ar r libjl.a $(JLOBJS) 36 | 37 | .c.o: $*.c *.h 38 | $(CC) $(CFLAGS) -c $*.c -o $*.o 39 | 40 | clean: 41 | rm -f jli libjl.a libjl.so src/*.o 42 | 43 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | JL 3 | ============================================================================== 4 | This is a small, embeddable LISP-like language. The intended use is for 5 | configuration files where it is desirable to be able to have complex 6 | configurations (JWM, for example). 7 | 8 | This is still a work in progress: there are still more functions to 9 | be implemented and the functionality of existing functions may change. 10 | 11 | Syntax 12 | ------------------------------------------------------------------------------ 13 | Like other LISP languages, JL uses s-expressions. For example: 14 | 15 | (list 1 2 3) 16 | 17 | calls the "list" function, passing 1, 2, and 3 as arguments. 18 | 19 | Data Types 20 | ------------------------------------------------------------------------------ 21 | There are 6 data types: 22 | 23 | 1. Numbers (floating point numbers) 24 | 2. Strings 25 | 3. Variables 26 | 4. Lambdas (functions defined within the language) 27 | 5. Lists 28 | 6. Special functions 29 | 30 | For comparisons, 0 and nil (the empty list) are considered false and all 31 | other values are considered true. 32 | 33 | Functions 34 | ------------------------------------------------------------------------------ 35 | The following built-in functions are available: 36 | 37 | - < Test if less than 38 | - > Test if greater than 39 | - <= Test if less than or equal to 40 | - >= Test if greater than or equal to 41 | - = Test if equal 42 | - != Test if not equal 43 | - + Return the sum of a list 44 | - - Subtract 45 | - * Return the produce of a list 46 | - / Divide 47 | - % Modulus 48 | - and Logical AND. 49 | - concat Concatenate strings. 50 | - cons Prepend an item to a list. 51 | - begin Execute a sequence of functions, return the value of the last. 52 | - define Insert a binding into the current namespace. 53 | - head Return the first element of a list 54 | - if Test a condition and evaluate and return the second argument 55 | if true, otherwise evaluate and return the third argument. 56 | - lambda Declare a function. 57 | - list Create a list 58 | - list? Determine if a value is a list. 59 | - not Logical NOT. 60 | - null? Determine if a value is nil. 61 | - number? Determine if a value is a number. 62 | - or Logical OR. 63 | - rest Return all but the first element of a list 64 | - string? Determine if a value is a string. 65 | - substr Return a substring of a string. 66 | 67 | Examples 68 | ------------------------------------------------------------------------------ 69 | Here are some example programs. See the "examples" directory for more. 70 | 71 | Return the factorial of a number: 72 | 
 73 |    (define fact (lambda (n)
 74 |       (if n
 75 |          (\* (fact (- n 1)) n)
 76 |          1)))
 77 |    (fact 5)
 78 |
79 | 80 | Find the nth item of a list: 81 | 
 82 |    (define nth (lambda (n lst)
 83 |       (if (<= n 1)
 84 |          (head lst)
 85 |          (nth (- n 1) (rest lst)))))
 86 |    (nth 2 (list 1 2 3))
 87 |
88 | 89 | Find nth Fibonacci number: 90 | 
 91 |    (define fib (lambda (n)
 92 |       (if (> n 1)
 93 |          (+ (fib (- n 1)) (fib (- n 2)))
 94 |          1)))
 95 |    (fib 10)
 96 |
97 | 98 | The map function: 99 | 
100 |    (define map (lambda (f lst)
101 |       (if lst
102 |          (cons (f (head lst)) (map f (rest lst)))
103 |          (list))))
104 |    (map (lambda (x) (+ x 1)) (list 1 2 3 4))
105 |
106 | 107 | The foldl function: 108 | 
109 |    (define foldl (lambda (f i lst)
110 |       (if lst
111 |          (foldl f (f i (head lst)) (rest lst))
112 |          i)))
113 |    (foldl (lambda (a b) (+ a b)) 0 (list 1 2 3 4))
114 |
115 | 116 | The reverse function implemented in terms of foldl: 117 | 
118 |    (define reverse (lambda (lst) (foldl (lambda (a b) (cons b a)) (list) lst)))
119 |    (reverse (list 1 2 3 4))
120 |
121 | 122 | License 123 | ------------------------------------------------------------------------------ 124 | JL uses the BSD 2-clause license. See LICENSE for more information. 125 | 126 | -------------------------------------------------------------------------------- /autogen.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | automake -a 3 | autoreconf --install --force 4 | touch config.rpath 5 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | AC_INIT(jl, 0.0.1, joewing@ojewing.net) 2 | AC_PREREQ(2.57) 3 | AC_CONFIG_SRCDIR([src]) 4 | AC_CONFIG_HEADER([config.h]) 5 | AC_LANG(C) 6 | 7 | AC_PROG_CC 8 | AC_PROG_CPP 9 | AC_PROG_INSTALL 10 | 11 | CFLAGS="$CFLAGS -I. -fpic -fvisibility=hidden" 12 | 13 | AC_ARG_ENABLE(debug, 14 | AC_HELP_STRING([--enable-debug], [create a debug build]) ) 15 | if test "$enable_debug" = "yes"; then 16 | CFLAGS="$CFLAGS -g -Wall -Werror" 17 | LDFLAGS="$LDFLAGS -g" 18 | else 19 | enable_debug="no" 20 | fi 21 | 22 | PACKAGE=jl 23 | 24 | AC_SUBST(CFLAGS) 25 | AC_SUBST(LDFLAGS) 26 | AC_SUBST(VERSION, "$PACKAGE_VERSION") 27 | AC_SUBST(INSTVERSION, `echo $PACKAGE_VERSION | tr -d .`) 28 | AC_SUBST(BINDIR, "$BINDIR") 29 | AC_SUBST(MANDIR, "$MANDIR") 30 | AC_SUBST(DATADIR, "$DATADIR") 31 | AC_SUBST(DATE, `date -u -d "@${SOURCE_DATE_EPOCH:-$(date +%s)}" +%Y-%m-%d`) 32 | AC_SUBST(SYSCONF, "$SYSCONF") 33 | AC_SUBST(PACKAGE, "$PACKAGE") 34 | 35 | 36 | AC_OUTPUT( 37 | Makefile 38 | ) 39 | -------------------------------------------------------------------------------- /examples/maze.jl: -------------------------------------------------------------------------------- 1 | ; Maze generate in JL 2 | ; Joe Wingbermuehle 3 | 4 | (define width 39) ; Width of the maze (must be odd) 5 | (define height 23) ; Height of the maze (must be odd) 6 | (define seed 17) ; Random number seed. 7 | 8 | ; Generate a random number. 9 | (define get-rand (lambda (s) (mod (+ (* 19 s) 1) 16383))) 10 | 11 | ; Set an element in a list. 12 | (define set-element (lambda (lst n v) 13 | (if n 14 | (cons (head lst) (set-element (rest lst) (- n 1) v)) 15 | (cons v (rest lst))))) 16 | 17 | ; Get a particular list element. 18 | (define get-element (lambda (lst n) 19 | (if n 20 | (get-element (rest lst) (- n 1)) 21 | (head lst)))) 22 | 23 | ; Initialize the maze matrix. 24 | (define init-maze (lambda (x y) 25 | (if (= y 1) 26 | (if (= x 1) (list 0) (cons 0 (init-maze (- x 1) y))) 27 | (if (= y height) 28 | (if (= x 1) 29 | (cons 0 (init-maze width (- y 1))) 30 | (cons 0 (init-maze (- x 1) y))) 31 | (if (= x 1) 32 | (cons 0 (init-maze width (- y 1))) 33 | (if (= x width) 34 | (cons 0 (init-maze (- x 1) y)) 35 | (cons 1 (init-maze (- x 1) y)))))))) 36 | 37 | (define update-x (lambda (x d) (+ x (get-element (list 1 -1 0 0) (mod d 4))))) 38 | 39 | (define update-y (lambda (y d) (+ y (get-element (list 0 0 1 -1) (mod d 4))))) 40 | 41 | ; Carve a maze. 42 | (define carve-maze (lambda (maze rand x y c) 43 | (define maze (set-element maze (+ (* y width) x) 0)) 44 | (define x1 (update-x x rand)) 45 | (define y1 (update-y y rand)) 46 | (define x2 (update-x x1 rand)) 47 | (define y2 (update-y y1 rand)) 48 | (if (and (> x2 0) (< x2 width) (> y2 0) (< y2 height) 49 | (get-element maze (+ (* y1 width) x1)) 50 | (get-element maze (+ (* y2 width) x2))) 51 | (begin 52 | (define maze (set-element maze (+ (* y1 width) x1) 0)) 53 | (define maze (carve-maze maze (get-rand rand) x2 y2 0)) 54 | (if (< c 4) (carve-maze maze (+ rand 1) x y (+ c 1)) maze)) 55 | (if (< c 4) (carve-maze maze (+ rand 1) x y (+ c 1)) maze)))) 56 | 57 | ; Initialize and carve a maze. 58 | (define generate-maze (lambda () 59 | (define init (init-maze width height)) 60 | (define carved (carve-maze init seed 2 2 0)) 61 | (define temp (set-element carved (+ (* 1 width) 2) 0)) 62 | (set-element temp (+ (* (- height 2) width) (- width 3)) 0))) 63 | 64 | ; Show a maze. 65 | (define show-maze (lambda (maze x y) 66 | (define element (get-element maze (+ (* y width) x))) 67 | (if (= element 1) (print "[]") (print " ")) 68 | (if (= (+ x 1) width) 69 | (begin 70 | (print "\n") 71 | (if (< (+ y 1) height) (show-maze maze 0 (+ y 1)))) 72 | (show-maze maze (+ x 1) y)))) 73 | 74 | (show-maze (generate-maze) 0 0) 75 | 76 | -------------------------------------------------------------------------------- /examples/perf.jl: -------------------------------------------------------------------------------- 1 | ;; Performance test for JL 2 | 3 | (define perf1 (lambda (n) (if n (+ n (perf1 (- n 1))) 0))) 4 | (define perf (lambda (n) (if n (+ (perf1 n) (perf (- n 1))) 0))) 5 | 6 | (perf 2048) 7 | 8 | -------------------------------------------------------------------------------- /examples/sort.jl: -------------------------------------------------------------------------------- 1 | ;; QuickSort in JL. 2 | 3 | (define filter (lambda (f lst) 4 | (if lst 5 | (if (f (head lst)) 6 | (cons (head lst) (filter f (rest lst))) 7 | (filter f (rest lst))) 8 | nil))) 9 | 10 | (define combine (lambda (as bs) 11 | (if as 12 | (cons (head as) (combine (rest as) bs)) 13 | bs))) 14 | 15 | (define qsort (lambda (lst) 16 | (if lst 17 | (begin 18 | (define pivot (head lst)) 19 | (define less (filter (lambda (a) (< a pivot)) (rest lst))) 20 | (define greater (filter (lambda (a) (>= a pivot)) (rest lst))) 21 | (combine (qsort less) (cons pivot (qsort greater)))) 22 | nil))) 23 | 24 | (print (qsort (list 7 3 2 6 9 1 8 4 5)) "\n") 25 | 26 | -------------------------------------------------------------------------------- /examples/test.jl: -------------------------------------------------------------------------------- 1 | ;;; Test suite for JL 2 | 3 | ; Assert that an expression is true. Prints a dot if true, or FAIL if false. 4 | (define assert (lambda (tst) (if tst (print ".") (print "\nFAIL\n")))) 5 | 6 | (define fib (lambda (n) 7 | (if (> n 1) ; Comment in the middle of a line 8 | (+ (fib (- n 1)) (fib (- n 2))) 9 | 1))) 10 | 11 | (assert (= (fib 4) 5)) 12 | (assert (= (fib 0) 1)) 13 | 14 | (define fact (lambda (n) 15 | (if (> n 0) (* (fact (- n 1)) n) 1))) 16 | 17 | (assert (= (fact 5) 120)) 18 | 19 | (define length (lambda (lst) 20 | (if (null? lst) 0 (+ 1 (length (rest lst)))))) 21 | 22 | (assert (= (length (list 1 2 3 4)) 4)) 23 | (assert (= (length (list)) 0)) 24 | 25 | (define nth (lambda (n lst) 26 | (if (<= n 1) (head lst) 27 | (nth (- n 1) (rest lst))))) 28 | 29 | (assert (= (nth 2 (list 5 4 3 2 1)) 4)) 30 | (assert (= (nth 1 (list 5 4 3 2 1)) 5)) 31 | 32 | (define map (lambda (f lst) 33 | (if (null? lst) nil (cons (f (head lst)) (map f (rest lst)))))) 34 | 35 | (define foldl (lambda (f i lst) 36 | (if lst (foldl f (f i (head lst)) (rest lst)) i))) 37 | 38 | (assert (= (foldl (lambda (a b) (+ a b)) 1 (list 2 3 4)) 10)) 39 | 40 | (assert (= (foldl (lambda (a b) (+ a b)) 0 41 | (map (lambda (x) (+ x 1)) (list 0 1 2 3))) 10)) 42 | 43 | (define reverse (lambda (lst) (foldl (lambda (a b) (cons b a)) (list) lst))) 44 | 45 | (define make-increment (lambda (i) (lambda (x) (+ x i)))) 46 | (define add-five (make-increment 5)) 47 | (assert (= (add-five 2) 7)) 48 | 49 | (define add (lambda (x y) (+ x y))) 50 | (define do-define (lambda (x) 51 | (define add (lambda (y) (- x y))) 52 | (add 1))) 53 | (assert (= (do-define 3) 2)) 54 | (assert (= (add 1 2) 3)) 55 | 56 | (define x 1) 57 | (define x 2) 58 | (assert (= x 2)) 59 | 60 | (assert (= (begin 1 2) 2)) 61 | 62 | (define y 1) 63 | (assert (= y 1)) 64 | (begin 65 | (assert (= y 1)) 66 | (define y 2) 67 | (assert (= y 2))) 68 | (assert (= y 1)) 69 | 70 | (assert (not (and 0 (assert 0)))) 71 | (assert (= 1 (or 1))) 72 | (assert (= 1 (not 0))) 73 | 74 | (define strlen (lambda (str) 75 | (define helper (lambda (i) (if (substr str i 1) (helper (+ i 1)) i))) 76 | (helper 0))) 77 | 78 | (assert (= (strlen "asdf") 4)) 79 | 80 | (assert (= 1 (number? 5))) 81 | (assert (= nil (number? nil))) 82 | (assert (= nil (number? "test"))) 83 | (assert (= nil (number? (list 1 2 3)))) 84 | (assert (= 1 (number? (head (list 1 2 3))))) 85 | 86 | (assert (= 1 (string? "asfd"))) 87 | (assert (= nil (string? nil))) 88 | (assert (= nil (string? 5))) 89 | (assert (= nil (string? (list 1 2 3)))) 90 | (assert (= 1 (string? (head (list "asdf" 2 3))))) 91 | 92 | (assert (= 1 (list? (list 1 2)))) 93 | (assert (= nil (list? nil))) 94 | (assert (= nil (list? 5))) 95 | (assert (= nil (list? "test"))) 96 | (assert (= 1 (list? (head (list (list 1 2) 2 3))))) 97 | 98 | (assert (< "a" "b")) 99 | (assert (= "asdf" "asdf")) 100 | (assert (<= "a" "b")) 101 | (assert (<= "a" "a")) 102 | (assert (!= "ab" "ac")) 103 | (assert (> "b" "a")) 104 | (assert (>= "b" "a")) 105 | (assert (>= "a" "a")) 106 | 107 | (assert (= ((lambda (a b) (+ a b 1)) 2 3) 6)) 108 | 109 | ; Test concat and whitespace before closing ')'. 110 | (define repeat 111 | (lambda (str i) 112 | (if (= i 1) 113 | str 114 | (if (> i 0) 115 | (concat (repeat str (- i 1)) "," str) 116 | "" 117 | ) 118 | ) 119 | ) 120 | ) 121 | (assert (= "0123456789,0123456789,0123456789" (repeat "0123456789" 3))) 122 | 123 | (print "\ndone\n") 124 | 125 | -------------------------------------------------------------------------------- /jl.h: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl.h 3 | * @author Joe Wingbermuehle 4 | * 5 | * Public interface to the JL interpreter. 6 | * 7 | */ 8 | 9 | #ifndef JL_H 10 | #define JL_H 11 | 12 | #ifdef __cplusplus 13 | extern "C" { 14 | #endif 15 | 16 | #define JL_VERSION_MAJOR 0 17 | #define JL_VERSION_MINOR 1 18 | 19 | #if defined _WIN32 || defined __CYGWIN__ 20 | # define JLEXPORT __declspec(dllexport) 21 | #else 22 | # define JLEXPORT __attribute__((visibility("default"))) 23 | #endif 24 | 25 | struct JLValue; 26 | struct JLContext; 27 | 28 | /** The type of special functions. 29 | * @param context The JL context. 30 | * @param args A list of arguments to the function, including its name. 31 | * @param extra Extra parameter from JLDefineSpecial. 32 | * @return The result, which should be retained (it will be freed if 33 | * not needed). 34 | */ 35 | typedef struct JLValue *(*JLFunction)(struct JLContext *context, 36 | struct JLValue *args, 37 | void *extra); 38 | 39 | /** Create a context for running JL programs. 40 | * @return The context. 41 | */ 42 | JLEXPORT 43 | struct JLContext *JLCreateContext(); 44 | 45 | /** Destroy a JL context. 46 | * @param context The context to be destroyed. 47 | */ 48 | JLEXPORT 49 | void JLDestroyContext(struct JLContext *context); 50 | 51 | /** Create and enter a new lexical scope. */ 52 | JLEXPORT 53 | void JLEnterScope(struct JLContext *context); 54 | 55 | /** Leave and destroy the current lexical scope. */ 56 | JLEXPORT 57 | void JLLeaveScope(struct JLContext *context); 58 | 59 | /** Increase the reference count of a value. 60 | * @param context The context containing the value. 61 | * @param value The value (can be NULL). 62 | */ 63 | JLEXPORT 64 | void JLRetain(struct JLContext *context, struct JLValue *value); 65 | 66 | /** Decrease the reference count of a value. 67 | * This will destroy the value if the reference count reaches zero. 68 | * @param context The context. 69 | * @param value The value to be released (can be NULL). 70 | */ 71 | JLEXPORT 72 | void JLRelease(struct JLContext *context, struct JLValue *value); 73 | 74 | /** Define a value. 75 | * This will add a binding to the current scope. 76 | * @param context The context in which to define the value. 77 | * @param name The name of the binding. 78 | * @param value The value to insert. 79 | */ 80 | JLEXPORT 81 | void JLDefineValue(struct JLContext *context, 82 | const char *name, 83 | struct JLValue *value); 84 | 85 | /** Define a special function. 86 | * A special function is simply a function that is implemented outside 87 | * of the JL environment. 88 | * This will add the special function to the current scope. 89 | * @param context The context in which to define the function. 90 | * @param name The name of the function. 91 | * @param func The function code. 92 | * @param extra Extra parameter to pass to func. 93 | */ 94 | JLEXPORT 95 | void JLDefineSpecial(struct JLContext *context, 96 | const char *name, 97 | JLFunction func, 98 | void *extra); 99 | 100 | /** Define a number. 101 | * This will add a number to the current scope. 102 | * @param context The context in which to define the number. 103 | * @param name The name of the binding (NULL for no name). 104 | * @param value The value to define. 105 | * @return The value. This value must be released if not used. 106 | */ 107 | JLEXPORT 108 | struct JLValue *JLDefineNumber(struct JLContext *context, 109 | const char *name, 110 | double value); 111 | 112 | /** Parse an expression. 113 | * Note that only a single expression is parsed. 114 | * @param context The context. 115 | * @param line The expression to be parsed. 116 | * @return The expression. This value must be released if not used. 117 | */ 118 | JLEXPORT 119 | struct JLValue *JLParse(struct JLContext *context, const char **line); 120 | 121 | /** Evaluate an expression. 122 | * @param context The context. 123 | * @param value The expression to evaluate. 124 | * @return The result. This value must be released if not used. 125 | */ 126 | JLEXPORT 127 | struct JLValue *JLEvaluate(struct JLContext *context, struct JLValue *value); 128 | 129 | /** Determine if a value is a number. 130 | * @param value The value to check (NULL is allowed). 131 | * @return 1 if a number, 0 otherwise. 132 | */ 133 | JLEXPORT 134 | char JLIsNumber(struct JLValue *value); 135 | 136 | /** Get the number representation of a value. 137 | * @param value The value (must be a non-NULL number value). 138 | * @return The numeric value. 139 | */ 140 | JLEXPORT 141 | double JLGetNumber(struct JLValue *value); 142 | 143 | /** Determine if a value is a string. 144 | * @param value The value to check (NULL is allowed). 145 | * @return 1 if a string, 0 otherwise. 146 | */ 147 | JLEXPORT 148 | char JLIsString(struct JLValue *value); 149 | 150 | /** Get the string representation of a value. 151 | * @param value The value (must be a non-NULL string value). 152 | * @return A NULL-terminated string. 153 | */ 154 | JLEXPORT 155 | const char *JLGetString(struct JLValue *value); 156 | 157 | /** Determine if a value is a list. 158 | * @param value The value to check. 159 | * @return 1 if a list, 0 otherwise. 160 | */ 161 | JLEXPORT 162 | char JLIsList(struct JLValue *value); 163 | 164 | /** Get the first item of a list. 165 | * @param value The list (must be a non-NULL list value). 166 | * @return The first item in the list (possibly NULL). 167 | */ 168 | JLEXPORT 169 | struct JLValue *JLGetHead(struct JLValue *value); 170 | 171 | /** Get the next item in a list. 172 | * @param value The previous value in the list (must be non-NULL). 173 | * @return The next item in the list (possibly NULL). 174 | */ 175 | JLEXPORT 176 | struct JLValue *JLGetNext(struct JLValue *value); 177 | 178 | /** Display a value. 179 | * @param context The context. 180 | * @param value The value to display. 181 | */ 182 | JLEXPORT 183 | void JLPrint(const struct JLContext *context, const struct JLValue *value); 184 | 185 | #ifdef __cplusplus 186 | } /* extern "C" */ 187 | #endif 188 | 189 | #endif /* JL_H */ 190 | -------------------------------------------------------------------------------- /jl.map: -------------------------------------------------------------------------------- 1 | 2 | JL_1.0 { 3 | global: JLCreateContext; 4 | JLDestroyContext; 5 | JLEnterScope; 6 | JLLeaveScope; 7 | JLRetain; 8 | JLRelease; 9 | JLDefineValue; 10 | JLDefineSpecial; 11 | JLDefineNumber; 12 | JLParse; 13 | JLEvaluate; 14 | JLIsNumber; 15 | JLGetNumber; 16 | JLIsString; 17 | JLGetString; 18 | JLIsList; 19 | JLGetHead; 20 | JLGetNext; 21 | JLPrint; 22 | local: *; 23 | }; 24 | -------------------------------------------------------------------------------- /src/jl-context.c: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl-context.c 3 | * @author Joe Wingbermuehle 4 | */ 5 | 6 | #include "jl.h" 7 | #include "jl-context.h" 8 | #include "jl-scope.h" 9 | #include "jl-value.h" 10 | 11 | #include 12 | #include 13 | #include 14 | 15 | #define BLOCK_SIZE 8192 16 | 17 | typedef struct FreeNode { 18 | union { 19 | BindingNode binding; 20 | ScopeNode scope; 21 | JLValue value; 22 | struct FreeNode *next; 23 | }; 24 | } FreeNode; 25 | 26 | typedef struct BlockNode { 27 | FreeNode nodes[BLOCK_SIZE]; 28 | struct BlockNode *next; 29 | } BlockNode; 30 | 31 | void *GetFree(JLContext *context) 32 | { 33 | FreeNode *node; 34 | if(context->freelist == NULL) { 35 | BlockNode *block = (BlockNode*)malloc(sizeof(BlockNode)); 36 | size_t i; 37 | block->next = context->blocks; 38 | context->blocks = block; 39 | for(i = 1; i < BLOCK_SIZE; i++) { 40 | block->nodes[i].next = context->freelist; 41 | context->freelist = &block->nodes[i]; 42 | } 43 | node = &block->nodes[0]; 44 | } else { 45 | node = context->freelist; 46 | context->freelist = node->next; 47 | } 48 | return node; 49 | } 50 | 51 | void PutFree(JLContext *context, void *value) 52 | { 53 | FreeNode *temp = (FreeNode*)value; 54 | temp->next = context->freelist; 55 | context->freelist = temp; 56 | } 57 | 58 | void FreeContext(JLContext *context) 59 | { 60 | while(context->blocks) { 61 | BlockNode *next = context->blocks->next; 62 | free(context->blocks); 63 | context->blocks = next; 64 | } 65 | free(context); 66 | } 67 | 68 | void Error(JLContext *context, const char *msg, ...) 69 | { 70 | va_list ap; 71 | va_start(ap, msg); 72 | context->error = 1; 73 | printf("ERROR[%d]: ", context->line); 74 | vprintf(msg, ap); 75 | printf("\n"); 76 | va_end(ap); 77 | } 78 | 79 | -------------------------------------------------------------------------------- /src/jl-context.h: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl-context.h 3 | * @author Joe Wingbermuehle 4 | */ 5 | 6 | #ifndef JL_CONTEXT_H 7 | #define JL_CONTEXT_H 8 | 9 | struct ScopeNode; 10 | struct FreeNode; 11 | struct BlockNode; 12 | 13 | typedef struct JLContext { 14 | struct ScopeNode *scope; 15 | struct FreeNode *freelist; 16 | struct BlockNode *blocks; 17 | unsigned int line; 18 | unsigned int levels; 19 | unsigned int max_levels; 20 | char error; 21 | } JLContext; 22 | 23 | void *GetFree(JLContext *context); 24 | 25 | void PutFree(JLContext *context, void *value); 26 | 27 | void FreeContext(JLContext *context); 28 | 29 | void Error(JLContext *context, const char *msg, ...); 30 | 31 | #endif /* JL_CONTEXT_H */ 32 | -------------------------------------------------------------------------------- /src/jl-func.c: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl-func.h 3 | * @author Joe Wingbermuehle 4 | */ 5 | 6 | #include "jl.h" 7 | #include "jl-func.h" 8 | #include "jl-value.h" 9 | #include "jl-context.h" 10 | #include "jl-scope.h" 11 | 12 | #include 13 | #include 14 | #include 15 | 16 | typedef struct InternalFunctionNode { 17 | const char *name; 18 | JLFunction function; 19 | } InternalFunctionNode; 20 | 21 | static char CheckCondition(JLContext *context, JLValue *value); 22 | static void InvalidArgumentError(JLContext *context, JLValue *args); 23 | static void TooManyArgumentsError(JLContext *context, JLValue *args); 24 | static void TooFewArgumentsError(JLContext *context, JLValue *args); 25 | 26 | static JLValue *CompareFunc(JLContext *context, JLValue *args, void *extra); 27 | static JLValue *AddFunc(JLContext *context, JLValue *args, void *extra); 28 | static JLValue *SubFunc(JLContext *context, JLValue *args, void *extra); 29 | static JLValue *MulFunc(JLContext *context, JLValue *args, void *extra); 30 | static JLValue *DivFunc(JLContext *context, JLValue *args, void *extra); 31 | static JLValue *ModFunc(JLContext *context, JLValue *args, void *extra); 32 | static JLValue *AndFunc(JLContext *context, JLValue *args, void *extra); 33 | static JLValue *OrFunc(JLContext *context, JLValue *args, void *extra); 34 | static JLValue *NotFunc(JLContext *context, JLValue *args, void *extra); 35 | static JLValue *BeginFunc(JLContext *context, JLValue *args, void *extra); 36 | static JLValue *ConsFunc(JLContext *context, JLValue *args, void *extra); 37 | static JLValue *DefineFunc(JLContext *context, JLValue *args, void *extra); 38 | static JLValue *HeadFunc(JLContext *context, JLValue *args, void *extra); 39 | static JLValue *IfFunc(JLContext *context, JLValue *args, void *extra); 40 | static JLValue *LambdaFunc(JLContext *context, JLValue *args, void *extra); 41 | static JLValue *ListFunc(JLContext *context, JLValue *args, void *extra); 42 | static JLValue *RestFunc(JLContext *context, JLValue *args, void *extra); 43 | static JLValue *SubstrFunc(JLContext *context, JLValue *args, void *extra); 44 | static JLValue *ConcatFunc(JLContext *context, JLValue *args, void *extra); 45 | static JLValue *IsNumberFunc(JLContext *context, JLValue *args, void *extra); 46 | static JLValue *IsStringFunc(JLContext *context, JLValue *args, void *extra); 47 | static JLValue *IsListFunc(JLContext *context, JLValue *args, void *extra); 48 | static JLValue *IsNullFunc(JLContext *context, JLValue *args, void *extra); 49 | 50 | static InternalFunctionNode INTERNAL_FUNCTIONS[] = { 51 | { "=", CompareFunc }, 52 | { "!=", CompareFunc }, 53 | { ">", CompareFunc }, 54 | { ">=", CompareFunc }, 55 | { "<", CompareFunc }, 56 | { "<=", CompareFunc }, 57 | { "+", AddFunc }, 58 | { "-", SubFunc }, 59 | { "*", MulFunc }, 60 | { "/", DivFunc }, 61 | { "mod", ModFunc }, 62 | { "and", AndFunc }, 63 | { "or", OrFunc }, 64 | { "not", NotFunc }, 65 | { "begin", BeginFunc }, 66 | { "cons", ConsFunc }, 67 | { "define", DefineFunc }, 68 | { "head", HeadFunc }, 69 | { "if", IfFunc }, 70 | { "lambda", LambdaFunc }, 71 | { "list", ListFunc }, 72 | { "rest", RestFunc }, 73 | { "substr", SubstrFunc }, 74 | { "concat", ConcatFunc }, 75 | { "number?", IsNumberFunc }, 76 | { "string?", IsStringFunc }, 77 | { "list?", IsListFunc }, 78 | { "null?", IsNullFunc } 79 | }; 80 | static size_t INTERNAL_FUNCTION_COUNT = sizeof(INTERNAL_FUNCTIONS) 81 | / sizeof(InternalFunctionNode); 82 | 83 | char CheckCondition(JLContext *context, JLValue *value) 84 | { 85 | JLValue *cond = JLEvaluate(context, value); 86 | char rc = 0; 87 | if(cond) { 88 | switch(cond->tag) { 89 | case JLVALUE_NUMBER: 90 | rc = cond->value.number != 0.0; 91 | break; 92 | case JLVALUE_LIST: 93 | rc = cond->value.lst != NULL; 94 | break; 95 | default: 96 | rc = 1; 97 | break; 98 | } 99 | JLRelease(context, cond); 100 | } 101 | return rc; 102 | } 103 | 104 | void InvalidArgumentError(JLContext *context, JLValue *args) 105 | { 106 | Error(context, "invalid argument to %s", args->value.str); 107 | } 108 | 109 | void TooManyArgumentsError(JLContext *context, JLValue *args) 110 | { 111 | Error(context, "too many arguments to %s", args->value.str); 112 | } 113 | 114 | void TooFewArgumentsError(JLContext *context, JLValue *args) 115 | { 116 | Error(context, "too few arguments to %s", args->value.str); 117 | } 118 | 119 | JLValue *CompareFunc(JLContext *context, JLValue *args, void *extra) 120 | { 121 | const char *op = args->value.str; 122 | JLValue *va = NULL; 123 | JLValue *vb = NULL; 124 | JLValue *result = NULL; 125 | char cond = 0; 126 | if(args->next == NULL || args->next->next == NULL) { 127 | TooFewArgumentsError(context, args); 128 | return NULL; 129 | } 130 | if(args->next->next->next) { 131 | TooManyArgumentsError(context, args); 132 | return NULL; 133 | } 134 | 135 | va = JLEvaluate(context, args->next); 136 | vb = JLEvaluate(context, args->next->next); 137 | if(va == NULL || vb == NULL || va->tag != vb->tag) { 138 | 139 | if(op[0] == '=') { 140 | cond = va == vb; 141 | } else if(op[0] == '!') { 142 | cond = va != vb; 143 | } else { 144 | InvalidArgumentError(context, args); 145 | } 146 | 147 | } else { 148 | 149 | /* Here we know that va and vb are not nil and are of the same type. */ 150 | double diff = 0.0; 151 | if(va->tag == JLVALUE_NUMBER) { 152 | diff = va->value.number - vb->value.number; 153 | } else if(va->tag == JLVALUE_STRING) { 154 | diff = strcmp(va->value.str, vb->value.str); 155 | } else { 156 | InvalidArgumentError(context, args); 157 | } 158 | 159 | if(op[0] == '=') { 160 | cond = diff == 0.0; 161 | } else if(op[0] == '!') { 162 | cond = diff != 0.0; 163 | } else if(op[0] == '<' && op[1] == 0) { 164 | cond = diff < 0.0; 165 | } else if(op[0] == '<' && op[1] == '=') { 166 | cond = diff <= 0.0; 167 | } else if(op[0] == '>' && op[1] == 0) { 168 | cond = diff > 0.0; 169 | } else if(op[0] == '>' && op[1] == '=') { 170 | cond = diff >= 0.0; 171 | } 172 | 173 | } 174 | 175 | if(cond) { 176 | result = JLDefineNumber(context, NULL, 1.0); 177 | } 178 | 179 | JLRelease(context, va); 180 | JLRelease(context, vb); 181 | return result; 182 | } 183 | 184 | JLValue *AddFunc(JLContext *context, JLValue *args, void *extra) 185 | { 186 | JLValue *vp; 187 | double sum = 0.0; 188 | for(vp = args->next; vp; vp = vp->next) { 189 | JLValue *arg = JLEvaluate(context, vp); 190 | if(arg == NULL || arg->tag != JLVALUE_NUMBER) { 191 | InvalidArgumentError(context, args); 192 | JLRelease(context, arg); 193 | return NULL; 194 | } 195 | sum += arg->value.number; 196 | JLRelease(context, arg); 197 | } 198 | return JLDefineNumber(context, NULL, sum); 199 | } 200 | 201 | JLValue *SubFunc(JLContext *context, JLValue *args, void *extra) 202 | { 203 | JLValue *vp = args->next; 204 | JLValue *arg = NULL; 205 | double total = 0.0; 206 | 207 | arg = JLEvaluate(context, vp); 208 | if(arg == NULL || arg->tag != JLVALUE_NUMBER) { 209 | InvalidArgumentError(context, args); 210 | JLRelease(context, arg); 211 | return NULL; 212 | } 213 | total = arg->value.number; 214 | JLRelease(context, arg); 215 | 216 | for(vp = vp->next; vp; vp = vp->next) { 217 | arg = JLEvaluate(context, vp); 218 | if(arg == NULL || arg->tag != JLVALUE_NUMBER) { 219 | InvalidArgumentError(context, args); 220 | JLRelease(context, arg); 221 | return NULL; 222 | } 223 | total -= arg->value.number; 224 | JLRelease(context, arg); 225 | } 226 | 227 | return JLDefineNumber(context, NULL, total); 228 | 229 | } 230 | 231 | JLValue *MulFunc(JLContext *context, JLValue *args, void *extra) 232 | { 233 | JLValue *vp; 234 | double product = 1.0; 235 | for(vp = args->next; vp; vp = vp->next) { 236 | JLValue *arg = JLEvaluate(context, vp); 237 | if(arg == NULL || arg->tag != JLVALUE_NUMBER) { 238 | InvalidArgumentError(context, args); 239 | JLRelease(context, arg); 240 | return NULL; 241 | } 242 | product *= arg->value.number; 243 | JLRelease(context, arg); 244 | } 245 | return JLDefineNumber(context, NULL, product); 246 | } 247 | 248 | JLValue *DivFunc(JLContext *context, JLValue *args, void *extra) 249 | { 250 | JLValue *va = NULL; 251 | JLValue *vb = NULL; 252 | JLValue *result = NULL; 253 | 254 | va = JLEvaluate(context, args->next); 255 | if(va == NULL || va->tag != JLVALUE_NUMBER) { 256 | InvalidArgumentError(context, args); 257 | goto div_done; 258 | } 259 | vb = JLEvaluate(context, args->next->next); 260 | if(vb == NULL || vb->tag != JLVALUE_NUMBER) { 261 | InvalidArgumentError(context, args); 262 | goto div_done; 263 | } 264 | if(args->next->next->next) { 265 | TooManyArgumentsError(context, args); 266 | goto div_done; 267 | } 268 | 269 | result = JLDefineNumber(context, NULL, va->value.number / vb->value.number); 270 | 271 | div_done: 272 | 273 | JLRelease(context, va); 274 | JLRelease(context, vb); 275 | return result; 276 | 277 | } 278 | 279 | JLValue *ModFunc(JLContext *context, JLValue *args, void *extra) 280 | { 281 | 282 | JLValue *va = NULL; 283 | JLValue *vb = NULL; 284 | JLValue *result = NULL; 285 | long temp; 286 | 287 | va = JLEvaluate(context, args->next); 288 | if(va == NULL || va->tag != JLVALUE_NUMBER) { 289 | InvalidArgumentError(context, args); 290 | goto mod_done; 291 | } 292 | vb = JLEvaluate(context, args->next->next); 293 | if(vb == NULL || vb->tag != JLVALUE_NUMBER) { 294 | InvalidArgumentError(context, args); 295 | goto mod_done; 296 | } 297 | if(args->next->next->next) { 298 | TooManyArgumentsError(context, args); 299 | goto mod_done; 300 | } 301 | temp = (long)vb->value.number; 302 | if(temp == 0) { 303 | goto mod_done; 304 | } 305 | 306 | result = JLDefineNumber(context, NULL, (long)va->value.number % temp); 307 | 308 | mod_done: 309 | 310 | JLRelease(context, va); 311 | JLRelease(context, vb); 312 | return result; 313 | 314 | } 315 | 316 | JLValue *AndFunc(JLContext *context, JLValue *args, void *extra) 317 | { 318 | JLValue *vp; 319 | for(vp = args->next; vp; vp = vp->next) { 320 | if(!CheckCondition(context, vp)) { 321 | return NULL; 322 | } 323 | } 324 | return JLDefineNumber(context, NULL, 1.0); 325 | } 326 | 327 | JLValue *OrFunc(JLContext *context, JLValue *args, void *extra) 328 | { 329 | JLValue *vp; 330 | for(vp = args->next; vp; vp = vp->next) { 331 | if(CheckCondition(context, vp)) { 332 | return JLDefineNumber(context, NULL, 1.0); 333 | } 334 | } 335 | return NULL; 336 | } 337 | 338 | JLValue *NotFunc(JLContext *context, JLValue *args, void *extra) 339 | { 340 | if(args->next == NULL) { 341 | TooFewArgumentsError(context, args); 342 | return NULL; 343 | } 344 | if(args->next->next != NULL) { 345 | TooManyArgumentsError(context, args); 346 | return NULL; 347 | } 348 | if(!CheckCondition(context, args->next)) { 349 | return JLDefineNumber(context, NULL, 1.0); 350 | } else { 351 | return NULL; 352 | } 353 | } 354 | 355 | JLValue *BeginFunc(JLContext *context, JLValue *args, void *extra) 356 | { 357 | JLValue *vp; 358 | JLValue *result = NULL; 359 | JLEnterScope(context); 360 | for(vp = args->next; vp; vp = vp->next) { 361 | JLRelease(context, result); 362 | result = JLEvaluate(context, vp); 363 | } 364 | JLLeaveScope(context); 365 | return result; 366 | } 367 | 368 | JLValue *ConsFunc(JLContext *context, JLValue *args, void *extra) 369 | { 370 | JLValue *head = NULL; 371 | JLValue *rest = NULL; 372 | JLValue *temp = NULL; 373 | JLValue *result = NULL; 374 | 375 | if(args->next == NULL || args->next->next == NULL) { 376 | TooFewArgumentsError(context, args); 377 | return NULL; 378 | } 379 | if(args->next->next->next) { 380 | TooManyArgumentsError(context, args); 381 | return NULL; 382 | } 383 | 384 | rest = JLEvaluate(context, args->next->next); 385 | if(rest != NULL && rest->tag != JLVALUE_LIST) { 386 | InvalidArgumentError(context, args); 387 | JLRelease(context, rest); 388 | return NULL; 389 | } 390 | 391 | temp = JLEvaluate(context, args->next); 392 | head = CopyValue(context, temp); 393 | JLRelease(context, temp); 394 | 395 | result = CreateValue(context, NULL, JLVALUE_LIST); 396 | if(rest) { 397 | head->next = rest->value.lst; 398 | JLRetain(context, rest->value.lst); 399 | JLRelease(context, rest); 400 | } 401 | result->value.lst = head; 402 | 403 | return result; 404 | } 405 | 406 | JLValue *DefineFunc(JLContext *context, JLValue *args, void *extra) 407 | { 408 | JLValue *vp = args->next; 409 | JLValue *result = NULL; 410 | if(vp == NULL) { 411 | TooFewArgumentsError(context, args); 412 | return NULL; 413 | } 414 | if(vp->tag != JLVALUE_VARIABLE) { 415 | InvalidArgumentError(context, args); 416 | return NULL; 417 | } 418 | result = JLEvaluate(context, vp->next); 419 | JLDefineValue(context, vp->value.str, result); 420 | return result; 421 | } 422 | 423 | JLValue *HeadFunc(JLContext *context, JLValue *args, void *extra) 424 | { 425 | JLValue *result = NULL; 426 | JLValue *vp = JLEvaluate(context, args->next); 427 | 428 | if(vp == NULL || vp->tag != JLVALUE_LIST) { 429 | InvalidArgumentError(context, args); 430 | goto head_done; 431 | } 432 | 433 | result = vp->value.lst; 434 | JLRetain(context, result); 435 | 436 | head_done: 437 | 438 | JLRelease(context, vp); 439 | return result; 440 | } 441 | 442 | JLValue *IfFunc(JLContext *context, JLValue *args, void *extra) 443 | { 444 | JLValue *vp = args->next; 445 | if(CheckCondition(context, vp)) { 446 | return JLEvaluate(context, vp->next); 447 | } else if(vp->next) { 448 | return JLEvaluate(context, vp->next->next); 449 | } 450 | return NULL; 451 | } 452 | 453 | JLValue *LambdaFunc(JLContext *context, JLValue *args, void *extra) 454 | { 455 | JLValue *result; 456 | JLValue *scope; 457 | 458 | if(args->next == NULL || args->next->next == NULL) { 459 | TooFewArgumentsError(context, args); 460 | return NULL; 461 | } 462 | 463 | scope = CreateValue(context, NULL, JLVALUE_SCOPE); 464 | scope->value.scope = context->scope; 465 | context->scope->count += 1; 466 | 467 | result = CreateValue(context, NULL, JLVALUE_LAMBDA); 468 | result->value.lst = scope; 469 | result->value.lst->next = args->next; 470 | JLRetain(context, args->next); 471 | 472 | return result; 473 | } 474 | 475 | JLValue *ListFunc(JLContext *context, JLValue *args, void *extra) 476 | { 477 | JLValue *result = NULL; 478 | if(args->next) { 479 | result = CreateValue(context, NULL, JLVALUE_LIST); 480 | JLValue **item = &result->value.lst; 481 | JLValue *vp; 482 | for(vp = args->next; vp; vp = vp->next) { 483 | JLValue *arg = JLEvaluate(context, vp); 484 | JLValue *temp = CopyValue(context, arg); 485 | *item = temp; 486 | item = &temp->next; 487 | JLRelease(context, arg); 488 | } 489 | } 490 | return result; 491 | } 492 | 493 | JLValue *RestFunc(JLContext *context, JLValue *args, void *extra) 494 | { 495 | JLValue *result = NULL; 496 | JLValue *vp = JLEvaluate(context, args->next); 497 | 498 | if(vp == NULL || vp->tag != JLVALUE_LIST) { 499 | InvalidArgumentError(context, args); 500 | goto rest_done; 501 | } 502 | 503 | if(vp->value.lst && vp->value.lst->next) { 504 | result = CreateValue(context, NULL, JLVALUE_LIST); 505 | result->value.lst = vp->value.lst->next; 506 | JLRetain(context, result->value.lst); 507 | } 508 | 509 | rest_done: 510 | 511 | JLRelease(context, vp); 512 | return result; 513 | } 514 | 515 | JLValue *SubstrFunc(JLContext *context, JLValue *args, void *extra) 516 | { 517 | JLValue *result = NULL; 518 | JLValue *str = NULL; 519 | JLValue *sval = NULL; 520 | JLValue *lval = NULL; 521 | size_t start = 0; 522 | size_t len = (size_t)-1; 523 | size_t slen; 524 | 525 | str = JLEvaluate(context, args->next); 526 | if(!str || str->tag != JLVALUE_STRING) { 527 | InvalidArgumentError(context, args); 528 | goto substr_done; 529 | } 530 | 531 | sval = JLEvaluate(context, args->next->next); 532 | if(sval) { 533 | if(sval->tag != JLVALUE_NUMBER) { 534 | InvalidArgumentError(context, args); 535 | goto substr_done; 536 | } 537 | start = (size_t)sval->value.number; 538 | } 539 | 540 | if(args->next->next) { 541 | if(args->next->next->next && args->next->next->next->next) { 542 | TooManyArgumentsError(context, args); 543 | goto substr_done; 544 | } 545 | lval = JLEvaluate(context, args->next->next->next); 546 | if(lval) { 547 | if(lval->tag != JLVALUE_NUMBER) { 548 | InvalidArgumentError(context, args); 549 | goto substr_done; 550 | } 551 | len = (size_t)lval->value.number; 552 | } 553 | } 554 | 555 | slen = strlen(str->value.str); 556 | if(start < slen && len > 0) { 557 | len = slen - start > len ? len : slen - start; 558 | result = CreateValue(context, NULL, JLVALUE_STRING); 559 | result->value.str = (char*)malloc(len + 1); 560 | memcpy(result->value.str, &str->value.str[start], len); 561 | result->value.str[len] = 0; 562 | } 563 | 564 | substr_done: 565 | 566 | JLRelease(context, str); 567 | JLRelease(context, sval); 568 | JLRelease(context, lval); 569 | 570 | return result; 571 | 572 | } 573 | 574 | JLValue *ConcatFunc(JLContext *context, JLValue *args, void *extra) 575 | { 576 | JLValue *result = CreateValue(context, NULL, JLVALUE_STRING); 577 | JLValue *vp; 578 | size_t len = 0; 579 | size_t max_len = 8; 580 | result->value.str = (char*)malloc(max_len); 581 | for(vp = args->next; vp; vp = vp->next) { 582 | JLValue *arg = JLEvaluate(context, vp); 583 | if(arg == NULL || arg->tag != JLVALUE_STRING) { 584 | InvalidArgumentError(context, args); 585 | JLRelease(context, arg); 586 | JLRelease(context, result); 587 | return NULL; 588 | } else { 589 | const size_t l = strlen(arg->value.str); 590 | const size_t new_len = len + l; 591 | if(new_len >= max_len) { 592 | max_len = new_len + 1; 593 | result->value.str = (char*)realloc(result->value.str, max_len); 594 | } 595 | memcpy(&result->value.str[len], arg->value.str, l); 596 | len = new_len; 597 | } 598 | JLRelease(context, arg); 599 | } 600 | result->value.str[len] = 0; 601 | return result; 602 | } 603 | 604 | JLValue *IsNumberFunc(JLContext *context, JLValue *args, void *extra) 605 | { 606 | JLValue *arg = NULL; 607 | JLValue *result = NULL; 608 | 609 | if(args->next == NULL) { 610 | TooFewArgumentsError(context, args); 611 | return NULL; 612 | } 613 | if(args->next->next) { 614 | TooManyArgumentsError(context, args); 615 | return NULL; 616 | } 617 | 618 | arg = JLEvaluate(context, args->next); 619 | if(arg && arg->tag == JLVALUE_NUMBER) { 620 | result = JLDefineNumber(context, NULL, 1.0); 621 | } 622 | JLRelease(context, arg); 623 | return result; 624 | } 625 | 626 | JLValue *IsStringFunc(JLContext *context, JLValue *args, void *extra) 627 | { 628 | JLValue *arg = NULL; 629 | JLValue *result = NULL; 630 | 631 | if(args->next == NULL) { 632 | TooFewArgumentsError(context, args); 633 | return NULL; 634 | } 635 | if(args->next->next) { 636 | TooManyArgumentsError(context, args); 637 | return NULL; 638 | } 639 | 640 | arg = JLEvaluate(context, args->next); 641 | if(arg && arg->tag == JLVALUE_STRING) { 642 | result = JLDefineNumber(context, NULL, 1.0); 643 | } 644 | JLRelease(context, arg); 645 | return result; 646 | 647 | } 648 | 649 | JLValue *IsListFunc(JLContext *context, JLValue *args, void *extra) 650 | { 651 | JLValue *arg = NULL; 652 | JLValue *result = NULL; 653 | 654 | if(args->next == NULL) { 655 | TooFewArgumentsError(context, args); 656 | return NULL; 657 | } 658 | if(args->next->next) { 659 | TooManyArgumentsError(context, args); 660 | return NULL; 661 | } 662 | 663 | arg = JLEvaluate(context, args->next); 664 | if(arg && arg->tag == JLVALUE_LIST) { 665 | result = JLDefineNumber(context, NULL, 1.0); 666 | } 667 | JLRelease(context, arg); 668 | return result; 669 | } 670 | 671 | JLValue *IsNullFunc(JLContext *context, JLValue *args, void *extra) 672 | { 673 | JLValue *arg = NULL; 674 | 675 | if(args->next == NULL) { 676 | TooFewArgumentsError(context, args); 677 | return NULL; 678 | } 679 | if(args->next->next) { 680 | TooManyArgumentsError(context, args); 681 | return NULL; 682 | } 683 | 684 | arg = JLEvaluate(context, args->next); 685 | if(arg == NULL) { 686 | return JLDefineNumber(context, NULL, 1.0); 687 | } else { 688 | JLRelease(context, arg); 689 | return NULL; 690 | } 691 | } 692 | 693 | void RegisterFunctions(JLContext *context) 694 | { 695 | size_t i; 696 | for(i = 0; i < INTERNAL_FUNCTION_COUNT; i++) { 697 | JLDefineSpecial(context, INTERNAL_FUNCTIONS[i].name, 698 | INTERNAL_FUNCTIONS[i].function, NULL); 699 | } 700 | } 701 | 702 | -------------------------------------------------------------------------------- /src/jl-func.h: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl-func.h 3 | * @author Joe Wingbermuehle 4 | * 5 | * Built-in JL functions. 6 | * 7 | */ 8 | 9 | #ifndef JL_FUNC_H 10 | #define JL_FUNC_H 11 | 12 | struct JLContext; 13 | 14 | void RegisterFunctions(struct JLContext *context); 15 | 16 | #endif /* JL_FUNC_H */ 17 | -------------------------------------------------------------------------------- /src/jl-scope.c: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl-scope.c 3 | * @author Joe Wingbermuehle 4 | */ 5 | 6 | #include "jl-scope.h" 7 | #include "jl-context.h" 8 | #include "jl-value.h" 9 | 10 | #include 11 | #include 12 | 13 | static unsigned int CountScopeBindings(BindingNode *binding, ScopeNode *scope); 14 | static void ReleaseBindings(JLContext *context, BindingNode *binding); 15 | 16 | unsigned int CountScopeBindings(BindingNode *binding, ScopeNode *scope) 17 | { 18 | unsigned int count = 0; 19 | if(binding) { 20 | count += CountScopeBindings(binding->left, scope); 21 | count += CountScopeBindings(binding->right, scope); 22 | if(binding->value && 23 | binding->value->tag == JLVALUE_LAMBDA && 24 | binding->value->count == 1) { 25 | if(binding->value->value.lst->value.scope == scope) { 26 | count += 1; 27 | } 28 | } 29 | } 30 | return count; 31 | } 32 | 33 | void ReleaseBindings(JLContext *context, BindingNode *binding) 34 | { 35 | if(binding) { 36 | ReleaseBindings(context, binding->left); 37 | ReleaseBindings(context, binding->right); 38 | free(binding->name); 39 | JLRelease(context, binding->value); 40 | PutFree(context, binding); 41 | } 42 | } 43 | 44 | void JLEnterScope(JLContext *context) 45 | { 46 | ScopeNode *scope = (ScopeNode*)GetFree(context); 47 | scope->count = 1; 48 | scope->bindings = NULL; 49 | scope->next = context->scope; 50 | context->scope = scope; 51 | } 52 | 53 | void JLLeaveScope(JLContext *context) 54 | { 55 | ScopeNode *scope = context->scope; 56 | context->scope = scope->next; 57 | ReleaseScope(context, scope); 58 | } 59 | 60 | void ReleaseScope(JLContext *context, ScopeNode *scope) 61 | { 62 | const unsigned int new_count = scope->count - 1 63 | - CountScopeBindings(scope->bindings, scope); 64 | if(new_count == 0) { 65 | ReleaseBindings(context, scope->bindings); 66 | PutFree(context, scope); 67 | } else { 68 | scope->count -= 1; 69 | } 70 | } 71 | 72 | JLValue *Lookup(JLContext *context, const char *name) 73 | { 74 | const ScopeNode *scope = context->scope; 75 | while(scope) { 76 | const BindingNode *binding = scope->bindings; 77 | while(binding) { 78 | const int v = strcmp(binding->name, name); 79 | if(v < 0) { 80 | binding = binding->left; 81 | } else if(v > 0) { 82 | binding = binding->right; 83 | } else { 84 | return binding->value; 85 | } 86 | } 87 | scope = scope->next; 88 | } 89 | Error(context, "symbol not found: %s", name); 90 | return NULL; 91 | } 92 | 93 | -------------------------------------------------------------------------------- /src/jl-scope.h: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl-scope.h 3 | * @author Joe Wingbermuehle 4 | */ 5 | 6 | #ifndef JL_SCOPE_H 7 | #define JL_SCOPE_H 8 | 9 | struct JLContext; 10 | struct JLValue; 11 | 12 | typedef struct BindingNode { 13 | char *name; 14 | struct JLValue *value; 15 | struct BindingNode *left; 16 | struct BindingNode *right; 17 | } BindingNode; 18 | 19 | typedef struct ScopeNode { 20 | BindingNode *bindings; 21 | struct ScopeNode *next; 22 | unsigned int count; 23 | } ScopeNode; 24 | 25 | void ReleaseScope(struct JLContext *context, ScopeNode *scope); 26 | 27 | struct JLValue *Lookup(struct JLContext *context, const char *name); 28 | 29 | #endif /* JL_SCOPE_H */ 30 | -------------------------------------------------------------------------------- /src/jl-value.c: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl-value.c 3 | * @author Joe Wingbermuehle 4 | */ 5 | 6 | #include "jl-value.h" 7 | #include "jl-context.h" 8 | #include 9 | 10 | JLValue *CreateValue(JLContext *context, const char *name, JLValueType tag) 11 | { 12 | JLValue *result = (JLValue*)GetFree(context); 13 | result->tag = tag; 14 | result->next = NULL; 15 | result->count = 1; 16 | JLDefineValue(context, name, result); 17 | return result; 18 | } 19 | 20 | JLValue *CopyValue(JLContext *context, const JLValue *other) 21 | { 22 | JLValue *result = NULL; 23 | if(other) { 24 | result = CreateValue(context, NULL, other->tag); 25 | result->value = other->value; 26 | switch(result->tag) { 27 | case JLVALUE_LIST: 28 | case JLVALUE_LAMBDA: 29 | case JLVALUE_SCOPE: 30 | JLRetain(context, result->value.lst); 31 | break; 32 | case JLVALUE_STRING: 33 | case JLVALUE_VARIABLE: 34 | result->value.str = strdup(result->value.str); 35 | break; 36 | default: 37 | break; 38 | } 39 | } else { 40 | result = CreateValue(context, NULL, JLVALUE_NIL); 41 | } 42 | return result; 43 | } 44 | 45 | -------------------------------------------------------------------------------- /src/jl-value.h: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl-value.h 3 | * @author Joe Wingbermuehle 4 | */ 5 | 6 | #ifndef JL_VALUE_H 7 | #define JL_VALUE_H 8 | 9 | #include "jl.h" 10 | 11 | /** Possible value types. */ 12 | typedef char JLValueType; 13 | #define JLVALUE_NIL 0 /**< Nil. */ 14 | #define JLVALUE_NUMBER 1 /**< Literal number. */ 15 | #define JLVALUE_STRING 2 /**< Literal string. */ 16 | #define JLVALUE_LIST 3 /**< Linked list. */ 17 | #define JLVALUE_LAMBDA 4 /**< Lambda function. */ 18 | #define JLVALUE_SPECIAL 5 /**< Special form. */ 19 | #define JLVALUE_SCOPE 6 /**< A scope (internal use). */ 20 | #define JLVALUE_VARIABLE 7 /**< A variable. */ 21 | 22 | /** Special function and extra parameter. */ 23 | typedef struct SpecialFunction { 24 | JLFunction func; 25 | void *extra; 26 | } SpecialFunction; 27 | 28 | /** Values in the JL environment. 29 | * Note that these are reference counted. 30 | */ 31 | typedef struct JLValue { 32 | union { 33 | struct JLValue *lst; 34 | SpecialFunction special; 35 | char *str; 36 | double number; 37 | void *scope; 38 | } value; 39 | struct JLValue *next; 40 | unsigned int count; 41 | JLValueType tag; 42 | } JLValue; 43 | 44 | JLValue *CreateValue(struct JLContext *context, 45 | const char *name, JLValueType tag); 46 | 47 | JLValue *CopyValue(struct JLContext *context, const JLValue *other); 48 | 49 | #endif /* JL_VALUE_H */ 50 | -------------------------------------------------------------------------------- /src/jl.c: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jl.c 3 | * @author Joe Wingbermuehle 4 | */ 5 | 6 | #include "jl.h" 7 | #include "jl-context.h" 8 | #include "jl-value.h" 9 | #include "jl-scope.h" 10 | #include "jl-func.h" 11 | 12 | #include 13 | #include 14 | #include 15 | 16 | static JLValue *EvalLambda(JLContext *context, 17 | const JLValue *lambda, 18 | JLValue *args); 19 | static JLValue *ParseLiteral(JLContext *context, const char **line); 20 | static JLValue *ParseList(JLContext *context, const char **line); 21 | static JLValue *ParseExpression(JLContext *context, const char **line); 22 | 23 | void JLRetain(JLContext *context, JLValue *value) 24 | { 25 | if(value) { 26 | value->count += 1; 27 | } 28 | } 29 | 30 | void JLRelease(JLContext *context, JLValue *value) 31 | { 32 | while(value) { 33 | value->count -= 1; 34 | if(value->count == 0) { 35 | JLValue *next = value->next; 36 | switch(value->tag) { 37 | case JLVALUE_LIST: 38 | case JLVALUE_LAMBDA: 39 | JLRelease(context, value->value.lst); 40 | break; 41 | case JLVALUE_STRING: 42 | case JLVALUE_VARIABLE: 43 | free(value->value.str); 44 | break; 45 | case JLVALUE_SCOPE: 46 | ReleaseScope(context, (ScopeNode*)value->value.scope); 47 | break; 48 | default: 49 | break; 50 | } 51 | PutFree(context, value); 52 | value = next; 53 | } else { 54 | break; 55 | } 56 | } 57 | } 58 | 59 | JLContext *JLCreateContext() 60 | { 61 | JLContext *context = (JLContext*)malloc(sizeof(JLContext)); 62 | context->scope = NULL; 63 | context->freelist = NULL; 64 | context->blocks = NULL; 65 | context->line = 1; 66 | context->levels = 0; 67 | context->max_levels = 1 << 15; 68 | context->error = 0; 69 | JLEnterScope(context); 70 | RegisterFunctions(context); 71 | JLDefineValue(context, "nil", NULL); 72 | return context; 73 | } 74 | 75 | void JLDestroyContext(JLContext *context) 76 | { 77 | JLLeaveScope(context); 78 | FreeContext(context); 79 | } 80 | 81 | void JLDefineValue(JLContext *context, const char *name, JLValue *value) 82 | { 83 | if(name) { 84 | BindingNode **root = &context->scope->bindings; 85 | JLRetain(context, value); 86 | while(*root) { 87 | const int v = strcmp((*root)->name, name); 88 | if(v < 0) { 89 | root = &(*root)->left; 90 | } else if(v > 0) { 91 | root = &(*root)->right; 92 | } else { 93 | /* Overwrite the old binding. */ 94 | JLRelease(context, (*root)->value); 95 | (*root)->value = value; 96 | return; 97 | } 98 | } 99 | 100 | /* New binding. */ 101 | *root = (BindingNode*)GetFree(context); 102 | (*root)->name = strdup(name); 103 | (*root)->value = value; 104 | (*root)->left = NULL; 105 | (*root)->right = NULL; 106 | 107 | } 108 | } 109 | 110 | void JLDefineSpecial(JLContext *context, 111 | const char *name, 112 | JLFunction func, 113 | void *extra) 114 | { 115 | JLValue *result = CreateValue(context, name, JLVALUE_SPECIAL); 116 | result->value.special.func = func; 117 | result->value.special.extra = extra; 118 | JLRelease(context, result); 119 | } 120 | 121 | JLValue *JLDefineNumber(JLContext *context, 122 | const char *name, 123 | double value) 124 | { 125 | JLValue *result = CreateValue(context, name, JLVALUE_NUMBER); 126 | result->value.number = value; 127 | return result; 128 | } 129 | 130 | JLValue *JLEvaluate(JLContext *context, JLValue *value) 131 | { 132 | JLValue *result = NULL; 133 | if(context->levels == 0) { 134 | context->error = 0; 135 | } else if(context->error) { 136 | return NULL; 137 | } 138 | context->levels += 1; 139 | if(value == NULL) { 140 | result = NULL; 141 | } else if(context->levels > context->max_levels) { 142 | Error(context, "maximum evaluation depth exceeded"); 143 | result = NULL; 144 | } else if(value->tag == JLVALUE_LIST) { 145 | JLValue *temp = JLEvaluate(context, value->value.lst); 146 | if(temp) { 147 | switch(temp->tag) { 148 | case JLVALUE_SPECIAL: 149 | result = (temp->value.special.func)(context, value->value.lst, 150 | temp->value.special.extra); 151 | break; 152 | case JLVALUE_LAMBDA: 153 | result = EvalLambda(context, temp, value->value.lst); 154 | break; 155 | default: 156 | result = JLEvaluate(context, temp); 157 | break; 158 | } 159 | JLRelease(context, temp); 160 | } 161 | } else if(value->tag == JLVALUE_VARIABLE) { 162 | result = Lookup(context, value->value.str); 163 | JLRetain(context, result); 164 | } else if(value->tag != JLVALUE_NIL) { 165 | result = value; 166 | JLRetain(context, result); 167 | } 168 | context->levels -= 1; 169 | return result; 170 | } 171 | 172 | JLValue *EvalLambda(JLContext *context, const JLValue *lambda, JLValue *args) 173 | { 174 | 175 | JLValue *scope; 176 | JLValue *params; 177 | JLValue *code; 178 | ScopeNode *old_scope; 179 | ScopeNode *new_scope; 180 | JLValue *bp; 181 | JLValue *ap; 182 | JLValue *result; 183 | 184 | /* The value of a lambda is a list containing the following: 185 | * - The scope in which to execute. 186 | * - A list of positional argument bindings. 187 | * - The code to execute (all remaining list items). 188 | * args should be a list of arguments that is the same length as 189 | * the number of parameters to the lambda. */ 190 | 191 | /* Make sure the lambda is well-defined. */ 192 | if(lambda->value.lst == NULL || 193 | lambda->value.lst->tag != JLVALUE_SCOPE || 194 | lambda->value.lst->next == NULL || 195 | lambda->value.lst->next->tag != JLVALUE_LIST) { 196 | Error(context, "invalid lambda"); 197 | return NULL; 198 | } 199 | scope = lambda->value.lst; 200 | params = lambda->value.lst->next->value.lst; 201 | code = lambda->value.lst->next->next; 202 | 203 | /* Insert bindings. */ 204 | old_scope = context->scope; 205 | context->scope = (ScopeNode*)scope->value.scope; 206 | JLEnterScope(context); 207 | new_scope = context->scope; 208 | bp = params; 209 | ap = args->next; /* Skip the name */ 210 | while(bp) { 211 | if(ap == NULL) { 212 | Error(context, "too few arguments"); 213 | result = NULL; 214 | goto done_eval_lambda; 215 | } 216 | if(bp->tag != JLVALUE_VARIABLE) { 217 | Error(context, "invalid lambda argument"); 218 | result = NULL; 219 | goto done_eval_lambda; 220 | } 221 | context->scope = old_scope; 222 | if(bp->next == NULL && ap->next != NULL) { 223 | 224 | /* Make the rest of the arguments into a list parameter. */ 225 | result = CreateValue(context, NULL, JLVALUE_LIST); 226 | JLValue **item = &result->value.lst; 227 | while(ap) { 228 | *item = JLEvaluate(context, ap); 229 | item = &(*item)->next; 230 | ap = ap->next; 231 | } 232 | 233 | } else { 234 | 235 | /* A single matching parameter. */ 236 | result = JLEvaluate(context, ap); 237 | ap = ap->next; 238 | 239 | } 240 | context->scope = new_scope; 241 | 242 | JLDefineValue(context, bp->value.str, result); 243 | JLRelease(context, result); 244 | bp = bp->next; 245 | } 246 | 247 | result = NULL; 248 | while(code) { 249 | result = JLEvaluate(context, code); 250 | code = code->next; 251 | if(code) { 252 | JLRelease(context, result); 253 | } 254 | } 255 | 256 | done_eval_lambda: 257 | 258 | JLLeaveScope(context); 259 | context->scope = old_scope; 260 | 261 | return result; 262 | 263 | } 264 | 265 | JLValue *ParseLiteral(JLContext *context, const char **line) 266 | { 267 | 268 | /* Separators include '(', ')', and white-space. 269 | * If if token starts with '"', we treat it as a string with escape 270 | * characters like in C. 271 | * Otherwise, if a token can be parsed as a number, we treat it as such. 272 | * Everything else we treat as a string. 273 | * Note that function lookups happen later, here we only generate 274 | * strings and floating-point numbers. 275 | */ 276 | 277 | JLValue *result = CreateValue(context, NULL, JLVALUE_NIL); 278 | 279 | if(**line == '\"') { 280 | size_t max_len = 16; 281 | size_t len = 0; 282 | char in_control = 0; 283 | char in_hex = 0; 284 | char in_octal = 0; 285 | result->value.str = (char*)malloc(max_len); 286 | *line += 1; 287 | while(**line && (in_control != 0 || **line != '\"')) { 288 | if(len + 1 >= max_len) { 289 | max_len += 16; 290 | result->value.str = (char*)realloc(result->value.str, max_len); 291 | } 292 | if(in_hex) { 293 | /* In a hex control sequence. */ 294 | if(**line >= '0' && **line <= '9') { 295 | result->value.str[len] *= 16; 296 | result->value.str[len] += **line - '0'; 297 | in_hex -= 1; 298 | *line += 1; 299 | } else if(**line >= 'a' && **line <= 'f') { 300 | result->value.str[len] *= 16; 301 | result->value.str[len] += **line - 'a' + 10; 302 | in_hex -= 1; 303 | *line += 1; 304 | } else if(**line >= 'A' && **line <= 'F') { 305 | result->value.str[len] *= 16; 306 | result->value.str[len] += **line - 'A' + 10; 307 | in_hex -= 1; 308 | *line += 1; 309 | } else { 310 | /* Premature end of hex sequence; reparse this character. */ 311 | in_hex = 0; 312 | } 313 | } else if(in_octal) { 314 | /* In an octal control sequence. */ 315 | if(**line >= '0' && **line <= '7') { 316 | result->value.str[len] *= 8; 317 | result->value.str[len] += **line - '0'; 318 | in_octal -= 1; 319 | *line += 1; 320 | } else { 321 | /* Premature end of octal sequence; reparse this character. */ 322 | in_octal = 0; 323 | } 324 | } else if(in_control) { 325 | /* In a control sequence. */ 326 | in_control = 0; 327 | switch(**line) { 328 | case 'a': /* bell */ 329 | result->value.str[len++] = '\a'; 330 | break; 331 | case 'b': /* backspace */ 332 | result->value.str[len++] = '\b'; 333 | break; 334 | case 'f': /* form-feed */ 335 | result->value.str[len++] = '\f'; 336 | break; 337 | case 'n': /* new-line */ 338 | result->value.str[len++] = '\n'; 339 | break; 340 | case 'r': /* carriage return */ 341 | result->value.str[len++] = '\r'; 342 | break; 343 | case 't': /* tab */ 344 | result->value.str[len++] = '\t'; 345 | break; 346 | case 'v': /* vertical tab */ 347 | result->value.str[len++] = '\v'; 348 | break; 349 | case 'x': /* Hex control sequence. */ 350 | in_hex = 2; 351 | break; 352 | case '0': /* Octal control sequence. */ 353 | in_octal = 3; 354 | break; 355 | default: /* Literal character */ 356 | result->value.str[len++] = **line; 357 | break; 358 | } 359 | *line += 1; 360 | } else if(**line == '\\') { 361 | /* Start of a control sequence. */ 362 | in_control = 1; 363 | *line += 1; 364 | } else { 365 | /* Regular character. */ 366 | result->value.str[len] = **line; 367 | len += 1; 368 | *line += 1; 369 | } 370 | } 371 | result->value.str[len] = 0; 372 | result->tag = JLVALUE_STRING; 373 | if(**line) { 374 | /* Skip the terminating '"'. */ 375 | *line += 1; 376 | } 377 | } else { 378 | 379 | const char *start = *line; 380 | char *end; 381 | size_t len = 0; 382 | 383 | /* Determine how long this token is. */ 384 | while(**line != 0 && **line != '(' && **line != ')' && 385 | **line != ' ' && **line != '\t' && **line != '\r' && 386 | **line != '\n' && **line != ';') { 387 | len += 1; 388 | *line += 1; 389 | } 390 | 391 | /* Attempt to parse the token as a double. */ 392 | result->value.number = strtod(start, &end); 393 | 394 | /* If we couldn't parse the whole thing, treat it as a variable. */ 395 | if(start + len != end) { 396 | result->tag = JLVALUE_VARIABLE; 397 | result->value.str = (char*)malloc(len + 1); 398 | memcpy(result->value.str, start, len); 399 | result->value.str[len] = 0; 400 | } else { 401 | result->tag = JLVALUE_NUMBER; 402 | } 403 | 404 | } 405 | 406 | return result; 407 | 408 | } 409 | 410 | JLValue *ParseList(JLContext *context, const char **line) 411 | { 412 | 413 | JLValue *result; 414 | JLValue **item; 415 | 416 | *line += 1; /* Skip '(' */ 417 | 418 | result = CreateValue(context, NULL, JLVALUE_LIST); 419 | result->value.lst = NULL; 420 | item = &result->value.lst; 421 | 422 | while(**line && **line != ')') { 423 | JLValue *temp = ParseExpression(context, line); 424 | if(temp == NULL) { 425 | break; 426 | } 427 | *item = temp; 428 | item = &(*item)->next; 429 | } 430 | 431 | if(**line != ')') { 432 | Error(context, "expected ')'"); 433 | JLRelease(context, result); 434 | return NULL; 435 | } 436 | 437 | *line += 1; /* Skip ')' */ 438 | 439 | return result; 440 | 441 | } 442 | 443 | JLValue *ParseExpression(JLContext *context, const char **line) 444 | { 445 | /* Skip leading white-space. */ 446 | for(;;) { 447 | if(**line == ';') { 448 | while(**line && **line != '\n') { 449 | *line += 1; 450 | } 451 | } else if(**line == '\n') { 452 | context->line += 1; 453 | } else if( **line != '\t' && 454 | **line != ' ' && 455 | **line != '\r') { 456 | break; 457 | } 458 | *line += 1; 459 | } 460 | 461 | switch(**line) { 462 | case 0: 463 | case ')': 464 | return NULL; 465 | case '(': 466 | return ParseList(context, line); 467 | default: 468 | return ParseLiteral(context, line); 469 | } 470 | } 471 | 472 | JLValue *JLParse(JLContext *context, const char **line) 473 | { 474 | JLValue *result = ParseExpression(context, line); 475 | if(**line == ')') { 476 | Error(context, "unexpected ')'"); 477 | *line += 1; 478 | } 479 | return result; 480 | } 481 | 482 | char JLIsNumber(JLValue *value) 483 | { 484 | if(value && value->tag == JLVALUE_NUMBER) { 485 | return 1; 486 | } else { 487 | return 0; 488 | } 489 | } 490 | 491 | double JLGetNumber(JLValue *value) 492 | { 493 | return value->value.number; 494 | } 495 | 496 | char JLIsString(JLValue *value) 497 | { 498 | if(value && value->tag == JLVALUE_STRING) { 499 | return 1; 500 | } else { 501 | return 0; 502 | } 503 | } 504 | 505 | const char *JLGetString(JLValue *value) 506 | { 507 | return value->value.str; 508 | } 509 | 510 | char JLIsList(JLValue *value) 511 | { 512 | if(value && value->tag == JLVALUE_LIST) { 513 | return 1; 514 | } else { 515 | return 0; 516 | } 517 | } 518 | 519 | JLValue *JLGetHead(JLValue *value) 520 | { 521 | return value->value.lst; 522 | } 523 | 524 | JLValue *JLGetNext(JLValue *value) 525 | { 526 | return value->next; 527 | } 528 | 529 | void JLPrint(const JLContext *context, const JLValue *value) 530 | { 531 | JLValue *temp; 532 | if(value == NULL || value->tag == JLVALUE_NIL) { 533 | printf("nil"); 534 | return; 535 | } 536 | switch(value->tag) { 537 | case JLVALUE_NUMBER: 538 | printf("%g", value->value.number); 539 | break; 540 | case JLVALUE_STRING: 541 | printf("\"%s\"", value->value.str); 542 | break; 543 | case JLVALUE_LIST: 544 | printf("("); 545 | for(temp = value->value.lst; temp; temp = temp->next) { 546 | JLPrint(context, temp); 547 | if(temp->next) { 548 | printf(" "); 549 | } 550 | } 551 | printf(")"); 552 | break; 553 | case JLVALUE_LAMBDA: 554 | printf("(lambda "); 555 | for(temp = value->value.lst->next; temp; temp = temp->next) { 556 | JLPrint(context, temp); 557 | if(temp->next) { 558 | printf(" "); 559 | } 560 | } 561 | printf(")"); 562 | break; 563 | case JLVALUE_SPECIAL: 564 | printf("special@%p(%p)", value->value.special.func, 565 | value->value.special.extra); 566 | break; 567 | case JLVALUE_VARIABLE: 568 | printf("%s", value->value.str); 569 | break; 570 | default: 571 | printf("\n?\n"); 572 | break; 573 | } 574 | } 575 | 576 | -------------------------------------------------------------------------------- /src/jli.c: -------------------------------------------------------------------------------- 1 | /** 2 | * @file jli.c 3 | * @authoer Joe Wingbermuehle 4 | * 5 | * This is a REPL for interfacing with JL on the command line. 6 | * 7 | */ 8 | 9 | #include "jl.h" 10 | 11 | #include 12 | #include 13 | 14 | static struct JLValue *PrintFunc(struct JLContext *context, 15 | struct JLValue *args, 16 | void *extra) 17 | { 18 | struct JLValue *vp; 19 | for(vp = JLGetNext(args); vp; vp = JLGetNext(vp)) { 20 | struct JLValue *result = JLEvaluate(context, vp); 21 | if(JLIsString(result)) { 22 | printf("%s", JLGetString(result)); 23 | } else { 24 | JLPrint(context, result); 25 | } 26 | JLRelease(context, result); 27 | } 28 | return NULL; 29 | } 30 | 31 | static struct JLValue *ProcessBuffer(struct JLContext *context, 32 | const char *line) 33 | { 34 | struct JLValue *result = NULL; 35 | while(*line) { 36 | struct JLValue *value = JLParse(context, &line); 37 | if(value) { 38 | JLRelease(context, result); 39 | result = JLEvaluate(context, value); 40 | JLRelease(context, value); 41 | } 42 | } 43 | return result; 44 | } 45 | 46 | int main(int argc, char *argv[]) 47 | { 48 | struct JLContext *context; 49 | struct JLValue *result; 50 | char *line = NULL; 51 | size_t cap = 0; 52 | char *filename = NULL; 53 | 54 | if(argc == 2) { 55 | filename = argv[1]; 56 | } else if(argc != 1) { 57 | printf("usage: %s \n", argv[0]); 58 | return -1; 59 | } else { 60 | printf("JL Interpreter v%d.%d\n", JL_VERSION_MAJOR, JL_VERSION_MINOR); 61 | printf("Type ^D to exit\n"); 62 | } 63 | 64 | context = JLCreateContext(); 65 | JLDefineSpecial(context, "print", PrintFunc, NULL); 66 | 67 | if(filename) { 68 | FILE *fd = fopen(filename, "r"); 69 | size_t len = 0; 70 | size_t max_len = 16; 71 | if(!fd) { 72 | printf("ERROR: file \"%s\" not found\n", filename); 73 | return -1; 74 | } 75 | line = (char*)malloc(max_len); 76 | for(;;) { 77 | const int ch = fgetc(fd); 78 | if(ch == EOF) { 79 | line[len] = 0; 80 | break; 81 | } 82 | if(len >= max_len) { 83 | max_len *= 2; 84 | line = (char*)realloc(line, max_len); 85 | } 86 | line[len] = (char)ch; 87 | len += 1; 88 | } 89 | fclose(fd); 90 | result = ProcessBuffer(context, line); 91 | JLRelease(context, result); 92 | } else { 93 | for(;;) { 94 | printf("> "); fflush(stdout); 95 | const ssize_t len = getline(&line, &cap, stdin); 96 | if(len <= 0) { 97 | break; 98 | } 99 | result = ProcessBuffer(context, line); 100 | printf("=> "); 101 | JLPrint(context, result); 102 | printf("\n"); 103 | JLRelease(context, result); 104 | } 105 | } 106 | if(line) { 107 | free(line); 108 | } 109 | JLDestroyContext(context); 110 | 111 | return 0; 112 | 113 | } 114 | 115 | --------------------------------------------------------------------------------