; to the StructureParser, but I'm guessing there's weird overlap with
; other things
-(defun parse (lexed-ast)
- "PARSE LEXED-AST => AST
+(defvar *dynamic-prims* nil)
+(defun global->prim (global) (list :name global))
+
+(defun parse (lexed-ast &optional external-globals)
+ "PARSE LEXED-AST &optional EXTERNAL-GLOBALS => AST
ARGUMENTS AND VALUES:
LEXED-AST: An ambigious ast
+ EXTERNAL-GLOBALS: A list of symbols in keyword package
AST: An unambigious ast that represents the code block of a model
DESCRIPTION:
PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
+ EXTERNAL-GLOBALS is a list of symbols representing global variables that
+ are not defined within the code. Normally these come from widgets defined
+ in the model file, but could arguably come from elsewhere.
+
This parser, unlike CLNL-PARSE:PARSE, should not be fed into the transpiler.
Rather, the ast that's returned can be queried with other functions included
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)))
+ (parse-internal lexed-ast)))
+
+(defun parse-internal (lexed-ast)
(cond
((not lexed-ast) nil)
((eql :to (car lexed-ast)) (parse-procedure lexed-ast))
- ((find (car lexed-ast) '(:breed :globals :turtles-own :patches-own))
- (parse-with-unevaluated-list lexed-ast))))
+ ((find (car lexed-ast) '(:globals :turtles-own :patches-own))
+ (parse-with-unevaluated-list lexed-ast))
+ ((eql (car lexed-ast) :breed) (parse-breed lexed-ast))))
; Due to the non expression style syntax of procedures, this must be special cased
(defun parse-procedure (tokens)
(list
(first in-block)
(second in-block)
- (clnl-parser:parse (cddr in-block)))
- (parse after-block))))
+ (clnl-parser:parse (cddr in-block) *dynamic-prims*))
+ (parse-internal after-block))))
(defun find-end (tokens)
(cond
; This is a special case but left with a little wiggle room for future
; enhancements, like code blocks
(defun parse-with-unevaluated-list (lexed-ast)
- (when (not (eql :[ (cadr lexed-ast)))
- (error "Expected list literal here"))
+ (when (not (eql :[ (cadr lexed-ast))) (error "Expected list literal here"))
+ (multiple-value-bind (in-list after-list) (find-closing-bracket (cddr lexed-ast))
+ (cons
+ (list (car lexed-ast) (cons :list-literal in-list))
+ (let
+ ((*dynamic-prims* (append (mapcar #'global->prim in-list) *dynamic-prims*)))
+ (parse-internal after-list)))))
+
+(defun parse-breed (lexed-ast)
+ (when (not (eql :[ (cadr lexed-ast))) (error "Expected list literal here"))
(multiple-value-bind (in-list after-list) (find-closing-bracket (cddr lexed-ast))
(cons
(list (car lexed-ast) (cons :list-literal in-list))
- (parse after-list))))
+ (parse-internal after-list))))
(defun find-closing-bracket (tokens)
(cond
(read-sections (append section (list line))))))))
(read-sections))))
(make-model
- :code (clnl-code-parser:parse (clnl-lexer:lex (format nil "~{~A~^~%~}" (nth 0 sections))))
+ :code (clnl-code-parser:parse
+ (clnl-lexer:lex (format nil "~{~A~^~%~}" (nth 0 sections)))
+ (remove nil
+ (mapcar
+ (lambda (widget)
+ (typecase widget
+ (slider (intern (string-upcase (slider-varname widget)) (find-package :keyword)))
+ (switch (intern (string-upcase (switch-varname widget)) (find-package :keyword)))))
+ (parse-interface (nth 1 sections)))))
:interface (parse-interface (nth 1 sections))
:info (nth 2 sections)
:turtle-shapes (nth 3 sections)
(defun prim-structure-prim (prim) (getf prim :structure-prim))
(defun prim-is-infix (prim) (getf prim :infix))
-(defun find-prim (symb) (find symb *prims* :key #'prim-name))
+(defun find-prim (symb)
+ (or
+ (find symb *prims* :key #'prim-name)
+ (find symb *dynamic-prims* :key #'prim-name)))
; Make this only as complicated as it needs to be, letting it grow
; as we take on more and more of the language
"PARSE LEXED-AST &optional DYNAMIC-PRIMS => AST
DYNAMIC-PRIMS: DYNAMIC-PRIM*
+ DYNAMIC-PRIM: (:name NAME :args ARGS :infix INFIX)
+ ARGS: ARG*
ARGUMENTS AND VALUES:
LEXED-AST: An ambigious ast
AST: An unambigious ast that can be transpiled
- DYNAMIC-PRIM: A prim not statically defined
+ NAME: A symbol in the keyword package
+ INFIX: Boolean denoting whether the prim is infix
+ ARG: A list of symbols denoting the type of argument
DESCRIPTION:
things not statically defined by the NetLogo language, be they user defined
procedures or generated primitives from breed declarations.
+ The possible values for ARG are :agentset, :boolean, :number, :command-block,
+ or t for wildcard.
+
The need for a parser between the lexer and the transpiler is because NetLogo
needs two passes to turn into something that can be used. This is the only entry
point into this module, and should probably remain that way.
(defprim :hatch (:number :command-block))
(defprim :let (t t))
(defprim :if (:boolean :command-block))
+(defprim :if-else (:boolean :command-block :command-block))
(defprim :ifelse (:boolean :command-block :command-block))
(defprim :label ())
(defprim :label-color ())
; Placeholder prims that should be populated in dynamic prims
-; Generated by globals/widgets
-(defprim :grass ())
-(defprim :initial-number-sheep ())
-(defprim :initial-number-wolves ())
-(defprim :sheep-gain-from-food ())
-(defprim :wolf-gain-from-food ())
-(defprim :sheep-reproduce ())
-(defprim :wolf-reproduce ())
-(defprim :grass? ())
-(defprim :grass-regrowth-time ())
-(defprim :show-energy? ())
-
; Generated by procedures
(defprim :move ())
(defprim :eat-grass ())
(defprim :grow-grass ())
(defprim :display-labels ())
-; Generated by *-own
-(defprim :countdown ())
-(defprim :energy ())
-
; Generated by a let
(defprim :prey ())
projects / clnl / commitdiff