From: Michael Graffam
Subject: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <pan.2004.02.22.23.22.38.390091@yahoo.com>
Hello all, 

Does anyone know of a Bison / Yacc compatible system for
Common Lisp? 

I'd like to make a GNU Octave to Common Lisp translator. 

From: Matthew Danish
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <20040223000850.GV8667@mapcar.org>
On Sun, Feb 22, 2004 at 06:22:38PM -0500, Michael Graffam wrote:
> 
> Hello all, 
> 
> Does anyone know of a Bison / Yacc compatible system for
> Common Lisp? 
> 
> I'd like to make a GNU Octave to Common Lisp translator. 

Are you looking for a Bison/Yacc or a parser-generator?  If the latter,
there is Zebu or some simple LALR parsers which can be combined with
some regex library for a lexer.

-- 
; Matthew Danish <·······@andrew.cmu.edu>
; OpenPGP public key: C24B6010 on keyring.debian.org
; Signed or encrypted mail welcome.
; "There is no dark side of the moon really; matter of fact, it's all dark."
From: Hannah Schroeter
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <c1d251$mbv$1@c3po.use.schlund.de>
Hello!

Matthew Danish  <·······@andrew.cmu.edu> wrote:
>[...]

>Are you looking for a Bison/Yacc or a parser-generator?  If the latter,
>there is Zebu or some simple LALR parsers which can be combined with
>some regex library for a lexer.

A regex library isn't really a good substitute for a lexer generator.
Testing
  (cond
    ((re-match input "foo") ...)
    ((re-match input "bar") ...)
    ...)
just by far isn't as efficient as testing all expressions simultaneously
with one generated automaton.

Kind regards,

Hannah.
From: Matthew Danish
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <20040224020842.GA31147@mapcar.org>
On Mon, Feb 23, 2004 at 02:19:13PM +0000, Hannah Schroeter wrote:
> Hello!
> 
> Matthew Danish  <·······@andrew.cmu.edu> wrote:
> >[...]
> 
> >Are you looking for a Bison/Yacc or a parser-generator?  If the latter,
> >there is Zebu or some simple LALR parsers which can be combined with
> >some regex library for a lexer.
> 
> A regex library isn't really a good substitute for a lexer generator.
> Testing
>   (cond
>     ((re-match input "foo") ...)
>     ((re-match input "bar") ...)
>     ...)
> just by far isn't as efficient as testing all expressions simultaneously
> with one generated automaton.

This is true; I was thinking of the library REGEX which has a way to
construct such an automaton, as used in the accompanying LEXER package.

-- 
; Matthew Danish <·······@andrew.cmu.edu>
; OpenPGP public key: C24B6010 on keyring.debian.org
; Signed or encrypted mail welcome.
; "There is no dark side of the moon really; matter of fact, it's all dark."
From: Hannah Schroeter
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <c1i1vv$iar$1@c3po.use.schlund.de>
Hello!

Matthew Danish  <·······@andrew.cmu.edu> wrote:
>[...]

>> A regex library isn't really a good substitute for a lexer generator.
>> Testing
>>   (cond
>>     ((re-match input "foo") ...)
>>     ((re-match input "bar") ...)
>>     ...)
>> just by far isn't as efficient as testing all expressions simultaneously
>> with one generated automaton.

>This is true; I was thinking of the library REGEX which has a way to
>construct such an automaton, as used in the accompanying LEXER package.

Okay, I didn't know that the Lisp library named REGEX has such a
nice addition. Interesting!

Kind regards,

Hannah.
From: james anderson
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <d21f61e3.0402230202.175e6df3@posting.google.com>
"Michael Graffam" <···················@yahoo.com> wrote in message news:<······························@yahoo.com>...
> Hello all, 
> 
> Does anyone know of a Bison / Yacc compatible system for
> Common Lisp? 
> 
> I'd like to make a GNU Octave to Common Lisp translator.

in addition to the parsers pointed to from www.cliki.net, another
alternative is the parser at
http://home.arcor.de/james_anderson/setf/code.html. the version there
is a bnf-based parser generator. i've not tried yacc grammar, but the
parser generator's input grammar is itself described by a grammar, so
it would be possible to supplant bnf with something yacc compatible.

