From: Frank Duncan 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=fb6e383;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))