other module/example?
How will wiki and blog be affected if at all?
- Welcome to newLISP Fan Club.
This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
#1
newLISP newS / cgi.lsp obsolete?
November 05, 2004, 11:23:57 AMother module/example?
How will wiki and blog be affected if at all?
#2
newLISP newS / I can work with s-expressions in newLISP - I'm happy
October 19, 2004, 02:49:33 PMThis looks okay to me.
#3
Anything else we might add? / I solved my problem on the daylight-corrected-timezone
October 15, 2004, 03:31:50 PMI did a work around in the cron.lsp so that it corrects
for the timezone adjusted for daylight savings time
if the computer adjusts the clock. That way crontab
entries are good to go. The cron.lsp utility will
automatically adjust when we go on/off daylight
savings time without restarting. (If the crontab
file changes it will automatically be reloaded by
cron within 1 minute.)
John
#4
newLISP newS / compile.lsp
October 15, 2004, 09:07:23 AMCode Select
;; usage: newlisp compile.lsp executable source.lsp
;; Note: requires link.lsp in the same directory.
;; To compile.lsp rename this file to cnl.lsp
;; and copy and paste "link.lsp" inline replacing
;; (load "link.lsp") below with this inline copy.
;; Now you can compile cnl.lsp with:
;;
;; newlisp compile.lsp cnl[.exe] cnl.lsp
;;
;; You can then use cnl like this:
;;
;; cnl executable source
(load "link.lsp")
(set 'os (& 0x0F (last (sys-info))))
(if (find os '(5 6))
(set 'newlisp "newlisp.exe")
(set 'newlisp "newlisp"))
(set 'argv (main-args))
(if (starts-with (first argv) "newlisp")
(set 'offset 1)
(set 'offset 0))
(if (< (length argv) (+ 3 offset))
(begin
(println)
(print "Usage: " (first argv))
(if (> offset 0)
(print " compile.lsp"))
(println " executable source.lsp")
(exit)))
(set 'executable-file (nth (+ 1 offset) argv))
(set 'source-file (nth (+ 2 offset) argv))
(link newlisp executable-file source-file)
(exit)
#5
newLISP and the O.S. / deleted
October 14, 2004, 12:30:58 PM #6
Anything else we might add? / Timezone and daylight savings time
October 14, 2004, 11:39:45 AMreturns UTC while
(date (apply date-value (now))
returns the proper timezone corrected for daylight
savings time if the computer clock is set
to daylight savings time. Without parsing
the output of
(date (apply date-value (now))
is there a way to determine wether or not daylight
savings time is in effect on the computer? The
reason I ask is so that I can write something like
(set 'timezone (- 0 (last (now))))
(now timezone)
and get back the "now" list corrected not just
for the timezone but corrected for daylight savings
time as well.
#7
newLISP and the O.S. / deleted
October 14, 2004, 11:17:28 AM #8
newLISP and the O.S. / A Unix like cron scheduler for windows
October 13, 2004, 06:25:45 PMrunning task could overshadow an adjacent alarm
if it runs past its trigger time.
Code Select
;; A Unix like cron scheduler for Windows.
;; by John W. Small
;; usage: newlisp cron.lsp [crontab]
;; crontab file:
;;
;; # This is a comment!
;;
;; # Fields:
;;
;; # minute: 0-59
;; # hour: 0-23
;; # day of the month: 1-31
;; # month of the year: 1-12
;; # day of the week: 0-6 with Sunday = 0
;;
;; # Field may contain a number, i.e. 5
;; # A comma separated (no spaces), i.e. 5,6,7
;; # A range (no spaces), i.e. 5-7
;; # an asterisk, i.e. * meaning all values
;;
;; # Scheduled tasks
;; # min hour monthday month weekday command arg
;;
;; 0 22 * * * start e:/backup/nightly.bat
;; 30 23 * * 5 start e:/backup/weekly.bat
(set 'crontab "crontab")
(set 'crontab-last-modified nil)
(set 'crontab-contents nil)
; find crontab
(let ((argv (main-args)))
(let ((argc (length argv)))
(if (> argc (if (= (first argv) "newlisp") 2 1))
(set 'crontab (nth (- argc 1) argv)))))
(if (not (file? crontab))
(begin
(println)
(println "crontab not found: " crontab)
(exit)))
(define (set-daylight-corrected-timezone)
(set 'daylight-corrected-timezone (- 0 (last (now))))
(let ((local-date (parse (date (apply date-value (now))) {s+} 0)))
(let ((local-time (nth 3 local-date)))
(let ((local-hour (integer (first (parse local-time ":"))))
(local-timezone-hour (nth 3 (now daylight-corrected-timezone))))
(set 'daylight-corrected-timezone
(+ daylight-corrected-timezone
(* 60 (- local-hour local-timezone-hour))))))))
; re-load crontab if changed
(define (crontab-refresh , crontab-file row-idx line fields)
(set-daylight-corrected-timezone)
(let ((last-modified (nth 6 (file-info crontab))))
(if (or (not crontab-last-modified)
(> last-modified crontab-last-modified))
(begin
(println)
(println (date (apply date-value (now))))
(println "Loading crontab: " crontab)
(set 'crontab-last-modified last-modified)
(set 'crontab-file (open crontab "read"))
(set 'crontab-contents '())
(set 'row-idx 0)
(while (read-line crontab-file)
(set 'line (trim (current-line)))
(set 'fields (filter (fn (f) (> (length f) 0))
(parse line {s+} 0)))
(if (and (> (length fields) 0)
(!= (nth 0 (first fields)) "#"))
(begin
(push fields crontab-contents row-idx)
(inc 'row-idx))))
(close crontab-file))))
crontab-contents)
(define (alarmed? scheduled actual , after before)
(or (= scheduled "*")
(cond
((find "," scheduled)
(find actual (map integer (parse scheduled ","))))
((find "-" scheduled)
(map set '(after before) (map integer (parse scheduled "-")))
(and (>= actual after) (<= actual before)))
(true
(= actual (integer scheduled))))))
;; list-let usage:
;;
;; (list-let '(1 2 3) (x y z)
;; (println x y z)
;; (list x y z))
(define-macro (list-let _values _vars)
(let ((bindings (map (fn (_var _value) (list _var _value))
_vars (eval _values)))
(body (rest (rest (args)))))
(eval (cons 'let (cons bindings body)))))
(while (crontab-refresh)
(list-let (now daylight-corrected-timezone)
(year month day hour minute sec micsec doy dow tz)
(dec 'dow)
(dolist (crontab-record crontab-contents)
(list-let crontab-record
(t_minute t_hour t_day t_month t_dow t_cmd t_arg)
(if (and
(alarmed? t_month month)
(alarmed? t_day day)
(alarmed? t_dow dow)
(alarmed? t_hour hour)
(alarmed? t_minute minute))
(if (file? t_arg)
(begin
(println)
(println (date (apply date-value (now))))
(println "Alarm on: " (join crontab-record " "))
(println t_cmd " " t_arg)
(exec t_arg)))))))
(sleep 60000))
(exit)
#9
Anything else we might add? / Question on (parse ...
October 13, 2004, 01:58:41 PMCode Select
> (parse "Hello World" {s+} 0)
("Hello" "World")
;; it works! And
> (parse "" {s+} 0)
()
;; it also works. But then
> (parse " " {s+} 0)
("" "")
;; Is this right? I want to get back an empty list.
#10
newLISP newS / list and association list cracking macros
October 10, 2004, 02:45:46 PMwith symbolic data structures.
The "list-let" macro below allows you to map
the elements of a list to "let" bindings.
Code Select
(define-macro (list-let _values _vars)
(let ((bindings (map (fn (_var _value) (list _var _value))
_vars (eval _values)))
(body (rest (rest (args)))))
(eval (cons 'let (cons bindings body)))))
(list-let '("John Doe" "Acme Widgets" "1-800-123-4567")
(name company phone)
(list company phone name))
;; => ("Acme Widgets" "1-800-123-4567" "John Doe")
The "alist-let" macro below allows you to map association
list values to let-bindings. The key name can be aliased
optionally along with a default value if the association is
not present.
Code Select
(define-macro (alist-let _alist _var-alias-defaults)
(let ((_alist (eval _alist)))
(let ((bindings
(map (fn (_var-alias-default , _value _alias _default)
(if (list? _var-alias-default)
(begin
(set '_value (assoc (first _var-alias-default) _alist))
(set '_alias (first (rest _var-alias-default)))
(set '_default (rest (rest _var-alias-default))))
(begin
(set '_alias _var-alias-default)
(set '_value (assoc _var-alias-default _alist))))
(if (list? _value)
(if (> (length _value) 2)
(list _alias (cons 'list (rest _value)))
(list _alias (first (rest _value))))
(list _alias _value)))
_var-alias-defaults))
(body (rest (rest (args)))))
(eval (cons 'let (cons bindings body))))))
(alist-let '((name "John" "Doe") (company "Acme Widgets") (phone "1-800-123-4567"))
(phone (name name1) (country country1 "USA") (company company1))
(list company1 phone name1 country1))
;; => ("Acme Widgets" "1-800-123-4567" ("John" "Doe") "USA")
Notice that the lookup returns a singleton value as is otherwise
a list is returned (see ("John Doe")).
While you can use context objects for synthesizing structures
these two macros allow you to to "crack" list structures
conveniently.
#11
Anything else we might add? / newLISP for PDA's and Pocket PC's
October 08, 2004, 05:55:04 AMmobile platforms?
#12
newLISP newS / lexical lambda's where ever you want them
October 01, 2004, 11:51:53 AMlexical scope behavior whenever you need it.
Code Select
(define z 3)
(define foo
(let ((y 2))
(expand (lambda (x) (list x y z)) 'y 'z)))
(foo 1) ;; ==> (1 2 3)
The "expand" built-in function takes its first
argument, e.g. the lambda expression here, and
expands all symbols within it to the values
calculated by evaluating the remaining
symbolic arguments.
Since the dynamic scope of "expand" is also the
lexical scope of lambda this results in the
expected behavior. Thus the "foo" above is bound
to the following lambda list:
Code Select
> foo
(lambda (x) (list x 2 3))
The following convenience macro expand-let lets
you set up lexical scope behavior wherever.
Code Select
(define z 3)
(define foo
(expand-let
(lambda (x) (list x y z))
(y 2) (z z)))
Now you can whichever scoping strategy you want,
lexical or dynamic.
Code Select
(define-macro (expand-let )
(eval
(cons 'let
(cons (rest (args))
(list (cons 'expand
(cons (first (args))
(map (fn (arg) (apply quote (list (first arg))))
(rest (args))))))))))
#13
newLISP newS / func-lettes, currying and other useful macros
October 01, 2004, 11:32:48 AMfor user defined functions. For example
Code Select
(define (foo x y) (+ x y))
> (fn-let foo (x 1))
(lambda (y) (let ((x 1)) (+ x y)))
fn-let creates a new lambda list with the curried
arguments moved into the internalize let expression.
Code Select
(define-macro (fn-let _f )
(let ((fargs (first (eval _f)))
(body (rest (eval _f)))
(cargs (map (fn (k-v) (first k-v)) (rest (args))))
(bindings (map (fn (k-v)
(list (first k-v)
(eval (last k-v))))
(rest (args)))))
(let ((new-fargs (difference fargs cargs))
(new-body (cons 'let (cons bindings body))))
(eval
(expand '(lambda new-fargs new-body)
'new-fargs 'new-body)))))
This will not work for built-in functions which
are not lambda lists. The following curry and rcurry
will work for built-ins but are not as generic as fn-let.
Code Select
(define (eval-args _args)
(map (fn (arg) (eval arg)) _args))
(define-macro (curry _f )
(let ((f (eval _f))
(cargs (eval-args (rest (args)))))
(expand
(lambda-macro ( )
(apply f (append (quote cargs) (eval-args (args)))))
'f 'cargs)))
(define-macro (rcurry _f )
(let ((f (eval _f))
(cargs (eval-args (rest (args)))))
(expand
(lambda-macro ( )
(apply f (append (eval-args (args)) (quote cargs))))
'f 'cargs)))
The following examples show how curried
functions can be used to factor problems.
Code Select
(define (math-series op init f a a++ >b?)
(if (>b? a)
init
(math-series op (op init (f a)) f (a++ a) a++ >b?)))
(define (summation f a step b)
(math-series add 0 f a (curry add step) (rcurry > b)))
(define (sigma f a b)
(summation f a 1 b))
(sigma add 1 3) ;; ==> 6
(define (step-integral dx f a)
(mul dx (f a)))
(define (integrate f a b dx)
(summation (fn-let step-integral (dx dx) (f f)) a dx b))
(define (line m b x)
(add (mul m x) b))
(integrate (fn-let line (m 1) (b 0)) 0 1 0.01) ;; 0.495 ...
(define (product f a b)
(math-series mul 1 f a (curry + 1) (rcurry > b)))
(define (factorial n)
(product mul 1 n))
(factorial 5) ;; ==> 120
(sigma (lambda (n) (/ 1.0 (factorial n))) 0 20)
;; ==> 2.7182 ...
I find these additonal macros and list functions
useful also.
Code Select
(define-macro (disjoin )
(let ((_f (eval (first (args))))
(_fs (eval-args (rest (args)))))
(expand
(lambda (arg , result f fs)
(set 'result false)
(set 'f _f)
(set 'fs (quote _fs))
(while (and f (not result))
(set 'result (f arg))
(set 'f (first fs))
(set 'fs (rest fs)))
result)
'_f '_fs)))
(define-macro (conjoin )
(let ((_f (eval (first (args))))
(_fs (eval-args (rest (args)))))
(expand
(lambda (arg , result f fs)
(set 'result true)
(set 'f _f)
(set 'fs (quote _fs))
(while (and f result)
(set 'result (f arg))
(set 'f (first fs))
(set 'fs (rest fs)))
result)
'_f '_fs)))
(define (fold-left f init xs)
(if (empty? xs)
init
(fold-left f (f init (first xs)) (rest xs))))
(define (fold-right f xs init)
(if (empty? xs)
init
(f (first xs) (fold-right f (rest xs) init))))
(define-macro (compose )
(let ((_fns (eval-args (reverse (args)))))
(expand
(lambda-macro ( )
(let ((fns (quote _fns))
(init (eval-args (args))))
(if (empty? fns)
init
(fold-left
(lambda (init f) (f init))
(apply (first fns) init)
(rest fns)))))
'_fns)))
(define (every pred? xs)
(or (empty? xs)
(and (pred? (first xs))
(every pred? (rest xs)))))
(define (some pred? xs)
(and (and (list? xs) (not (empty? xs)))
(or (pred? (first xs))
(some pred? (rest xs)))))
The following snippet show how these can be used.
Code Select
(every integer? '(1 2 3 4)) ;; ==> true
(some integer? '(a b c 4 d)) ;; ==> nil
(filter (disjoin symbol? string?) '(1 a 2 "two" 3))
;; (a "two")
#14
Anything else we might add? / lambda(-macro) ideas
September 28, 2004, 06:48:52 AMexcept that the former had strict evaluation of actual
arguments and the latter lazy evaluation of actual
arguments. Make this the default behavior (which it is
now). But suppose newlisp had atomatized behavior like
this:
(lambda (x ~y) ....) ;; y is lazy
(lambda-macro (!x y) ...) ;; x is strict
Also if newlisp allowed something like the following
(define (foo x y) ...)
(~foo 1)
which had the effect of cloning foo on the fly
returning
(lambda (y , x) (set 'x 1) ... ;; old foo)
then this would allow transparent currying. It seems
with the lambda lists that doing this sort of thing
of rotating argument would not be that difficult to
add to newlisp.
The default behavior of
(define (bar) ...)
(~bar)
would simply return bar.
A different approach to:
(lambda (x ~y) .... (eval y) ...) ;; y is lazy
could be
(lambda (x (f y)) .... (f x) ...) ;; y is lambda argument
This would be interpreted as
(lambda-macro (!x f-body)
(set 'f (expand (lambda (y) f-body) 'f-body))
...)
We could then call it like this
((lambda (x (f y)) ... (f y) ...) 1 (println y))
In other words the actual argument passed would be
wrapped in a lambda expression having a y argument.
Instead of our expression being lazily evaluated it would
be delay evaluated, i.e. call by function instead of call by
name.
#15
Anything else we might add? / quasiquote and ref
September 28, 2004, 06:43:14 AMCode Select
(define-macro (qq s-exp)
(while (set 'idx (chop (ref 'uq s-exp)))
(set 'qx (pop s-exp idx))
(push (eval (first (rest qx))) s-exp idx))
s-exp)
;; now use it
(set 'x 'hello)
(qq ( (uq (+ 1 2)) ((uq (+ 3 4)) (uq x)))) => (3 (7 hello))
;; something similar could be done for 'uq@'
1. It would be nice if "ref" had a version that took a predicate, e.g.
Code Select
(ref? (lambda (s-expr) (or (= 'uq s-expr) (= 'uq@ s-expr)))
s-exp)
and returned the ref path along with the value returned by
the predicate.
2. Also if the continuation bookmark could be captured and
returned as well so that the depth first? search could continue
from where it left off that would also be nice.
Essentially my longer version was taking this approach (1 & 2) but
the size and speed advantage of your approach is obvious.