(let*
((lexed-ast (let ((ast (cl-nl.lexer:lex str))) (format t "Via lexing, AST for ~S became ~S~%" str ast) ast))
(parsed-ast (let ((ast (cl-nl.parser:parse lexed-ast))) (format t "Via parsing, AST for ~S became ~S~%" lexed-ast ast) ast))
- (transpiled-ast (let ((ast (cl-nl.transpiler:transpile-command-block parsed-ast))) (format t "Via transpiling, AST for ~S became ~S~%" parsed-ast ast) ast)))
+ (transpiled-ast (let ((ast (cl-nl.transpiler:transpile-commands parsed-ast))) (format t "Via transpiling, AST for ~S became ~S~%" parsed-ast ast) ast)))
(eval transpiled-ast)))
(defun p (result) result)
)
(defun run-commands (cmds)
- (eval (cl-nl.transpiler:transpile-command-block (cl-nl.parser:parse (cl-nl.lexer:lex cmds)))))
+ (eval (cl-nl.transpiler:transpile-commands (cl-nl.parser:parse (cl-nl.lexer:lex cmds)))))
(defvar *current-id* 0)
-(defstruct turtle who color heading)
+(defstruct turtle who color heading xcor ycor)
(defvar *turtles* nil)
+(defvar *myself* nil)
+(defvar *self* nil)
(defun show (n)
(format t "Showing: ~A~%" n))
(push
(make-turtle :who *current-id*
:color (coerce (+ 5 (* 10 (cl-nl.random:next-int 14))) 'double-float)
- :heading (coerce (cl-nl.random:next-int 360) 'double-float))
+ :heading (coerce (cl-nl.random:next-int 360) 'double-float)
+ :xcor 0d0
+ :ycor 0d0)
*turtles*)
(incf *current-id*))
+(defun turtles () *turtles*)
+
+(defun ask (agent-set fn)
+ (mapcar
+ (lambda (agent)
+ (let
+ ((*myself* *self*)
+ (*self* agent))
+ (funcall fn)))
+ (shuffle agent-set)))
+
+(defun shuffle (agent-set)
+ (let
+ ((copy (copy-list agent-set)))
+ (append
+ (loop for i to (- (length copy) 2)
+ for idx = (+ i (cl-nl.random:next-int (- (length copy) i)))
+ for next = (nth idx copy)
+ do (setf (nth idx copy) (nth i copy))
+ collect next)
+ (last copy))))
+
+(defun fd (n)
+ (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude"))
+ (setf (turtle-xcor *self*) (+ (turtle-xcor *self*) (sin (* pi (/ (turtle-heading *self*) 180)))))
+ (setf (turtle-ycor *self*) (+ (turtle-ycor *self*) (cos (* pi (/ (turtle-heading *self*) 180))))))
+
(defun create-turtles (n)
(loop for i from 1 to n do (create-turtle)))
(mapcar
(lambda (turtle)
(format nil
- "\"~A\",\"~A\",\"~A\",\"0\",\"0\",\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""
+ "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""
(turtle-who turtle)
(format-num (turtle-color turtle))
- (format-num (turtle-heading turtle))))
+ (format-num (turtle-heading turtle))
+ (format-num (turtle-xcor turtle))
+ (format-num (turtle-ycor turtle))
+ ))
(reverse *turtles*)))
(format nil "~S" "PATCHES")
"\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
(defpackage #:cl-nl.transpiler
(:use :common-lisp)
- (:export :transpile-command-block))
+ (:export :transpile-commands))
(defpackage #:cl-nl.nvm
(:use :common-lisp)
(defun prim-name (prim) (getf prim :name))
(defun prim-num-args (prim) (length (getf prim :args)))
+(defun prim-args (prim) (getf prim :args))
(defun find-prim (symb) (find symb *prims* :key #'prim-name))
-; We don't care if it's a command!
-;(defun is-command (symb)
-; (let
-; ((prim (find-prim symb)))
-; (and prim (eql :command (getf prim :type)))))
-
; Make this only as complicated as it needs to be, letting it grow
; as we take on more and more of the language
(defun parse (lexed-ast)
(cond
((not lexed-ast) nil)
((numberp (car lexed-ast)) (cons (coerce (car lexed-ast) 'double-float) (parse (cdr lexed-ast))))
+ ((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast)))
((and (symbolp (car lexed-ast)) (find-prim (car lexed-ast)))
(let*
((prim (find-prim (car lexed-ast)))
(cons
(cons
(prim-name prim)
- (butlast parsed-remainder (- (length parsed-remainder) num-args)))
+ (mapcar
+ #'help-arg
+ (prim-args prim)
+ (butlast parsed-remainder (- (length parsed-remainder) num-args))))
(nthcdr num-args parsed-remainder))))
(t (error "Couldn't parse ~S" lexed-ast))))
+(defun help-arg (arg-type arg)
+ (case arg-type
+ (:command-block
+ (if (not (and (consp arg) (eql 'block (car arg))))
+ (error "Required a block, but found a ~A" arg)
+ (cons :command-block (cdr arg))))
+ (t arg)))
+
+(defun parse-block (tokens)
+ (multiple-value-bind (in-block after-block) (find-closing-bracket tokens)
+ (cons
+ (cons
+ 'block
+ (parse in-block))
+ (parse after-block))))
+
+(defun find-closing-bracket (tokens &optional (depth 0))
+ (cond
+ ((not tokens) (error "Failed to find a matching closing bracket"))
+ ((and (eql :] (car tokens)) (= depth 0)) (values nil (cdr tokens)))
+ (t (multiple-value-bind
+ (in-block after-block)
+ (find-closing-bracket (cdr tokens) (case (car tokens) (:[ (1+ depth)) (:] (1- depth)) (t depth)))
+ (values (cons (car tokens) in-block) after-block)))))
+
(defmacro defprim (name args)
`(push
(list :name ,name :args ',args)
; Current list of argument types we accept:
; - :number
; - t - any type
+(defprim :ask (:agentset :command-block))
(defprim :crt (:number))
+(defprim :fd (:number))
(defprim :show (t))
+(defprim :turtles ())
; Let this grow, slowly but surely, eventually taking on calling context, etc.
; For now, it's just a
-(defun transpile-command-block (parsed-ast)
+(defun transpile-commands (parsed-ast)
`(progn
,@(mapcar #'transpile-command parsed-ast)))
((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
((not (listp reporter)) (error "Expected a statement of some sort"))
+ ((eql :command-block (car reporter)) (transpile-command-block reporter))
((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))))))
+(defun transpile-command-block (block)
+ `(lambda () ,@(mapcar #'transpile-command (cdr block))))
+
(defmacro defprim (name type nvm-func)
`(push
(list :name ,name :type ,type :func ',nvm-func)
*prims*))
; 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)
(defun run-all-tests ()
(format t "~%Here we goooooooo~%")
- (run-tests *tests*))
+ (run-tests (reverse *tests*)))
(defun run-tests-matching (match)
(run-tests (remove-if-not (lambda (test-name) (cl-ppcre:scan (format nil "^~A$" match) test-name)) *tests* :key #'car)))
(defsimpletest "Nothing" "" "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")
(defsimpletest "Simple crt" "crt 1" "2F08B31AC06C9D5339E6B3E953C2B4B71FDB9CDE")
(defsimpletest "Simple crt 2" "crt 5" "9FE588C2749CD9CE66CB0EA451EFB80476E881FB")
+(defsimpletest "Simple crt and fd" "crt 5 ask turtles [ fd 1 ]" "BEB43404EDC7852985A9A7FC312481785FE553A0")
projects / clnl / commitdiff