From: Frank Duncan <frank@kank.net>
Date: Sun, 15 May 2016 02:28:10 +0000 (-0500)
Subject: Extension loading - CLI Extension loaded by default
X-Git-Tag: v0.1.0~10
X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=cca1c12;p=clnl

Extension loading - CLI Extension loaded by default
---

diff --git a/bin/all.lisp b/bin/all.lisp
index fb64370..eca1162 100644
--- 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 c3ec27e..f66dbb6 100644
--- 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 5fe98b8..4e75407 100644
--- 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
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
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
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
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 6db65fb..443f85d 100644
--- 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))