X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fparse.lisp;h=72c7edcd6ff03fed43788f0e51debf6736299c6a;hb=fb6e383b5e0f5c86e4c79e0839dcbfee91b2e9fc;hp=c4270190c3c10654f7d517d86442833969c0ebc8;hpb=18f00de47300789104d94745cd9db874b2071b7e;p=clnl diff --git a/src/main/parse.lisp b/src/main/parse.lisp index c427019..72c7edc 100644 --- a/src/main/parse.lisp +++ b/src/main/parse.lisp @@ -99,8 +99,9 @@ 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 (when (prim-structure-prim prim) @@ -108,6 +109,17 @@ DESCRIPTION: (parse-prim prim lexed-ast nil arg-countdown)) (t (error "Couldn't parse ~S" lexed-ast)))))))) +(defun parse-let (lexed-ast arg-countdown) + (when (not (keywordp (car lexed-ast))) (error "Needed a keyword for let")) + (let* + ((half-parsed-remainder (parse-internal (cdr lexed-ast) :arg-countdown 1))) + (let + ((*dynamic-prims* (cons (list :name (car lexed-ast)) *dynamic-prims*))) + (parse-internal + (cdr half-parsed-remainder) + :arg-countdown (when arg-countdown (1- arg-countdown)) + :prev-item (list :let (car lexed-ast) (car half-parsed-remainder)))))) + (defun parse-prim (prim lexed-ast prev-item arg-countdown) (let* ((num-args (- (prim-num-args prim) (if (prim-is-infix prim) 1 0))) @@ -169,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) @@ -218,7 +230,7 @@ DESCRIPTION: (defprim :with (:reporter-block)) (defprim :fd (:number)) (defprim :hatch (:number :command-block)) -(defprim :let (t t)) +; (defprim :let (t t)) ; keeping this here, commented out, to note that it has special processing (defprim :if (:boolean :command-block)) (defprim :if-else (:boolean :command-block :command-block)) (defprim :ifelse (:boolean :command-block :command-block)) @@ -259,25 +271,3 @@ DESCRIPTION: (defstructureprim :patches-own) (defstructureprim :to) (defstructureprim :to-report) - -; Placeholder prims that should be populated in dynamic prims - -; Generated by procedures -(defprim :move ()) -(defprim :eat-grass ()) -(defprim :reproduce-sheep ()) -(defprim :reproduce-wolves ()) -(defprim :catch-sheep ()) -(defprim :death ()) -(defprim :grow-grass ()) -(defprim :display-labels ()) - -; Generated by a let -(defprim :prey ()) - -; 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))