code.consxy.com Git - clnl/blob - src/main/code-parse.lisp

   1 (in-package #:clnl-code-parser)
   2
   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
   7 ; other things
   8
   9 (defun parse (lexed-ast)
  10  "PARSE LEXED-AST => AST
  11
  12 ARGUMENTS AND VALUES:
  13
  14   LEXED-AST: An ambigious ast
  15   AST: An unambigious ast that represents the code block of a model
  16
  17 DESCRIPTION:
  18
  19   PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
  20
  21   This parser, unlike CLNL-PARSE:PARSE, should not be fed into the transpiler.
  22
  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."
  26  (cond
  27   ((not lexed-ast) nil)
  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))))
  31
  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)
  35   (cons
  36    in-block
  37    (parse after-block))))
  38
  39 (defun find-end (tokens)
  40  (cond
  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)))))
  45
  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))
  52   (cons
  53    (list (car lexed-ast) (cons :list-literal in-list))
  54    (parse after-list))))
  55
  56 (defun find-closing-bracket (tokens)
  57  (cond
  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)))))
  63
  64 (defun globals (code-parsed-ast)
  65  "GLOBALS MODEL => GLOBALS
  66
  67   GLOBALS: GLOBAL*
  68
  69 ARGUMENTS AND VALUES:
  70
  71   MODEL: An ast as created by clnl-code-parse:parse
  72   GLOBAL: A symbol interned in clnl:*model-package*
  73
  74 DESCRIPTION:
  75
  76   Returns the globals that get declared in the code."
  77  (mapcar
  78   (lambda (global) (list (symbol-name global) 0d0))
  79   (cdr (second (find :globals code-parsed-ast :key #'car)))))