Skip to content

Commit

Permalink
add some functions
Browse files Browse the repository at this point in the history
  • Loading branch information
kosh04 committed Mar 9, 2015
1 parent 787b837 commit bed2d7b
Show file tree
Hide file tree
Showing 7 changed files with 79 additions and 1 deletion.
17 changes: 17 additions & 0 deletions help.lsp
@@ -0,0 +1,17 @@
(define (apropos str (do-print true))
"Return symbols that matches the regexp."
(let ((acc (find-all str (symbols) $it
(lambda (x y)
(regex x (term y))))))
(when (and acc do-print)
(dolist (item acc)
(cond
((primitive? (eval item))
(println item "\t" "<primitive>"))
((lambda? (eval item))
(println item "\t" "<lambda>"))
((macro? (eval item))
(println item "\t" "<macro>"))
("else"
(println item)))))
acc))
4 changes: 4 additions & 0 deletions math.lsp
@@ -0,0 +1,4 @@
;;; math.lsp

;(import "msvcrt" "log10")
(define (log10 n) (log n 10))
15 changes: 15 additions & 0 deletions regex.lsp
Expand Up @@ -36,5 +36,20 @@
PRECOMPILED 0x10000
)

;; 正規表現のオプション(//six)を数値に変換するヘルパー関数
;; v.10.6.2 より直接指定が利用可能
(define (re kwd)
(letn ((opt 0)
(|| (lambda (i) (setq opt (| opt i)))))
(dostring (c kwd)
(case (char c)
("i" (|| 1)) ; PCRE_CASELESS
("m" (|| 2)) ; PCRE_MULTILINE
("s" (|| 4)) ; PCRE_DOTALL
("x" (|| 8)) ; PCRE_EXTENDED
(true (throw-error "unknown keyword"))))
opt))


(context MAIN)
;;; EOF
16 changes: 16 additions & 0 deletions sequence.lsp
@@ -0,0 +1,16 @@
;;; sequence.lsp

(define (sample seq)
(unless (or (list? seq)
(string? seq))
(throw-error "Error:LIST_OR_STRING_EXPECTED"))
;;(first (randomize seq true))
(seq (rand (length seq))))

;; syntax: (range [from] to [step])
(define (range)
(case (length (args))
(1 (sequence 0 (args 0)))
(2 (sequence (args 0) (args 1)))
(3 (sequence (args 0) (args 1) (args 2)))
(true '())))
17 changes: 17 additions & 0 deletions system.lsp
@@ -0,0 +1,17 @@
;;; system.lsp

(define (has x)
(let ((features '(("library" 0x040)
("utf8" 0x080)
("newlisp64" 0x100)
("ipv6" 0x200)
("ffi" 0x400))))
(!= 0 (& (or (lookup (lower-case x) features) 0)
(sys-info -1)))))

(define (die)
(if (args) (write 2 (apply format (args))))
(exit))

(define (%bits i (len 64))
(replace " " (format (string "%" len "s") (bits i)) "0"))
2 changes: 1 addition & 1 deletion unicode.lsp
@@ -1,4 +1,4 @@
;; unicode.lsp
;;; unicode.lsp

(define (utf8?)
"Non-nil means newLISP is UTF-8 eoncoding are supported."
Expand Down
9 changes: 9 additions & 0 deletions utils.lsp
@@ -0,0 +1,9 @@
;;; utils.lsp

(define (compose)
"Compose function right-associatively."
(letex ((_fns (reverse (args))))
(lambda (x)
(dolist (f '_fns)
(setf x (f x)))
x)))

0 comments on commit bed2d7b

Please sign in to comment.