From 18f00de47300789104d94745cd9db874b2071b7e Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 23 Apr 2016 16:02:06 -0500 Subject: [PATCH] Improve parser - generate prims from globals --- src/main/code-parse.lisp | 40 +++++++++++++++++++++++++++++++--------- src/main/model.lisp | 10 +++++++++- src/main/parse.lisp | 31 +++++++++++++------------------ 3 files changed, 53 insertions(+), 28 deletions(-) diff --git a/src/main/code-parse.lisp b/src/main/code-parse.lisp index 69806ca..7cdf2b5 100644 --- a/src/main/code-parse.lisp +++ b/src/main/code-parse.lisp @@ -6,28 +6,42 @@ ; 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) @@ -36,8 +50,8 @@ DESCRIPTION: (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 @@ -49,12 +63,20 @@ DESCRIPTION: ; 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 diff --git a/src/main/model.lisp b/src/main/model.lisp index 1927ff5..33f90aa 100644 --- a/src/main/model.lisp +++ b/src/main/model.lisp @@ -54,7 +54,15 @@ DESCRIPTION: (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) diff --git a/src/main/parse.lisp b/src/main/parse.lisp index eaaa3fe..c427019 100644 --- a/src/main/parse.lisp +++ b/src/main/parse.lisp @@ -31,7 +31,10 @@ (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 @@ -39,12 +42,16 @@ "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: @@ -54,6 +61,9 @@ 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. @@ -210,6 +220,7 @@ DESCRIPTION: (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 ()) @@ -251,18 +262,6 @@ DESCRIPTION: ; 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 ()) @@ -273,10 +272,6 @@ DESCRIPTION: (defprim :grow-grass ()) (defprim :display-labels ()) -; Generated by *-own -(defprim :countdown ()) -(defprim :energy ()) - ; Generated by a let (defprim :prey ()) -- 2.25.1