Commits

Greg Slepak  committed f101c2a

initial import

  • Participants

Comments (0)

Files changed (8)

+\.html$
+;; @module ObjNL.lsp
+;; @description Objective newLISP - Real Object Oriented Programming for newLISP
+;; @version 1.0
+;; @author Greg Slepak
+;; @location http://www.taoeffect.com/newlisp/ObjNL.lsp.txt
+;; <h3>Introductory Guide</h3>
+;; The @link http://www.taoeffect.com/blog/2009/12/introducing-objective-newlisp/ official&nbsp;guide
+;; is highly recommended reading if you are planning on using Objective newLISP.
+;; <h3>What is Objective newLISP?</h3>
+;; Objective newLISP is a new and exciting way of doing <b>real</b>
+;; object oriented programming in newLISP where instances are passed
+;; by reference and can easily hold references to other objects while
+;; maintaining their own mutable state.
+;; <p>It supports most of the object oriented concepts you'll find
+;; in other languages. It supports inheritance, interfaces (aka protocols),
+;; as well as class and instance variables.</p>
+;; <p>Objects are passed <i>by reference</i>, so there's no problem with passing
+;; an object through multiple user-defined functions and modifying it.</p>
+;; <p>Accessing instance variables no longer requires a function call plus a
+;; list traversal. Simply access the symbol directly.</p>
+;; <p>Objective newLISP also enhances newLISP by providing convenient and safe
+;; macros for deep reference access.</p>
+;; <p>With Objective newLISP it is possible to take full advantage of everything
+;; object-oriented programming has to offer.</p>
+;; <h3>Conventions</h3>
+;; There are very few conventions in ObjNL, but there are some:
+;; <ul>
+;; <li>Classes should be written in camel-case and begin with a capital letter.</li>
+;; <li>ObjNL reserves the @ character for itself to prefix symbols of special meaning.
+;; You should avoid prefixing your symbols with it if possible.</li>
+;; </ul>
+;; <h3>Requirements</h3>
+;; newLISP 10.1.9 or higher is <b>strongly recommended</b>, but any version after 10.1 should work.
+;; <h3>Version history</h3>
+;; <b>1.0</b> &bull; initial release
+
+;; @syntax ObjNL
+;; <p>'ObjNL' is the root class for Objective newLISP. All other classes ultimately
+;; inherit from it. It defines several instance and class variables:</p>
+;; <ul>
+;; <li>'@self' to refer to the current object (be it an instance or class).</li>
+;; <li>'@self-sym' is the symbol that represents the '@self' context.</li>
+;; <li>'@class' is the context representing the class this object belongs to.</li>
+;; <li>'@super' refers to the super-class of this object.</li>
+;; <li>'@interfaces' a list of interfaces that this object conforms to.</li>
+;; <li>'@rc' an integer representing the retain count of this object.</li>
+;; </ul>
+(set 'ObjNL:@super nil                 ; ObjNL has no super class
+     'ObjNL:@self ObjNL                ; similar to ObjC, can be instance or class
+     'ObjNL:@self-sym 'ObjNL           ; symbol referencing name of this context
+     'ObjNL:@class ObjNL               ; always refers to class, never instance
+     'ObjNL:@interfaces (list ObjNL)   ; ObjNL implements ObjNL
+     'ObjNL:@rc 1                      ; the object's retain (or 'reference') count
+)
+
+(context ObjNL)
+;; @syntax (ObjNL:ObjNL)
+;; <p>The constructor is the default function. It is called by 'instantiate'.</p>
+;; <p>The default implementation simply returns 'true'.</p>
+(define (ObjNL:ObjNL) true)
+
+;; @syntax (ObjNL:dealloc)
+;; <p>Called by 'deallocate' to give the object an opportunity to release resources and objects.</p>
+(define (ObjNL:dealloc))
+
+;; @syntax (ObjNL:equals <ctx-obj>)
+;; <p>Provides a method for classes to define what it means for objects to be equal.</p>
+;; <p>The default implementation returns 'true' if two objects are the same instance.</p>
+(define (ObjNL:equals obj) (= obj @self))
+(context MAIN)
+
+; it's possible to even implement reference counting :-p
+
+;; @syntax (new-class <sym-class> [<ctx-super> [<list-interfaces>]])
+;; @param <sym-class> The name of the class
+;; @param <ctx-super> The superclass, accessible through '@super'
+;; @param <list-interfaces> Any contexts to "mixin", accessible through '@interfaces'
+;; @return The context of the new class created.
+(define (new-class sym-class (super ObjNL) (interfaces '()) , class)
+	(set 'class            (new super sym-class)
+	     'class:@super     super
+	     'class:@class     class
+	     'class:@self      class
+	     'class:@self-sym  sym-class
+	)
+	; NOTE: newLISP Bug? Why does pushing to the back result in odd behavior?
+	; (push class class:@interfaces -1)
+	(push class class:@interfaces)
+	(dolist (iface interfaces)
+		(setf iface (eval iface))
+		(new  iface sym-class)
+		(push iface class:@interfaces)
+	)
+	class
+)
+
+;; @syntax (instantiate <ctx-class> [<arg-1> ...])
+;; <p>Returns a new instance of <ctx-class> by calling its
+;; constructor and passing in any arguments. If the constructor
+;; returns nil then the instance is deallocated and nil is returned.</p>
+;; <p>The returned object <b>must</b> be deallocated using the 'deallocate'
+;; function.</p>
+(define (instantiate class)
+	(letn (	obj-sym	(sym (string class "#" (++ class:@instance-counter)))
+			obj		(new class obj-sym)
+		)
+		; set these prior to calling the constructor
+		(set 'obj:@self obj 'obj:@self-sym obj-sym)
+		(if (apply obj $args)
+			obj
+			(begin (deallocate obj) nil)
+		)
+	)
+)
+;; @syntax (add-interface <ctx-iface> <ctx-obj>)
+;; <p>Uses the function 'new' to add <ctx-iface> to the object and
+;; adds the interface to <ctx-obj>s '@interfaces'.</p>
+(define (add-interface iface obj)
+	(new iface obj:@self-sym)
+	(push iface obj:@interfaces)
+)
+;; @syntax (deallocate <ctx-obj>)
+;; <p>Calls the objects 'dealloc' method and then 'delete'&apos;s the object.</p>
+;; <p><b>NOTE:</b> On versions of newLISP prior to 10.1.9 this is a fairly slow
+;; operation, make sure to use at least version 10.1.9 with Objective newLISP.</p>
+(define (deallocate obj)
+	(obj:dealloc)
+	(let (obj-sym obj:@self-sym)
+		(delete obj-sym nil) ; delete the context
+		(delete obj-sym nil) ; delete the symbol in MAIN
+	)
+)
+
+;; @syntax (implements? <ctx-interface> <ctx-obj>)
+;; @return true or nil as to whether this <ctx-obj> implements <ctx-interface>.
+(define (implements? iface obj)
+	(not (nil? (find iface obj:@interfaces)))
+)
+
+;; @syntax (retain <ctx-obj>)
+;; <p>Increment's <ctx-obj>&apos;s retain count and returns the object.</p>
+(define (retain obj)
+	(++ obj:@rc)
+	obj
+)
+
+;; @syntax (release <ctx-obj>)
+;; <p>Decrement's <ctx-obj>&apos;s retain count. Deallocates the object if the retain count hits zero.</p>
+(define (release obj)
+	(when (zero? (-- obj:@rc))
+		(deallocate obj)
+	)
+)
+
+;; @syntax (autorelease <ctx-obj>)
+;; <p>Adds <ctx-obj> to the current 'MAIN:@autorelease' pool and returns the object.</p>
+(define (autorelease obj)
+	(push obj (first @autorelease))
+	obj
+)
+
+;; @syntax (push-autorelease-pool)
+;; <p>Pushes a new autorelease pool onto the 'MAIN:@autorelease' stack.</p>
+(define (push-autorelease-pool)
+	(push '() @autorelease)
+)
+
+;; @syntax (pop-autorelease-pool)
+;; <p>Pops the current 'MAIN:@autorelease' pool and releases the objects in it.</p>
+(define (pop-autorelease-pool , obj)
+	(dolist (obj (pop @autorelease))
+		(release obj)
+	)
+)
+
+(global 'new-class 'instantiate 'deallocate 'implements?
+	'retain 'release 'autorelease 'push-autorelease-pool 'pop-autorelease-pool '@autorelease)
+
+;; @syntax (. <obj> <field-1> [<field-2> [<field-n>]])
+;; <p>The dot macro is used for "deep value access":</p>
+;; <b>example:</b>
+;; <pre>
+;; (new-class 'Foo)
+;; (new-class 'Bar)
+;; (context Bar)
+;; (define (Bar:Bar f)
+;; 	(setf foo f)
+;; 	true ; -> do not deallocate us if 'f' is nil
+;; )
+;; (context Foo)
+;; (define (Foo:Foo b)
+;; 	(setf bar b)
+;; 	true ; -> do not deallocate us if 'b' is nil
+;; )
+;; (context MAIN)
+;; (setf f (instantiate Foo (instantiate Bar)))
+;; (set (.& f bar foo) f) ; => Foo#1
+;; (. f bar foo bar)      ; => Bar#1</pre>
+(context '.)
+(define-macro (.:. obj)
+	(doargs (field)
+		(setf obj (eval (sym field (eval obj) nil)))
+	)
+)
+
+;; @syntax (.& <obj> <field-1> [<field-2> [<field-n>]])
+;; <p>The dot-reference macro is similar to the dot macro, except it returns the
+;; context-qualified symbol for the final field instead of its value ("deep symbol access").
+;; This allows you to combine it with 'set'.</p>
+;; @see '.' macro for example usage.
+(context '.&)
+(define-macro (.&:.& obj)
+	(doargs (field)
+		(setf obj (sym field (eval obj)))
+	)
+)
+
+(context MAIN)
+namespace.lsp adds java-like namespaces to newLISP!
+
+You can do stuff like:
+
+	(ns-import 'com.example.*)
+	(ns-import 'com.example.Test)
+
+To understand what this is and how it works just follow these steps:
+
+1) Run main.lsp in the project directory.
+
+	[prompt]$ newlisp main.lsp
+
+2) Read main.lsp
+3) Look at the directory structure in src/
+4) Look inside Bar.lsp, Foo.lsp, and Test.lsp.
+5) Learn about Objective newLISP if you haven't already, but this is optional! you don't need to use ObjNL with namespace.lsp if you don't want.
+
+For an even deeper understanding of how it works, look at ns-create and ns-import in namespace.lsp. There's only 2 short functions to get this functionality! The rest is just making sure your directory structure follows the "package path".
+
+I.e. if you've got a context Test and its package path is: com.example.Test
+Your Test.lsp file should be inside com/example.
+#!/usr/bin/newlisp
+
+;; @author Greg Slepak
+;; @description This is just an example you can run from the terminal like so:
+;; 
+;; 	[prompt]$ newlisp main.lsp
+;; 
+;; Note that you don't need ObjNL.lsp, this is just demonstrating that the
+;; two projects work together just fine.
+
+(load "namespace.lsp" "ObjNL.lsp")
+(add-to-load-path "src")
+
+(ns-import 'com.example.*)
+
+(Test:foo)
+(Foo:foo 5)
+(Bar:foo "hello from Bar!")
+
+; Test, unlike the others, is an ObjNL class
+; check to make sure that's true:
+
+(setf obj (instantiate Test "happy"))
+(obj:foo "ObjNL works!")
+
+(println "obj implements: " obj:@interfaces)
+(println "value of obj:a -> " obj:a)
+
+(release obj)
+
+; notice if we call it again nothing's loaded since it has already been loaded
+; and load is being overwritten with our fancy load-once
+(ns-import 'com.example.*)
+(ns-import 'com.example.Test)
+
+(exit)

File namespace.lsp

+;; @module namespace.lsp
+;; @description A java-like namespace system for newLISP
+;; @version 1.0
+;; @author Greg Slepak
+
+;; @syntax (ns-create <sym-ns>)
+;; <p>Example: Call like this from within com/example/Foo.lsp:</p>
+;; <pre> (context (ns-create 'com.example.Foo))</pre>
+;; <p>'Foo' *must* start with a capital letter.</p>
+;; <p>You can also just do '(context &apos;com.example.Foo)', but then
+;; 'com.example.Foo:Foo' will be 'nil' instead of referring to the context.</p>
+(define (ns-create ns)
+	(set (sym (last (parse (term ns) ".")) ns) ns))
+
+;; @syntax (ns-import <sym-ns>)
+;; <p><pre> (ns-import 'com.example.*)</pre></p>
+;; <p>That will import all of the classes/contexts from com/example.
+;; They must start with a capital letter or they won't be imported.
+;; Aliases are made in the current context to them so that you don't
+;; have to write out the fully-qualified name. For example:</p>
+;; <pre> (ns-import 'com.example.Test)</pre>
+;; <p>Both examples will load the files only once. In the above example,
+;; the symbol Test will be set to the context 'com.example.Test' in the 
+;; calling context.</p>
+(define (ns-import ns , tmp)
+	(letn (
+			path-l  (parse (term ns) ".")
+			pctx    (prefix ns)
+			class   (pop path-l -1)
+			path    (join path-l "/")
+			ld      (fn (file class ns , alias)
+			            (load file)
+			            ; in context that called this function, make Test refer to com.example.Test
+			            (set (sym class pctx) (prefix (sym class ns)))))
+		(if (= "*" class)
+			(dolist (dir load-once.lp break)
+				(when (directory? (setf tmp (string dir "/" path)))
+					(setf break true)
+					(dolist (file (directory tmp {^[A-Z].+\.lsp$}))
+						(setf class (first (parse file ".")))
+						(ld (string tmp "/" file) class (sym (string (join path-l "." true) class))))))
+			(ld (string path "/" class ".lsp") class ns))))
+
+
+(global 'ns-package 'ns-import)
+
+
+; protect against situation where one of the load functions is used to
+; load this file, thereby redefining the function itself while it's running
+; and causing newlisp to crash.
+; This may also speed up the loading of this file the second time around.
+(unless load-once
+	; empty load path initially
+	(setf load-once.lp '())
+	(new Tree 'load-once.loaded)
+	
+;; @syntax (add-to-load-path <str-path-1> <str-path-2> ...)
+;; <p>The built-in function 'load' is overwritten so that files
+;; are loaded only once. In addition it supports the concept of "load paths"
+;; which can be added using this function. This means that you no longer need
+;; to modify third-party code that contains 'load' calls to files located in
+;; different locations. Simply add a new load path instead.</p>
+;; <b>example:</b>
+;; <pre> ; the old way
+;; (load "MyClass.lsp") ;=> ERROR! MyClass.lsp doesn't exist here!
+;; ; we must rewrite the file to point to the new location of MyClass.lsp:
+;; (load "../../myfolder/MyClass.lsp")
+;; ; -------------------------------
+;; ; New way, using add-to-load-path
+;; ; -------------------------------
+;; (add-to-load-path "../../myfolder")
+;; ; no need to update any source files, it just works.</pre>
+;; <b>warning:</b> Use this function sparingly as name-conflicts could
+;; result in the wrong file being loaded!
+	(define (add-to-load-path)
+		(doargs (path)
+			(setf load-once.lp (unique (push (real-path path) load-once.lp)))))
+	
+	(define (load-once)
+		; check if the last argument is a context (to behave like 'load' does)
+		(let (ctx (let (_ctx (last $args)) (if (context? _ctx) _ctx MAIN)) filename nil)
+			(doargs (file (context? file))
+				(setf filename file)
+				(dolist (lp load-once.lp (file? file))
+					(setf file (string lp "/" filename))
+				)
+				(unless (setf file (real-path file))
+					(throw-error (string "cannot load file: " filename))
+				)
+				(when (not (load-once.loaded file))
+					(load-once.loaded file true)
+					(sys-load file ctx)))))
+					
+	(global 'load-once 'add-to-load-path)
+	
+	; swap these functions for ours and save the originals
+	(constant (global 'sys-load) load)
+	(constant 'load load-once)
+)

File src/com/example/Bar.lsp

+; a java-like package system for newLISP
+
+(context (ns-create 'com.example.Bar))
+
+(define (foo bar)
+	(println (context) ":foo -> " bar))
+
+(println (context) " loaded")

File src/com/example/Foo.lsp

+; a java-like package system for newLISP
+
+(context (ns-create 'com.example.Foo))
+
+(define (foo bar)
+	(println (context) ":foo -> " bar))
+
+(println (context) " loaded")

File src/com/example/Test.lsp

+; a java-like package system for newLISP
+
+; this is the shortest way I know of to:
+; 1) create and switch to the com.example.Test namespace
+; 2) create the ObjNL class com.example.Test
+(new-class (sym (term (context (ns-create 'com.example.Test))) MAIN))
+
+; a constructor. yes, unfortunately we have no choice
+; but to write out its name fully. :-\
+(define (com.example.Test:com.example.Test _a)
+	(setf a _a)
+	true
+)
+
+(define (foo bar)
+	(println (context) ":foo -> " bar))
+
+(println (context) " loaded. Test = " Test)