1 (in-package #:clnl-code-parser)
3 ; This is different from the general parser (in clnl-parser) in that
4 ; it's made for parsing the code section of nlogo files, and so works
5 ; outside of the constraints. In NetLogo, I believe this is analagous
6 ; to the StructureParser, but I'm guessing there's weird overlap with
9 (defvar *dynamic-prims* nil)
10 (defun global->prim (global) (list :name global))
11 (defun breed->prims (breed-list)
13 ((plural-name (symbol-name (car breed-list))))
15 (list :name (car breed-list))
16 (list :name (intern (format nil "~A-HERE" plural-name) :keyword))
17 (list :name (intern (format nil "CREATE-~A" plural-name) :keyword) :args '(:number :command-block)))))
19 (defun parse (lexed-ast &optional external-globals)
20 "PARSE LEXED-AST &optional EXTERNAL-GLOBALS => AST
24 LEXED-AST: An ambigious ast
25 EXTERNAL-GLOBALS: A list of symbols in keyword package
26 AST: An unambigious ast that represents the code block of a model
30 PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
32 EXTERNAL-GLOBALS is a list of symbols representing global variables that
33 are not defined within the code. Normally these come from widgets defined
34 in the model file, but could arguably come from elsewhere.
36 This parser, unlike CLNL-PARSE:PARSE, should not be fed into the transpiler.
38 Rather, the ast that's returned can be queried with other functions included
39 in the CLNL-CODE-PARSER package to tease out necessary information. Some of
40 those things will involve code blocks that can then be transpiled."
44 (mapcar #'global->prim external-globals)
45 (procedures->prims lexed-ast))))
46 (parse-internal lexed-ast)))
48 (defun procedures->prims (lexed-ast)
51 ; We'll need argument handling here sometime :)
52 ((eql :to (car lexed-ast)) (cons (list :name (cadr lexed-ast)) (procedures-to-prims (cdr lexed-ast))))
53 (t (procedures-to-prims (cdr lexed-ast)))))
55 (defun parse-internal (lexed-ast)
58 ((eql :to (car lexed-ast)) (parse-procedure lexed-ast))
59 ((find (car lexed-ast) '(:globals :turtles-own :patches-own))
60 (parse-with-unevaluated-list lexed-ast))
61 ((eql (car lexed-ast) :breed) (parse-breed lexed-ast))))
63 ; Due to the non expression style syntax of procedures, this must be special cased
64 (defun parse-procedure (tokens)
65 (multiple-value-bind (in-block after-block) (find-end tokens)
70 (clnl-parser:parse (cddr in-block) *dynamic-prims*))
71 (parse-internal after-block))))
73 (defun find-end (tokens)
75 ((not tokens) (error "Failed to find end"))
76 ((eql :end (car tokens)) (values nil (cdr tokens)))
77 (t (multiple-value-bind (in-block after-block) (find-end (cdr tokens))
78 (values (cons (car tokens) in-block) after-block)))))
80 ; This is a special case but left with a little wiggle room for future
81 ; enhancements, like code blocks
82 (defun parse-with-unevaluated-list (lexed-ast)
83 (when (not (eql :[ (cadr lexed-ast))) (error "Expected list literal here"))
84 (multiple-value-bind (in-list after-list) (find-closing-bracket (cddr lexed-ast))
86 (list (car lexed-ast) (cons :list-literal in-list))
88 ((*dynamic-prims* (append (mapcar #'global->prim in-list) *dynamic-prims*)))
89 (parse-internal after-list)))))
91 (defun parse-breed (lexed-ast)
92 (when (not (eql :[ (cadr lexed-ast))) (error "Expected list literal here"))
93 (multiple-value-bind (in-list after-list) (find-closing-bracket (cddr lexed-ast))
95 (list (car lexed-ast) (cons :list-literal in-list))
97 ((*dynamic-prims* (append (breed->prims in-list) *dynamic-prims*)))
98 (parse-internal after-list)))))
100 (defun find-closing-bracket (tokens)
102 ((not tokens) (error "Failed to find a matching closing bracket"))
103 ((eql :] (car tokens)) (values nil (cdr tokens)))
104 ((eql :[ (car tokens)) (error "Expected name or ]"))
105 (t (multiple-value-bind (in-block after-block) (find-closing-bracket (cdr tokens))
106 (values (cons (car tokens) in-block) after-block)))))
108 (defun globals (code-parsed-ast)
109 "GLOBALS MODEL => GLOBALS
113 ARGUMENTS AND VALUES:
115 MODEL: An ast as created by clnl-code-parse:parse
116 GLOBAL: A symbol interned in clnl:*model-package*
120 Returns the globals that get declared in the code."
122 (lambda (global) (list (intern (symbol-name global) clnl:*model-package*) 0d0))
123 (cdr (second (find :globals code-parsed-ast :key #'car)))))