Code 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)
- 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.
Pages1
#1
newLISP newS / compile.lsp
October 15, 2004, 09:07:23 AM #2
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.
#3
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)
#4
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.
#5
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.
#6
Anything else we might add? / newLISP for PDA's and Pocket PC's
October 08, 2004, 05:55:04 AMmobile platforms?
#7
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))))))))))
#8
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")
#9
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.
#10
Anything else we might add? / a quasiquote implementation in newLisp
September 26, 2004, 12:10:26 PMa quasiquote / unquote mechanism in newlisp.
Note the use of uq and uq@.
Code Select
;; usage: (qq (x y (uq (+ 1 2)) (uq@ (list 1 2 3))))
;; ==> (x y 3 1 2 3)
(define-macro (qq s-expr)
(qq-eval s-expr))
;; Since qq is a macro you can't use (args) within.
;; Use qq-eval instead which is not a macro and thus
;; (args) will not capture the qq's (args).
;; usage: (qq-eval '(x y (uq (+ 1 2)) (uq@ (list 1 2 3))))
;; ==> (x y 3 1 2 3)
(define (qq-eval s-expr , i)
(if (list? s-expr)
(begin
(setq i 0)
(while (< i (length s-expr))
(let ((ss-expr (nth i s-expr)))
(if (list? ss-expr)
(cond
((= 'uq (first ss-expr))
(nth-set i s-expr (eval (qq-eval (last ss-expr))))
(inc 'i))
((= 'uq@ (first ss-expr))
(let ((ss-exprs (eval (qq-eval (last ss-expr)))))
(if (list? ss-exprs)
(begin
(pop s-expr i)
(dotimes (j (length ss-exprs))
(push (nth j ss-exprs) s-expr i)
(inc 'i)))
(begin
(nth-set i s-expr ss-exprs)
(inc 'i)))))
(true
(nth-set i s-expr (qq-eval ss-expr))
(inc 'i)))
(begin
(inc 'i)
s-expr))))
s-expr)
s-expr))
The following demonstrates the use of qq and qq-eval.
Code Select
;; Abbreviation for lambda or fn
(define-macro ( )
(eval (qq-eval '(lambda (uq (first (args))) (uq@ (rest (args)))))))
;; Abbreviation for define
(define-macro (: _var-or-fn _value)
(if (list? _var-or-fn)
(eval (qq-eval '(define (uq _var-or-fn) (uq@ (rest (args))))))
(eval (qq (set _var-or-fn (uq _value))))))
Notice that qq is not used whenever (args)
appears in the expression being quasiquoted.
I'm hoping this makes writing macros more
convenient in newLisp.
Warning: I've only briefly tested this.
#11
Whither newLISP? / modified expand-let and other macros
September 25, 2004, 07:40:29 PMthe previous two definitions of expand-let. This is
Lutz's version slightly edited.
(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))))))))))
> (expand-let '(x y z) (x 1) (y (+ 1 1)) (z 3))
(1 2 3)
I've noticed that expand-let used within a define-macro
is not a good idea if you intend to use (args) within the let
part. The problem is that it is lazily evalued within the expand-let
macro itself and thus pulls the wrong arguments.
For example consider a macro "" as a replacement for
lambda or fn.
;; wrong!!!
(define-macro ( )
(expand-let (lambda fargs body)
(fargs (first (args)))
(body (cons 'begin (rest (args))))))
;; correct
(define-macro ( )
(let ((fargs (first (args)))
(body (cons 'begin (rest (args)))))
(expand (lambda fargs body) 'fargs 'body)))
This also shows how "expand" is used with define-macro
together to constitute a macro expansion facility.
The define-macro by itself is just a lambda expression
with lazily evaluated arguments. I was hoping that
expand-let would make a more convenient synthesis of
a quasiquote/unquote mechanism. (I'm working on
implementing the quasiquote macro which will call
qq-eval and qq-eval-@ functions to synthesize unquote
and ,@ constructs.)
Perhaps the macro above is mainly of academic
interest but I never the less find an abbreviation for
"define" convenient and semantically pleasing. (Any
comments?)
(define-macro (: _var-or-fn _value)
(if (list? _var-or-fn)
(let ((_fn-name (first _var-or-fn))
(_fargs (rest _var-or-fn))
(_body (cons 'begin (rest (args)))))
(set _fn-name (expand (lambda _fargs _body)
'_fargs '_body)))
(set _var-or-fn (eval _value))))
(: rows '((a11 a12 a13)(a21 a22 a33)(a31 a32 a33)))
(: (id x) x)
> rows
((a11 a12 a13)(a21 a22 a33)(a31 a32 a33))
> (map id '(1 2 3))
(1 2 3)
But I guess convenience should be of form and not
just syntactical sugar in order to warrant the
overhead of calling a macro.
(More macros are coming.)
#12
Whither newLISP? / Macros and expand
September 24, 2004, 12:49:04 PMexpand with macros.
So I define the macro "expand-let"
with the following semantics.
(expand-let '(x y z) (x 1) (y 2) (z 3))
"expands" to the equivalent of
(let ((x 1)(y 2)(z 3))
(expand '(x y z) 'x 'y 'z))
returning
(1 2 3)
The following is my implementation of this semantics
(define (keys alist)
(map (fn (pair) (first pair)) alist))
(define (bindings alist)
(map (fn (pair) (cons (first pair) (eval (last pair)))) alist))
(define-macro (expand-let expr)
(let ((ks (keys (rest (args))))
(bs (bindings (rest (args)))))
(eval (expand '(let bs
(apply expand (cons (eval expr) (quote ks))))
'ks 'bs))))
Is the above definition of expand-let reasonable
or is it poorly constructed?
(I have a follow up example/question that builds on nested
macros if this is okay thus far.)
Thanks.
#13
Whither newLISP? / Struggling to grasp newlisp macros
September 23, 2004, 08:19:18 PMdefine-macro works.
>(define-macro (foo _x _x) (list _x _y))
(lambda-macro (_x _y) (list _x _y))
> (foo 1 2)
(1 2)
> (foo a b)
(a b)
So far so good. Conceptually I'm thinking the macro
invocation is a two step process.
> (foo a b)
((lambda-macro (_x _x) (list _x _y)) 'a 'b)
which returns
(list 'a 'b)
which is then interpreted normally returning
(a b)
But now when I define bar
> (define-macro (bar _x _y) (fn () (list _x _y))
(lambda-macro (_x _y) (lambda () (list _x _y)))
and apply it to
> (bar a b)
(lambda () (list _x _y))
But I expected from my obviously wrong conceptual
model for
> (bar a b)
> ((lambda-macro (_x _y) (lambda () (list _x _y)) 'a 'b)
to have returned
(lambda () (list 'a 'b))
But it returned instead
(lambda () (list _x _y))
It appears that the internally defined lambda expression
is evaluated without substituting 'a and 'b in place
of _x and _y formal arguments.
What's happening? Where is my thinking wrong?
Thanks
#14
Whither newLISP? / variable length argument lists
September 21, 2004, 07:12:15 PMis the preferred idiom for specifying a function
taking a variable number of arguments?
Do you simply have to anticipate these optional arguments?
(define (foo x y z) ...)
But if this is the case than passing this variable number
of arguments onto another such function such as a native
function is problematic.
(define (foo x y z) (+ x y z)) ;; no good if y or z is nil
Do I have to resort to prepacking my arguments into an array.
(define (foo x optargs-list)
(apply + (cons x optargs-list)))
#15
newLISP and the O.S. / newlisp-tk on windows
September 21, 2004, 02:08:47 PMI get this error message which doesn't seem to effective anything
else negatively.
Error sourcing /freewrap/newlisp-tk.tcl: couldn't change
working directory to "c:/newlisp/": no such file or directory
I installed newlisp in a directory different from "c:/newlisp".
Can I safely ignore this error message?
#16
Whither newLISP? / quasiquote and unqoute
September 19, 2004, 06:48:59 PM`(1 , (+ 2 3))
So that it evaluates to:
(1 5)
It looks like I have to use some like a macro to achieve this
effect.
Pages1