% translate lisp code into C
% --------------------------
%
% e.g. translate a single lisp statement into a single C statement
%   or translate a series of lisp statements into a C program
%      by embedding them inside a main routine
%
% it currently handles the following styles of lisp statement:
%    (defvar V N)  where V is a variable name and N is a number or variable
%    (F Args)      where F is a function name and Args is one or more variables,
%                       numbers, or function calls
%    (setf V N)    where V is a variable name and N is a number, variable,
%                       or function call
%
% at the moment, the lisp code accepted and the C code produced must be in
%    the form of lists of atoms - a set of sample routines are provided to
%    print them in a more user friendly form (at the bottom of this file).
%
% sample output: (shows the original lisp and the C translation)
% --------------
% lisp:
% ( defvar X 3 ) ( f 3 X ) ( setf X ( g 5.5 ) )
%
% C:
% int main ( ) {
% double X = 3 ;
% f ( 3 , X ) ;
% X = g ( 5.5 ) ;
% }
%
% Underlying grammar decomposition:
% ---------------------------------
% program    --> statements
% statements --> statement
%            --> statement, statements
% statement  --> vardef
%            --> proccall
%            --> assign
% vardef     --> bracket, defvar, identifier, value, bracket
% assign     --> bracket, setf,   identifier, value, bracket
% proccall   --> funcall
% funcall    --> bracket, identifier,  argslist, bracket
% arguments  --> argument
%            --> argument, arguments
% argument   --> identifier
%            --> value
%            --> funcall
% identifier --> atom (that isn't reserved)
% value      --> number
%
% most rules are presented in the form
%    goal(CCode) -->
%       subgoal1, subgoal2, etc,
%       { prolog to produce the C Code }.


% translate one or more lisp statements into C, and embed that into a C main
program(CCode) -->
   statements(P),
   { concatenate([['int', 'main', '(', ')', '{'], P, ['}']], CCode) }.

% statements can be either a single statement or multiple
statements([S]) -->
   statement(S).
statements([First|Rest]) -->
   statement(First),statements(Rest).

% supported statement types are:
%    variable declarations using defvar,
%    assignment statements using setf,
%    function calls
statement(Info) -->
   vardef(Info).
statement(Info) -->
   proccall(Info).
statement(Info) -->
   assign(Info).

% translate (defvar Var Value) into  double Var = Value;
vardef(CCode) -->
   openB, vdef, identifier(Var), argument(Val), closeB,
   { CCode = ['double', Var, '=', Val, ';'] }.

% translate (setf Var Value) into  Var = Value;
assign(CCode) -->
   openB, setf, identifier(Var), argument(Val), closeB,
   { CCode = [Var, '=', Val, ';'] }.

% translate stand-alone function call into a stand-alone C statement
proccall(CCode) -->
   funcall(FCode),
   { append(FCode, [';'], CCode) }.

% translate (F A B C ...) into F(A, B, C, ...)
funcall([F, '(' | Rest]) -->
   openB, identifier(F), arguments(Vals), closeB,
   { append(Vals, [ ')' ], Rest) }.

% arguments can be a single argument or multiple
arguments(CCode) -->
   argument(Val),
   { CCode = [ Val ] }.
arguments(CCode) -->
   argument(Val), arguments(Vals),
   { CCode = [ Val, ',' | Vals ] }.

% valid arguments can be variables, numbers, or function calls
argument(Var) -->
   identifier(Var).
argument(Val) -->
   value(Val).
argument(FCode) -->
   funcall(FCode).

% identifiers are any non-keyword
identifier(Id) -->
   [ Id ],
   { atom(Id), Id \= 'defvar', Id \= 'setf' }.

% numbers are retained as-is
value(Val) -->
   [ Val ],
   { number(Val) }.

% identify core lisp symbols and keywords
setf --> ['setf'].
vdef --> ['defvar'].
openB --> ['('].
closeB --> [')'].

% -------------- Concatenation ------------

% describe a list of lists using dcgs
list([]) --> [].
list([L|Lists]) --> [L], list(Lists).

% use that to form concatenated lists
concat([]) --> [].
concat([L|Lists]) --> list(L), concat(Lists).

% make a regular prolog concatenate rule
concatenate(LoL, Result) :- phrase(concat(LoL), Result, []).

% -------------- Pretty-printer ------------

printCode(Lang, Codelist) :- format("~w:~n", [Lang]),
   foreach(member(S,Codelist),
       (is_list(S) -> foreach(member(E,S), printSym(Lang, E))
                  ;   printSym(Lang, S))), nl.

printSym("C", Sym) :- member(Sym, ['{', '}', ';']), format("~w~n", [Sym]).
printSym(_, Sym) :- format("~w ", [Sym]).

% -------------- Sample tests --------------

checkS(L,S) :- phrase(statement(S), L, []).
checkP(L,P) :- phrase(program(P), L, []).

% t1 translates a defvar statement
%     (defvar X 3) ==>  double X = 3;
t1  :- L = ['(', 'defvar', 'X', '3', ')'],
       checkS(L, S),
       printCode("lisp", L),
       printCode("C", S).

% t2 translates a function call with two args
%     (f 3 Abc) ==> f(3,Abc);
t2  :- L = ['(', 'f', '3', 'Abc', ')'],
       checkS(L, S),
       printCode("lisp", L),
       printCode("C", S).

% t3 translates a setf
%     (setf foo -13) ==> foo = -13;
t3  :- L = ['(', 'setf', 'foo', '-13', ')'],
       checkS(L, S),
       printCode("lisp", L),
       printCode("C", S).

% t4 translates a setf with a function call
%     (setf X (f 5.5)) ==> X = f(5.5);
t4  :- L = ['(', 'setf', 'X', '(', 'f', '5.5', ')', ')'],
       checkS(L, S),
       printCode("lisp", L),
       printCode("C", S).

% t10 translates a program that contains the statements from t1,t2,t3
t10 :- L = [ '(', 'defvar', 'X', '3', ')',
             '(', 'f', '3', 'X', ')',
             '(', 'setf', 'X', '3', ')'
           ],
       checkP(L, P),
       printCode("lisp", L), nl,
       printCode("C", P).


% --------------- Sample runs --------------
%
% ?- t1.
% lisp:
% ( defvar X 3 )
%
% C:
% double X = 3 ;
% true
%
% ?- t2.
% lisp: ( f 3 Abc )
%
% C:
% f ( 3 , Abc ) ;
% true
%
% ?- t3.
% lisp:
% ( setf foo -13 )
%
% C:
% foo = -13 ;
% true
%
% ?- t4.
% lisp:
% ( setf X ( f 5.5 ) )
%
% C:
% X = f ( 5.5 ) ;
% true
%
% ?- t10.
% lisp:
% ( defvar X 3 ) ( f 3 X ) ( setf X 3 )
%
% C:
% int main ( ) {
% double X = 3 ;
% f ( 3 , X ) ;
% X = 3 ;
% }
% true
%