From: Frank Duncan <frank@kank.net>
Date: Sat, 23 Apr 2016 21:59:07 +0000 (-0500)
Subject: Improve parser - generate some prims from breed statements
X-Git-Tag: v0.1.0~50
X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=fb6e383b5e0f5c86e4c79e0839dcbfee91b2e9fc;p=clnl

Improve parser - generate some prims from breed statements
---

diff --git a/src/main/code-parse.lisp b/src/main/code-parse.lisp
index 644ef13..c0e553b 100644
--- a/src/main/code-parse.lisp
+++ b/src/main/code-parse.lisp
@@ -8,6 +8,13 @@
 
 (defvar *dynamic-prims* nil)
 (defun global->prim (global) (list :name global))
+(defun breed->prims (breed-list)
+ (let
+  ((plural-name (symbol-name (car breed-list))))
+  (list
+   (list :name (car breed-list))
+   (list :name (intern (format nil "~A-HERE" plural-name) :keyword))
+   (list :name (intern (format nil "CREATE-~A" plural-name) :keyword) :args '(:number :command-block)))))
 
 (defun parse (lexed-ast &optional external-globals)
  "PARSE LEXED-AST &optional EXTERNAL-GLOBALS => AST
@@ -86,7 +93,9 @@ DESCRIPTION:
  (multiple-value-bind (in-list after-list) (find-closing-bracket (cddr lexed-ast))
   (cons
    (list (car lexed-ast) (cons :list-literal in-list))
-   (parse-internal after-list))))
+   (let
+    ((*dynamic-prims* (append (breed->prims in-list) *dynamic-prims*)))
+    (parse-internal after-list)))))
 
 (defun find-closing-bracket (tokens)
  (cond
diff --git a/src/main/model.lisp b/src/main/model.lisp
index 33f90aa..7a18fb0 100644
--- a/src/main/model.lisp
+++ b/src/main/model.lisp
@@ -60,8 +60,8 @@ DESCRIPTION:
            (mapcar
             (lambda (widget)
              (typecase widget
-              (slider (intern (string-upcase (slider-varname widget)) (find-package :keyword)))
-              (switch (intern (string-upcase (switch-varname widget)) (find-package :keyword)))))
+              (slider (intern (string-upcase (slider-varname widget)) :keyword))
+              (switch (intern (string-upcase (switch-varname widget)) :keyword))))
             (parse-interface (nth 1 sections)))))
    :interface (parse-interface (nth 1 sections))
    :info (nth 2 sections)
diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index ad9f746..72c7edc 100644
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -99,8 +99,8 @@ DESCRIPTION:
        (parse-internal (cdr lexed-ast)
         :prev-item (coerce (car lexed-ast) 'double-float)
         :arg-countdown (when arg-countdown (1- arg-countdown))))
-      ((eql (intern "(" (find-package :keyword)) (car lexed-ast)) (parse-parened-expr (cdr lexed-ast) arg-countdown))
-      ((eql (intern ")" (find-package :keyword)) (car lexed-ast)) (error "Closing parens has no opening parens"))
+      ((eql (intern "(" :keyword) (car lexed-ast)) (parse-parened-expr (cdr lexed-ast) arg-countdown))
+      ((eql (intern ")" :keyword) (car lexed-ast)) (error "Closing parens has no opening parens"))
       ((eql :let (car lexed-ast)) (parse-let (cdr lexed-ast) arg-countdown))
       ((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast) arg-countdown))
       (prim
@@ -181,14 +181,14 @@ DESCRIPTION:
 (defun find-closing-paren (tokens &optional (depth 0))
  (cond
   ((not tokens) (error "Failed to find a matching closing bracket"))
-  ((and (eql (intern ")" (find-package :keyword)) (car tokens)) (= depth 0)) (values nil (cdr tokens)))
+  ((and (eql (intern ")" :keyword) (car tokens)) (= depth 0)) (values nil (cdr tokens)))
   (t (multiple-value-bind
       (in-block after-block)
       (find-closing-paren
        (cdr tokens)
        (cond
-        ((eql (intern "(" (find-package :keyword)) (car tokens)) (1+ depth))
-        ((eql (intern ")" (find-package :keyword)) (car tokens)) (1- depth)) (t depth)))
+        ((eql (intern "(" :keyword) (car tokens)) (1+ depth))
+        ((eql (intern ")" :keyword) (car tokens)) (1- depth)) (t depth)))
       (values (cons (car tokens) in-block) after-block)))))
 
 (defmacro defprim (name args &optional infix)
@@ -271,12 +271,3 @@ DESCRIPTION:
 (defstructureprim :patches-own)
 (defstructureprim :to)
 (defstructureprim :to-report)
-
-; Placeholder prims that should be populated in dynamic prims
-
-; Generated by breeds
-(defprim :sheep ())
-(defprim :wolves ())
-(defprim :create-sheep (:number :command-block))   ; look at me not have to do optionals yet
-(defprim :sheep-here ())
-(defprim :create-wolves (:number :command-block))