...
From: Henrik Motakef
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <878yiu9m6p.fsf@aenaeas.internal.henrik-motakef.de>
"Michael Graffam" <···················@yahoo.com> writes:

> Does anyone know of a Bison / Yacc compatible system for
> Common Lisp? 

<http://www.cliki.net/Text> has pointers to some parser
generators. They all are not yacc-compatible in the sense
that they work with unmodified yacc grammars.
From: Robert E. Brown
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <87smh12243.fsf@loki.bibliotech.com>
Bison does not currently have a Common Lisp backend.  I've talked to the
maintainers of Bison and they're interested in supporting other languages,
but nothing much has happened beyond C, C++ and maybe a bit of Java.
Bison's M4 backend will have to be changed a lot before languages that don't
look like C can be supported.

However, I've translated the Bison C parser skeleton into Common Lisp, and
tested it with a couple of simple grammars.  If you have a working
Yacc/Bison grammar for the GNU Octave language, you should be able to plug
the C parsing tables that Bison generates into the Lisp skeleton below to
get a working Common Lisp parser.

                        bob


====================
calc.tab.lisp - a parser for one of the test grammars in the Bison
distribution
====================

;; A Bison parser, made from calc.y, by GNU bison 1.75.

;; Skeleton parser for Yacc-like parsing with Bison,

;; Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002 Free Software
;; Foundation, Inc.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  */

;; As a special exception, when this file is copied by Bison into a
;; Bison output file, you may use that output file without restriction.
;; This special exception was added by the Free Software Foundation
;; in version 1.24 of Bison.

;; Written by Richard Stallman by simplifying the original so called
;; ``semantic'' parser.

;; All symbols defined below should begin with yy or YY, to avoid
;; infringing on user name space.  This should be done even for local
;; variables, as they might otherwise be expanded by user macros.
;; There are some unavoidable exceptions within include files to
;; define necessary library symbols; they are noted "INFRINGES ON
;; USER NAME SPACE" below.


(defconstant +CALC_EOF+ 0)
(defconstant +NUM+ 258)
(defconstant +NEG+ 259)


(defvar yydebug nil
  "Controls generation of tracing output")


(defconstant +yyfinal+ 11
  "State number of the termination state")
(defconstant +yylast+ 59)


(defconstant +yyntokens+    14  "Number of terminals")
(defconstant +yynnts+       4   "Number of nonterminals")
(defconstant +yynrules+     15  "Number of rules")
(defconstant +yynstates+    28  "Number of states")

(defconstant +yyundeftok+ 2)
(defconstant +yymaxutok+ 259)

(defconstant +yytranslate+
  (make-array 260                    ;; XXXXXXXXXXX size is YYLEX + 1 I think
              :element-type '(unsigned-byte 8)
              :initial-contents '(
       0     2     2     2     2     2     2     2     2     2
      11     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
      12    13     7     6     2     5     2     8     2     2
       2     2     2     2     2     2     2     2     2     2
       2     4     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2    10     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     2     2     2     2
       2     2     2     2     2     2     1     2     3     9
                                  ))
  "YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.")


(defun yytranslate (x)
  "(yytranslate yylex) -- Bison symbol number corresponding to yylex."
  (if (<= x +yymaxutok+)
      (aref +yytranslate+ x)
      +yyundeftok+))


#+yydebug
(defconstant +yyprhs+
  (make-array 16
              :element-type '(unsigned-byte 8)
              :initial-contents '(
       0     0     3     5     8    10    13    15    19    23
      27    31    35    38    42    46
                                  ))
  "YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in YYRHS.")

#+yydebug
(defconstant +yyrhs+
  (make-array 50
              :element-type '(signed-byte 8)
              :initial-contents '(
      15     0    -1    16    -1    15    16    -1    11    -1
      17    11    -1     3    -1    17     4    17    -1    17
       6    17    -1    17     5    17    -1    17     7    17
      -1    17     8    17    -1     5    17    -1    17    10
      17    -1    12    17    13    -1    12     1    13    -1
                                  ))
  "YYRHS -- A `-1'-separated list of the rules' RHS")

