1 (in-package #:clnl-transpiler)
3 (defparameter *prims* nil)
4 (defparameter *prim-aliases* nil)
6 (defvar *local-variables* nil)
8 (defun prim-name (prim) (getf prim :name))
9 (defun prim-type (prim) (getf prim :type))
10 (defun prim-func (prim) (getf prim :func))
11 (defun is-reporter (prim) (eql :reporter (getf prim :type)))
12 (defun is-command (prim) (eql :command (getf prim :type)))
14 (defun find-prim (symb)
17 (find symb *prims* :key #'prim-name)
18 (find-prim (getf (find symb *prim-aliases* :key #'prim-name) :real-symb)))))
20 ; Let this grow, slowly but surely, eventually taking on calling context, etc.
21 ; For now, it's just a
22 (defun transpile-commands (parsed-ast)
23 "TRANSPILE-COMMANDS PARSED-AST => AST
27 PARSED-AST: An ast as returned by the parser
28 AST: An common lisp AST that can be actually run in a common lisp instance
32 TRANSPILE-COMMANDS takes a unambigious PARSED-AST and converts it to
35 Calling eval on that code should work correctly as long as you have a
36 running engine. This is the entry point for commands, so it does
37 extra checking to ensure that commands are actually in the PARSED-AST."
39 ,@(transpile-commands-inner parsed-ast)))
41 (defun transpile-commands-inner (parsed-ast)
43 ((not parsed-ast) nil)
44 ((and (listp (car parsed-ast)) (eql :let (caar parsed-ast))) (list (handle-let parsed-ast)))
47 (transpile-command (car parsed-ast))
48 (transpile-commands-inner (cdr parsed-ast))))))
50 (defun handle-let (parsed-ast &optional vars)
52 (and (listp (car parsed-ast)) (eql :let (caar parsed-ast)))
54 ((*local-variables* (cons (second (car parsed-ast)) *local-variables*)))
59 (transpile-reporter (second (car parsed-ast)))
60 (transpile-reporter (third (car parsed-ast))))
64 ,@(transpile-commands-inner parsed-ast))))
66 (defun transpile-command (command)
68 ((not (listp command)) (error "Expected a statement of some sort"))
69 ((not (find-prim (car command))) (error "Couldn't find the command for ~S" (car command)))
70 ((not (is-command (find-prim (car command)))) (error "Expected command, got ~S" (car command)))
71 (t (apply (prim-func (find-prim (car command))) (mapcar #'transpile-reporter (cdr command))))))
73 (defun transpile-reporter (reporter)
74 "TRANSPILE-REPORTER REPORTER => AST
78 REPORTER: An ast returned from the parser.
79 AST: An common lisp AST that can be actually run in a common lisp instance
83 TRANSPILE-REPORTER takes a unambigious PARSED-AST and converts it to
86 Calling eval on that code should work correctly as long as you have a
87 running engine. This is the entry point for reporters, so it does
88 extra checking to ensure that the reporter is actually in the REPORTER.
90 The Common lisp code that is returned, when run, will return some value."
92 ((numberp reporter) reporter) ; The parser converts to double for us
93 ; The parser should have checked that having a symbol here is ok
94 ((symbolp reporter) (intern (symbol-name reporter) clnl:*model-package*))
95 ((not (listp reporter)) (error "Expected a statement of some sort"))
96 ((eql :command-block (car reporter)) (transpile-command-block reporter))
97 ((eql :reporter-block (car reporter)) (transpile-reporter-block reporter))
98 ((and (symbolp (car reporter)) (find (car reporter) *local-variables*))
99 (intern (symbol-name (car reporter)) clnl:*model-package*))
100 ((not (find-prim (car reporter))) (error "Couldn't find the reporter for ~S" (car reporter)))
101 ((not (is-reporter (find-prim (car reporter)))) (error "Expected reporter, got ~S" (car reporter)))
102 (t (apply (prim-func (find-prim (car reporter))) (mapcar #'transpile-reporter (cdr reporter))))))
104 (defun transpile-command-block (block)
105 `(lambda () ,@(transpile-commands-inner (cdr block))))
107 (defun transpile-reporter-block (block)
108 (when (/= (length block) 2) (error "Reporter block invalid ~S" block))
110 ,(transpile-reporter (cadr block))))
112 ; Undoes the previous function :)
113 (defun make-command-block-inline (block)
116 (defmacro defprim (name type func)
117 `(push (list :name ,name :type ,type :func ,func) *prims*))
119 (defmacro defsimpleprim (name type simple-func)
120 `(defprim ,name ,type (lambda (&rest args) `(,',simple-func ,@args))))
122 (defmacro defkeywordprim (name)
123 `(defprim ,name :reporter (lambda () ',name)))
125 (defmacro defprim-alias (name real-symb)
126 `(push (list :name ,name :real-symb ,real-symb) *prim-aliases*))
128 (defmacro defagentvalueprim (name)
129 `(defprim ,name :reporter (lambda () `(clnl-nvm:agent-value ,,name))))
131 ; We count on the parser to handle arguemnts for us, when collating things.
133 (defsimpleprim := :reporter cl:equalp)
134 (defprim :!= :reporter (lambda (a b) `(not (equalp ,a ,b))))
135 (defsimpleprim :<= :reporter cl:<=)
136 (defsimpleprim :< :reporter cl:<)
137 (defsimpleprim :- :reporter cl:-)
138 (defsimpleprim :+ :reporter cl:+)
139 (defsimpleprim :* :reporter cl:*)
140 (defsimpleprim :/ :reporter cl:/)
141 (defprim :any? :reporter (lambda (agentset) `(> (length ,agentset) 0)))
142 (defsimpleprim :ask :command clnl-nvm:ask)
143 (defagentvalueprim :color)
144 (defsimpleprim :crt :command clnl-nvm:create-turtles)
145 (defsimpleprim :die :command clnl-nvm:die)
146 (defsimpleprim :fd :command clnl-nvm:forward)
147 (defprim :if :command (lambda (pred a) `(when ,pred ,@(make-command-block-inline a))))
148 (defprim :ifelse :command (lambda (pred a b)
150 ,@(make-command-block-inline a)
151 ,@(make-command-block-inline b))))
153 (defprim-alias :if-else :ifelse)
154 (defagentvalueprim :label)
155 (defagentvalueprim :label-color)
156 (defsimpleprim :lt :command clnl-nvm:turn-left)
157 (defkeywordprim :nobody)
158 (defsimpleprim :one-of :reporter clnl-nvm:one-of)
159 (defsimpleprim :of :reporter clnl-nvm:of)
160 (defsimpleprim :patches :reporter clnl-nvm:patches)
161 (defagentvalueprim :pcolor)
162 (defsimpleprim :reset-ticks :command clnl-nvm:reset-ticks)
163 (defsimpleprim :random :reporter clnl-nvm:random)
164 (defsimpleprim :random-float :reporter clnl-nvm:random-float)
165 (defsimpleprim :random-xcor :reporter clnl-nvm:random-xcor)
166 (defsimpleprim :random-ycor :reporter clnl-nvm:random-ycor)
167 (defsimpleprim :rt :command clnl-nvm:turn-right)
168 (defsimpleprim :show :command clnl-nvm:show)
169 (defsimpleprim :set :command cl:setf)
170 (defsimpleprim :setxy :command clnl-nvm:setxy)
171 (defagentvalueprim :size)
172 (defsimpleprim :tick :command clnl-nvm:tick)
173 (defsimpleprim :ticks :reporter clnl-nvm:ticks)
174 (defsimpleprim :turtles :reporter clnl-nvm:turtles)
175 (defagentvalueprim :who)
178 (defmacro defcolorprim (color) `(defprim ,color :reporter (lambda () `(clnl-nvm:lookup-color ,,color))))
179 (defcolorprim :black)
181 (defcolorprim :brown)
182 (defcolorprim :green)
183 (defcolorprim :white)