X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fcode-parse.lisp;h=c0e553be8106676aeb3382229f4a57cbb93268ed;hb=daa3b99;hp=7cdf2b5b1864ff53ea9483a18464e2b906cc56c4;hpb=18f00de47300789104d94745cd9db874b2071b7e;p=clnl diff --git a/src/main/code-parse.lisp b/src/main/code-parse.lisp index 7cdf2b5..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 @@ -32,9 +39,19 @@ DESCRIPTION: in the CLNL-CODE-PARSER package to tease out necessary information. Some of those things will involve code blocks that can then be transpiled." (let - ((*dynamic-prims* (mapcar #'global->prim external-globals))) + ((*dynamic-prims* + (append + (mapcar #'global->prim external-globals) + (procedures->prims lexed-ast)))) (parse-internal lexed-ast))) +(defun procedures->prims (lexed-ast) + (cond + ((not lexed-ast) nil) + ; We'll need argument handling here sometime :) + ((eql :to (car lexed-ast)) (cons (list :name (cadr lexed-ast)) (procedures-to-prims (cdr lexed-ast)))) + (t (procedures-to-prims (cdr lexed-ast))))) + (defun parse-internal (lexed-ast) (cond ((not lexed-ast) nil) @@ -76,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