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    (list
  37     (first in-block)
  38     (second in-block)
  39     (clnl-parser:parse (cddr in-block)))
  40    (parse after-block))))
  41
  42 (defun find-end (tokens)
  43  (cond
  44   ((not tokens) (error "Failed to find end"))
  45   ((eql :end (car tokens)) (values nil (cdr tokens)))
  46   (t (multiple-value-bind (in-block after-block) (find-end (cdr tokens))
  47       (values (cons (car tokens) in-block) after-block)))))
  48
  49 ; This is a special case but left with a little wiggle room for future
  50 ; enhancements, like code blocks
  51 (defun parse-with-unevaluated-list (lexed-ast)
  52  (when (not (eql :[ (cadr lexed-ast)))
  53   (error "Expected list literal here"))
  54  (multiple-value-bind (in-list after-list) (find-closing-bracket (cddr lexed-ast))
  55   (cons
  56    (list (car lexed-ast) (cons :list-literal in-list))
  57    (parse after-list))))
  58
  59 (defun find-closing-bracket (tokens)
  60  (cond
  61   ((not tokens) (error "Failed to find a matching closing bracket"))
  62   ((eql :] (car tokens)) (values nil (cdr tokens)))
  63   ((eql :[ (car tokens)) (error "Expected name or ]"))
  64   (t (multiple-value-bind (in-block after-block) (find-closing-bracket (cdr tokens))
  65       (values (cons (car tokens) in-block) after-block)))))
  66
  67 (defun globals (code-parsed-ast)
  68  "GLOBALS MODEL => GLOBALS
  69
  70   GLOBALS: GLOBAL*
  71
  72 ARGUMENTS AND VALUES:
  73
  74   MODEL: An ast as created by clnl-code-parse:parse
  75   GLOBAL: A symbol interned in clnl:*model-package*
  76
  77 DESCRIPTION:
  78
  79   Returns the globals that get declared in the code."
  80  (mapcar
  81   (lambda (global) (list (symbol-name global) 0d0))
  82   (cdr (second (find :globals code-parsed-ast :key #'car)))))