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

   1 (in-package #:cl-nl.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  (cond
  35   ((not lexed-ast) nil)
  36   ((numberp (car lexed-ast)) (cons (coerce (car lexed-ast) 'double-float) (parse (cdr lexed-ast))))
  37   ((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast)))
  38   ((and (symbolp (car lexed-ast)) (find-prim (car lexed-ast)))
  39    (let*
  40     ((prim (find-prim (car lexed-ast)))
  41      (num-args (prim-num-args prim))
  42      (parsed-remainder (parse (cdr lexed-ast))))
  43     (cons
  44      (cons
  45       (prim-name prim)
  46       (mapcar
  47        #'help-arg
  48        (prim-args prim)
  49        (butlast parsed-remainder (- (length parsed-remainder) num-args))))
  50      (nthcdr num-args parsed-remainder))))
  51   (t (error "Couldn't parse ~S" lexed-ast))))
  52
  53 (defun help-arg (arg-type arg)
  54  (case arg-type
  55   (:command-block
  56    (if (not (and (consp arg) (eql 'block (car arg))))
  57        (error "Required a block, but found a ~A" arg)
  58        (cons :command-block (cdr arg))))
  59   (t arg)))
  60
  61 (defun parse-block (tokens)
  62  (multiple-value-bind (in-block after-block) (find-closing-bracket tokens)
  63   (cons
  64    (cons
  65     'block
  66     (parse in-block))
  67    (parse after-block))))
  68
  69 (defun find-closing-bracket (tokens &optional (depth 0))
  70  (cond
  71   ((not tokens) (error "Failed to find a matching closing bracket"))
  72   ((and (eql :] (car tokens)) (= depth 0)) (values nil (cdr tokens)))
  73   (t (multiple-value-bind
  74       (in-block after-block)
  75       (find-closing-bracket (cdr tokens) (case (car tokens) (:[ (1+ depth)) (:] (1- depth)) (t depth)))
  76       (values (cons (car tokens) in-block) after-block)))))
  77
  78 (defmacro defprim (name args)
  79  `(push
  80    (list :name ,name :args ',args)
  81    *prims*))
  82
  83 ; This list of prims will get combined with the mapping to actual code later
  84 ; Current list of argument types we accept:
  85 ; - :number
  86 ; - :agentset
  87 ; - :command-block
  88 ; - t - any type
  89 (defprim :ask (:agentset :command-block))
  90 (defprim :crt (:number))
  91 (defprim :fd (:number))
  92 (defprim :random-float (:number))
  93 (defprim :show (t))
  94 (defprim :turtles ())