#+yydebug
(defconstant +yyrline+
  (make-array 16                        ; XXXXXXX
              :element-type '(unsigned-byte 8)
              :initial-contents '(
       0    49    49    51    54    56    59    61    67    68
      69    70    71    72    73    74
                                  ))
  "YYRLINE[YYN] -- source line where rule number YYN was defined")



#+(or yydebug yyerror-verbose)
(defconstant +yytname+
  (make-array 19
              :element-type 'string
              :initial-contents '(
  "\"end of file\"" "error" "$undefined" "\"number\"" "'='" "'-'"
  "'+'" "'*'" "'/'" "NEG" "'^'" "'\\n'" "'('" "')'" "$accept"
  "input" "line" "exp" 0
                                  ))
  "YYTNME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
   First, the terminals, then, starting at YYNTOKENS, nonterminals")


#+yyprint
(defconstant +yytoknum+
  (make-array 14
              :element-type 'string
              :initial-contents '(
       0   256   257   258    61    45    43    42    47   259
      94    10    40    41
                                  ))
  "YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
   token YYLEX-NUM")
  

(defconstant +yyr1+
  (make-array 16
              :element-type '(unsigned-byte 8)
              :initial-contents '(
       0    14    15    15    16    16    17    17    17    17
      17    17    17    17    17    17
                                  ))
  "YYR1[YYN] -- Symbol number of symbol that rule YYN derives")

(defconstant +yyr2+
  (make-array 16
              :element-type '(unsigned-byte 8)
              :initial-contents '(
       0     2     1     2     1     2     1     3     3     3
       3     3     2     3     3     3
                                  ))
  "YYR2[YYN] -- Number of symbols composing right hand side of rule YYN")

(defconstant +yydefact+
  (make-array 28
              :element-type '(unsigned-byte 8)
              :initial-contents '(
       0     6     0     4     0     0     2     0    12     0
       0     1     3     0     0     0     0     0     0     5
      15    14     7     9     8    10    11    13
                                  ))
  "YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
   means the default is an error.")

(defconstant +yydefgoto+
  (make-array 4
              :element-type '(signed-byte 8)
              :initial-contents '(
      -1     5     6     7
                                  ))
  "YYDEFGOTO[NTERM-NUM]")


(defconstant +yypact-ninf+ -10)
(defconstant +yypact+
  (make-array 28
              :element-type '(signed-byte 8)
              :initial-contents '(
      33   -10    36   -10    18    17   -10    -1    -9    -5
      27   -10   -10    36    36    36    36    36    36   -10
     -10   -10    45    49    49    -9    -9    -9
                                  ))
  "YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
   STATE-NUM.")

(defconstant +yypgoto+
  (make-array 4
              :element-type '(signed-byte 8)
              :initial-contents '(
     -10   -10    13    -2
                                  ))
  "YYPGOTO[NTERM-NUM]")

(defconstant +yytable-ninf+ -1)
(defconstant +yytable+
  (make-array 60
              :element-type '(signed-byte 8)
              :initial-contents '(
       8    18    10    13    14    15    16    17    20    18
      19    22    23    24    25    26    27    11    12     9
       1     1     2     2     0     0     0     0     3     4
       4    13    14    15    16    17     1    18     2     1
      21     2     0     0     3     4     0     0     4    -1
      14    15    16    17     0    18    16    17     0    18
                                  ))
  "YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
   positive, shift that token.  If negative, reduce the rule which
   number is the opposite.  If zero, do what YYDEFACT says.
   If YYTABLE_NINF, parse error.")

(defconstant +yycheck+
  (make-array 60
              :element-type '(signed-byte 8)
              :initial-contents '(
       2    10     4     4     5     6     7     8    13    10
      11    13    14    15    16    17    18     0     5     1
       3     3     5     5    -1    -1    -1    -1    11    12
      12     4     5     6     7     8     3    10     5     3
      13     5    -1    -1    11    12    -1    -1    12     4
       5     6     7     8    -1    10     7     8    -1    10
                                  )))

