* Specifications
** linc syntax
*** preprocessing-tokens
**** #include

#+BEGIN_EXAMPLE
(include <foo.h>|"foo.h" …)
#+END_EXAMPLE

**** rest
In (#… ) expressions pp-tokens are sequences of symbol, integers
floating-point numbers or strings.  Depending on the # operator, the
strings are taken literally, or assumed to contain the text to be used
in the generation of the operator.

This may lead to the need of escaping strings in strings in some cases.

#+BEGIN_EXAMPLE
(#define foo "bar baz")
-->
#define foo bar baz

(#define foo "bar \"baz\"")
-->
#define foo bar "baz"

(#include "foo.h")
-->
#includle "foo.h"

(#include <foo.h>)
-->
#include <foo.h>
#+END_EXAMPLE


#+BEGIN_EXAMPLE
    (#define foo         "bar baz")
    (#define foo (x)     "bar x baz")
    (#define foo (x ...) "bar VA_ARGS baz")
    (#undef foo)
    (#line "file.c" 33
    (#line 42
    (#error "Not implemented yet")
    (#pragma foo 42 "bar baz")
    (#)

    ;; #if/#ifdef/#ifndef
    (#if condition
      (c-code)
     #elif condition
      (c-code)
     #else
      (c-code))

    ;; #cond
    (#cond
      (condition (c-code))
      (condition (c-code))
      (t         (c-code)))

    ;; condition can be (defined foo)
#+END_EXAMPLE

*** other

#+BEGIN_EXAMPLE
We don't allow:

INVALID:
                (function (x y z) -> int)

for function types,
and we don't allow:

INVALID:
                (declare-function name (x y z) -> int
                      (declare-variable x int)
                      (declare-variable y int)
                      (declare-variable z int)
                   (block (return (+ x y z))))
for declarations.

But (function (int float) -> int)
is valid as is (function ((x int) (y float)) -> int)
But for multi-word types, they must have to be in parenthesis:
   (function ((long int) (short int)) -> int)
#+END_EXAMPLE
*** statements
  (break)
  (continue)
  (label foo)
  (goto foo)
  (asm "string")
  (return [expression])

  (switch expression
    (case val1
      stmts)
    (case val2
      stmts)
    (default
     stmts))
  (block
      stmts…)
  (if expression
      stmts
      [stmts])
  (while expression
    stmts…)
  (do
   stmts…
   while expression)
  (for (init test incr)
    stmts…)

  (let (bindings…)
    stmts)
  (let* (bindings…)
    stmts)
  (cond
    (()))

** Usage

Linc forms appear in lisp programs as literals,
or be generated by lisp programs,
or read from =.linc= files.

Linc forms can be either translated to C source ie. "compiled",
or "interpreted" directly in lisp, for development and debugging purpose,
with some limitations on use of external C objects (CFFI can be used).

#+BEGIN_EXAMPLE
(defparameter *c-source* '#{

    (define-function string_add ((a (char *)) (b (char *))) (char *)
      (let ((av int)
            (bv int)
            (res (char *) (malloc (+ 2 (max (strlen a) (strlen b))))))
        (sscanf a "%d" (address av))
        (sscanf b "%d" (address bv))
        (sprintf res "%d" (+ a b))
        (return res)))

   })
#+END_EXAMPLE

#+BEGIN_EXAMPLE
(linc-compile-toplevel-form *c-source* :output *c-file*)
(linc-compile-file *linc-source-file*  :output *c-file*)
#+END_EXAMPLE

#+BEGIN_EXAMPLE
linc-compile-file (input-file &key verbose print
                   (if-does-not-exist :error)
                   (external-format :default)
                   output-file)
#+END_EXAMPLE


Each syntactic element is represented by:
- a lisp class,
- with a PRINT-OBJECT method to output the constructor form,
- with a constructor to make an instance.
- with a C-SEXP method to output the C sexp,
- with a GENERATE method to emit the C code,
- the C sexp operator is interned in COM.INFORMATIMAGO.LANGUAGES.LINC.C, and is aliased to the contructor.

* README

Mon Jul  2 19:28:51 CEST 2012

This project is published as-is.
It is far from finished.

Tue Oct  4 16:14:25 CEST 2005

Let's start a linc project.

** LINC IS NOT C

Well, almost not.

The objective is to be able to write programs in a lisp environment
that will be generated as C sources, human readable and human
maintenable, with no obvious hint of being generated from a lisp
environment.

| Scheme to C:       | http://www-swiss.ai.mit.edu/~jaffer/Docupage/schlep.html      |
|                    |                                                               |
| C# pretty-printer: | http://depni.sinp.msu.ru/~ivan_iv/lisp/sharpclass.lisp        |
|                    |                                                               |
| LinJ:              | http://www.evaluator.pt/linj.html                             |
|                    | http://www.evaluator.pt/downloads/tutorial.html               |
|                    | git clone https://github.com/xach/linj                        |
|                    |                                                               |
| SC:                | http://super.para.media.kyoto-u.ac.jp/~tasuku/sc/index-e.html |
|                    | ~/src/lisp/src/sc080709b                                      |

CLiCC http://www.cliki.net/CLiCC  starts from:

#+BEGIN_EXAMPLE
    ;;---------------------------------------------------------------------
    ;; TAILP sublist list
    ;;---------------------------------------------------------------------
    (defun tailp (sublist list)
      (cond
        ((eql sublist list) t)
        ((atom list) nil)
        (t (tailp sublist (cdr list)))))
#+END_EXAMPLE

and generates:

#+BEGIN_EXAMPLE
    void Ftailp(CL_FORM *base)
    {
        M1_1:;
        if(EQL(ARG(0), ARG(1)))
        {
            LOAD_SYMBOL(SYMBOL(Slisp, 48), ARG(0));	/* T */
        }
        else
        {
            if(CL_ATOMP(ARG(1)))
            {
                LOAD_NIL(ARG(0));
            }
            else
            {
                COPY(GET_CDR(ARG(1)), ARG(2));
                COPY(ARG(2), ARG(1));
                goto M1_1;
            }
        }
        goto RETURN1;
        RETURN1:;
    }
#+END_EXAMPLE

We want to generate something like:

#+BEGIN_EXAMPLE
   /*---------------------------------------------------------------------*/
   /* TAILP sublist list                                                  */
   /*---------------------------------------------------------------------*/
   bool tailp(object_t* sublist,object_t* list){
        if(sublist==list){
            return(true);
        }else if(atom(list)){
            return(false);
        }else{
            return(tailp(sublist,list_rest((list_t*)list)));
        }
   }
#+END_EXAMPLE

Or, starting from:

#+BEGIN_EXAMPLE
    (defun fact (x)
       (if (<= x 1)
           1
           (* x (fact (1- x)))))
#+END_EXAMPLE

we want to generate something like:

#+BEGIN_EXAMPLE
    unsigned int fact(unsigned int x){
        if(x<=1){
            return(1);
        }else{
            return(x*fact(x-1));
        }
    }
#+END_EXAMPLE

A good thing in CLiCC: it defines a Common Lisp subset translatable to C.
This subset could be a upper bound for our project.

** MODULES

Let's start with a bottom up approach.

First we define a s-expr syntax for C, with a direct generation to C.

Then we remove progressively more and more C from it, implementing at
the same time the translator:
- type inference to remove the need for most declarations.
- mapping of packages to source files, or definition of a module construct.
- FFI with Verrazano http://common-lisp.net/project/fetter/

** URLs

http://www.unmutual.info/software/scexp/scexp-0.9.tar.gz

* Notes
** c-syntax

   A layer of CLOS classes to generate C++ syntax.
   Also, we could have a C++ parser producing a parse tree using these
   objects.

   Note: identical terminals or non-terminals may correspond to
         different C-syntax classes, depending on their use in
         production:

            (char*)42     * --> pointer
            4*2           * --> times
            *str          * --> deref
            char  *a;     * --> defptr ?

** c-sexp

   A S-expr syntax for C++ code.  Parsing (evaluating?) these
   S-expressions will produce a C-syntax object tree.

** linc

   Yay!

file:///home/pjb/library/informatique/protocols_and_standards/ISO-IEC-14882/www.kuzbass.ru:8086/docs/isocpp/index.html

*** Old code

Code that was commented out; removed from sources:

#+BEGIN_CODE

(make-instance 'expression
  :operator (find-operator 'c::+)
  :arguments '(2 3))


 (in-package :com.informatimago.languages.linc)
 (in-package :com.informatimago.languages.linc.c)

c1::c2::m1(a,b,c);
((:: c1 c2 m1) (a b c))

(defparameter *operator-map*
  (loop
     :with opmap = (make-hash-table)
     :for priority :from 0
     :for level :in *operator-precedence*
     :do (loop
            :for ops :in (cdr level)
            :do (loop
                   :for op :in (ensure-list (car ops))
                   :do (setf (gethash op opmap) (list* (car level) priority
                                                       (cdr  ops)))))
     :finally (return opmap)))
;;
;;
(defun operator (op)
  (or (gethash op *operator-map*)
      ;; TODO: what about linc macros?
      (gethash 'c::call *operator-map*)))

(defun operator-associativity (op)  (first  (operator op)))
(defun operator-precedence    (op)  (second (operator op)))
(defun operator-arity         (op)  (third  (operator op)))
(defun operator-generate      (op)  (or (fourth (operator op)) (symbol-name op)))


(defun operator-associativity (op)  (associativty  (find-operator op)))
(defun operator-precedence    (op)  (priority      (find-operator op)))
(defun operator-arity         (op)  (arity         (find-operator op)))
(defun operator-generate      (op)  (generator (find-operator op)))
;;
(defun expression-operator   (expr)
  (cond
    ((symbolp expr)                      'c::identifier)
    ((atom expr)                         'c::literal)
    ((find-raw-operator (car expr))      (car expr))
    (t                                   'c::call)))
;;
(defun expression-arguments  (expr)
  (cond
    ((atom expr)                         (list expr))
    ((find-raw-operator (car expr))      (cdr expr))
    (t                                   expr)))
;;
(defun expression-precedence (expr)
  (operator-precedence (expression-operator expr)))



(maphash (lambda (k v) (print (list k (operator-generate k)))) *operator-map*)
(operator-precedence (car '((c::scope c1 c2 m1) (a b c))))
(operator-precedence (car '(c::scope c1 c2 m1)))

(generate-statement '(progn
                               (= a (+ (+ (+ (+ a b) c) d) e))
                               (= a (+ a (+ b (+ c (+ d e)))))
                               (= a (+ a b c d e))))
{
a=((((a+b)+c)+d)+e); /* left */
a=(a+(b+(c+(d+e))));
a=(a+b+c+d+e);
}
;;
(generate-statement '(progn
                               (= (= (= (= a b) c) d) 0); invalid!
                               (= a (= b (= c (= d 0))))
                               #|(= a b c d)|#))
{
(((a=b)=c)=d)=0; /* invalid! */
a=(b=(c=(d=0))); /* right */
}






(defun generate-expression (expr &key (level 99 levelp) (naked t))
  ;;   (+ a (* b c))    (10 16 (11 16 16))
  ;;   a + b*c
  ;;
  ;;   (* (+ a b) c)    (11 (10 16 16) 16)
  ;;   (a+b) * c
  ;;
  ;;   (+ a (+ b c))    (10 16 (10 16 16))
  ;;   a + (b+c)
  ;;
  ;;   (+ (+ a b) c)    (10 (10 16 16) 16)
  ;;   a+b+c
  ;;
  ;;
  ;;   (= a (= b c))    (1 16 (1 16 16))
  ;;   a = b=c
  (when (and naked (not levelp)) (setf level -1))
  (let* ((operator (expression-operator expr))
         (oplevel  (operator-precedence operator)))
    (if (< oplevel level)
      ;; need parentheses:
      (with-parens "()" (generate-expression expr :level oplevel :naked nil))
      ;; no need for parentheses:
      (let ((argc (length (expression-arguments  expr)))
            (gene (operator-generate operator)))
        (unless (ecase (operator-arity operator)
                  (3    (=  3 argc))
                  (2    (=  2 argc))
                  (1    (=  1 argc))
                  (2-*  (<= 2 argc))
                  (1-*  (<= 1 argc))
                  (0-*  t))
          (error "Syntax error in: ~S~%~
                    Expected ~A arguments, got ~A"
                 expr (operator-arity operator) argc))
        (etypecase gene
          (string
           (if (eql 1 (operator-arity operator))
             (progn
               (emit gene)
               (generate-expression (first (expression-arguments expr))
                                    :level oplevel :naked nil))
             (generate-list
              gene
              (lambda (item) (generate-expression item :level oplevel :naked nil))
              (expression-arguments  expr))))
          (function
           (apply gene oplevel (expression-arguments  expr))))))))



(generate-statement
 (%label <identifier> [<statement>])
 (%case <constant-expression> [<statement>])
 (%default [<statement>])
 (%block [<statement>...])
 (%if <condition> [<statement>] [<statement>]])
 (%switch <condition> [<statement>])
 (%while <condition> [<statement>])
 (%do [<statement>] <expression>)
 (%for (<for-init-statement> [<condition>] [<expression>]) [<statement>])
 (%break)
 (%continue)
 (%return [<expression>])
 (%goto <identifier>)
 [<expression>])


(defun generate-statement (statement &key same-line)
  (if (atom statement)
    (progn ;; label
      (unless same-line (emit :newline))
      (emit statement ":"))
    (case (first statement)
      ((c::block)
       (emit "{")
       (map nil (function generate-statement)  (rest statement))
       (emit :fresh-line "}"))
      ((c::let)
       (emit :fresh-line "{")
       (when (second statement)
         (map nil (lambda (decl)
                      (emit :newline)
                    (generate-parameter decl)
                    (emit ";"))
              (second  statement))
         (emit :newline))
       (map nil (function generate-statement) (cddr statement))
       (emit :fresh-line "}"))
      ((c::if)
       (unless same-line (emit :newline))
       (case (length statement)
         (3
          (emit "if" "(")
          (generate-expression (second statement))
          (emit ")")
          (generate-statement (third statement)))
         (4
          (emit "if" "(")
          (generate-expression (second statement))
          (emit ")")
          (generate-statement (third statement))
          (emit "else")
          (generate-statement (fourth statement)))
         (otherwise
          (error "Syntax error in ~S; ~%~
              Expected syntax: (IF condition then-statement [else-statement])~%~
              Got: ~S" (first statement) statement))))
      ((c::case)
       (unless same-line (emit :newline))
       (when (<= (length statement) 1)
         (error "Syntax error in ~S; ~%~
             Expected syntax: (CASE expression (constants statement...)...)~%~
             Got: ~S" (first statement) statement))
       (emit "switch" "(")
       (generate-expression (second statement))
       (emit ")" "{")
       (map nil (lambda (clause)
                    (map nil (lambda (constant)
                                 (if (eq constant c::otherwise)
                                   (emit "default" ":")
                                   (progn
                                     (emit "case")
                                     (generate-expression constant)
                                     (emit ":"))))
                         (ensure-list (first clause)))
                  (map nil (function generate-statement) (rest clause))
                  (emit :fresh-line "break" ";"))
            (cddr statement))
       (emit :fresh-line "}"))
      ((c::while)
       (unless same-line (emit :newline))
       (when (<= (length statement) 1)
         (error "Syntax error in ~S; ~%~
             Expected syntax: (WHILE condition statement...)~%~
             Got: ~S" (first statement) statement))
       (emit "while" "(")
       (generate-expression (second statement))
       (emit ")")
       (generate-statement (if (= 1 (length (cddr statement)))
                             (third statement)
                             `(c::block ,@(cddr statement)))))
      ((c::do)
       (unless same-line (emit :newline))
       (when (or (<= (length statement) 3)
                 (not (eq 'c::while (first (last statement 2)))))
         (error "Syntax error in ~S; ~%~
             Expected syntax: (DO statement ... WHILE condition)~%~
             Got: ~S" (first statement) statement))
       (emit "do")
       (let ((body (butlast (rest statement) 2)))
         (generate-statement (if (= 1 (length body))
                               body
                               `(c::block ,@body))))
       (emit "while" "(")
       (generate-expression (first (last statement)))
       (emit ")"))
      ((c::for)
       (unless same-line (emit :newline))
       (when (< (length statement) 4)
         (error "Syntax error in ~S; ~%~
             Expected syntax: (FOR init increment stop statement ...)~%~
             Got: ~S" (first statement) statement))
       (destructuring-bind (for init increm stop . body) statement
         ;; (for initial-stat increment-expr stop-expr &body body)
         (emit "for" "(")
         (if init
           (generate-statement init)
           (emit ";"))
         (generate-expression increm)
         (emit ";")
         (generate-expression stop)
         (emit ")")
         (generate-statement (if (= 1 (length body))
                               body
                               `(c::block ,@body)))))
      ((c::break)
       (unless same-line (emit :newline))
       (when (< 1 (length statement))
         (error "Syntax error in ~S; ~%~
             Expected syntax: (BREAK)~%~
             Got: ~S" (first statement) statement))
       (emit "break" ";"))
      ((c::continue)
       (unless same-line (emit :newline))
       (when (< 1 (length statement))
         (error "Syntax error in ~S; ~%~
             Expected syntax: (CONTINUE)~%~
             Got: ~S" (first statement) statement))
       (emit"continue" ";"))
      ((c::return)
       (unless same-line (emit :newline))
       (case (length statement)
         (1 (emit "return" ";"))
         (2 (emit "return" "(")
            (generate-expression (second statement))
            (emit ")" ";"))
         (otherwise
          (error "Syntax error in ~S; ~%~
              Expected syntax: (RETURN [result])~%~
              Got: ~S" (first statement) statement))))
      ((c::goto)
       (unless same-line (emit :newline))
       (when (/= 2 (length statement))
         (error "Syntax error in ~S; ~%~
             Expected syntax: (GOTO identifier)~%~
             Got: ~S" (first statement) statement))
       (emit "goto" " ")
       (generate-expression (second statement))
       (emit ";"))
      (otherwise
       (unless same-line (emit :newline))
       (generate-expression statement)
       (emit ";")))))

(::)
(generate-declaration
;;
(vector type  [<constant-expression>])
(pointer type [const] [volatile])
(reference type)
(function (arg-type...) [result-type] [const] [volatile] (throw exception...))
(pointer const volatile typename _) ; typename* const volatile   name;
(pointer const volatile          _) ; * const volatile name;
(reference _)
;;
(declare ((pointer type) name))         ; type* name;
(declare ((pointer type) name 0)        ; type* name=0;
         ((function (int (pointer const char)) void const (throw (:: std exception)))
          fname) ; void fname(int,char const*) throw(std::exception);
         ((vector (vector (vector int 4) 5) 6) a) ; int a[6][5][4];
         )
;;
 )

(generate-statement
 (%label <identifier> [<statement>])
 (%case <constant-expression> [<statement>])
 (%default [<statement>])
 (%block [<statement>...])
 (%if <condition> [<statement>] [<statement>]])
 (%switch <condition> [<statement>])
 (%while <condition> [<statement>])
 (%do [<statement>] <expression>)
 (%for (<for-init-statement> [<condition>] [<expression>]) [<statement>])
 (%break)
 (%continue)
 (%return [<expression>])
 (%goto <identifier>)
 [<expression>])

(%switch state
        (%case 1)
        (printf "one\n")
        (%break)
        (%case 2)
        (printf "two\n")
        (%case 3) (%case 4 (printf "three of four\n")) (%break))


;; (load (compile-file "example.linc"))
;;
;; CL compiles and CL loads and executes the example.linc program.
;; To execute a LINC program we provide a C semantics layer.
;;
;;
;;
;; (define-module example
;;   (:c-name "example")
;;   (:export simple_addition))
;; (in-module example)
;; (use-module "<string.h>")
;;
;; (define-type string_t (pointer unsigned-char))
;;
;; (define-function string_add ((a string_t) (b string_t)) string_t
;;   (let ((av int)
;;         (bv int)
;;         (res string_t (malloc (+ 2 (max (strlen a) (strlen b))))))
;;     (sscanf a "%d" (address av))
;;     (sscanf b "%d" (address bv))
;;     (sprintf res "%d" (+ a b))
;;     (return res)))
;;
;; (define-function simple_addition
;;     ((a int) (b signed-short) (c unsigned-char) (d float))
;;     int
;;   (return (+ a b c d)))
;;
;;
;; int simple_addition (int a,signed short b,unsigned char c,float d){
;;    return(a+b+c+d);
;; }
;;
;;
;; (defun string_add (a b)
;;   (assert (c:subtypep (c:type-of a) '(c:pointer c:unsigned-char)))
;;   (assert (c:subtypep (c:type-of b) '(c:pointer c:unsigned-char)))
;;   (let ((av 0) (bv 0) (res (make-string (+ 2 (strlen a) (strlen b)))))))
;; (defun simple_addition (a b c d)
;;   (assert (c:subtypep (c:type-of a) 'c:int))
;;   (assert (c:subtypep (c:type-of b) 'c:signed-short))
;;   (assert (c:subtypep (c:type-of c) 'c:unsigned-char))
;;   (assert (c:subtypep (c:type-of d) 'c:float))
;;   (c:int (+ (c:value-of a) (c:value-of b) (c:value-of c) (c:value-of d))))
;;
;;
;; (defun c:+ (arg &rest args)
;;   ())
;;
;;
;; (com.informatimago.languages.linc:compile-file "example.linc")
;;
;; LINC "compiles" the example.linc program, that is, generate C header
;; and source files.
;;
;;
;; (com.informatimago.languages.linc:compile-file "example.linc"
;;                    :external-format charset:utf-8
;;                    :verbose t
;;                    :print   t
;;                    :output-file "example.c"
;;                    :ouput-file-type "m"
;;                    :c-compilation-command "make example")
;;
;;
;;
;;     signed-char
;;     unsigned-char
;;     char
;;
;;     short-int
;;     int
;;     long-int
;;     unsigned-short-int
;;     unsigned-int
;;     unsigned-long-int
;;
;;     float
;;     double-float
;;     long-float
;;
;;     void
;;
;;
;;     (define-module bcmem
;;         (:c-name "BcMem")
;;       (:export allocate deallocate copy))
;;
;;     (define-module bcstring
;;         (:c-name "BcString")
;;       (:export id s p set-capacity-copy))
;;     (in-module bcstring)
;;     (use-module "<string.h>")
;;     (use-module bcmem)
;;
;;     (define-variable  ID
;;         (array (*) (const char))
;;       "$Id: BcString.c,v 1.3 2004/01/21 06:26:09 pjbpjb Exp $")
;;
;;     (define-type S
;;         (structure
;;          (data       (pointer char))
;;          (dlength    INT32)
;;          (allocation INT32)))
;;
;;      (define-type P (pointer S))
;;
;;     (comment "
;;         INVARIANTS:
;;             data#NIL
;;             1<=allocation
;;             0<=dlength<allocation
;;             data[dlength]=(char)0
;;             for all i in [0..dlength-1], data[i]#(char)0
;;     ")
;;
;;     (define-constant Alloc-Increment 128)
;;     (define-macro Minimum (a b) (if (< a b) a b))
;;
;;     (define-function Set-Capacity-Copy
;;         ((t t) (nAllocation INT32) (copy BOOLEAN)) T
;;         (let ((this P (cast t P))
;;               (ndata (pointer char))
;;               (nLength INT32))
;;           (if (> nAllocation 1)
;;               (progn
;;                 (setf nData (BcMem:Allocate (* (sizeof char) nAllocation)))
;;                 (if copy
;;                     (progn
;;                       (setf nLength (Minimum (1- nAllocation) (-> this dlength)))
;;                       (BcMem:Copy (-> this data) nData (* nLength (sizeof char))))
;;                     (setf nLength 0)))
;;               (setf nAllocation 1
;;                     nData (BcMem:Allocate (* (sizeof char) nAllocation))
;;                     nLength 0))
;;           (setf (aref nData  nLength) (cast 0 char))
;;           (BcMem:Deallocate (cast (address (-> this data))
;;                                   (pointer (pointer void))))
;;           (setf (-> this data)       nData
;;                 (-> this dlength)    nLength
;;                 (-> this allocation) nAllocation)
;;           (return this)))
;;
;;
;;
;;     (--> (define-variable ?identifier ?type (&optional ?initform))
;;          (if (exported-p ?identifier)
;;              (progn
;;                (in-header "extern" ?type ?identifier ";")
;;                (in-body  ?type ?identifier (when ?initform
;;                                              "=" ?initform) ";"))
;;              (in-body "static" ?type ?identifier (when ?initform
;;                                                    "=" ?initform) ";")))
;;
;;     (--> (define-type ?identifier ?type)
;;          (if (exported-p ?identifier)
;;              (in-header "typedef" ?type ?identifier)
;;              (in-body   "typedef" ?type ?identifier)))
;;
;;
;;     (--> (scope (&optional ?class) ?identifier)
;;          (when ?class ?class) "::" ?identifier)
;;
;;     (--> (comment ?comment) "/*" ?comment "*/")
;;
;;     (--> (define-constant ?constant-identifier ?expression)
;;          "#define" ?constant-identifier ?expression)
;;
;;     (--> (define-macro ?identifier ?arguments ?expression)
;;          "#define" ?identifier ?arguments ?expression)
;;
;;     (--> (return ?expression)
;;          "return" "(" ?expression ")" ";")
;;
;;
;;
;;     (defparameter *special-operators* (make-hash-table))
;;
;;     (defun define-special-operator (name generator)
;;       (setf (gethash name *special-operators*) generator))
;;
;;     (defun spec-gen (name)
;;       (gethash name *special-operators*))
;;
;;
;;     (defmacro defspec (name arguments &body body)
;;       (define-special-operator ',name `(lambda ,arguments ,@body)))



;; ;;
;; ;; variable
;; ;;
;; ;;      int x;
;; (declare x int)
;; ;;      int y=42;
;; (declare y int 42)
;; ;;      char *a=0,*b=0,*c=0;
;; (declare (a b c) (pointer char) 0)
;; ;;      int (*f)(int x);
;; (declare f (pointer (function ((x int)) int)))
;; ;;
;; ;;      int f(int x);
;; (declare f (function ((x int)) int))
;; ;;
;; ;; function
;; ;;
;; ;;      int f(int x){ /* body */ }
;; (declare f (function ((x int)) int)
;;   (progn ...))
;; ;;


;; (declare colors (enum (blue 1) white red))
;; enum { blue=1, white, red } colors;


;; (class (scope Configuration Exception InvalidFieldException))

;;                          (scope c d)              com.informatimago.languages.linc.c::d
;;                 (scope b (scope c d))          b::c::d
;;        (scope a (scope b (scope c d)))      a::b::c::d
;; (scope (scope a (scope b (scope c d))))   ::a::b::c::d
;;
;; (scope a b c d)           a::b::c::d
;; (scope (scope a b c d)) ::a::b::c::d
;; (scope printf)          ::printf


  ;; (#cond
  ;;   (expr
  ;;    dasd
  ;;    dasdas
  ;;    dasda)
  ;;   (expr
  ;;    dasas
  ;;    dasdas
  ;;    dasda))
  ;;
  ;; (#if expr
  ;;   (#progn dasd
  ;;           dasd)
  ;;   (#progn dasd
  ;;           dasd))
  ;;
  ;; (#ifdef  expr
  ;;          (#progn dasd
  ;;                  dasd)
  ;;          (#progn dasd
  ;;                  dasd))
  ;; (#ifndef expr
  ;;          (#progn dasd
  ;;                  dasd)
  ;;          (#progn dasd
  ;;                  dasd))
  ;;
  ;; (#include dada...)
  ;; (#define ident ...)
  ;; (#define (ident ...) ...)
  ;; (#undef ident)
  ;; (#line ...)
  ;; (#error ...)
  ;; (#pragma ...)
  ;; (#)



#- (and)
  (declaration
 ::=
 ;; simple-definition
 (  decl-specifier-seq[opt] init-declarator-list[opt] ";"  )
 ;; (  function-definition  )
 (  decl-specifier-seq[opt] declarator ctor-initializer[opt] function-body  )
 (  decl-specifier-seq[opt] declarator function-try-block  )
 (  "asm" "(" string-literal ")" ";"  )
 ;; namespace-alias-definition
 (  "namespace" identifier "=" qualified-namespace-specifier ";"  )
 ;; using-declaration
 (  "using" "typename"[opt] "::"[opt] nested-name-specifier unqualified-id ";"  )
 (  "using" "::"  unqualified-id ";"  )
 ;; using-directive
 (  "using"  "namespace"  "::"[opt] nested-name-specifier[opt] namespace-name ";"  )


 ;; (  template-declaration  )
 (  "export"[opt] "template" "<" template-parameter-list ">" declaration  )

 ;; (  explicit-instantiation  )
 (  "template" declaration  )

 ;; (  explicit-specialization  )
 (  "template" "<" ">" declaration  )

 ;; (  linkage-specification  )
 (  "extern" string-literal "{" declaration-seq[opt] "}"  )
 (  "extern" string-literal declaration  )

 ;; (  namespace-definition  )
 (  "namespace" identifier[opt] "{" namespace-body "}"  )
 )

#+END_CODE

*** Design

=c-syntax.lisp=

Class hierarchy:

#+BEGIN_EXAMPLE

0-*-arguments ()
1-*-arguments ()
2-*-arguments ()
1-argument ()
2-arguments ()
3-arguments ()

c-item
^
|
+--- expression (c-item)
|    ^
|    |
|    +--- <operator> ---> <arguments>
|
+--- statement (c-item)
|    ^
|    |
|    +--- <statement> ---> <optional-arguments> | <condition-expression> | <let-statements> | <let-bindings>
|
+--- declaration (c-item)
|    ^
|    |
|    +--- <declaration>
|
+--- declarator (c-item)
     ^
     |
     +--- <declarator>

#+END_EXAMPLE

Each syntactic element is represented by:
- a lisp class,
- with a PRINT-OBJECT method to output the constructor form,
- with a constructor to make an instance.
- with a C-SEXP method to output the C sexp,
- with a GENERATE method to emit the C code,
- the C sexp operator is interned in COM.INFORMATIMAGO.LANGUAGES.LINC.C, and is aliased to the contructor.


#+BEGIN_EXAMPLE


    ("(6.7.1)" storage-class-specifier -->
     |typedef|
     |extern|
     |static|
     |_Thread_local|
     |auto|
     |register|)

    ("(6.7.2)" type-specifier -->
     |void|
     |char|
     |short|
     |int|
     |long|
     |float|
     |double|
     |signed|
     |unsigned|
     |_Bool|
     |_Complex|
     atomic-type-specifier
     struct-or-union-specifier
     enum-specifier
     typedef-name)

    ("(6.7.3)" type-qualifier -->
     |const|
     |restrict|
     |volatile|
     |_Atomic|)


    ("(6.7.4)" function-specifier -->
     |inline|
     |_Noreturn|)

    ("(6.7.5)" alignment-specifier -->
     (|_Alignas| \( type-name \))
     (|_Alignas| \( constant-expression \)))

    ("(6.7.6)" declarator -->
     ((opt pointer) direct-declarator))


declarations:

     (storage-class-specifier (opt declaration-specifiers) (opt init-declararator) \;)
     (type-specifier          (opt declaration-specifiers) (opt init-declararator) \;)
     (type-qualifier          (opt declaration-specifiers) (opt init-declararator) \;)
     (function-specifier      (opt declaration-specifiers) (opt init-declararator) \;)
     (alignment-specifier     (opt declaration-specifiers) (opt init-declararator) \;)
     static_assert-declaration

declarator:
     ((opt pointer) direct-declarator))

direct-declarator:
     identifier
     (\( declarator \))
     (direct-declarator \[ (opt type-qualifier-list) (opt assignment-expression) \])
     (direct-declarator \[ static (opt type-qualifier-list) assignment-expression \])
     (direct-declarator \[ type-qualifier-list static assignment-expression \])
     (direct-declarator \[ (opt type-qualifier-list) \* \])
     (direct-declarator \( parameter-type-list \))
     (direct-declarator \( (opt identifier-list) \)))



#+END_EXAMPLE



toplevel forms:

#+BEGIN_EXAMPLE

(include <file>)
(include "file")

(declare-structure   name slots)
(declare-union       name alternatives)
(declare-type        name type)
(declare-enumeration name values)

(declare-constant    name type)
(define-constant     name type value)

(declare-variable    name type)
(define-variable     name type value)

(declare-function    name lambda-list type [inline] [noreturn])
(define-function     name lambda-list type [inline] [noreturn] &body body)

(define-macro        name [lambda-list] expansion-string)


// future?

(declare-constant    name [extern] [static] [thread-local] [const] [restrict] [volatile] [atomic] type)
(define-constant     name [extern] [static] [thread-local] [const] [restrict] [volatile] [atomic] type value)

(declare-variable    name [extern] [static] [thread-local] [const] [restrict] [volatile] [atomic] type)
(define-variable     name [extern] [static] [thread-local] [const] [restrict] [volatile] [atomic] type value)

(declare-function    name [extern] [static] [thread-local] [inline] [noreturn] lambda-list type)
(define-function     name [extern] [static] [thread-local] [inline] [noreturn] lambda-list type &body body)

(define-macro        name [lambda-list] expansion)

#+END_EXAMPLE


|---------------+---------|
| typedef       | typ     |
|---------------+---------|
| extern        | var fun |
| static        | var fun |
|---------------+---------|
| _Thread_local | var     |
| auto          | var     |
| register      | var     |


|----------+-----|
| const    | typ |
| restrict | typ |
| volatile | typ |
| _Atomic  | typ |


| c        | lisp     |
|----------+----------|
| void     | void     |
| char     | char     |
| short    | short    |
| int      | int      |
| long     | long     |
| float    | float    |
| double   | double   |
| signed   | signed   |
| unsigned | unsigned |
| _Bool    | bool     |
| _Complex | complex  |

|--------------------+---|
| void               | 0 |
|--------------------+---|
| bool               |   |
| float              |   |
| double             |   |
| complex            |   |
|--------------------+---|
| char               | 1 |
| signed char        | 1 |
| unsigned char      | 1 |
| short              | 2 |
| signed short       | 2 |
| unsigned short     | 2 |
| int                | 4 |
| signed int         | 4 |
| unsigned int       | 4 |
| long               | 8 |
| signed long        | 8 |
| unsigned long      | 8 |
| long long          | 8 |
| signed long long   | 8 |
| unsigned long long | 8 |
ViewGit