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 (defun parse (lexed-ast)
10 "PARSE LEXED-AST => AST
14 LEXED-AST: An ambigious ast
15 AST: An unambigious ast that represents the code block of a model
19 PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
21 This parser, unlike CLNL-PARSE:PARSE, should not be fed into the transpiler.
23 Rather, the ast that's returned can be queried with other functions included
24 in the CLNL-CODE-PARSER package to tease out necessary information. Some of
25 those things will involve code blocks that can then be transpiled."
28 ((eql :to (car lexed-ast)) (parse-procedure lexed-ast))
29 ((find (car lexed-ast) '(:breed :globals :turtles-own :patches-own))
30 (parse-with-unevaluated-list lexed-ast))))
32 ; Due to the non expression style syntax of procedures, this must be special cased
33 (defun parse-procedure (tokens)
34 (multiple-value-bind (in-block after-block) (find-end tokens)
37 (parse after-block))))
39 (defun find-end (tokens)
41 ((not tokens) (error "Failed to find end"))
42 ((eql :end (car tokens)) (values nil (cdr tokens)))
43 (t (multiple-value-bind (in-block after-block) (find-end (cdr tokens))
44 (values (cons (car tokens) in-block) after-block)))))
46 ; This is a special case but left with a little wiggle room for future
47 ; enhancements, like code blocks
48 (defun parse-with-unevaluated-list (lexed-ast)
49 (when (not (eql :[ (cadr lexed-ast)))
50 (error "Expected list literal here"))
51 (multiple-value-bind (in-list after-list) (find-closing-bracket (cddr lexed-ast))
53 (list (car lexed-ast) (cons :list-literal in-list))
56 (defun find-closing-bracket (tokens)
58 ((not tokens) (error "Failed to find a matching closing bracket"))
59 ((eql :] (car tokens)) (values nil (cdr tokens)))
60 ((eql :[ (car tokens)) (error "Expected name or ]"))
61 (t (multiple-value-bind (in-block after-block) (find-closing-bracket (cdr tokens))
62 (values (cons (car tokens) in-block) after-block)))))
64 (defun globals (code-parsed-ast)
65 "GLOBALS MODEL => GLOBALS
71 MODEL: An ast as created by clnl-code-parse:parse
72 GLOBAL: A symbol interned in clnl:*model-package*
76 Returns the globals that get declared in the code."
78 (lambda (global) (list (symbol-name global) 0d0))
79 (cdr (second (find :globals code-parsed-ast :key #'car)))))