(defconstant +yystos+
  (make-array 28
              :element-type '(unsigned-byte 8)
              :initial-contents '(
       0     3     5    11    12    15    16    17    17     1
      17     0    16     4     5     6     7     8    10    11
      13    13    17    17    17    17    17    17
                                  ))
  "YYSTOS[STATE-NUM] -- The (internal number of the) accessing
   symbol of state STATE-NUM")


(defconstant +yyempty+ -2)
(defconstant +yyeof+ 0)

(defconstant +yyterror+ 1)


(defconstant +yyinitdepth+ 200
  "YYINITDEPTH -- initial size of the parser's stacks.")


(defconstant +yymaxdepth+ 10000
  "YYMAXDEPTH -- maximum size the stacks can grow to (effective only
   if the built-in stack extension method is used).

   Do not make this value too large; the results are undefined if
   SIZE_MAX < YYSTACK_BYTES (YYMAXDEPTH)
   evaluated with infinite-precision integer arithmetic.")

#-yyfprintf
(defmacro yyfprintf (&rest args)
  `(format ,@args))

(defmacro yydprintf (&rest args)
  #+yydebug
  `(format ,@args)
  #-yydebug
  (declare (ignore args)))

(defun yydsymprint-1 (yyout yytype yyvalue)
  (if (< yytype +yyntokens+)
      (progn (yyfprintf yyout "token ~A (" (aref +yytname+ yytype))
             #+yyprint (yyprint yyout (aref +yytoknum+ yytype) yyvalue))
      (yyfprintf yyout "nterm ~A (" (aref +yytname+ yytype)))

  ;; empty case statement

  (yyfprintf yyout ")"))

(defmacro yydsymprint (yyout yytype yyvalue)
  #+yydebug
  `(yydsymprint-1 ,yyout ,yytype ,yyvalue)
  #-yydebug
  (declare (ignore yyout yytype yyvalue)))



(defvar *yychar* 0
  "The lookahead symbol")
(declaim (type fixnum *yychar*))

(defvar *yylval* 0
  "The semantic value of the lookahead symbol")         ; type YYSTYPE
(declaim (type fixnum *yylval*))

(defvar *yynerrs* 0
  "Number of parse errors so far.")
(declaim (type fixnum *yynerrs*))



; yyparse return t if OK, nil if error, and throws an exception on stack
; overflow ???

;;(declaim (function () boolean) yyparse)



(defun yyparse ()
 (prog ((yystate 0)
        (yyn 0)
        (yyresult 0)
        ;; Number of tokens to shift before error messages enabled.
        (yyerrstatus 0)
        ;; Lookahead token as an internal (translated) token number.
        (yychar1 0)

        ;; Three stacks and their tools:
        ;; `yyss': related to states,
        ;; `yyvs': related to semantic values,
        ;; `yyls': related to locations.

        ;;  Refer to the stacks thru separate pointers, to allow yyoverflow
        ;;  to reallocate them elsewhere.

        ;; The state stack.

        (yyss (make-array +yyinitdepth+ :initial-element 0))
        (yyss-index 0)

        ;; The semantic value stack.
        (yyvs (make-array +yyinitdepth+ :initial-element 0))
        (yyvs-index 0)

        (yystacksize +yyinitdepth+)

        ;; The variables used to return semantic value and location from the
        ;; action routines.
        (yyval 0)

        ;; When reducing, the number of symbols on the RHS of the reduced rule.
        (yylen 0)
        )
    (declare (type fixnum yystate yyn yyresult yyerrstatus yychar1))
    (declare (type fixnum yystacksize))
    (declare (type fixnum yyval))

    (yydprintf *error-output* "Starting parse~%")

    (setf *yynerrs* 0)
    (setf *yychar* +yyempty+)            ; Cause a token to be read.

    (go yysetstate)


    ;; Push a new state, which is found in yystate.

    YYNEWSTATE

    ;; In all cases, when you get here, the value and location stacks
    ;; have just been pushed. so pushing a state here evens the stacks.

    (incf yyss-index)

    YYSETSTATE

    (setf (aref yyss yyss-index) yystate)

    (when (>= yyss-index (- yystacksize 1))
      (error "overflow"))

    (yydprintf *error-output* "Entering state ~A~%" yystate)

    (go yybackup)


    YYBACKUP


    ;; Do appropriate processing given the current state.
    ;; Read a lookahead token if we need one and don't already have one.

    ;; First try to decide what to do without reference to lookahead token.

    (setf yyn (aref +yypact+ yystate))
    (when (= yyn +yypact-ninf+)
      (go yydefault))

    ;; Not known => get a lookahead token if don't already have one.

    ;; *yychar* is either YYEMPTY or YYEOF or a valid token in external form.

    (when (= *yychar* +yyempty+)
      (yydprintf *error-output* "Reading a token: ")
      (setf *yychar* (yylex)))

    ;; Convert token to internal form (in yychar1) for indexing tables with.

    (if (<= *yychar* 0)                   ; This means end of input.
        (progn (setf yychar1 0)
               (setf *yychar* +yyeof+)    ; Don't call YYLEX any more.

               (yydprintf *error-output* "Now at end of input.~%"))
        (progn (setf yychar1 (yytranslate *yychar*))

               ;; We have to keep this `#if YYDEBUG', since we use variables
               ;; which are defined only if `YYDEBUG' is set.

               (yydprintf *error-output* "Next token is ")
               (yydsymprint *error-output* yychar1 *yylval*)
               (yydprintf *error-output* "~%")))

    ;; If the proper action on seeing token YYCHAR1 is to reduce or to
    ;; detect an error, take that action.

    (incf yyn yychar1)
    (when (or (< yyn 0)
              (< +yylast+ yyn)
              (not (= (aref +yycheck+ yyn) yychar1)))
      (go yydefault))

    (setf yyn (aref +yytable+ yyn))
    (when (<= yyn 0)
      (when (or (= yyn 0) (= yyn +yytable-ninf+))
        (go yyerrlab))
      (setf yyn (- yyn))
      (go yyreduce))

    (when (= yyn +yyfinal+)
      (go yyacceptlab))

    ;; Shift the lookahead token.

    (yydprintf *error-output* "Shifting token ~A (~A), "
               *yychar* (aref +yytname+ yychar1))

    ;; Discard the token being shifted unless it is eof.
    (when (not (= *yychar* +yyeof+))
      (setf *yychar* +yyempty+))

    (incf yyvs-index)
    (setf (aref yyvs yyvs-index) *yylval*)

    ;; Count tokens shifted since error; after three, turn off error status.

    (when yyerrstatus
      (decf yyerrstatus))

    (setf yystate yyn)
    (go yynewstate)


    YYDEFAULT                   ; do the default action for the current state


    (setf yyn (aref +yydefact+ yystate))
    (when (= yyn 0)
      (go yyerrlab))
    (go yyreduce)


    YYREDUCE                    ; do a reduction


    ;; yyn is the number of a rule to reduce with

    (setf yylen (aref +yyr2+ yyn))

    ;; If YYLEN is nonzero, implement the default value of the action:
    ;; `$$ = $1'.

    ;; Otherwise, the following line sets YYVAL to garbage.
    ;; This behavior is undocumented and Bison
    ;; users should not rely upon it.  Assigning to YYVAL
    ;; unconditionally makes the parser a bit smaller, and it avoids a
    ;; GCC warning that YYVAL may be used uninitialized.  */

    (setf yyval (aref yyvs (+ yyvs-index 1 (- yylen))))


    #+yydebug
    (progn (yyfprintf *error-output* "Reducing via rule ~A (line ~A), "
                      (1- yyn) (aref +yyrline+ yyn))
           (loop for yyi = (aref +yyprhs+ yyn) then (incf yyi)
                 while (>= (aref +yyrhs+ yyi) 0)
                 do (yyfprintf *error-output* "~A "
                               (aref +yytname+ (aref +yyrhs+ yyi))))
           (yyfprintf *error-output* " -> ~A~%"
                      (aref +yytname+ (aref +yyr1+ yyn))))


(case yyn
  (4
   )
  (5
   )
  (6
   (setf yyval (aref yyvs yyvs-index)))

  (7
   (when (not (= (aref yyvs (- yyvs-index 2))
                 (aref yyvs yyvs-index)))
     (format *error-output* "calc: error: ~A != ~A~%"
             (aref yyvs (- yyvs-index 2))
             (aref yyvs yyvs-index)))
   (setf yyval (if (= (aref yyvs (- yyvs-index 2))
                      (aref yyvs yyvs-index))
                   1
                   0)))

  (8
   (setf yyval
         (+ (aref yyvs (- yyvs-index 2))
            (aref yyvs (- yyvs-index 0)))))

  (9
   (setf yyval
         (- (aref yyvs (- yyvs-index 2))
            (aref yyvs (- yyvs-index 0)))))

  (10
   (setf yyval
         (* (aref yyvs (- yyvs-index 2))
            (aref yyvs (- yyvs-index 0)))))

  (11
   (setf yyval
         (/ (aref yyvs (- yyvs-index 2))
            (aref yyvs (- yyvs-index 0)))))

  (12
   (setf yyval (- (aref yyvs (- yyvs-index 0)))))

  (13
   (setf yyval
         (expt (aref yyvs (- yyvs-index 2))
               (aref yyvs (- yyvs-index 0)))))

  (14
   (setf yyval (aref yyvs (1- yyvs-index))))

  (15
   (setf yyval 0))
  )


  (decf yyvs-index yylen)
  (decf yyss-index yylen)

  #+yydebug
  (when yydebug
    (let ((yysp-index-1 (1- yyss-index)))
      (yyfprintf *error-output* "state stack now")
      (loop for i from 0 upto yyss-index
            do (yyfprintf *error-output* " ~A" (aref yyss i)))
      (yyfprintf *error-output* "~%")))


  (incf yyvs-index)
  (setf (aref yyvs yyvs-index) yyval)

  ;; Now `shift' the result of the reduction.  Determine what state
  ;; that goes to, based on the state we popped back to and the rule
  ;; number reduced by.

  (setf yyn (aref +yyr1+ yyn))

  (setf yystate (+ (aref +yypgoto+ (- yyn +yyntokens+))
                   (aref yyss yyss-index)))

  (setf yystate
        (if (and (<= 0 yystate +yylast+)
                 (= (aref +yycheck+ yystate) (aref yyss yyss-index)))
            (aref +yytable+ yystate)
            (aref +yydefgoto+ (- yyn +yyntokens+))))

  (go yynewstate)


  YYERRLAB                              ; here on detecting error


  ;; If not already recovering from an error, report this error.
  (unless yyerrstatus
    (incf *yynerrs*)

    #+yyerror-verbose
    (progn
      (setf yyn (aref +yypact+ yystate))
      (when (< +yypact-ninf+ yyn +yylast+)
        (let ((yysize 0)
              (yytype (yytranslate *yychar*))
              (yycount 0))
          ;; XXXXXXXXXXXXXX more to translate
        )))

    (yyerror "parse error"))
  (go yyerrlab1)


  YYERRLAB1                           ; error raised explicitly by an action


  (when (= yyerrstatus 3)
    ;; If just tried and failed to reuse lookahead token after an
    ;; error, discard it.

    (when (= *yychar* +yyeof+)

      (decf yyvs-index)
      (decf yyss-index)

      (loop while (> yyss-index 0)
            do (yydprintf *error-output* "Error: popping ")
               (yydsymprint *error-output*
                            (aref +yystos+ (aref yyss yyss-index))
                            (aref yyvs yyvs-index))
               (yydprintf *error-output* "~%")
               (decf yyvs-index)
               (decf yyss-index))
      (go yyabortlab))

    (yydprintf *error-output* "Discarding token %A (%A).~%"
               *yychar* (aref +yytname+ yychar1))
    (setf *yychar* +yyempty+))


  ;; Else will try to reuse lookahead token after shifting the error token.

  (setf yyerrstatus 3)            ; Each real token shifted decrements this.

  (loop (setf yyn (aref +yypact+ yystate))
        (when (not (= yyn +yypact-ninf+))
          (incf yyn +yyterror+)
          (when (and (<= 0 yyn)
                     (<= yyn +yylast+)
                     (= (aref +yycheck+ yyn) +yyterror+))
            (setf yyn (aref +yytable+ yyn))
            (when (< 0 yyn)
              (return))))

        ;; Pop the current state because it cannot handle the error token.

        (when (= yyss-index 0)
          (go yyabortlab))

        (yydprintf *error-output* "Error: popping ")
        (yydsymprint *error-output*
                     (aref +yystos+ (aref yyss yyss-index))
                     (aref yyvs yyvs-index))
        (yydprintf *error-output* "~%")

        ;; XXX (setf (aref yyvs yyvs-index) nil)                ; yydestruct

        (decf yyvs-index)
        (decf yyss-index)
        (setf yystate (aref yyss yyss-index)))

  (when (= yyn +yyfinal+)
    (go yyacceptlab))

  (yydprintf *error-output* "Shifting error token, ")

  (incf yyvs-index)
  (setf (aref yyvs yyvs-index) *yylval*)

  (setf yystate yyn)
  (go yynewstate)



  YYACCEPTLAB                           ; YYACCEPT comes here


  (setf yyresult 0)
  (go yyreturn)


  YYABORTLAB                            ; YYABORT comes here


  (setf yyresult 1)
  (go yyreturn)


;  YYOVERFLOWLAB                         ; parser overflow comes here


;  (yyerror "parser stack overflow")
;  (setf yyresult 2)


  YYRETURN


  (return-from yyparse yyresult)
))




