Good show!
m i c h a e l
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.
Show posts Menu
> (net-eval "localhost" 4711 "(context 'C)" 1000)
C
> (net-eval "localhost" 4711 "(context)" 1000)
MAIN
> _
> (dolist (ea '((context 'C) (constant 'v 8) (context MAIN))) (eval ea))
ERR: symbol not in current context in function constant : MAIN:v
> _
> (new Class 'Thing)
Thing
> (set 'Thing:attribute 1)
1
> (constant 'Thing:attribute 1)
ERR: symbol not in current context in function constant : Thing:it
> _
> (dup (format "%c" $idx) 10)
("" " 01" " 02" " 03" " 04" " 05" " 06" " 07" " 08" "t")
> _
> (map (fn (ea) (format "%c" ea)) (sequence 0 9))
("" " 01" " 02" " 03" " 04" " 05" " 06" " 07" " 08" "t")
> (map (curry format "%c") (sequence 0 9))
("" " 01" " 02" " 03" " 04" " 05" " 06" " 07" " 08" "t")
(set (global 'extend) (lambda-macro (sig)
(eval
(cons 'define (cons sig
(expand (args) (list (list (sig 0) (eval (sig 0)))))
))
)
))
> (new Class 'Point)
Point
> (Point)
(Point)
> (extend (Point:Point (x 0) (y 0)) (Point:Point x y))
(lambda ((x 0) (y 0)) ((lambda () (cons (context) (args))) x y))
> (Point)
(Point 0 0)
> (Point 10)
(Point 10 0)
> (Point 10 20)
(Point 10 20)
> (Point 10 20 30)
(Point 10 20)
> ; or just regular functions (not built-ins)
> (define (f n) (* n n))
(lambda (n) (* n n))
> (f 5 5)
25
> (extend (f n (n2 0)) (+ (f n) n2))
(lambda (n (n2 0)) (+ ((lambda (n) (* n n)) n) n2))
> (f 5 5)
30
> ; you can keep going, but be careful
> (extend (f n (n2 0) (n3 0)) (+ (f n n2) (* n3 2)))
(lambda (n (n2 0) (n3 0)) (+ ((lambda (n (n2 0)) (+ ((lambda (n) (* n n)) n) n2))
n n2)
(* n3 2)))
> (f 5 5)
30
> (f 5 5 5)
40
> (f 5)
25
> _
(set (global 'obj) (fn (class that) (if that (setq class:obj that) class:obj)))
(extend (Class:Class) (obj (context) (apply Class:Class (args))))
> (new Class 'Author)
Author
> (extend (Author:Author (last-name "") (first-name "")) (Author:Author last-name first-name))
(lambda ((last-name "") (first-name "")) ((lambda () (obj (context) (apply (lambda
()
(cons (context) (args)))
(args)))) last-name first-name))
> (Author)
(Author "" "")
> (Author "Heller" "Joseph")
(Author "Heller" "Joseph")
> (obj Author)
(Author "Heller" "Joseph")
(define (Class:access it idx value allow-nil?)
(if (or value allow-nil?)
(begin (setf (it idx) value) (obj (it 0) it))
(it idx)
)
)
(define (Author:last-name it last-name) (:access it 1 last-name))
(define (Author:first-name it first-name) (:access it 2 first-name))
> (Author "" "Jerome")
(Author "" "Jerome")
> (:last-name (object Author) "Salinger")
(Author "Salinger" "Jerome")
> (:first-name (obj Author) "J.D.")
(Author "Salinger" "J.D.")
> (define (Author:string it) (string (:first-name it) " " (:last-name it)))
(lambda (it) (string (: first-name it) " " (: last-name it)))
> (:string (obj Author))
"J.D. Salinger"
> _
(new Tree 'Obj)
(set (global 'obj) (fn (a b)
(if
(string? a) (if (object? b) (Obj a b) (Obj a))
(object? a) (Obj b a)
(string? b) (Obj b a:obj)
(a:? b) (setq a:obj b)
(nil? b) a:obj
)
))
> (Author "Heller" "Joseph")
(Author "Heller" "Joseph")
> (obj Author "jh")
(Author "Heller" "Joseph")
> (obj (Author "Serling" "Rod") "rs")
(Author "Serling" "Rod")
> (obj "rs")
(Author "Serling" "Rod")
> (obj "jh")
(Author "Heller" "Joseph")
> _
> (obj (Author "Salinger" "Jerome") "jds")
(Author "Salinger" "Jerome")
> (:first-name (obj "jds") "J. D.")
(Author "Salinger" "J. D.")
> (obj Author "jds")
(Author "Salinger" "J. D.")
> (obj "jds")
(Author "Salinger" "J. D.")
> _
> (obj (Author "Salinger" "Jerome") "jds")
(Author "Salinger" "Jerome")
> (obj "jds" (:first-name (obj "jds") "J. D."))
(Author "Salinger" "J. D.")
> (obj "jds")
(Author "Salinger" "J. D.")
> _
;; [class method] generic class predicate
(define (Class:? it) (= (and it (list? it) (it 0)) (context)))
;; making objects displayable
(define (Class:string it) (MAIN:string it))
(define (Class:print it) (MAIN:print (:string it)))
(define (Class:println it) (:print it) (MAIN:print "n"))
(new Class 'Mutable)
;; note: mutable objects require accessors to update their state
;; an inherited helper method called :access simplifies accessor writing
;; the constructor creates the object's reference
(define (Mutable:Mutable id)
(set id (cons (context) (cons id (args))))
)
;; an accessor for the object's id (currently read-only)
(define (Mutable:id it) (it 1))
;; a helper method for writing accessors
(define (Mutable:access it idx value allow-nil?)
(setq this (eval (:id it)))
(if (or value allow-nil?)
(begin
(setf (this idx) value)
(set (:id it) this)
)
(this idx)
)
)
(new Mutable 'Point)
;; keeping a reference to the inherited constructor so we can overwrite it
(setq Point:^Point Point:Point)
;; overwriting the constructor
(define (Point:Point id (x 0) (y 0))
(Point:^Point id x y)
)
;; Point's x and y accessors using inherited :access method
(define (Point:x it value) (:access it 2 value))
(define (Point:y it value) (:access it 3 value))
;; Point's string representation
(define (Point:string it) (replace "MAIN:" (string it) ""))
;; moving a Point to a specific place (x y)
(define (Point:move it x y) (:x it x) (:y it y))
;; sliding a Point by some amount (x y)
(define (Point:slide it x y)
(:move it (MAIN:+ (:x it) x) (MAIN:+ (:y it) y))
)
;; adding two Points together
(define (Point:+ it other)
(:slide it (:x other) (:y other))
)
;; a helper function that displays an expression and its result
;; as if it had been entered on the command-line
(define (run e)
(print "> " (string e) "n")
(:println (eval e))
)
(println "Sample Run using Mutable Points")
(run '(Point 'p1 10 20))
(run 'p1)
(run '(:slide p1 5 8))
(run 'p1)
(run '(Point 'p2 88 99))
(run '(:+ p1 p2))
(run 'p1)
(run 'p2)
(println "> _")
Sample Run using Mutable Points
> (Point 'p1 10 20)
(Point p1 10 20)
> p1
(Point p1 10 20)
> (: slide p1 5 8)
(Point p1 15 28)
> p1
(Point p1 15 28)
> (Point 'p2 88 99)
(Point p2 88 99)
> (: + p1 p2)
(Point p1 103 127)
> p1
(Point p1 103 127)
> p2
(Point p2 88 99)
> _
#!/usr/bin/newlisp
(new Tree 'counts)
(while (read-line)
(dolist (word (parse (current-line) " "))
(counts word (inc (counts word)))
)
)
(dolist (each (sort (counts)))
(println (each 0) " " (each 1))
)
(exit)
(define (Class:Class) (cons (context) (args)))
(define (Class:? obj)
(and (list? obj) (not (empty? obj)) (= (obj 0) (context)))
)
> (Point:? (Point 23 54))
true
> (Complex:? (Complex 0.68 -1.64))
true
> (Complex:? (Point 0 0))
nil
> _
(constant (global 'object?)
(fn (obj)
(and (list? obj) (not (empty? obj)) (context? (obj 0)))
)
)
(define (Class:? obj) (and (object? obj) (= (obj 0) (context))))
> (:? (Point 23 43))
true
> (:? (Complex 0.33 0.11))
true
> (:? (CornFlakes (CornFlake) (CornFlake) (CornFlake) ...))
true
> _
(set '... '...)
(load "/lisp/data-type.lsp")
(data-type (shape x y))
(define (shape:move shp newx newy)
(shape:x shp newx)
(shape:y shp newy)
)
(define (shape:r-move shp newx newy)
(shape:move shp (+ (shape:x shp) newx) (+ (shape:y) newy))
)
(define-macro (shape:move shp newx newy)
(nth-set ((eval shp) 0) (eval newx))
(nth-set ((eval shp) 1) (eval newy))
)
(context 'user)
(define (f a b)
(+ a b (- b a)))
(context MAIN)
(constant (global 'f) user:f)
(define (docs:f) ; not making any new symbols
(show {f
syntax: (f int-a int-b)
What the function does.
example:
> (f 1 3)
6
> (f 3 1)
2
> _}))
(context 'testing) ; making new symbols
(define (testing:f) ; context is needed (not the global f)
(let (f. MAIN:f) ; and so is MAIN (not testing's f)
(test=
(f. 1 3) 6
(f. 3 1) 2
(f. 1 1) 2
(f. 3 3) 6)))
(context MAIN)
> (docs:f)
|
f
syntax: (f int-a int-b)
What the function does.
example:
> (f 1 3)
6
> (f 3 1)
2
> _
|
> (testing:f)
testing:passed
> ;; I also modified Lutz's *help* macro to use the function
> ;; in *docs* (if there is one) for all user-defined functions
> (help f)
|
f
syntax: (f int-a int-b)
What the function does.
example:
> (f 1 3)
6
> (f 3 1)
2
> _
|
> _
> (symbols strings)
(strings:address strings:append strings:char strings:dup
strings:ends-with strings:encrypt strings:eval-string ...)
> _
(define (f a b)
(set
'a (or a 1)
'b (or b 3))
(+ a b b a))
(define (f a b)
(default
a 1
b 2)
(+ a b b a))
(define (f (a 1) (b 3))
(+ a b b a))
> [text]
a
b
c
[/text]
^C
user reset -
(c)ontinue, (d)ebug, e(x)it, (r)eset:x
bash> _