Extension loading - CLI Extension loaded by default

diff --git a/bin/all.lisp b/bin/all.lisp
index fb64370d3f24b7c8dffac6b2ff331218b26bf067..eca1162c079ae52f3e91e5a94a6a7f55c58c66e0 100644 (file)
--- a/bin/all.lisp
+++ b/bin/all.lisp
@@ -3,6 +3,7 @@
 (asdf:initialize-source-registry `(:source-registry (:tree ,(car (directory "src"))) :INHERIT-CONFIGURATION))
 (asdf:load-system :clnl)
 (asdf:load-system :clnl-test)
+(asdf:load-system :clnl-extension-cli)
 #-travis(asdf:load-system :style-checker)
 #-travis(asdf:load-system :docgen)
 
@@ -21,7 +22,10 @@
 (when (not (find-package :docgen)) (asdf:load-system :docgen))
 (format t "~%~c[1;33mChecking Docs~c[0m~%" #\Esc #\Esc)
 (when (not (docgen:pretty-print-validate-packages
-            :clnl :clnl-parser :clnl-random :clnl-transpiler :clnl-nvm :clnl-lexer :clnl-interface :clnl-cli :clnl-model :clnl-code-parser))
+            :clnl :clnl-parser :clnl-random :clnl-transpiler :clnl-nvm
+            :clnl-lexer :clnl-interface :clnl-cli :clnl-model :clnl-code-parser
+            :clnl-extensions
+            :clnl-extension-cli))
  (format t "~c[1;31mFailed doc check!~c[0m~%" #\Esc #\Esc)
  (sb-ext:exit :code 1))
 (format t "~c[1;32m- Doc Check Passed!~c[0m~%" #\Esc #\Esc)

diff --git a/src/main/clnl.asd b/src/main/clnl.asd
index c3ec27e3af697586c8e6a8a167010ce573162e06..f66dbb63019d2bc0c1a49aff4276a6509f7adeb9 100644 (file)
--- a/src/main/clnl.asd
+++ b/src/main/clnl.asd
@@ -5,6 +5,7 @@
  :author "Frank Duncan (frank@kank.com)"
  :components ((:file "package")
               (:file "base")
+              (:file "extensions")
               (:file "model")
               (:file "lex")
               (:file "parse")

diff --git a/src/main/code-parse.lisp b/src/main/code-parse.lisp
index 5fe98b8d32b89d94d53a72447c14a68897482557..4e75407706a9fc9f4268c57f1d4e64cfd66edd10 100644 (file)
--- a/src/main/code-parse.lisp
+++ b/src/main/code-parse.lisp
@@ -68,7 +68,8 @@ DESCRIPTION:
   ((*dynamic-prims*
     (append
      (mapcar #'global->prim (mapcar #'car external-globals))
-     (procedures->prims lexed-ast)))
+     (procedures->prims lexed-ast)
+     (clnl-extensions:load-extension :cli)))
    (parsed (parse-internal lexed-ast)))
   (values
    (butlast parsed)

diff --git a/src/main/extensions.lisp b/src/main/extensions.lisp
new file mode 100644 (file)
index 0000000..6755d50
--- /dev/null
+++ b/src/main/extensions.lisp
@@ -0,0 +1,49 @@
+(in-package #:clnl-extensions)
+
+(defun load-extension (extension)
+ "LOAD-EXTENSION EXTENSION => PRIMS
+
+ARGUMENTS AND VALUES:
+
+  EXTENSION: A symbol
+  PRIMS: Primitives that can be sent to the parser and transpiler
+
+DESCRIPTION:
+
+  LOAD-EXTENSION takes an EXTENSION and does the work to load the asdf package,
+  as well as munge the prims from extension style prims to things to be used by
+  the CLNL compiler stack.
+
+  It returns those PRIMS after checking that all the pieces are there to not
+  break the runtime."
+ (let*
+  ((name (intern (format nil "CLNL-EXTENSION-~A" (string-upcase extension)) :keyword)))
+  (asdf:load-system name)
+  (let
+   ((pkg (find-package name)))
+   (when (or (not pkg)) (error "Can't find package with extension name: ~A" name))
+   (multiple-value-bind (symb status) (find-symbol "PRIMS" pkg)
+    (when (not symb) (error "Can't find PRIMS function within extension: ~A" name))
+    (when (not (eql status :external)) (error "PRIMS function is not external in extension: ~A" name))
+    (when (not (and (fboundp symb) (not (macro-function symb)) (not (special-operator-p symb))))
+     (error "PRIMS is not a function in ~A" name))
+    (mapcar
+     (lambda (prim)
+      (when (not (getf prim :name)) (error "Prim requires a name: ~A ~A" name prim))
+      (let
+       ((type (getf prim :type)))
+       (when (or (not type) (not (find type '(:reporter :command))))
+        (error "Prim type invalid, needs to be :reporter or :command: ~A ~A ~A" name prim type)))
+      (when (not (getf prim :func))
+       (error "Prim needs a func: ~A ~A" name prim))
+      (list
+       :name (intern
+              (format nil "~A:~A"
+               (if (eql extension :cli) "" (string-upcase extension))
+               (string-upcase (getf prim :name)))
+              :keyword)
+       :type (getf prim :type)
+       :precedence (or (getf prim :precedence) (if (eql :reporter (getf prim :type)) 10 0))
+       :args (getf prim :args)
+       :func (getf prim :func)))
+     (funcall (symbol-function symb)))))))

diff --git a/src/main/extensions/cli/cli.lisp b/src/main/extensions/cli/cli.lisp
new file mode 100644 (file)
index 0000000..843cf01
--- /dev/null
+++ b/src/main/extensions/cli/cli.lisp
@@ -0,0 +1,13 @@
+(in-package #:clnl-extension-cli)
+
+(defun prims ()
+ "PRIMS => PRIMS
+
+ARGUMENTS AND VALUES:
+
+  PRIMS: Primitives defined for this extension
+
+DESCRIPTION:
+
+  PRIMS returns the primitives used in the CLI extension."
+ nil)

diff --git a/src/main/extensions/cli/clnl-extension-cli.asd b/src/main/extensions/cli/clnl-extension-cli.asd
new file mode 100644 (file)
index 0000000..65e8dd8
--- /dev/null
+++ b/src/main/extensions/cli/clnl-extension-cli.asd
@@ -0,0 +1,5 @@
+(asdf:defsystem clnl-extension-cli
+ :name "CLI Extension"
+ :maintainer "Frank Duncan (frank@kank.com)"
+ :author "Frank Duncan (frank@kank.com)"
+ :components ((:file "package") (:file "cli")))

diff --git a/src/main/extensions/cli/package.lisp b/src/main/extensions/cli/package.lisp
new file mode 100644 (file)
index 0000000..00873dc
--- /dev/null
+++ b/src/main/extensions/cli/package.lisp
@@ -0,0 +1,15 @@
+(defpackage #:clnl-extension-cli
+ (:use :common-lisp)
+ (:export #:prims)
+ (:documentation
+  "CLI Extension
+
+The CLI Extension provides prims for interacting with the interface from the
+commandline.  It is a special extension in that it is the only one that without
+a prefix being appended to the prims.
+
+It uses the available functions made public through normal clnl packages to
+offer command line operations to control the clnl program.  Because it is
+an extension, all primitives are also available to any NetLogo programs
+running in CLNL.  As there is no special case control mechanism in the original
+NetLogo, the CLI extension represents a departure from classic NetLogo."))

diff --git a/src/main/package.lisp b/src/main/package.lisp
index 6db65fb757d38018bf8fc9178c95561f8f986480..443f85d29f3d79dbb7a2851e1ab2dd8edccaabb8 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -141,6 +141,22 @@ all of the sections, and subsections held within.  This package houses not only
 the code to read and write .nlogo files, but also the living state of the model
 as clnl runs."))
 
+(defpackage #:clnl-extensions
+ (:use :common-lisp)
+ (:export #:load-extension)
+ (:documentation
+  "CLNL Extensions
+
+The loading and handling of extensions to CLNL modeled after the way that
+NetLogo handles extensions.
+
+Extensions are defined as Common Lisp systems (under asdf) that export
+the primitive PRIMS.  The name of the asdf system is defined to be the
+name of the extension prepended by CLNL-EXTENSION-, such that for a hypothetical
+extension ARRAY, the name of the asdf system would be CLNL-EXTENSION-ARRAY
+and found through conventional asdf means.  The package that the required
+functions are symbols in should be the same as the asdf system."))
+
 (defpackage #:clnl-default-model-package
  (:use :common-lisp)
  (:shadow #:go))