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

   1 (in-package #:clnl-parser)
   2
   3 ; Ok, after thinking about this a little, the parser is completely contextual
   4 ; based on what has come before.  We can't do a contextless parsing, like we
   5 ; could in other languages, due to amiguity about reporters vs reporter tasks
   6 ;
   7 ; So, for instance, we could have:
   8 ;   x + y => (+ x y)
   9 ;   x + y => (x (task +) y)
  10 ; So the definition of "+" is completely dependent on the nature of x
  11 ;
  12 ; The goal of this parser should be to turn in the amiguous lexed ast representing
  13 ; NetLogo into an unambigious S-expression, and nothing more, so things like
  14 ; expectation of commands being the first symbol is not be necessary until later
  15 ;
  16 ; In general, the parser will:
  17 ;  * Parse the structure of the lexed output first
  18 ;  * Parse the structure of the individual expressions (finding ('s and ['s and doing the right thing)
  19 ;  * Coalate things into an unambigious expressions
  20 ;  * Then we're done, let someone else make it evaluatable
  21 ;    - We don't really care if things are commands or reporters right now
  22
  23 (defparameter *prims* nil)
  24
  25 (defun prim-name (prim) (getf prim :name))
  26 (defun prim-num-args (prim) (length (getf prim :args)))
  27 (defun prim-args (prim) (getf prim :args))
  28
  29 (defun find-prim (symb) (find symb *prims* :key #'prim-name))
  30
  31 ; Make this only as complicated as it needs to be, letting it grow
  32 ; as we take on more and more of the language
  33 (defun parse (lexed-ast)
  34  "PARSE LEXED-AST => AST
  35
  36 ARGUMENTS AND VALUES:
  37
  38   LEXED-AST: An ambigious ast
  39   AST: An unambigious ast that can be transpiled
  40
  41 DESCRIPTION:
  42
  43   PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
  44
  45   The need for a parser between the lexer and the transpiler is because NetLogo
  46   needs two passes to turn into something that can be used.  This is the only entry
  47   point into this module, and should probably remain that way.
  48
  49   There's also a lot of error checking that the LEXED-AST even makes sense, even
  50   though the lexer obviously thought it did.
  51
  52   Examples are too numerous and varied, but by inserting an output between
  53   the lexer and this code, a good idea of what goes on can be gotten."
  54  (cond
  55   ((not lexed-ast) nil)
  56   ((numberp (car lexed-ast)) (cons (coerce (car lexed-ast) 'double-float) (parse (cdr lexed-ast))))
  57   ((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast)))
  58   ((and (symbolp (car lexed-ast)) (find-prim (car lexed-ast)))
  59    (let*
  60     ((prim (find-prim (car lexed-ast)))
  61      (num-args (prim-num-args prim))
  62      (parsed-remainder (parse (cdr lexed-ast))))
  63     (cons
  64      (cons
  65       (prim-name prim)
  66       (mapcar
  67        #'help-arg
  68        (prim-args prim)
  69        (butlast parsed-remainder (- (length parsed-remainder) num-args))))
  70      (nthcdr num-args parsed-remainder))))
  71   (t (error "Couldn't parse ~S" lexed-ast))))
  72
  73 (defun help-arg (arg-type arg)
  74  (case arg-type
  75   (:command-block
  76    (if (not (and (consp arg) (eql 'block (car arg))))
  77     (error "Required a block, but found a ~A" arg)
  78     (cons :command-block (cdr arg))))
  79   (t arg)))
  80
  81 (defun parse-block (tokens)
  82  (multiple-value-bind (in-block after-block) (find-closing-bracket tokens)
  83   (cons
  84    (cons
  85     'block
  86     (parse in-block))
  87    (parse after-block))))
  88
  89 (defun find-closing-bracket (tokens &optional (depth 0))
  90  (cond
  91   ((not tokens) (error "Failed to find a matching closing bracket"))
  92   ((and (eql :] (car tokens)) (= depth 0)) (values nil (cdr tokens)))
  93   (t (multiple-value-bind
  94       (in-block after-block)
  95       (find-closing-bracket (cdr tokens) (case (car tokens) (:[ (1+ depth)) (:] (1- depth)) (t depth)))
  96       (values (cons (car tokens) in-block) after-block)))))
  97
  98 (defmacro defprim (name args)
  99  `(push
 100    (list :name ,name :args ',args)
 101    *prims*))
 102
 103 ; This list of prims will get combined with the mapping to actual code later
 104 ; Current list of argument types we accept:
 105 ; - :number
 106 ; - :agentset
 107 ; - :command-block
 108 ; - t - any type
 109 (defprim :ask (:agentset :command-block))
 110 (defprim :crt (:number))
 111 (defprim :fd (:number))
 112 (defprim :random-float (:number))
 113 (defprim :show (t))
 114 (defprim :turtles ())