code.consxy.com Git - clnl/blob - src/main/transpile.lisp

   1 (in-package #:clnl-transpiler)
   2
   3 (defparameter *prims* nil)
   4 (defparameter *prim-aliases* nil)
   5
   6 (defun prim-name (prim) (getf prim :name))
   7 (defun prim-type (prim) (getf prim :type))
   8 (defun prim-func (prim) (getf prim :func))
   9 (defun is-reporter (prim) (eql :reporter (getf prim :type)))
  10 (defun is-command (prim) (eql :command (getf prim :type)))
  11
  12 (defun find-prim (symb)
  13  (when symb
  14   (or
  15    (find symb *prims* :key #'prim-name)
  16    (find-prim (getf (find symb *prim-aliases* :key #'prim-name) :real-symb)))))
  17
  18 ; Let this grow, slowly but surely, eventually taking on calling context, etc.
  19 ; For now, it's just a
  20 (defun transpile-commands (parsed-ast)
  21  "TRANSPILE-COMMANDS PARSED-AST => AST
  22
  23 ARGUMENTS AND VALUES:
  24
  25   PARSED-AST: An ast as returned by the parser
  26   AST: An common lisp AST that can be actually run in a common lisp instance
  27
  28 DESCRIPTION:
  29
  30   TRANSPILE-COMMANDS takes a unambigious PARSED-AST and converts it to
  31   Common Lisp code.
  32
  33   Calling eval on that code should work correctly as long as you have a
  34   running engine.  This is the entry point for commands, so it does
  35   extra checking to ensure that commands are actually in the PARSED-AST."
  36  `(progn
  37    ,@(mapcar #'transpile-command parsed-ast)))
  38
  39 (defun transpile-command (command)
  40  (cond
  41   ((not (listp command)) (error "Expected a statement of some sort"))
  42   ((not (find-prim (car command))) (error "Couldn't find the command for ~S" (car command)))
  43   ((not (is-command (find-prim (car command)))) (error "Expected command, got ~S" (car command)))
  44   (t (apply (prim-func (find-prim (car command))) (mapcar #'transpile-reporter (cdr command))))))
  45
  46 (defun transpile-reporter (reporter)
  47  "TRANSPILE-REPORTER REPORTER => AST
  48
  49 ARGUMENTS AND VALUES:
  50
  51   REPORTER: An ast returned from the parser.
  52   AST: An common lisp AST that can be actually run in a common lisp instance
  53
  54 DESCRIPTION:
  55
  56   TRANSPILE-REPORTER takes a unambigious PARSED-AST and converts it to
  57   Common Lisp code.
  58
  59   Calling eval on that code should work correctly as long as you have a
  60   running engine.  This is the entry point for reporters, so it does
  61   extra checking to ensure that the reporter is actually in the REPORTER.
  62
  63   The Common lisp code that is returned, when run, will return some value."
  64  (cond
  65   ((numberp reporter) reporter) ; The parser converts to double for us
  66   ((symbolp reporter) reporter) ; The parser should have checked that having a symbol here is ok
  67   ((not (listp reporter)) (error "Expected a statement of some sort"))
  68   ((eql :command-block (car reporter)) (transpile-command-block reporter))
  69   ((not (find-prim (car reporter))) (error "Couldn't find the reporter for ~S" (car reporter)))
  70   ((not (is-reporter (find-prim (car reporter)))) (error "Expected reporter, got ~S" (car reporter)))
  71   (t (apply (prim-func (find-prim (car reporter))) (mapcar #'transpile-reporter (cdr reporter))))))
  72
  73 (defun transpile-command-block (block)
  74  `(lambda () ,@(mapcar #'transpile-command (cdr block))))
  75
  76 ; Undoes the previous function :)
  77 (defun make-command-block-inline (block)
  78  (cddr block))
  79
  80 (defmacro defprim (name type func)
  81  `(push (list :name ,name :type ,type :func ,func) *prims*))
  82
  83 (defmacro defsimpleprim (name type simple-func)
  84  `(defprim ,name ,type (lambda (&rest args) `(,',simple-func ,@args))))
  85
  86 (defmacro defkeywordprim (name)
  87  `(defprim ,name :reporter (lambda () ',name)))
  88
  89 (defmacro defprim-alias (name real-symb)
  90  `(push (list :name ,name :real-symb ,real-symb) *prim-aliases*))
  91
  92 ; We count on the parser to handle arguemnts for us, when collating things.
  93
  94 (defsimpleprim := :reporter cl:equalp)
  95 (defprim :!= :reporter (lambda (a b) `(not (equalp ,a ,b))))
  96 (defsimpleprim :<= :reporter cl:<=)
  97 (defsimpleprim :< :reporter cl:<)
  98 (defsimpleprim :- :reporter cl:-)
  99 (defsimpleprim :+ :reporter cl:+)
 100 (defsimpleprim :* :reporter cl:*)
 101 (defsimpleprim :/ :reporter cl:/)
 102 (defprim :any? :reporter (lambda (agentset) `(> (length ,agentset) 0)))
 103 (defsimpleprim :ask :command clnl-nvm:ask)
 104 (defsimpleprim :crt :command clnl-nvm:create-turtles)
 105 (defsimpleprim :die :command clnl-nvm:die)
 106 (defsimpleprim :fd :command clnl-nvm:forward)
 107 (defprim :if :command (lambda (pred a) `(when ,pred ,@(make-command-block-inline a))))
 108 (defprim :ifelse :command (lambda (pred a b)
 109                            `(if ,pred
 110                              ,@(make-command-block-inline a)
 111                              ,@(make-command-block-inline b))))
 112
 113 (defprim-alias :if-else :ifelse)
 114 (defsimpleprim :lt :command clnl-nvm:turn-left)
 115 (defkeywordprim :nobody)
 116 (defsimpleprim :random-float :reporter clnl-nvm:random-float)
 117 (defsimpleprim :rt :command clnl-nvm:turn-right)
 118 (defsimpleprim :show :command clnl-nvm:show)
 119 (defsimpleprim :turtles :reporter clnl-nvm:turtles)
 120
 121 ; Colors
 122 (defmacro defcolorprim (color) `(defprim ,color :reporter (lambda () `(clnl-nvm:lookup-color ,,color))))
 123 (defcolorprim :black)
 124 (defcolorprim :blue)
 125 (defcolorprim :brown)
 126 (defcolorprim :green)
 127 (defcolorprim :white)