X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Ftranspile.lisp;h=3feedc2df85292309b56f95bc8d997647fbce667;hp=a9cf77b128d2465ee20baf862f6b358a518aa2c2;hb=9eef8ecae4fad1e01413807ebc80ae45b5990706;hpb=4a9ed570e6d2c79ac7cac0a6a84d414ee658cd3e diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp index a9cf77b..3feedc2 100644 --- a/src/main/transpile.lisp +++ b/src/main/transpile.lisp @@ -1,15 +1,9 @@ -(in-package #:cl-nl.transpiler) - -; This is responsible for taking an ast and turning it into valid CL code -; targeting the nvm. Here is where start to care about commands versus reporters -; and ensuring that things are in the right place. The reason we wait until here -; is because we want to allow someone else to play with the AST before handing it off -; to us. For instance, the command center wants to add "show" to reporters, and -; the users dictate based on entry point whether they are expecting a command -; or a reporter. So monitors can say "hey, transpile this reporter" and we'll check -; to make sure it actually is. +(in-package #:clnl-transpiler) (defparameter *prims* nil) +(defparameter *prim-aliases* nil) + +(defvar *local-variables* nil) (defun prim-name (prim) (getf prim :name)) (defun prim-type (prim) (getf prim :type)) @@ -17,42 +11,180 @@ (defun is-reporter (prim) (eql :reporter (getf prim :type))) (defun is-command (prim) (eql :command (getf prim :type))) -(defun find-prim (symb) (find symb *prims* :key #'prim-name)) +(defun find-prim (symb) + (when symb + (or + (find symb *prims* :key #'prim-name) + (find-prim (getf (find symb *prim-aliases* :key #'prim-name) :real-symb))))) ; Let this grow, slowly but surely, eventually taking on calling context, etc. -; For now, it's just a +; For now, it's just a (defun transpile-commands (parsed-ast) + "TRANSPILE-COMMANDS PARSED-AST => AST + +ARGUMENTS AND VALUES: + + PARSED-AST: An ast as returned by the parser + AST: An common lisp AST that can be actually run in a common lisp instance + +DESCRIPTION: + + TRANSPILE-COMMANDS takes a unambigious PARSED-AST and converts it to + Common Lisp code. + + Calling eval on that code should work correctly as long as you have a + running engine. This is the entry point for commands, so it does + extra checking to ensure that commands are actually in the PARSED-AST." `(progn - ,@(mapcar #'transpile-command parsed-ast))) + ,@(transpile-commands-inner parsed-ast))) + +(defun transpile-commands-inner (parsed-ast) + (cond + ((not parsed-ast) nil) + ((and (listp (car parsed-ast)) (eql :let (caar parsed-ast))) (list (handle-let parsed-ast))) + (t + (cons + (transpile-command (car parsed-ast)) + (transpile-commands-inner (cdr parsed-ast)))))) + +(defun handle-let (parsed-ast &optional vars) + (if + (and (listp (car parsed-ast)) (eql :let (caar parsed-ast))) + (let + ((*local-variables* (cons (second (car parsed-ast)) *local-variables*))) + (handle-let + (cdr parsed-ast) + (cons + (list + (transpile-reporter (second (car parsed-ast))) + (transpile-reporter (third (car parsed-ast)))) + vars))) + `(let* + ,vars + ,@(transpile-commands-inner parsed-ast)))) (defun transpile-command (command) (cond ((not (listp command)) (error "Expected a statement of some sort")) ((not (find-prim (car command))) (error "Couldn't find the command for ~S" (car command))) ((not (is-command (find-prim (car command)))) (error "Expected command, got ~S" (car command))) - (t `(,(prim-func (find-prim (car command))) ,@(mapcar #'transpile-reporter (cdr command)))))) + (t (apply (prim-func (find-prim (car command))) (mapcar #'transpile-reporter (cdr command)))))) (defun transpile-reporter (reporter) + "TRANSPILE-REPORTER REPORTER => AST + +ARGUMENTS AND VALUES: + + REPORTER: An ast returned from the parser. + AST: An common lisp AST that can be actually run in a common lisp instance + +DESCRIPTION: + + TRANSPILE-REPORTER takes a unambigious PARSED-AST and converts it to + Common Lisp code. + + Calling eval on that code should work correctly as long as you have a + running engine. This is the entry point for reporters, so it does + extra checking to ensure that the reporter is actually in the REPORTER. + + The Common lisp code that is returned, when run, will return some value." (cond ((numberp reporter) reporter) ; The parser converts to double for us - ((symbolp reporter) reporter) ; The parser should have checked that having a symbol here is ok + ((stringp reporter) reporter) + ; The parser should have checked that having a symbol here is ok + ((symbolp reporter) (intern (symbol-name reporter) clnl:*model-package*)) ((not (listp reporter)) (error "Expected a statement of some sort")) ((eql :command-block (car reporter)) (transpile-command-block reporter)) + ((eql :list-literal (car reporter)) (cons 'list (mapcar #'transpile-reporter (cdr reporter)))) + ((eql :reporter-block (car reporter)) (transpile-reporter-block reporter)) + ((and (symbolp (car reporter)) (find (car reporter) *local-variables*)) + (intern (symbol-name (car reporter)) clnl:*model-package*)) ((not (find-prim (car reporter))) (error "Couldn't find the reporter for ~S" (car reporter))) ((not (is-reporter (find-prim (car reporter)))) (error "Expected reporter, got ~S" (car reporter))) - (t `(,(prim-func (find-prim (car reporter))) ,@(mapcar #'transpile-reporter (cdr reporter)))))) + (t (apply (prim-func (find-prim (car reporter))) (mapcar #'transpile-reporter (cdr reporter)))))) (defun transpile-command-block (block) - `(lambda () ,@(mapcar #'transpile-command (cdr block)))) + `(lambda () ,@(transpile-commands-inner (cdr block)))) + +(defun transpile-reporter-block (block) + (when (/= (length block) 2) (error "Reporter block invalid ~S" block)) + `(lambda () + ,(transpile-reporter (cadr block)))) + +; Undoes the previous function :) +(defun make-command-block-inline (block) + (cddr block)) + +(defmacro defprim (name type func) + `(push (list :name ,name :type ,type :func ,func) *prims*)) -(defmacro defprim (name type nvm-func) - `(push - (list :name ,name :type ,type :func ',nvm-func) - *prims*)) +(defmacro defsimpleprim (name type simple-func) + `(defprim ,name ,type (lambda (&rest args) `(,',simple-func ,@args)))) + +(defmacro defkeywordprim (name) + `(defprim ,name :reporter (lambda () ',name))) + +(defmacro defprim-alias (name real-symb) + `(push (list :name ,name :real-symb ,real-symb) *prim-aliases*)) + +(defmacro defagentvalueprim (name) + `(defprim ,name :reporter (lambda () `(clnl-nvm:agent-value ,,name)))) ; We count on the parser to handle arguemnts for us, when collating things. -(defprim :ask :command cl-nl.nvm::ask) -(defprim :crt :command cl-nl.nvm::create-turtles) -(defprim :fd :command cl-nl.nvm::fd) -(defprim :show :command cl-nl.nvm::show) -(defprim :turtles :reporter cl-nl.nvm::turtles) + +(defsimpleprim := :reporter cl:equalp) +(defprim :!= :reporter (lambda (a b) `(not (equalp ,a ,b)))) +(defsimpleprim :<= :reporter cl:<=) +(defsimpleprim :< :reporter cl:<) +(defsimpleprim :- :reporter cl:-) +(defsimpleprim :+ :reporter cl:+) +(defsimpleprim :* :reporter cl:*) +(defsimpleprim :/ :reporter cl:/) +(defprim :any? :reporter (lambda (agentset) `(> (clnl-nvm:count ,agentset) 0))) +(defsimpleprim :ask :command clnl-nvm:ask) +(defagentvalueprim :color) +(defsimpleprim :count :reporter clnl-nvm:count) +(defsimpleprim :crt :command clnl-nvm:create-turtles) +(defsimpleprim :die :command clnl-nvm:die) +(defsimpleprim :fd :command clnl-nvm:forward) +(defsimpleprim :hatch :command clnl-nvm:hatch) +(defprim :if :command (lambda (pred a) `(when ,pred ,@(make-command-block-inline a)))) +(defprim :ifelse :command (lambda (pred a b) + `(if ,pred + ,@(make-command-block-inline a) + ,@(make-command-block-inline b)))) + +(defprim-alias :if-else :ifelse) +(defagentvalueprim :label) +(defagentvalueprim :label-color) +(defsimpleprim :lt :command clnl-nvm:turn-left) +(defsimpleprim :not :reporter cl:not) +(defkeywordprim :nobody) +(defsimpleprim :one-of :reporter clnl-nvm:one-of) +(defsimpleprim :of :reporter clnl-nvm:of) +(defsimpleprim :patches :reporter clnl-nvm:patches) +(defagentvalueprim :pcolor) +(defsimpleprim :reset-ticks :command clnl-nvm:reset-ticks) +(defsimpleprim :random :reporter clnl-nvm:random) +(defsimpleprim :random-float :reporter clnl-nvm:random-float) +(defsimpleprim :random-xcor :reporter clnl-nvm:random-xcor) +(defsimpleprim :random-ycor :reporter clnl-nvm:random-ycor) +(defsimpleprim :rt :command clnl-nvm:turn-right) +(defsimpleprim :set :command cl:setf) +(defsimpleprim :set-default-shape :command clnl-nvm:set-default-shape) +(defsimpleprim :setxy :command clnl-nvm:setxy) +(defsimpleprim :show :command clnl-nvm:show) +(defagentvalueprim :size) +(defsimpleprim :tick :command clnl-nvm:tick) +(defsimpleprim :ticks :reporter clnl-nvm:ticks) +(defsimpleprim :turtles :reporter clnl-nvm:turtles) +(defagentvalueprim :who) +(defsimpleprim :with :reporter clnl-nvm:with) + +; Colors +(defmacro defcolorprim (color) `(defprim ,color :reporter (lambda () `(clnl-nvm:lookup-color ,,color)))) +(defcolorprim :black) +(defcolorprim :blue) +(defcolorprim :brown) +(defcolorprim :green) +(defcolorprim :white)