projects
/
jscl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Move package code to the beginning of th file
[jscl.git]
/
test.lisp
diff --git
a/test.lisp
b/test.lisp
index
3676a91
..
489c36c
100644
(file)
--- a/
test.lisp
+++ b/
test.lisp
@@
-12,15
+12,25
@@
(%compile-defvar ',name))
(setq ,name ,value)))
(%compile-defvar ',name))
(setq ,name ,value)))
-(defvar t 't)
-(defvar nil 'nil)
-
(defmacro defun (name args &rest body)
`(progn
(eval-when-compile
(%compile-defun ',name))
(fsetq ,name (lambda ,args ,@body))))
(defmacro defun (name args &rest body)
`(progn
(eval-when-compile
(%compile-defun ',name))
(fsetq ,name (lambda ,args ,@body))))
+(defvar *package* (new))
+
+(defvar t 't)
+(defvar nil 'nil)
+
+(defun intern (name)
+ (let ((s (get *package* name)))
+ (if s s (set *package* name (make-symbol name)))))
+
+(defun find-symbol (name)
+ (get *package* name))
+
+
(defmacro when (condition &rest body)
`(if ,condition (progn ,@body) nil))
(defmacro when (condition &rest body)
`(if ,condition (progn ,@body) nil))
@@
-61,9
+71,6
@@
(defun atom (x)
(not (consp x)))
(defun atom (x)
(not (consp x)))
-(defun listp (x)
- (or (consp x) (null x)))
-
(defun ensure-list (x)
(if (listp x)
x
(defun ensure-list (x)
(if (listp x)
x
@@
-89,13
+96,18
@@
(defmacro decf (x)
`(setq ,x (1- ,x)))
(defmacro decf (x)
`(setq ,x (1- ,x)))
-(defun length (list)
+(defun list-length (list)
(let ((l 0))
(while (not (null list))
(incf l)
(setq list (cdr list)))
l))
(let ((l 0))
(while (not (null list))
(incf l)
(setq list (cdr list)))
l))
+(defun length (seq)
+ (if (stringp seq)
+ (string-length seq)
+ (list-length seq)))
+
(defun mapcar (func list)
(if (null list)
'()
(defun mapcar (func list)
(if (null list)
'()
@@
-105,17
+117,6
@@
(defmacro push (x place)
`(setq ,place (cons ,x ,place)))
(defmacro push (x place)
`(setq ,place (cons ,x ,place)))
-(defvar *package* (new))
-
-(defun intern (name)
- (let ((s (get *package* name)))
- (if s
- s
- (set *package* name (make-symbol name)))))
-
-(defun find-symbol (name)
- (get *package* name))
-
(defmacro cond (&rest clausules)
(if (null clausules)
nil
(defmacro cond (&rest clausules)
(if (null clausules)
nil
@@
-222,10
+223,15
@@
(defun char= (x y) (= x y))
(defun char= (x y) (= x y))
+(defun <= (x y) (or (< x y) (= x y)))
+(defun >= (x y) (not (< x y)))
+
+(defun listp (x)
+ (or (consp x) (null x)))
+
(defun integerp (x)
(and (numberp x) (= (floor x) x)))
(defun integerp (x)
(and (numberp x) (= (floor x) x)))
-
(defun last (x)
(if (null (cdr x))
x
(defun last (x)
(if (null (cdr x))
x
@@
-252,29
+258,32
@@
((eql x (car list))
(remove x (cdr list)))
(t
((eql x (car list))
(remove x (cdr list)))
(t
- (cons (car x) (remove x (cdr list))))))
+ (cons (car list) (remove x (cdr list))))))
(defun digit-char-p (x)
(defun digit-char-p (x)
- (if (and (< #\0 x) (< x #\9))
+ (if (and (<= #\0 x) (<= x #\9))
(- x #\0)
nil))
(defun parse-integer (string)
(let ((value 0)
(index 0)
(- x #\0)
nil))
(defun parse-integer (string)
(let ((value 0)
(index 0)
- (size (string-length string)))
+ (size (length string)))
(while (< index size)
(setq value (+ (* value 10) (digit-char-p (char string index))))
(while (< index size)
(setq value (+ (* value 10) (digit-char-p (char string index))))
- (incf index))))
+ (incf index))
+ value))
(defun every (function seq)
;; string
(let ((ret t)
(index 0)
(defun every (function seq)
;; string
(let ((ret t)
(index 0)
- (size (string-length seq)))
+ (size (length seq)))
(while (and ret (< index size))
(unless (funcall function (char seq index))
(while (and ret (< index size))
(unless (funcall function (char seq index))
- (setq ret nil)))))
+ (setq ret nil))
+ (incf index))
+ ret))
(defun eql (x y)
(eq x y))
(defun eql (x y)
(eq x y))
@@
-322,7
+331,6
@@
(defun terminalp (ch)
(or (null ch) (whitespacep ch) (char= #\) ch) (char= #\( ch)))
(defun terminalp (ch)
(or (null ch) (whitespacep ch) (char= #\) ch) (char= #\( ch)))
-
(defun read-until (stream func)
(let ((string "")
(ch))
(defun read-until (stream func)
(let ((string "")
(ch))
@@
-422,12
+430,10
@@
(parse-integer string)
(intern (string-upcase string))))))))
(parse-integer string)
(intern (string-upcase string))))))))
-
(defun ls-read-from-string (string)
(ls-read (make-string-stream string)))
(defun ls-read-from-string (string)
(ls-read (make-string-stream string)))
-
;;;; Compiler
(defvar *compilation-unit-checks* '())
;;;; Compiler
(defvar *compilation-unit-checks* '())
@@
-516,8
+522,8
@@
(remove nil (mapcar (lambda (x)
(ls-compile x env fenv))
sexps))
(remove nil (mapcar (lambda (x)
(ls-compile x env fenv))
sexps))
- ";
-"))
+ (concat ";" *newline*)))
+
(defmacro define-compilation (name args &rest body)
;; Creates a new primitive `name' with parameters args and
;; @body. The body can access to the local environment through the
(defmacro define-compilation (name args &rest body)
;; Creates a new primitive `name' with parameters args and
;; @body. The body can access to the local environment through the
@@
-560,7
+566,7
@@
*newline*
(if rest-argument
(let ((js!rest (lookup-variable-translation rest-argument new-env)))
*newline*
(if rest-argument
(let ((js!rest (lookup-variable-translation rest-argument new-env)))
- (concat "var " js!rest ";" *newline*
+ (concat "var " js!rest "= false;" *newline*
"for (var i = arguments.length-1; i>="
(integer-to-string (length required-arguments))
"; i--)" *newline*
"for (var i = arguments.length-1; i>="
(integer-to-string (length required-arguments))
"; i--)" *newline*
@@
-788,7
+794,7
@@
(defun macrop (x)
(and (symbolp x) (eq (binding-type (lookup-function x *fenv*)) 'macro)))
(defun macrop (x)
(and (symbolp x) (eq (binding-type (lookup-function x *fenv*)) 'macro)))
-(defun ls-macroexpand-1 (form &optional env fenv)
+(defun ls-macroexpand-1 (form env fenv)
(when (macrop (car form))
(let ((binding (lookup-function (car form) *env*)))
(if (eq (binding-type binding) 'macro)
(when (macrop (car form))
(let ((binding (lookup-function (car form) *env*)))
(if (eq (binding-type binding) 'macro)
@@
-811,7
+817,7
@@
(t
(error (concat "Invalid function designator " (symbol-name function))))))
(t
(error (concat "Invalid function designator " (symbol-name function))))))
-(defun ls-compile (sexp &optional env fenv)
+(defun ls-compile (sexp env fenv)
(cond
((symbolp sexp) (lookup-variable-translation sexp env))
((integerp sexp) (integer-to-string sexp))
(cond
((symbolp sexp) (lookup-variable-translation sexp env))
((integerp sexp) (integer-to-string sexp))
@@
-826,7
+832,7
@@
(defun ls-compile-toplevel (sexp)
(setq *toplevel-compilations* nil)
(defun ls-compile-toplevel (sexp)
(setq *toplevel-compilations* nil)
- (let ((code (ls-compile sexp)))
+ (let ((code (ls-compile sexp nil nil)))
(prog1
(concat (join (mapcar (lambda (x) (concat x ";" *newline*))
*toplevel-compilations*)
(prog1
(concat (join (mapcar (lambda (x) (concat x ";" *newline*))
*toplevel-compilations*)
@@
-837,3
+843,6
@@
(defun eval (x)
(js-eval (ls-compile x nil nil)))
(defun eval (x)
(js-eval (ls-compile x nil nil)))
+
+
+(debug (eq (ls-read-from-string "+") '+))