MODULE MakeSLisp;

IMPORT sExpressions;
FROM sExpressions IMPORT Cons, MakeSymbolicAtom;

VAR quoteAtom, condAtom, letAtom, defunAtom, setcAtom : sExpressions.T;

PROCEDURE sList2 (e1, e2 : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN Cons(e1, Cons(e2, sExpressions.TheEmptyList))
END sList2;

PROCEDURE sList3 (e1, e2, e3 : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN Cons(e1, sList2(e2, e3))
END sList3;

PROCEDURE sList4 (e1, e2, e3, e4 : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN Cons(e1, sList3(e2, e3, e4))
END sList4;

PROCEDURE Identifier (name : TEXT) : sExpressions.T =

BEGIN
  RETURN MakeSymbolicAtom(name)
END Identifier;

PROCEDURE NumericAtomExpr (Num : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN Num
END NumericAtomExpr;

PROCEDURE SymbolicAtomExpr (Sym : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN sList2(quoteAtom, Sym)
END SymbolicAtomExpr;

PROCEDURE ListExpr (theElems : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN sList2(quoteAtom, theElems)
END ListExpr;

PROCEDURE FnCall (theCallee, theArguments : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN Cons(theCallee, theArguments)
END FnCall;

PROCEDURE CondExpr (theClauses : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN Cons(condAtom, theClauses)
END CondExpr;

PROCEDURE LetExpr
	    (theLocalDefs, theFinalExpr : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN sList3(letAtom, theLocalDefs, theFinalExpr)
END LetExpr;

PROCEDURE Clause (thePred, theResult : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN sList2(thePred, theResult)
END Clause;

PROCEDURE LocalDef (theName, theVal : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN sList2(theName, theVal)
END LocalDef;

PROCEDURE ConstDef (theName, theVal : sExpressions.T) : sExpressions.T =

BEGIN
  RETURN sList3(setcAtom, theName, theVal)
END ConstDef;

PROCEDURE FnDef (theName, theParms, theBody : sExpressions.T) : sExpressions.T
	    =

BEGIN
  RETURN sList4(defunAtom, theName, theParms, theBody)
END FnDef;

BEGIN
  quoteAtom := MakeSymbolicAtom("quote");
  condAtom := MakeSymbolicAtom("cond");
  letAtom := MakeSymbolicAtom("let");
  defunAtom := MakeSymbolicAtom("defun");
  setcAtom := MakeSymbolicAtom("setc")
END MakeSLisp.