(defvar *yyin* nil)                     ; The input


(defun yyerror (message)
  (format *error-output* "~S" message))


(defconstant +end-of-file+ -1)

(defun yygetc ()
  (let ((char (read-char *yyin* nil nil)))
    (if (null char)
        +end-of-file+
        (char-code char))))

(defun yyungetc (c)
  (unread-char (code-char c) *yyin*))

(defun isdigit (c)
  (<= (char-code #\0) c (char-code #\9)))

(defun read-signed-integer ()
  (let ((c (yygetc))
        (sign 1)
        (n 0))
    (when (= c (char-code #\-))
      (setf c (yygetc))
      (setf sign -1))
    (loop for ch = c then (yygetc)
          while (isdigit ch)
            do (setf n (+ (* 10 n) (- ch (char-code #\0))))
          finally (yyungetc ch))
    (* sign n)))


;; Lexical analyzer returns an integer on the stack and the token
;; NUM, or the ASCII character read if not a number.  Skips all
;; blanks and tabs, returns 0 for EOF.


(defun yylex ()
  (let ((c 0))
    (loop for ch = (yygetc) then (yygetc)
          until (and (not (= ch (char-code #\Space)))
                     (not (= ch (char-code #\Tab))))
          finally (setf c ch))

    (when (or (= c (char-code #\.))
              (isdigit c))
      (yyungetc c)
      (setf *yylval* (read-signed-integer))
      (return-from yylex +NUM+))

    (when (= c +end-of-file+)
      (return-from yylex +CALC_EOF+))

    c))

(defun main ()
  (setf *yyin* *standard-input*)
  (yyparse))
From: Michael Graffam
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <pan.2004.02.24.02.24.01.185638@yahoo.com>
On Mon, 23 Feb 2004 11:26:52 -0500, Robert E. Brown wrote:

> However, I've translated the Bison C parser skeleton into Common Lisp, and
> tested it with a couple of simple grammars.  If you have a working
> Yacc/Bison grammar for the GNU Octave language, you should be able to plug
> the C parsing tables that Bison generates into the Lisp skeleton below to
> get a working Common Lisp parser.

Great! I do have a working grammar for Octave: from the Octave
sources itself. 

Thanks for the code. I'll keep the group posted on how the
progress goes. I'd like to essentially re-write the GNU Octave
primitives in Common Lisp (using a LAPACK/BLAS package like Matlisp)
and provide (near?) complete compatibilty with Octave by translating
Octave "m-files" into Common Lisp code.

This would allow extending Octave (or, the Lisp version of it) with
real symbolic support (via Maxima) and yield an Octave compiler
for free. 

If anyone is interested in this project, would like to help or has some
useful suggestions, feel free to respond here or via email. 
From: Matthias
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <36wllmsx0in.fsf@goya03.ti.uni-mannheim.de>
"Michael Graffam" <···················@yahoo.com> writes:
> This would allow extending Octave (or, the Lisp version of it) with
> real symbolic support (via Maxima) and yield an Octave compiler
> for free. 
> 
> If anyone is interested in this project, would like to help or has some
> useful suggestions, feel free to respond here or via email. 

This sounds like a very cool project.  If you haven't already, check
also out lush, http://lush.sourceforge.net.  It is a Lisp for
scientific computing, has great libs, but is build on a no-so-great
(IMHO!)  Lisp/C/language mix.

Best wishes!

  Matthias
From: Ivan Boldyrev
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <jotsg1x446.ln2@ibhome.cgitftp.uiggm.nsc.ru>
On 8664 day of my life ··@spam.pls wrote:
> If you haven't already, check also out lush,
> http://lush.sourceforge.net.  It is a Lisp for scientific computing,
> has great libs, but is build on a no-so-great (IMHO!)
> Lisp/C/language mix.

It's very impressive, how can I declare integer (or fixnum) variable?
I could ony declare double variables :(  But for array indexes and
fixnum computations it is overkill... 

-- 
Ivan Boldyrev

                               Onions have layers.  Unix has layers too.
From: Lupo LeBoucher
Subject: Re: Bison/Yacc for Common Lisp?
Date: 
Message-ID: <i9udnYDerKxC4qPdRVn-hw@io.com>
In article <······························@yahoo.com>,
Michael Graffam <···················@yahoo.com> wrote:
>On Mon, 23 Feb 2004 11:26:52 -0500, Robert E. Brown wrote:
>
>> However, I've translated the Bison C parser skeleton into Common Lisp, and
>> tested it with a couple of simple grammars.  If you have a working
>> Yacc/Bison grammar for the GNU Octave language, you should be able to plug
>> the C parsing tables that Bison generates into the Lisp skeleton below to
>> get a working Common Lisp parser.
>
>Great! I do have a working grammar for Octave: from the Octave
>sources itself. 
>
>Thanks for the code. I'll keep the group posted on how the
>progress goes. I'd like to essentially re-write the GNU Octave
>primitives in Common Lisp (using a LAPACK/BLAS package like Matlisp)
>and provide (near?) complete compatibilty with Octave by translating
>Octave "m-files" into Common Lisp code.
>
>This would allow extending Octave (or, the Lisp version of it) with
>real symbolic support (via Maxima) and yield an Octave compiler
>for free. 

That's a pretty good idea; somewhat akin to the "coup" people were 
thinking of doing by rewriting a C compiler in Lisp (since GCC is an 
abomination unto all right-thinking people who no longer use a VAX-like 
architecture).

I will point out a couple of things though:
1) Such a thing is already sort of there in Maxima/Macsyma
2) Such a thing is already sort of there in Axiom
3) Such a thing is already sort of there in Lush

In cases 1 & 2, you get your matrix-language equipped with symbolic stuff 
for free. Adding bits of Maxima code, rather than using the whole thing at 
once, looks to me a nightmare. I have already considered doing this. I 
found it easier to futz with Norvig's mini-CAS stuff for basic things.

In case 3, you get no symbolic stuff built in, but you get a hell of a lot 
of other kinds of incredibly useful neat software, a weird compiled 
language that is a sort of Lispey F-95 (and so, good with matrices), the 
ability to add C-frags and C-libraries pretty simply, and a halfway decent 
dialect of interpreted Lisp (which is nowhere near as complete as ACL, but 
is still quite likeable in many ways). Despite it's lack of a nice IDE, 
I'm finding Lush to be incredibly useful and, unlike any other Lisp I 
have used *handy* in a pythonistic way.

Granted, none of these matrix language dialects are 1:1 with octave 
m-files, but they have much the same functionality. You might ask 
yourself, before going through lots of trouble, what problem you are 
trying to solve here. Maybee you could do better modifying or adding to 
these existing code-bases.

-Lupo
"It has been my experience that folks who have no vices have very few 
virtues."-Abraham Lincoln                                 <··@io.com>