jatha-cvs Mailing List for Jatha - Java LISP library
Brought to you by:
mhewett
You can subscribe to this list here.
2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(72) |
Jun
(14) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(31) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2006 |
Jan
(17) |
Feb
(32) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2007 |
Jan
|
Feb
(8) |
Mar
(9) |
Apr
(20) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2008 |
Jan
|
Feb
|
Mar
(16) |
Apr
|
May
|
Jun
|
Jul
(8) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2009 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(11) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
From: Micheal H. <mh...@us...> - 2009-07-26 05:29:09
|
Update of /cvsroot/jatha/jatha In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19773 Modified Files: build.xml Log Message: Fixed compile and deploy targets Index: build.xml =================================================================== RCS file: /cvsroot/jatha/jatha/build.xml,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** build.xml 26 Apr 2007 05:57:23 -0000 1.5 --- build.xml 26 Jul 2009 05:28:58 -0000 1.6 *************** *** 35,38 **** --- 35,39 ---- <property name="dir.www.download" value="${dir.www}/download" /> <property name="dir.www.download.current" value="${dir.www.download}/current" /> + <property name="dir.www.repository" value="${dir.www}/repository" /> <property name="dir.build" value="${base}/build" /> *************** *** 67,71 **** <target name="deploy" depends="jar" description="Deploy jar file"> ! <copy overwrite="yes" file="${dir.build.lib}/${code.jarfile}" tofile="${dir.deploy}/${code.jarfile}"/> </target> --- 68,73 ---- <target name="deploy" depends="jar" description="Deploy jar file"> ! <copy overwrite="yes" file="${dir.build.lib}/${code.jarfile}" tofile="${dir.www.repository}/${code.jarfile}"/> ! <!-- copy overwrite="yes" file="${dir.build.lib}/${code.jarfile}" tofile="${dir.deploy}/${code.jarfile}"/ --> </target> *************** *** 73,76 **** --- 75,79 ---- <target name="compile" depends="taskInit" description="Compile"> + <ant dir="src" target="compile"/> </target> |
From: Micheal H. <mh...@us...> - 2009-07-26 05:28:46
|
Update of /cvsroot/jatha/jatha/www/repository In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19726/www/repository Added Files: jatha-2.9.jar Log Message: added repository to www --- NEW FILE: jatha-2.9.jar --- (This appears to be a binary file; contents omitted.) |
From: Micheal H. <mh...@us...> - 2009-07-26 05:28:23
|
Update of /cvsroot/jatha/jatha/www/repository In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19678/www/repository Log Message: Directory /cvsroot/jatha/jatha/www/repository added to the repository |
From: Micheal H. <mh...@us...> - 2009-07-26 05:23:24
|
Update of /cvsroot/jatha/jatha/src/org/jatha/compile In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19191/org/jatha/compile Modified Files: GoPrimitive.java LispCompiler.java ReturnFromPrimitive.java TagbodyPrimitive.java Log Message: Several fixes from third parties Index: ReturnFromPrimitive.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/compile/ReturnFromPrimitive.java,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ReturnFromPrimitive.java 1 Jun 2005 13:08:02 -0000 1.1 --- ReturnFromPrimitive.java 26 Jul 2009 05:23:12 -0000 1.2 *************** *** 41,88 **** */ public class ReturnFromPrimitive extends LispPrimitive { ! public ReturnFromPrimitive(final Jatha lisp) { ! super(lisp,"RETURN-FROM",1,2); ! } ! public void Execute(final SECDMachine machine) throws CompilerException { ! final LispValue tag = machine.S.pop(); ! final LispValue args = machine.S.pop(); ! final LispValue retVal = (args.basic_length()==0)?f_lisp.NIL:args.car(); ! machine.S.push(retVal); ! findBlock(tag,machine); ! } ! private void findBlock(final LispValue tag, final SECDMachine machine) throws CompilerException { ! LispValue currVal = null; ! while(true) { ! currVal = machine.C.pop(); ! while(currVal != f_lisp.NIL && currVal != machine.RTN && currVal != machine.RTN_IF && currVal != machine.RTN_IT && currVal != machine.JOIN && currVal != machine.BLK) { ! currVal = machine.C.pop(); ! } ! if(currVal == machine.BLK) { ! currVal = machine.C.pop(); ! if(tag == currVal) { ! return; // We found the place! ! } ! } else if(currVal == machine.RTN || currVal == machine.RTN_IF || currVal == machine.RTN_IT || currVal == machine.JOIN) { ! ((SECDop)currVal).Execute(machine); ! } else { ! throw new IllegalArgumentException("RETURN-FROM called with in bad form, no matching block outside"); ! } } } ! public LispValue CompileArgs(final LispCompiler compiler, final SECDMachine machine, final LispValue args, final LispValue valueList, final LispValue code) throws CompilerException { ! final LispValue tag = args.car(); ! if(!compiler.getLegalBlocks().contains(tag)) { ! throw new IllegalReturnStatement("No enclosing lexical block with tag " + tag); ! } ! final LispValue fullCode = args.cdr(); ! final LispValue compiledCode = compiler.compileArgsLeftToRight(fullCode, valueList,f_lisp.makeCons(machine.LIS,f_lisp.makeCons(fullCode.length(),f_lisp.makeCons(machine.LDC,f_lisp.makeCons(tag,code))))); ! return compiledCode; ! } ! public static class IllegalReturnStatement extends CompilerException { ! IllegalReturnStatement() { super(); } ! IllegalReturnStatement(final String s) { super(s); } } }// ReturnFromPrimitive --- 41,95 ---- */ public class ReturnFromPrimitive extends LispPrimitive { ! public ReturnFromPrimitive(final Jatha lisp) { ! super(lisp,"RETURN-FROM",1,2); ! } ! public void Execute(final SECDMachine machine) throws CompilerException ! { ! final LispValue tag = machine.S.pop(); ! final LispValue args = machine.S.pop(); ! final LispValue retVal = (args.basic_length()==0)?f_lisp.NIL:args.car(); ! machine.S.push(retVal); ! findBlock(tag,machine); ! } ! private void findBlock(final LispValue tag, final SECDMachine machine) throws CompilerException ! { ! LispValue currVal = null; ! while(true) { ! currVal = machine.C.pop(); ! while (currVal != f_lisp.NIL && currVal != machine.RTN && currVal != machine.RTN_IF && currVal != machine.RTN_IT && currVal != machine.JOIN && currVal != machine.BLK && !(currVal instanceof TagbodyPrimitive)) { ! currVal = machine.C.pop(); ! } ! if (currVal == machine.BLK) ! { ! currVal = machine.C.pop(); ! if (tag == currVal) ! { ! return; // We found the place! } + } else if(currVal == machine.RTN || currVal == machine.RTN_IF || currVal == machine.RTN_IT || currVal == machine.JOIN) { + ((SECDop)currVal).Execute(machine); + } else if (currVal instanceof TagbodyPrimitive) { + machine.C.push(currVal); + ((LispPrimitive)currVal).Execute(machine); + } else { + throw new IllegalArgumentException("RETURN-FROM called with in bad form, no matching block outside"); + } } + } ! public LispValue CompileArgs(final LispCompiler compiler, final SECDMachine machine, final LispValue args, final LispValue valueList, final LispValue code) throws CompilerException { ! final LispValue tag = args.car(); ! if(!compiler.getLegalBlocks().contains(tag)) { ! throw new IllegalReturnStatement("No enclosing lexical block with tag " + tag); } + final LispValue fullCode = args.cdr(); + final LispValue compiledCode = compiler.compileArgsLeftToRight(fullCode, valueList,f_lisp.makeCons(machine.LIS,f_lisp.makeCons(fullCode.length(),f_lisp.makeCons(machine.LDC,f_lisp.makeCons(tag,code))))); + return compiledCode; + } + public static class IllegalReturnStatement extends CompilerException { + IllegalReturnStatement() { super(); } + IllegalReturnStatement(final String s) { super(s); } + } }// ReturnFromPrimitive Index: LispCompiler.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/compile/LispCompiler.java,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** LispCompiler.java 2 Jul 2008 05:29:53 -0000 1.34 --- LispCompiler.java 26 Jul 2009 05:23:12 -0000 1.35 *************** *** 85,89 **** private final Stack<LispValue> legalBlocks = new Stack<LispValue>(); private final Stack<Set<LispValue>> legalTags = new Stack<Set<LispValue>>(); ! private final Map<Long, LispValue> registeredDos = new HashMap<Long, LispValue>(); // static initializer. --- 85,89 ---- private final Stack<LispValue> legalBlocks = new Stack<LispValue>(); private final Stack<Set<LispValue>> legalTags = new Stack<Set<LispValue>>(); ! private final Map<Long, LispValue> registeredGos = new HashMap<Long, LispValue>(); // static initializer. *************** *** 413,418 **** } ! public Map<Long, LispValue> getRegisteredDos() { ! return registeredDos; } --- 413,418 ---- } ! public Map<Long, LispValue> getRegisteredGos() { ! return registeredGos; } Index: TagbodyPrimitive.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/compile/TagbodyPrimitive.java,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** TagbodyPrimitive.java 10 Mar 2008 03:26:13 -0000 1.3 --- TagbodyPrimitive.java 26 Jul 2009 05:23:12 -0000 1.4 *************** *** 29,32 **** --- 29,33 ---- import java.util.Map; import java.util.HashMap; + import java.util.HashSet; import java.util.List; import java.util.ArrayList; *************** *** 43,110 **** * @version $Revision$ */ ! public class TagbodyPrimitive extends LispPrimitive { ! public TagbodyPrimitive(final Jatha lisp) { ! super(lisp,"TAGBODY",1,Long.MAX_VALUE); } ! public void Execute(final SECDMachine machine) { ! machine.S.pop(); ! machine.C.pop(); } - - public LispValue CompileArgs(final LispCompiler compiler, final SECDMachine machine, final LispValue args, final LispValue valueList, final LispValue code) throws CompilerException { - final Map<LispValue, Integer> tags = new HashMap<LispValue, Integer>(); - final List<LispValue> progns = new ArrayList<LispValue>(); - for(final Iterator<LispValue> iter = args.iterator();iter.hasNext();) { - final LispValue val = iter.next(); - if(val.basic_symbolp()) { - tags.put(val,new Integer(progns.size())); - } else if(val.basic_listp()) { - progns.add(val); - } - } - final Map<LispValue, List<LispValue>> tags2 = new HashMap<LispValue, List<LispValue>>(); - for(final Iterator<LispValue> iter = tags.keySet().iterator();iter.hasNext();) { - final LispValue tag = iter.next(); - final int index = tags.get(tag).intValue(); - tags2.put(tag,progns.subList(index,progns.size())); - } - compiler.getLegalTags().push(tags.keySet()); ! final Map<LispValue, LispValue> tags3 = new HashMap<LispValue, LispValue>(); ! for(final Iterator<LispValue> iter = tags2.keySet().iterator();iter.hasNext();) { ! final LispValue tag = iter.next(); ! final LispValue allProgns = f_lisp.makeList(f_lisp.makeCons(f_lisp.getEval().intern("PROGN"),f_lisp.makeList(tags2.get(tag)))); ! tags3.put(tag,compiler.compileArgsLeftToRight(allProgns,valueList,code)); ! } - final Map<LispValue, LispValue> metaCode = new HashMap<LispValue, LispValue>(); - for(final Iterator<LispValue> iter = tags3.keySet().iterator();iter.hasNext();) { - final LispValue tag = iter.next(); - final LispValue codeX = f_lisp.makeList(f_lisp.QUOTE,tags3.get(tag)); - final LispValue code2 = compiler.compile(codeX,valueList,f_lisp.NIL); - metaCode.put(tag,code2); - } ! final LispValue all = f_lisp.makeList(f_lisp.makeCons(f_lisp.getEval().intern("PROGN"),f_lisp.makeList(progns))); ! final LispValue theCode = compiler.compileArgsLeftToRight(all,valueList,f_lisp.makeList(code.car())); ! compiler.getLegalTags().pop(); ! LispValue loadBindings = f_lisp.NIL; ! LispValue unloadBindings = f_lisp.NIL; ! for(final Iterator<Long> iter = compiler.getRegisteredDos().keySet().iterator();iter.hasNext();) { ! final Long key = iter.next(); ! final LispValue tag = compiler.getRegisteredDos().get(key); ! if(tags.containsKey(tag)) { ! final LispValue tagSym = f_lisp.getEval().intern("#:T"+key); ! loadBindings = f_lisp.makeCons(machine.LDC,f_lisp.makeCons(tags3.get(tag), ! f_lisp.makeCons(machine.SP_BIND,f_lisp.makeCons(tagSym,loadBindings)))); ! unloadBindings = f_lisp.makeCons(machine.SP_UNBIND,f_lisp.makeCons(tagSym,unloadBindings)); ! iter.remove(); ! } ! } ! return loadBindings.append(f_lisp.makeList(machine.TAG_B)).append(theCode).append(f_lisp.makeList(machine.TAG_E)).append(unloadBindings).append(code.cdr()); } }// TagbodyPrimitive --- 44,192 ---- * @version $Revision$ */ ! public class TagbodyPrimitive extends LispPrimitive ! { ! public static final boolean DEBUG = false; ! ! ! public TagbodyPrimitive(final Jatha lisp) { ! super(lisp,"TAGBODY",1,Long.MAX_VALUE); ! } ! ! public void Execute(final SECDMachine machine) { ! machine.S.pop(); ! machine.C.pop(); ! machine.X.pop(); ! } ! ! /** ! * Compiles the arguments for Tagbody. ! * An argument is either a list, in which case it is a statement to be executed ! * or a symbol, in which case it is a tag that can be a destination of a (GO tag) statement. ! */ ! public LispValue CompileArgs(final LispCompiler compiler, final SECDMachine machine, final LispValue args, final LispValue valueList, final LispValue code) throws CompilerException ! { ! if (DEBUG) ! System.out.println("\n\nTAGBODY compile ----------------------------------"); ! ! final Map<LispValue, Integer> tags = new HashMap<LispValue, Integer>(); ! final List<LispValue> progns = new ArrayList<LispValue>(); ! ! // Put all the tags in a tag map, and put all the statements in the progns list. ! for(final Iterator<LispValue> iter = args.iterator();iter.hasNext();) { ! final LispValue val = iter.next(); ! if(val.basic_symbolp()) { ! tags.put(val,new Integer(progns.size())); ! } else if(val.basic_listp()) { ! progns.add(val); ! } } ! // DEBUG ! if (DEBUG) ! { ! System.out.println("\n\n Found " + tags.size() + " tags ------------------------------"); ! if (tags.size() > 0) ! for (Map.Entry<LispValue, Integer> entry : tags.entrySet()) ! System.out.format(" %d: %s\n", entry.getValue(), entry.getKey().toString()); } ! // Map each tag to all statements that will be executed after a (GO ...) for that tag. ! final Map<LispValue, List<LispValue>> tags2 = new HashMap<LispValue, List<LispValue>>(); ! for(final Iterator<LispValue> iter = tags.keySet().iterator();iter.hasNext();) { ! final LispValue tag = iter.next(); ! final int index = tags.get(tag).intValue(); ! tags2.put(tag,progns.subList(index,progns.size())); ! } ! if (DEBUG) ! { ! System.out.println("\n\n Found " + tags.size() + " tag bodies -------------------------------"); ! if (tags2.size() > 0) ! for (Map.Entry<LispValue, List<LispValue>> entry : tags2.entrySet()) ! System.out.format(" %s: %d\n", entry.getKey().toString(), entry.getValue().size()); ! } ! // Tell the compiler what tags are available. ! compiler.getLegalTags().push(tags.keySet()); ! // Put a progn around each tag destination computed above ! // Compile the progn and store the compiled code with the tag. ! final Map<LispValue, LispValue> tags3 = new HashMap<LispValue, LispValue>(); ! for(final Iterator<LispValue> iter = tags2.keySet().iterator();iter.hasNext();) { ! final LispValue tag = iter.next(); ! final LispValue allProgns = f_lisp.makeList(f_lisp.makeCons(f_lisp.getEval().intern("PROGN"),f_lisp.makeList(tags2.get(tag)))); ! tags3.put(tag,compiler.compileArgsLeftToRight(allProgns,valueList,code)); ! } ! if (DEBUG) ! { ! System.out.println("\n\n Created " + tags3.size() + " tagbody progns ---------------------------------------"); ! if (tags3.size() > 0) ! for (Map.Entry<LispValue, LispValue> entry : tags3.entrySet()) ! System.out.format(" %s: %s\n", entry.getKey().toString(), entry.getValue().toString()); ! } ! // Compile the quoted code ?? why ?? ! final Map<LispValue, LispValue> metaCode = new HashMap<LispValue, LispValue>(); ! for(final Iterator<LispValue> iter = tags3.keySet().iterator();iter.hasNext();) { ! final LispValue tag = iter.next(); ! final LispValue codeX = f_lisp.makeList(f_lisp.QUOTE,tags3.get(tag)); ! final LispValue code2 = compiler.compile(codeX,valueList,f_lisp.NIL); ! metaCode.put(tag,code2); ! } ! if (DEBUG) ! { ! System.out.println("\n\n Created " + metaCode.size() + " tagbody metacodes -----------------------------------"); ! if (metaCode.size() > 0) ! for (Map.Entry<LispValue, LispValue> entry : metaCode.entrySet()) ! System.out.format(" %s: %s\n", entry.getKey().toString(), entry.getValue().toString()); } + + // Put a progn around all of the progns and compile it. + final LispValue all = f_lisp.makeList(f_lisp.makeCons(f_lisp.getEval().intern("PROGN"),f_lisp.makeList(progns))); + final LispValue theCode = compiler.compileArgsLeftToRight(all,valueList,f_lisp.makeList(code.car())); + + // Remove the list of legal tags + compiler.getLegalTags().pop(); + + if (DEBUG) + { + Map<Long, LispValue> gos = compiler.getRegisteredGos(); + System.out.println("\n\n Found " + gos.size() + " tagbody gos --------------------------------"); + if (gos.size() > 0) + for (Map.Entry<Long, LispValue> entry : gos.entrySet()) + System.out.format(" %d: %s\n", entry.getKey(), entry.getValue().toString()); + } + + // Generate the code. + LispValue loadBindings = f_lisp.NIL; + LispValue unloadBindings = f_lisp.NIL; + + HashSet<LispValue> allTags = new HashSet<LispValue>(compiler.getRegisteredGos().values()); + + for(final Iterator<Long> iter = compiler.getRegisteredGos().keySet().iterator();iter.hasNext();) { + final Long key = iter.next(); + final LispValue tag = compiler.getRegisteredGos().get(key); + if(tags.containsKey(tag)) { + final LispValue tagSym = f_lisp.getEval().intern("#:T"+key); + loadBindings = f_lisp.makeCons(machine.LD_GLOBAL,f_lisp.makeCons(tag,f_lisp.makeCons(machine.SP_BIND,f_lisp.makeCons(tagSym,loadBindings)))); + unloadBindings = f_lisp.makeCons(machine.SP_UNBIND,f_lisp.makeCons(tagSym,unloadBindings)); + iter.remove(); + } + } + + for(final Iterator<LispValue> iter = allTags.iterator();iter.hasNext();) { + final LispValue tag = iter.next(); + if(tags.containsKey(tag)) { + loadBindings = f_lisp.makeCons(machine.LDC,f_lisp.makeCons(tags3.get(tag), + f_lisp.makeCons(machine.SP_BIND,f_lisp.makeCons(tag,loadBindings)))); + unloadBindings = f_lisp.makeCons(machine.SP_UNBIND,f_lisp.makeCons(tag,unloadBindings)); + } + } + + if (DEBUG) + System.out.println("\nEND TAGBODY -----------------------------------------"); + + return loadBindings.append(f_lisp.makeList(machine.TAG_B)).append(theCode).append(f_lisp.makeList(machine.TAG_E)).append(unloadBindings).append(code.cdr()); + } }// TagbodyPrimitive Index: GoPrimitive.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/compile/GoPrimitive.java,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** GoPrimitive.java 30 Jun 2005 00:24:23 -0000 1.2 --- GoPrimitive.java 26 Jul 2009 05:23:12 -0000 1.3 *************** *** 37,121 **** * @version $Revision$ */ ! public class GoPrimitive extends LispPrimitive { ! private long counter = 0L; ! public GoPrimitive(final Jatha lisp) { ! super(lisp,"GO",1); ! } ! public void Execute(final SECDMachine machine) { ! /* System.err.println("our registers (before):"); ! System.err.println("S: " + machine.S.value()); ! System.err.println("E: " + machine.E.value()); ! System.err.println("C: " + machine.C.value()); ! System.err.println("D: " + machine.D.value()); ! System.err.println("X: " + machine.X.value()); ! System.err.println("x1");*/ ! final LispValue tag = machine.S.pop().car(); ! // System.err.println("x2"); ! machine.S.assign(f_lisp.NIL); ! // System.err.println("x3"); ! final LispValue code = machine.B.gethash(tag).car(); ! // System.err.println("x4 - " + machine.X.value().first().first()); ! machine.E.assign(machine.X.value().first().first()); ! // System.err.println("x5 - " + machine.X.value().first().second()); ! machine.D.assign(machine.X.value().first().second()); ! /* System.err.println("x6 - " + machine.X); ! System.err.println("x6 - " + machine.X.value()); ! System.err.println("x6 - " + machine.X.value().first()); ! System.err.println("x6 - " + machine.X.value().first().third());*/ ! ((StandardLispHashTable)machine.B).assign((StandardLispHashTable)machine.X.value().first().third()); ! // System.err.println("x7"); ! machine.C.assign(code); ! /* ! LispValue full = machine.D.value(); ! full = removeUntilTagbody(machine,full); ! machine.D.assign(full); ! machine.C.assign(code); ! if(machine.E.value().car() == f_lisp.NIL) { ! machine.E.assign(machine.E.value().cdr()); // black magic. ! } ! */ ! /* ! System.err.println("our registers (after):"); ! System.err.println("S: " + machine.S.value()); ! System.err.println("E: " + machine.E.value()); ! System.err.println("C: " + machine.C.value()); ! System.err.println("D: " + machine.D.value()); ! System.err.println("X: " + machine.X.value());*/ ! } ! public LispValue removeUntilTagbody(final SECDMachine machine,final LispValue input) { ! LispValue walker = input; ! LispValue inner = input.car(); ! final java.util.List unbinds = new java.util.ArrayList(); ! while(!(inner.car() instanceof TagbodyPrimitive) && walker != f_lisp.NIL) { ! if(inner.car() == machine.SP_UNBIND ) { ! unbinds.add(inner.first()); ! unbinds.add(inner.second()); ! } ! inner = inner.cdr(); ! while(inner.car() == f_lisp.NIL && walker != f_lisp.NIL) { ! walker = walker.cdr(); ! inner = walker.car(); ! } ! } ! return (walker == f_lisp.NIL)?f_lisp.makeList(f_lisp.makeList(unbinds)):f_lisp.makeCons(f_lisp.makeList(unbinds).append(inner),walker.cdr()); } ! public LispValue CompileArgs(final LispCompiler compiler, final SECDMachine machine, final LispValue args, final LispValue valueList, final LispValue code) throws CompilerException { ! final LispValue tag = args.car(); ! if(!compiler.isLegalTag(tag)) { ! throw new IllegalArgumentException("Tag " + tag + " is not legal in this lexical context"); ! } ! long nextVal = 0L; ! synchronized(this) { ! nextVal = counter++; ! } ! compiler.getRegisteredDos().put(new Long(nextVal),tag); ! return compiler.compileArgsLeftToRight(f_lisp.makeList(f_lisp.makeList(f_lisp.QUOTE,f_lisp.makeList(f_lisp.getEval().intern("#:T"+nextVal)))),valueList,code); } ! }// GoPrimitive --- 37,82 ---- * @version $Revision$ */ ! public class GoPrimitive extends LispPrimitive ! { ! private long counter = 0L; ! public GoPrimitive(final Jatha lisp) { ! super(lisp,"GO",1); ! } ! public void Execute(final SECDMachine machine) ! { ! final LispValue tag = machine.S.pop().car(); ! machine.S.assign(f_lisp.NIL); ! final LispValue code = machine.B.gethash(tag).car(); ! machine.E.assign(machine.X.value().first().first()); ! machine.D.assign(machine.X.value().first().second()); ! ((StandardLispHashTable)machine.B).assign((StandardLispHashTable)machine.X.value().first().third()); ! machine.C.assign(code); ! } ! public LispValue CompileArgs(final LispCompiler compiler, final SECDMachine machine, final LispValue args, final LispValue valueList, final LispValue code) throws CompilerException ! { ! final LispValue tag = args.car(); ! long nextVal = 0L; ! if(!compiler.isLegalTag(tag)) { ! throw new IllegalArgumentException("Tag " + tag + " is not legal in this lexical context"); } ! // Added (mh) 12 Mar 2008 because duplicate tags were being entered, causing extra code to be generated. ! // This is related to a Jatha bug for nested dotimes. ! if (! compiler.getRegisteredGos().containsValue(tag)) ! { ! synchronized(this) { ! nextVal = counter++; ! } ! compiler.getRegisteredGos().put(new Long(nextVal),tag); } ! ! return compiler.compileArgsLeftToRight(f_lisp.makeList(f_lisp.makeList(f_lisp.QUOTE,f_lisp.makeList(f_lisp.getEval().intern("#:T"+nextVal)))),valueList,code); ! } ! ! } // GoPrimitive |
From: Micheal H. <mh...@us...> - 2009-07-26 05:23:24
|
Update of /cvsroot/jatha/jatha/src/org/jatha In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19191/org/jatha Modified Files: Jatha.java Log Message: Several fixes from third parties Index: Jatha.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/Jatha.java,v retrieving revision 1.52 retrieving revision 1.53 diff -C2 -d -r1.52 -r1.53 *** Jatha.java 24 Jul 2008 23:59:02 -0000 1.52 --- Jatha.java 26 Jul 2009 05:23:12 -0000 1.53 *************** *** 106,110 **** private int VERSION_MICRO = 0; private String VERSION_TYPE = ""; ! private String VERSION_DATE = "16 Mar 2008"; private String VERSION_URL = "http://jatha.sourceforge.net/"; --- 106,110 ---- private int VERSION_MICRO = 0; private String VERSION_TYPE = ""; ! private String VERSION_DATE = "25 Jul 2009"; private String VERSION_URL = "http://jatha.sourceforge.net/"; *************** *** 493,500 **** LispValue STAR, STARSTAR, STARSTARSTAR; ! LispValue MAX_LIST_LENGTH; LispValue LOAD_VERBOSE; ! static long MAX_LIST_LENGTH_VALUE = 1000000; boolean useGUI = true; // Whether or not to use GUI-based interaction. --- 493,503 ---- LispValue STAR, STARSTAR, STARSTARSTAR; ! LispValue MAX_LIST_LENGTH; // obsolete. Use PRINT_LENGTH instead ! LispValue PRINT_LENGTH, PRINT_LEVEL; // (mh) 24 March 2008 LispValue LOAD_VERBOSE; ! static long MAX_LIST_LENGTH_VALUE = 100000; ! static long PRINT_LENGTH_VALUE = 512; ! static long PRINT_LEVEL_VALUE = 15; // is this big enough? Emacs uses 4 and 512 for level and length boolean useGUI = true; // Whether or not to use GUI-based interaction. *************** *** 605,609 **** } - /** * Returns the value of *MAX-LIST-LENGTH*. --- 608,611 ---- *************** *** 635,638 **** --- 637,697 ---- } + /** + * Returns the value of *PRINT-LENGTH*. + * This value is only used to prevent runaway list processing. + */ + public LispInteger getPrintLength() + { + return (LispInteger)(PRINT_LENGTH.symbol_value()); + } + + + /** + * Sets the value of *PRINT-LENGTH*. + * This vlaue is only used to prevent runaway list processing. + */ + public void setPrintLength(long newLength) + { + PRINT_LENGTH.setf_symbol_value(new StandardLispInteger(this, newLength)); + } + + + /** + * Sets the value of *PRINT-LENGTH*. + * This vlaue is only used to prevent runaway list processing. + */ + public void setPrintLength(LispNumber newLength) + { + PRINT_LENGTH.setf_symbol_value(new StandardLispInteger(this, (long)(newLength.getDoubleValue()))); + } + + /** + * Returns the value of *PRINT-LENGTH*. + * This value is only used to prevent runaway list processing. + */ + public LispInteger getPrintLevel() + { + return (LispInteger)(PRINT_LEVEL.symbol_value()); + } + + /** + * Sets the value of *PRINT-LENGTH*. + * This vlaue is only used to prevent runaway list processing. + */ + public void setPrintLevel(long newLength) + { + PRINT_LEVEL.setf_symbol_value(new StandardLispInteger(this, newLength)); + } + + + /** + * Sets the value of *PRINT-LENGTH*. + * This vlaue is only used to prevent runaway list processing. + */ + public void setPrintLevel(LispNumber newLength) + { + PRINT_LEVEL.setf_symbol_value(new StandardLispInteger(this, (long)(newLength.getDoubleValue()))); + } + *************** *** 656,659 **** --- 715,719 ---- boolean illegalArg = false; boolean test = false; + String file = null; for (int i=0; i < args.length; i++) *************** *** 664,667 **** --- 724,729 ---- else if (args[i].equalsIgnoreCase("-test")) test = true; + else if (args[0].charAt(0) != '-') + file = args[0]; else { *************** *** 676,680 **** --- 738,757 ---- { runTest(); + } + + else if (file != null) + { + applet = new Jatha(false, false, false); + applet.init(); + //applet.MACHINE.real = true; ??? from Ola Bini + try { + applet.load(new FileReader(file), false); + } catch (FileNotFoundException ex) { + ex.printStackTrace(); + } catch (CompilerException ex) { + ex.printStackTrace(); + } } + else // start normally { *************** *** 682,685 **** --- 759,763 ---- applet = new Jatha(useDisplay, true, help); applet.init(); + //SECDMachine.DEBUG = true; applet.start(); } *************** *** 746,749 **** --- 824,831 ---- MAX_LIST_LENGTH = EVAL.intern("*MAX-LIST-LENGTH*",f_systemPackage); MAX_LIST_LENGTH.setf_symbol_value(new StandardLispInteger(this, MAX_LIST_LENGTH_VALUE)); + PRINT_LENGTH = EVAL.intern("*PRINT-LENGTH*",f_systemPackage); + PRINT_LENGTH.setf_symbol_value(new StandardLispInteger(this, PRINT_LENGTH_VALUE)); + PRINT_LEVEL = EVAL.intern("*PRINT-LEVEL*",f_systemPackage); + PRINT_LEVEL.setf_symbol_value(new StandardLispInteger(this, PRINT_LEVEL_VALUE)); f_systemPackage.export(STAR); *************** *** 751,754 **** --- 833,838 ---- f_systemPackage.export(STARSTARSTAR); f_systemPackage.export(MAX_LIST_LENGTH); + f_systemPackage.export(PRINT_LENGTH); + f_systemPackage.export(PRINT_LEVEL); // Defines global variables, etc. Should only be called once. |
From: Micheal H. <mh...@us...> - 2009-07-26 05:23:24
|
Update of /cvsroot/jatha/jatha/src/org/jatha/dynatype In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19191/org/jatha/dynatype Modified Files: LispArray.java LispValue.java StandardLispCons.java StandardLispValue.java Log Message: Several fixes from third parties Index: LispArray.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/LispArray.java,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** LispArray.java 2 Jul 2008 05:29:53 -0000 1.1 --- LispArray.java 26 Jul 2009 05:23:13 -0000 1.2 *************** *** 29,36 **** // date Mon Feb 24 22:40:45 1997 /** ! * Implements the Common LISP 'hashtable' type, including ! * all four types: eq, eql, equal, and equalp has tables. ! * The functions gethash, remhash, and setf-gethash are ! * used to perform operatios on hash tables. * * @see LispValue --- 29,33 ---- // date Mon Feb 24 22:40:45 1997 /** ! * Implements the Common LISP 'array' type. * * @see LispValue Index: StandardLispValue.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/StandardLispValue.java,v retrieving revision 1.30 retrieving revision 1.31 diff -C2 -d -r1.30 -r1.31 *** StandardLispValue.java 2 Jul 2008 05:29:53 -0000 1.30 --- StandardLispValue.java 26 Jul 2009 05:23:13 -0000 1.31 *************** *** 327,339 **** } /** * Counts cdrs so as not to have runaway lists. */ ! public String toStringAsCdr_internal(long index) { ! if (index > f_lisp.getMaxListLength().getLongValue()) { ! System.err.println("Printing list...longer than *MAX-LIST-LENGTH*. Truncated."); System.err.println("Next few items are: "); LispValue ptr = this; --- 327,366 ---- } + /** + * This printer is protected and won't print more + * than *PRINT-LENGTH* items or *PRINT-LEVEL* levels. + * @param length + * @param level + */ + public String toString_internal(long length, long level) + { + return this.toString(); + } + + /** + * *PRINT-LEVEL* is usually small enough to not have a stack overflow, + * so we use recursion here. Probably should be written like + * toStringAsCdr_internal, though. + */ + public String toStringAsCar_internal(long length, long level) + { + if (level > f_lisp.getPrintLevel().getLongValue()) + { + System.err.println("Printing list deeper than *PRINT-LEVEL*. Truncated."); + return "..."; + } + + // else + return toString_internal(length, level + 1); + } /** * Counts cdrs so as not to have runaway lists. */ ! public String toStringAsCdr_internal(long length, long level) { ! if (length > f_lisp.getPrintLength().getLongValue()) { ! System.err.println("Printing list...longer than *PRINT-LENGTH*. Truncated."); System.err.println("Next few items are: "); LispValue ptr = this; *************** *** 353,358 **** buf.append(" "); ! buf.append(this.car().toString()); ! buf.append(this.cdr().toStringAsCdr_internal(index+1)); return buf.toString(); } --- 380,385 ---- buf.append(" "); ! buf.append(this.car().toStringAsCar_internal(length, level+1)); ! buf.append(this.cdr().toStringAsCdr_internal(length+1, level)); return buf.toString(); } Index: StandardLispCons.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/StandardLispCons.java,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** StandardLispCons.java 2 Jul 2008 05:29:53 -0000 1.10 --- StandardLispCons.java 26 Jul 2009 05:23:13 -0000 1.11 *************** *** 154,163 **** public String toString() { ! StringBuffer buf = new StringBuffer(); buf.append("("); ! buf.append(carCell.toString()); ! buf.append(cdrCell.toStringAsCdr_internal((long)1)); buf.append(")"); --- 154,173 ---- public String toString() { ! return toString_internal(0, 0); ! } + /** + * This printer is protected and won't print more + * than *PRINT-LENGTH* items or *PRINT-LEVEL* levels. + * @param length + * @param level + */ + public String toString_internal(long length, long level) + { + StringBuffer buf = new StringBuffer(); buf.append("("); ! buf.append(carCell.toStringAsCar_internal(length, level+1)); ! buf.append(cdrCell.toStringAsCdr_internal(length+1, level)); buf.append(")"); *************** *** 165,185 **** } /** * Counts cdrs so as not to have runaway lists. */ ! public String toStringAsCdr_internal(long index) { LispValue ptr = this; StringBuffer buf = new StringBuffer(); ! long maxLength = f_lisp.getMaxListLength().getLongValue(); ! while (index <= maxLength) { if (ptr == f_lisp.NIL) return buf.toString(); buf.append(" "); ! buf.append(ptr.car().toString()); ! index++; ptr = ptr.cdr(); if (! (ptr instanceof LispCons)) --- 175,234 ---- } + /* + (defun print-nested-sequence (self stream depth) + (declare (ignore depth) (special *max-print-length* *cnesl-syntax*)) + (let ((data (nested-sequence-data self)) + (type (nested-sequence-type self))) + (cond ((eql type 'char) + (format stream "~s" (coerce data 'string))) + ((= (length data) 0) + (if *cnesl-syntax* + (format stream "[]" vcode-sequence-letter) + (format stream "#~a()" vcode-sequence-letter))) + ((<= (length data) *max-print-length*) + (if *cnesl-syntax* + (format stream "[~s~{,~s~}]" (car data) (cdr data)) + (format stream "#~a~s" vcode-sequence-letter data))) + (t + (let ((data (subseq data 0 *max-print-length*))) + (if *cnesl-syntax* + (format stream "[~s~{,~s~},...]" (car data) (cdr data)) + (format stream "#~a(~{~s ~}...)" vcode-sequence-letter))))))) + + */ + + /** + * *PRINT-LEVEL* is usually small enough to not have a stack overflow, + * so we use recursion here. Probably should be written like + * toStringAsCdr_internal, though. + */ + public String toStringAsCar_internal(long length, long level) + { + if (level > f_lisp.getPrintLevel().getLongValue()) + { + System.err.println("Printing list deeper than *PRINT-LEVEL*. Truncated."); + return "..."; + } + + // else + return toString_internal(length, level +1); + } /** * Counts cdrs so as not to have runaway lists. */ ! public String toStringAsCdr_internal(long length, long level) { LispValue ptr = this; StringBuffer buf = new StringBuffer(); ! long maxLength = f_lisp.getPrintLength().getLongValue(); ! while (length <= maxLength) { if (ptr == f_lisp.NIL) return buf.toString(); buf.append(" "); ! buf.append(ptr.car().toString_internal(length, level+1)); ! length++; ptr = ptr.cdr(); if (! (ptr instanceof LispCons)) *************** *** 190,194 **** } ! System.err.println("Printing list...longer than *MAX-LIST-LENGTH*. Truncated."); System.err.println("Next few items are: "); for (int i=0; i<10; ++i) --- 239,243 ---- } ! System.err.println("Printing list...longer than *PRINT-LENGTH*. Truncated."); System.err.println("Next few items are: "); for (int i=0; i<10; ++i) *************** *** 228,237 **** * But also works for single values. */ ! public Collection toCollection() { ! ArrayList result = new ArrayList(); for (Iterator iterator = this.iterator(); iterator.hasNext();) ! result.add(iterator.next()); return result; --- 277,286 ---- * But also works for single values. */ ! public Collection<LispValue> toCollection() { ! List<LispValue> result = new ArrayList<LispValue>(this.basic_length()); for (Iterator iterator = this.iterator(); iterator.hasNext();) ! result.add((LispValue)iterator.next()); return result; Index: LispValue.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/LispValue.java,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** LispValue.java 2 Jul 2008 05:29:53 -0000 1.28 --- LispValue.java 26 Jul 2009 05:23:13 -0000 1.29 *************** *** 231,238 **** /** * Counts cdrs so as not to have runaway lists. */ ! public String toStringAsCdr_internal(long index); --- 231,247 ---- + public String toString_internal(long length, long level); + + /** + * Counts cars so as not to have runaway lists. + * Max depth is determined by *PRINT-LEVEL*. + */ + public String toStringAsCar_internal(long length, long level); + /** * Counts cdrs so as not to have runaway lists. + * Max length is determined by *PRINT-LENGTH*. */ ! public String toStringAsCdr_internal(long length, long level); |
From: Micheal H. <mh...@us...> - 2009-07-26 05:23:23
|
Update of /cvsroot/jatha/jatha/src/org/jatha/test/junit In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19191/org/jatha/test/junit Modified Files: CoreTest.java Log Message: Several fixes from third parties Index: CoreTest.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/test/junit/CoreTest.java,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** CoreTest.java 12 May 2005 18:47:13 -0000 1.13 --- CoreTest.java 26 Jul 2009 05:23:13 -0000 1.14 *************** *** 304,307 **** --- 304,308 ---- } + @SuppressWarnings("unused") public void testBasicLength() { *************** *** 421,425 **** } - parser = new LispParser(f_lisp, "(aaa 42)"); try { --- 422,425 ---- *************** *** 1622,1624 **** } ! } --- 1622,1637 ---- } ! // SK: 25 Jul 2009 ! public void testIntegerParse() ! { ! LispParser parser = new LispParser(f_lisp, "+1"); ! try ! { ! LispValue val = parser.parse(); ! assertTrue(val.basic_integerp() && val.toString().equalsIgnoreCase("1")); ! } catch (Exception e2) { ! fail("Incorrectly converted +1: " + e2.getMessage()); ! } ! } ! ! } \ No newline at end of file |
From: Micheal H. <mh...@us...> - 2009-07-26 05:23:21
|
Update of /cvsroot/jatha/jatha/src/org/jatha/machine In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19191/org/jatha/machine Modified Files: SECDMachine.java SECDRegister.java opLDF.java opTAG_E.java Log Message: Several fixes from third parties Index: SECDRegister.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/machine/SECDRegister.java,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** SECDRegister.java 4 May 2005 23:42:21 -0000 1.5 --- SECDRegister.java 26 Jul 2009 05:23:13 -0000 1.6 *************** *** 35,38 **** --- 35,42 ---- * which resets the value, and a <tt>value()</tt> * method which retrieves the whole stack. + * + * Due to the problems with LispValue.pop(), this + * is not the stack itself, but contains a Symbol + * whose value is the stack. * * @author Micheal S. Hewett he...@cs... *************** *** 40,52 **** public class SECDRegister extends StandardLispSymbol { public SECDRegister(Jatha lisp, String name) { super(lisp, name); assign(lisp.NIL); } ! // POP and PUSH are defined by LispSymbol /** --- 44,67 ---- public class SECDRegister extends StandardLispSymbol { + protected LispValue f_registerSymbol = null; + public SECDRegister(Jatha lisp, String name) { super(lisp, name); + long rand = (long)(Math.rint(Math.random() * 1000.0)); + f_registerSymbol = new StandardLispSymbol(lisp, "*REGISTER-" + rand + "*"); assign(lisp.NIL); } + public LispValue pop() + { + return f_registerSymbol.pop(); + } ! public LispValue push(LispValue val) ! { ! return f_registerSymbol.push(val); ! } /** *************** *** 57,61 **** public void assign(LispValue newValue) { ! setf_symbol_value(newValue); } --- 72,76 ---- public void assign(LispValue newValue) { ! f_registerSymbol.setq(newValue); } *************** *** 67,71 **** public LispValue value() { ! return symbol_value(); } --- 82,86 ---- public LispValue value() { ! return f_registerSymbol.symbol_value(); } Index: opTAG_E.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/machine/opTAG_E.java,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** opTAG_E.java 25 Jul 2008 00:02:58 -0000 1.3 --- opTAG_E.java 26 Jul 2009 05:23:13 -0000 1.4 *************** *** 32,53 **** * TAGBODY end. * Pops itself from the C register. - * Pops the X register. * * @author <a href="mailto:Ola...@it...">Ola Bini</a> * @version $Revision$ */ ! class opTAG_E extends SECDop { ! /** ! * It calls <tt>SECDop()</tt> with the machine argument ! * and the label of this instruction. ! * @see SECDMachine ! */ ! public opTAG_E(final Jatha lisp) { ! super(lisp, "TAG_E"); ! } ! public void Execute(final SECDMachine machine) { ! machine.C.pop(); ! machine.X.pop(); ! } } --- 32,52 ---- * TAGBODY end. * Pops itself from the C register. * * @author <a href="mailto:Ola...@it...">Ola Bini</a> * @version $Revision$ */ ! class opTAG_E extends SECDop ! { ! /** ! * It calls <tt>SECDop()</tt> with the machine argument ! * and the label of this instruction. ! * @see SECDMachine ! */ ! public opTAG_E(final Jatha lisp) { ! super(lisp, "TAG_E"); ! } ! public void Execute(final SECDMachine machine) { ! machine.C.pop(); ! } } Index: SECDMachine.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/machine/SECDMachine.java,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** SECDMachine.java 13 Dec 2005 17:06:57 -0000 1.10 --- SECDMachine.java 26 Jul 2009 05:23:13 -0000 1.11 *************** *** 51,55 **** Jatha f_lisp = null; ! private static boolean DEBUG = false; // ------ Registers -------------- --- 51,55 ---- Jatha f_lisp = null; ! public static boolean DEBUG = false; // ------ Registers -------------- *************** *** 73,77 **** public SECDop AP = null; ! public SECDop BLK = null; //OB: new opcode June 2005 public SECDop DAP = null; public SECDop DUM = null; --- 73,77 ---- public SECDop AP = null; ! public SECDop BLK = null; //OB: new opcode June 2005 public SECDop DAP = null; public SECDop DUM = null; *************** *** 230,233 **** --- 230,235 ---- System.out.print("\n C: " + C.value()); System.out.print("\n D: " + D.value()); + System.out.print("\n B: " + B.toString()); + System.out.print("\n X: " + X.value()); // System.out.print(" of class " + opcode.getClass().getName()); System.out.print("\n" + opcode); // Testing *************** *** 235,240 **** } ! if (opcode != null) ((LispPrimitive)opcode).Execute(this); else { --- 237,243 ---- } ! if (opcode != null) { ((LispPrimitive)opcode).Execute(this); + } else { *************** *** 251,254 **** --- 254,259 ---- System.err.print("\n C: " + C.value()); System.err.print("\n D: " + D.value()); + System.out.print("\n B: " + B.toString()); + System.out.print("\n X: " + X.value()); // System.out.print(" of class " + opcode.getClass().getName()); System.err.print("\n" + opcode); // Testing Index: opLDF.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/machine/opLDF.java,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** opLDF.java 22 Mar 2007 02:12:51 -0000 1.6 --- opLDF.java 26 Jul 2009 05:23:13 -0000 1.7 *************** *** 34,38 **** * opLDF prepares to execute a non-recursive function. * It makes a closure and pushes it on the S register. ! * Uses S register (2 values). * Modifes C, D, E, and S registers. * @see SECDMachine --- 34,39 ---- * opLDF prepares to execute a non-recursive function. * It makes a closure and pushes it on the S register. ! * Uses C register (2 values). ! * Closure is cons(C.pop(), E.value()). * Modifes C, D, E, and S registers. * @see SECDMachine |
From: Micheal H. <mh...@us...> - 2009-07-26 05:23:20
|
Update of /cvsroot/jatha/jatha/src/org/jatha/read In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19191/org/jatha/read Modified Files: LispParser.java Log Message: Several fixes from third parties Index: LispParser.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/read/LispParser.java,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** LispParser.java 2 Jul 2008 05:29:53 -0000 1.13 --- LispParser.java 26 Jul 2009 05:23:13 -0000 1.14 *************** *** 399,403 **** newCell = f_lisp.NIL; ! LispValue newListLast = null; while (true) --- 399,403 ---- newCell = f_lisp.NIL; ! LispValue newListLast = f_lisp.NIL; while (true) *************** *** 471,476 **** else { ! newCell = f_lisp.makeCons(f_lisp.NIL, f_lisp.NIL); /* (NIL . NIL) */ ! newCell.rplaca(newToken); newListLast.rplacd(newCell); --- 471,475 ---- else { ! newCell = f_lisp.makeCons(newToken, f_lisp.NIL); /* (NIL . NIL) */ newListLast.rplacd(newCell); *************** *** 815,821 **** // Let Java tell us by generating a NumberFormatException // when the number is too big (or too negatively big). ! try { newCell = f_lisp.makeInteger(new Long(token)); } ! catch (NumberFormatException e) ! { newCell = f_lisp.makeBignum(new BigInteger(token)); } } else if (REAL_token_p(token)) --- 814,828 ---- // Let Java tell us by generating a NumberFormatException // when the number is too big (or too negatively big). ! ! // SK: java cannot parse integer with '+' in front of it? 25 Jul 2009 ! if( token.charAt(0) == '+' ){ ! token = token.substring(1); ! } ! ! try { ! newCell = f_lisp.makeInteger(new Long(token)); ! } catch (NumberFormatException e) { ! newCell = f_lisp.makeBignum(new BigInteger(token)); ! } } else if (REAL_token_p(token)) *************** *** 826,830 **** { newCell = f_lisp.makeString(token.substring(1, token.length() - 1)); } catch (StringIndexOutOfBoundsException e) ! { System.err.println("Hey, got a bad string index in 'tokenToLispValue'!"); }; } --- 833,837 ---- { newCell = f_lisp.makeString(token.substring(1, token.length() - 1)); } catch (StringIndexOutOfBoundsException e) ! { System.err.println("Hey, got a bad string index in 'tokenToLispValue'!"); } } *************** *** 867,871 **** else if (token.startsWith(":")) { ! external = true; token = token.substring(1, token.length()); } --- 874,879 ---- else if (token.startsWith(":")) { ! if (pkg != null) ! external = true; token = token.substring(1, token.length()); } *************** *** 873,877 **** // Handle external symbols separately, except for keywords ! if (external && !(packageStr.equals(""))) { newCell = ((LispPackage)pkg).getExternalSymbol(f_lisp.makeString(token)); --- 881,885 ---- // Handle external symbols separately, except for keywords ! if (external && (pkg != null) && (! packageStr.equals(""))) { newCell = ((LispPackage)pkg).getExternalSymbol(f_lisp.makeString(token)); *************** *** 885,890 **** else if (pkg == keywordPackage) newCell = f_lisp.EVAL.intern(token.toUpperCase(), (LispPackage)pkg); ! else newCell = f_lisp.EVAL.intern(token, (LispPackage) pkg); } else --- 893,900 ---- else if (pkg == keywordPackage) newCell = f_lisp.EVAL.intern(token.toUpperCase(), (LispPackage)pkg); ! else if (pkg != null) newCell = f_lisp.EVAL.intern(token, (LispPackage) pkg); + else + newCell= f_lisp.makeSymbol(token); } else *************** *** 892,896 **** System.err.println("ERROR: Unrecognized input: \"" + token + "\""); newCell = f_lisp.NIL; ! }; if (newCell == null) --- 902,906 ---- System.err.println("ERROR: Unrecognized input: \"" + token + "\""); newCell = f_lisp.NIL; ! } if (newCell == null) *************** *** 899,903 **** + token + "\", returning NIL."); newCell = f_lisp.NIL; ! }; return(newCell); --- 909,913 ---- + token + "\", returning NIL."); newCell = f_lisp.NIL; ! } return(newCell); *************** *** 906,924 **** // ---- Utility functions ---------------------------------- ! static boolean isLparen(char x) { return (x == LEFT_PAREN); }; ! static boolean isRparen(char x) { return (x == RIGHT_PAREN); }; ! static boolean isAtSign(char x) { return (x == AT_SIGN); }; ! static boolean isBackQuote(char x) { return (x == BACK_QUOTE); }; ! static boolean isBackSlash(char x) { return (x == BACKSLASH); }; ! static boolean isColon(char x) { return (x == COLON); }; ! static boolean isComma(char x) { return (x == COMMA); }; ! static boolean isDoubleQuote(char x) { return (x == DOUBLE_QUOTE); }; ! static boolean isOrBar(char x) { return (x == OR_BAR); }; ! static boolean isPound(char x) { return (x == POUND); }; ! static boolean isPeriod(char x) { return (x == PERIOD); }; ! static boolean isQuote(char x) { return (x == SINGLE_QUOTE); }; ! static boolean isSemi(char x) { return (x == SEMICOLON); }; ! static boolean isLeftAngleBracket(char x) { return (x == LEFT_ANGLE_BRACKET); }; ! static boolean isRightAngleBracket(char x) { return (x == RIGHT_ANGLE_BRACKET);}; static boolean isSpace(char x) --- 916,934 ---- // ---- Utility functions ---------------------------------- ! static boolean isLparen(char x) { return (x == LEFT_PAREN); } ! static boolean isRparen(char x) { return (x == RIGHT_PAREN); } ! static boolean isAtSign(char x) { return (x == AT_SIGN); } ! static boolean isBackQuote(char x) { return (x == BACK_QUOTE); } ! static boolean isBackSlash(char x) { return (x == BACKSLASH); } ! static boolean isColon(char x) { return (x == COLON); } ! static boolean isComma(char x) { return (x == COMMA); } ! static boolean isDoubleQuote(char x) { return (x == DOUBLE_QUOTE); } ! static boolean isOrBar(char x) { return (x == OR_BAR); } ! static boolean isPound(char x) { return (x == POUND); } ! static boolean isPeriod(char x) { return (x == PERIOD); } ! static boolean isQuote(char x) { return (x == SINGLE_QUOTE); } ! static boolean isSemi(char x) { return (x == SEMICOLON); } ! static boolean isLeftAngleBracket(char x) { return (x == LEFT_ANGLE_BRACKET); } ! static boolean isRightAngleBracket(char x) { return (x == RIGHT_ANGLE_BRACKET); } static boolean isSpace(char x) *************** *** 981,989 **** } catch (StringIndexOutOfBoundsException e) { ! System.err.println("Hey, got a bad string index in 'firstCharNotInSet'!"); }; // System.out.println("...returning " + searchIndex); return searchIndex + 1; ! }; --- 991,1000 ---- } catch (StringIndexOutOfBoundsException e) { ! System.err.println("Hey, got a bad string index in 'firstCharNotInSet'!"); ! } // System.out.println("...returning " + searchIndex); return searchIndex + 1; ! } *************** *** 1027,1031 **** return(firstCharNotInSet(index, str, INTchars) == length); ! }; --- 1038,1042 ---- return(firstCharNotInSet(index, str, INTchars) == length); ! } *************** *** 1045,1049 **** } catch (StringIndexOutOfBoundsException e) { ! System.err.println("Hey, got a bad string index in 'INTEGER_token_p'! on string '" + str + "'"); }; if (index == length) // Don't accept a single '-' or '+' --- 1056,1061 ---- } catch (StringIndexOutOfBoundsException e) { ! System.err.println("Hey, got a bad string index in 'INTEGER_token_p'! on string '" + str + "'"); ! } if (index == length) // Don't accept a single '-' or '+' *************** *** 1053,1057 **** } ! boolean NIL_token_p(String str) { return(str.equalsIgnoreCase("NIL")); }; boolean STRING_token_p(String str) --- 1065,1069 ---- } ! boolean NIL_token_p(String str) { return(str.equalsIgnoreCase("NIL")); } boolean STRING_token_p(String str) *************** *** 1068,1072 **** } catch (StringIndexOutOfBoundsException e) { ! System.err.println("Hey, got a bad string index in 'NIL_token_p'!"); }; return value; --- 1080,1084 ---- } catch (StringIndexOutOfBoundsException e) { ! System.err.println("Hey, got a bad string index in 'NIL_token_p'!"); } return value; *************** *** 1074,1081 **** ! boolean SYMBOL_token_p(String str) { return(str.length() >= 1); }; ! boolean T_token_p(String str) { return(str.equalsIgnoreCase("T")); }; --- 1086,1093 ---- ! boolean SYMBOL_token_p(String str) { return(str.length() >= 1); } ! boolean T_token_p(String str) { return(str.equalsIgnoreCase("T")); } |
From: Micheal H. <mh...@us...> - 2009-07-26 05:22:53
|
Update of /cvsroot/jatha/jatha/src In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19131 Modified Files: ChangeLog.txt Log Message: Updated ChangeLog for v2.9 Index: ChangeLog.txt =================================================================== RCS file: /cvsroot/jatha/jatha/src/ChangeLog.txt,v retrieving revision 1.41 retrieving revision 1.42 diff -C2 -d -r1.41 -r1.42 *** ChangeLog.txt 11 Mar 2008 23:53:03 -0000 1.41 --- ChangeLog.txt 26 Jul 2009 05:22:37 -0000 1.42 *************** *** 1,10 **** ! Jatha 2.9.0 (released ?? ?? 2008) (tm) Added new function EXPT. (tm) Improved support for parsing large quoted lists. (mh) Simplified internal representation of lambda lists (from Kensuke Matsuzaki) ! (mh) Some code changes to convert Lists to Lists with Generic Types for Java 1.5 ! (mh) Fixed grindef, which was not working since ??? Jatha 2.8.0 (released 25 Apr 2007) --- 1,17 ---- ! Jatha 2.9.0 (released ?? ?? 2009) (tm) Added new function EXPT. (tm) Improved support for parsing large quoted lists. (mh) Simplified internal representation of lambda lists (from Kensuke Matsuzaki) ! (mh) Some code changes to convert List types to List<> with Generics for Java 1.5. ! (mh) Fixed grindef, which was not working for a long time. ! (mh) Fixed minor problem in parsing a list from a string to correctly handle uninterned symbols. ! (mh) Changed SECDRegister to indirect through a LispSymbol to get around problems with pop(). ! (mh) Fixed problem in compiling dotimes, where GO tags were being duplicated during compilation, resulting in extra code generated (from Ola Bini). ! (tm) Added a preliminary implementation of LispArray (from Tim McComb). ! (sk) Fixed a problem with parsing integers with a leading "+" (from Sergey Kolos). ! (ob) New SETF macro (from Ola Bini). ! Jatha 2.8.0 (released 25 Apr 2007) |
From: Micheal H. <mh...@us...> - 2009-07-26 05:21:35
|
Update of /cvsroot/jatha/jatha/src/init In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19015 Modified Files: 03.lisp Log Message: setf macro from Ola Bini Index: 03.lisp =================================================================== RCS file: /cvsroot/jatha/jatha/src/init/03.lisp,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** 03.lisp 30 Jun 2005 03:30:31 -0000 1.8 --- 03.lisp 26 Jul 2009 05:21:23 -0000 1.9 *************** *** 150,152 **** (princ #\Newline)) ! (export '(caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr unless when let* in-package eval-when return loop dotimes dolist terpri)) \ No newline at end of file --- 150,169 ---- (princ #\Newline)) ! (defmacro setf (place value) ! (if (listp place) ! `(,(let ((name (car place))) ! (cond ! ((eq name 'aref) 'setf-aref) ! ((eq name 'car) 'setf-car) ! ((eq name 'cdr) 'setf-cdr) ! ((eq name 'documentation) 'setf-documentation) ! ((eq name 'gethash) 'setf-gethash) ! ((eq name 'symbol-function) 'setf-symbol-function) ! ((eq name 'symbol-plist) 'setf-symbol-plist) ! ((eq name 'symbol-value) 'setf-symbol-value))) ! ,@(cdr place) ! ,value) ! `(set ',place ,value))) ! ! (export '(caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr unless when let* in-package eval-when return loop dotimes dolist terpri setf)) ! |
From: Micheal H. <mh...@us...> - 2008-07-25 00:03:01
|
Update of /cvsroot/jatha/jatha/src/org/jatha/machine In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv10260/src/org/jatha/machine Modified Files: opTAG_E.java Log Message: Added comments. Index: opTAG_E.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/machine/opTAG_E.java,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** opTAG_E.java 22 Mar 2007 02:12:51 -0000 1.2 --- opTAG_E.java 25 Jul 2008 00:02:58 -0000 1.3 *************** *** 30,34 **** /** ! * * @author <a href="mailto:Ola...@it...">Ola Bini</a> * @version $Revision$ --- 30,37 ---- /** ! * TAGBODY end. ! * Pops itself from the C register. ! * Pops the X register. ! * * @author <a href="mailto:Ola...@it...">Ola Bini</a> * @version $Revision$ |
From: Micheal H. <mh...@us...> - 2008-07-25 00:02:47
|
Update of /cvsroot/jatha/jatha/src/org/jatha/machine In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv10243/src/org/jatha/machine Modified Files: opTAG_B.java Log Message: Added comments. Index: opTAG_B.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/machine/opTAG_B.java,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** opTAG_B.java 30 Jun 2005 00:24:22 -0000 1.1 --- opTAG_B.java 25 Jul 2008 00:02:43 -0000 1.2 *************** *** 31,35 **** /** ! * * @author <a href="mailto:Ola...@it...">Ola Bini</a> * @version $Revision$ --- 31,38 ---- /** ! * Helps to implement TAGBODY. ! * Pops itself from the C register. ! * Pushes onto to the X register the value: (E D new HashTable(B)) ! * * @author <a href="mailto:Ola...@it...">Ola Bini</a> * @version $Revision$ |
From: Micheal H. <mh...@us...> - 2008-07-25 00:02:18
|
Update of /cvsroot/jatha/jatha/src/org/jatha/machine In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv10173/src/org/jatha/machine Modified Files: opBLK.java Log Message: Fixed grammar on comments. Index: opBLK.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/machine/opBLK.java,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** opBLK.java 1 Jun 2005 13:08:03 -0000 1.1 --- opBLK.java 25 Jul 2008 00:02:09 -0000 1.2 *************** *** 31,36 **** /** ! * <p>The BLK-operation is a marker, which pops itself and it's argument from the C register. It's purpose is to be a marker for the ! * non-local exit special forms. It's used to implement the <i>block</i> special form.</p> * * @author <a href="mailto:Ola...@it...">Ola Bini</a> --- 31,38 ---- /** ! * <p>The BLK-operation is a marker, which pops itself and its argument from the C register. ! * Its purpose is to be a marker for the ! * non-local exit special forms. ! * It is used to implement the <i>block</i> special form.</p> * * @author <a href="mailto:Ola...@it...">Ola Bini</a> |
From: Micheal H. <mh...@us...> - 2008-07-24 23:59:08
|
Update of /cvsroot/jatha/jatha/src/org/jatha In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv8384/src/org/jatha Modified Files: Jatha.java Log Message: Updated to latest version. Added test code and command line options. Index: Jatha.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/Jatha.java,v retrieving revision 1.51 retrieving revision 1.52 diff -C2 -d -r1.51 -r1.52 *** Jatha.java 2 Jul 2008 05:29:53 -0000 1.51 --- Jatha.java 24 Jul 2008 23:59:02 -0000 1.52 *************** *** 641,645 **** * and enables the Console I/O stream. The user can optionally * specify -nodisplay to use the console for input. ! * * @param args */ --- 641,649 ---- * and enables the Console I/O stream. The user can optionally * specify -nodisplay to use the console for input. ! * <ul> ! * <li>-nodisplay Don't start the GUI. Use command line only.</li> ! * <li>-test Run a test routine.</li> ! * <li>-help Display help</li> ! * </ul> * @param args */ *************** *** 651,654 **** --- 655,659 ---- boolean help = false; boolean illegalArg = false; + boolean test = false; for (int i=0; i < args.length; i++) *************** *** 657,660 **** --- 662,667 ---- else if (args[i].equalsIgnoreCase("-help")) help = true; + else if (args[i].equalsIgnoreCase("-test")) + test = true; else { *************** *** 666,674 **** System.exit(1); ! ! // Okay to proceed. Make a text window if we are to use a GUI. ! applet = new Jatha(useDisplay, true, help); ! applet.init(); ! applet.start(); } --- 673,701 ---- System.exit(1); ! if (test) ! { ! runTest(); ! } ! else // start normally ! { ! // Okay to proceed. Make a text window if we are to use a GUI. ! applet = new Jatha(useDisplay, true, help); ! applet.init(); ! applet.start(); ! } ! } ! ! /** ! * This can be used to run a test routine. ! * ! */ ! protected static void runTest() ! { ! Jatha lisp = new Jatha(false, true, false); ! lisp.init(); ! LispValue result = lisp.eval("(defun loop-test () (setq sum 0) (dotimes (i 3) (dotimes (j 3) (setq sum (+ sum 1)))))"); ! System.out.println("Result = " + result); ! result = lisp.eval("(grindef 'loop-test)"); ! System.out.println("Result = " + result); } |
Update of /cvsroot/jatha/jatha/src/org/jatha/dynatype In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv15981/dynatype Modified Files: LispValue.java StandardLispCons.java StandardLispValue.java Added Files: StandardLispArray.java LispArray.java LispValueNotAnArrayException.java Log Message: Added preliminary support for arrays. Index: StandardLispValue.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/StandardLispValue.java,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 *** StandardLispValue.java 11 Mar 2008 23:53:03 -0000 1.29 --- StandardLispValue.java 2 Jul 2008 05:29:53 -0000 1.30 *************** *** 404,407 **** --- 404,421 ---- } + public LispValue aref(LispValue args) + { + throw new LispValueNotAnArrayException("The first argument to AREF"); + } + public LispValue setf_aref(LispValue location, LispValue value) + { + throw new LispValueNotAnArrayException("The first argument to SETF-AREF"); + } + public LispValue arrayDimensions() + { + throw new LispValueNotAnArrayException("The first argument to ARRAY-DIMENSIONS"); + } + public LispValue arrayp () { return f_lisp.NIL; } + /** * Arcsin function, argument in radians. *************** *** 457,463 **** --- 471,483 ---- { throw new LispValueNotAConsException("The argument to CAR"); } + public LispValue setf_car (LispValue newCar) + { throw new LispValueNotAConsException("The argument to SETF-CAR"); } + public LispValue cdr () { throw new LispValueNotAConsException("The argument to CDR"); } + public LispValue setf_cdr (LispValue newCdr) + { throw new LispValueNotAConsException("The argument to SETF-CDR"); } + public LispValue ceiling () { throw new LispValueNotANumberException("The first argument to CEILING"); } Index: LispValue.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/LispValue.java,v retrieving revision 1.27 retrieving revision 1.28 diff -C2 -d -r1.27 -r1.28 *** LispValue.java 11 Mar 2008 23:53:03 -0000 1.27 --- LispValue.java 2 Jul 2008 05:29:53 -0000 1.28 *************** *** 273,276 **** --- 273,297 ---- /** + * Lookup a value in an array. + * @param args + */ + public LispValue aref(LispValue args); + + /** + * Sets a value in an array. + */ + public LispValue setf_aref(LispValue location, LispValue value); + + /** + * Returns a list of the dimension sizes an array. + */ + public LispValue arrayDimensions(); + + /** + * Returns T if the object is an array. + */ + public LispValue arrayp(); + + /** * Look up a value in an association list. * @param index *************** *** 306,309 **** --- 327,335 ---- /** + * Sets the first element of a list. + */ + public LispValue setf_car(LispValue newCar); + + /** * Returns all but the first element of a list. * CDR of NIL is NIL. *************** *** 312,315 **** --- 338,346 ---- /** + * Sets the tail of a list. + */ + public LispValue setf_cdr(LispValue newCdr); + + /** * Returns T if the object is a Character. */ *************** *** 455,459 **** /** ! * Returns T if the object is a floating-point number. */ public LispValue hashtablep(); --- 486,490 ---- /** ! * Returns T if the object is a hashtable. */ public LispValue hashtablep(); --- NEW FILE: StandardLispArray.java --- package org.jatha.dynatype; import java.io.*; import java.util.*; import org.jatha.Jatha; public class StandardLispArray extends StandardLispValue implements LispArray { protected LispValue[] theArray; protected ArrayList<Integer> dimensions; protected ArrayList<Integer> multipliers; protected int totalSize; protected LispValue defaultValue; public StandardLispArray(Jatha lisp, LispValue dimensionsArg) throws LispException { super(lisp); f_lisp = lisp; dimensions = new ArrayList<Integer>(); defaultValue = lisp.NIL; Collection collection = dimensionsArg.toCollection(); totalSize = 1; for (Object obj : collection) { if (((LispValue) obj).basic_integerp()) { long objLongValue = ((LispNumber) obj).getLongValue(); if (objLongValue > Integer.MAX_VALUE) { throw new LispIndexOutOfRangeException(String.format("%d", objLongValue)); } dimensions.add((int) objLongValue); long proposedSize = totalSize * objLongValue; if (proposedSize > Integer.MAX_VALUE) { throw new LispIndexOutOfRangeException(String.format("%d", proposedSize)); } totalSize = (int) proposedSize; } else { throw new LispValueNotAnIntegerException(obj.toString()); } } theArray = new LispValue[totalSize]; multipliers = new ArrayList<Integer>(dimensions.size()); for (int i = 0; i < dimensions.size(); i++) { int multiplier = 1; for (int j = i + 1; j < dimensions.size(); j++) { multiplier *= dimensions.get(j); } multipliers.add(i, multiplier); } } public StandardLispArray(Jatha lisp, LispValue dimensionsArg, List<LispValue> data) throws LispException { this(lisp, dimensionsArg); int idx = 0; for (LispValue val : data) { theArray[idx++] = val; } } @Override public void internal_princ(PrintStream os) { os.print(toString()); } @Override public void internal_prin1(PrintStream os) { os.print(toString()); } @Override public void internal_print(PrintStream os) { os.print(toString()); } @Override public Object toJava() { return toCollection(); } @Override public LispValue arrayp() { return f_lisp.T; } public LispValue arrayDimensions() { LispValue rest = f_lisp.NIL; for (int i = dimensions.size() - 1; i >= 0; i--) { rest = f_lisp.makeCons(f_lisp.makeInteger(dimensions.get(i)), rest); } return rest; } public void assign(final StandardLispArray value) { this.theArray = new LispValue[value.theArray.length]; System.arraycopy(value.theArray, 0, this.theArray, 0, value.theArray.length); this.dimensions = (ArrayList<Integer>) (value.dimensions.clone()); this.multipliers = (ArrayList<Integer>) (value.multipliers.clone()); this.totalSize = value.totalSize; this.defaultValue = value.defaultValue; } @Override public Collection toCollection() { return toCollectionSubarray(0, 0); } private Collection toCollectionSubarray(int offset, int depth) { Collection collection = new ArrayList(); int multiplier = multipliers.get(depth); if (depth < dimensions.size() - 1) { for (int i = 0; i < dimensions.get(depth); i++) { collection.add(toCollectionSubarray(offset + i * multiplier, depth + 1)); } } else { for (int i = 0; i < dimensions.get(depth); i++) { collection.add(lookup(offset + i * multiplier)); } } return collection; } @Override public LispValue type_of() { return f_lisp.ARRAY_TYPE; } @Override public LispValue typep(LispValue type) { LispValue result = super.typep(type); if ((result == f_lisp.T) || (type == f_lisp.ARRAY_TYPE)) { return f_lisp.T; } else { return f_lisp.NIL; } } @Override public String toString() { StringBuffer buffer = new StringBuffer(String.format("#%dA(", dimensions.size())); toStringSubarray(buffer, 0, 0); buffer.append(')'); return buffer.toString(); } private void toStringSubarray(StringBuffer buffer, int offset, int depth) { int multiplier = multipliers.get(depth); if (depth < dimensions.size() - 1) { for (int i = 0; i < dimensions.get(depth); i++) { buffer.append('('); toStringSubarray(buffer, offset + i * multiplier, depth + 1); buffer.append(')'); } } else { for (int i = 0; i < dimensions.get(depth); i++) { if (i > 0) { buffer.append(' '); } buffer.append(lookup(offset + i * multiplier).toString()); } } } private LispValue lookup(int idx) { if (idx >= theArray.length) { return defaultValue; } return theArray[idx] == null ? defaultValue : theArray[idx]; } private int indexFromLocation(LispValue location) throws LispException { long index = 0; for (int i = 0; i < multipliers.size(); i++) { LispValue val = location.car(); if (val.basic_integerp()) { long longValue = ((LispNumber) val).getLongValue(); if (longValue >= dimensions.get(i)) { throw new LispIndexOutOfRangeException(String.format("%d", longValue)); } index += (int) longValue * multipliers.get(i); } else { throw new LispValueNotAnIntegerException(val.toString()); } location = location.cdr(); } return (int) index; } @Override public LispValue setf_aref(LispValue location, LispValue value) throws LispException { int index = indexFromLocation(location); theArray[index] = value; return value; } @Override public LispValue aref(LispValue args) throws LispException { // Either the arguments are given as a list in the first argument, or // are given as the rest of the arguments. int index = args.car().basic_listp() ? indexFromLocation(args.car()) : indexFromLocation(args); return lookup(index); } } --- NEW FILE: LispValueNotAnArrayException.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.dynatype; public class LispValueNotAnArrayException extends LispException { LispValueNotAnArrayException() { super(); } LispValueNotAnArrayException(String s) { super(s + " is not an ARRAY."); } } --- NEW FILE: LispArray.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.dynatype; // date Mon Feb 24 22:40:45 1997 /** * Implements the Common LISP 'hashtable' type, including * all four types: eq, eql, equal, and equalp has tables. * The functions gethash, remhash, and setf-gethash are * used to perform operatios on hash tables. * * @see LispValue * @author Micheal S. Hewett he...@cs... * @version 1.0 * */ public interface LispArray extends LispValue { } Index: StandardLispCons.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/StandardLispCons.java,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** StandardLispCons.java 9 Mar 2008 08:41:09 -0000 1.9 --- StandardLispCons.java 2 Jul 2008 05:29:53 -0000 1.10 *************** *** 230,234 **** public Collection toCollection() { ! ArrayList result = new ArrayList(this.basic_length()); for (Iterator iterator = this.iterator(); iterator.hasNext();) --- 230,234 ---- public Collection toCollection() { ! ArrayList result = new ArrayList(); for (Iterator iterator = this.iterator(); iterator.hasNext();) *************** *** 278,282 **** --- 278,295 ---- public LispValue car() { return carCell; } + + public LispValue setf_car(LispValue newCar) + { + carCell = newCar; + return carCell; + } + public LispValue cdr() { return cdrCell; } + + public LispValue setf_cdr(LispValue newCdr) + { + cdrCell = newCdr; + return cdrCell; + } public LispValue consp () { return f_lisp.T; } |
From: Timothy M. <tm...@us...> - 2008-07-02 05:30:00
|
Update of /cvsroot/jatha/jatha/src/org/jatha/compile In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv15981/compile Modified Files: LispCompiler.java Added Files: SetfCdrPrimitive.java ArefPrimitive.java MakeArrayPrimitive.java ArrayDimensionsPrimitive.java ArraypPrimitive.java SetfCarPrimitive.java SetfArefPrimitive.java Log Message: Added preliminary support for arrays. --- NEW FILE: ArefPrimitive.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.compile; import org.jatha.Jatha; import org.jatha.dynatype.LispValue; import org.jatha.machine.*; public class ArefPrimitive extends LispPrimitive { public ArefPrimitive(Jatha lisp) { super(lisp, "AREF", 2, Long.MAX_VALUE); } public void Execute(SECDMachine machine) { LispValue args = machine.S.pop(); machine.S.push(args.car().aref(args.cdr())); machine.C.pop(); } // Unlimited number of evaluated args. public LispValue CompileArgs(LispCompiler compiler, SECDMachine machine, LispValue args, LispValue valueList, LispValue code) throws CompilerException { return compiler.compileArgsLeftToRight(args, valueList, f_lisp.makeCons(machine.LIS, f_lisp.makeCons(args.length(), code))); } } --- NEW FILE: SetfCarPrimitive.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.compile; import org.jatha.Jatha; import org.jatha.dynatype.*; import org.jatha.machine.*; public class SetfCarPrimitive extends LispPrimitive { public SetfCarPrimitive(Jatha lisp) { super(lisp, "SETF-CAR", 2); } public void Execute(SECDMachine machine) { LispValue arg2 = machine.S.pop(); LispValue arg1 = machine.S.pop(); machine.S.push(arg1.setf_car(arg2)); machine.C.pop(); } } --- NEW FILE: MakeArrayPrimitive.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.compile; import org.jatha.Jatha; import org.jatha.dynatype.*; import org.jatha.machine.*; public class MakeArrayPrimitive extends LispPrimitive { public MakeArrayPrimitive(Jatha lisp) { super(lisp, "MAKE-ARRAY", 1); } public void Execute(SECDMachine machine) { machine.S.push(new StandardLispArray(f_lisp, machine.S.pop())); machine.C.pop(); } } --- NEW FILE: SetfCdrPrimitive.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.compile; import org.jatha.Jatha; import org.jatha.dynatype.*; import org.jatha.machine.*; public class SetfCdrPrimitive extends LispPrimitive { public SetfCdrPrimitive(Jatha lisp) { super(lisp, "SETF-CDR", 2); } public void Execute(SECDMachine machine) { LispValue arg2 = machine.S.pop(); LispValue arg1 = machine.S.pop(); machine.S.push(arg1.setf_cdr(arg2)); machine.C.pop(); } } --- NEW FILE: ArraypPrimitive.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.compile; import org.jatha.Jatha; import org.jatha.machine.*; public class ArraypPrimitive extends LispPrimitive { public ArraypPrimitive(Jatha lisp) { super(lisp, "ARRAYP", 1); } public void Execute(SECDMachine machine) { machine.S.push(machine.S.pop().arrayp()); machine.C.pop(); } } Index: LispCompiler.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/compile/LispCompiler.java,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** LispCompiler.java 16 Mar 2008 06:18:13 -0000 1.33 --- LispCompiler.java 2 Jul 2008 05:29:53 -0000 1.34 *************** *** 164,167 **** --- 164,170 ---- Register(new ArcTangentPrimitive(f_lisp),SYSTEM_PKG); Register(new ArcTangent2Primitive(f_lisp),SYSTEM_PKG); + Register(new ArrayDimensionsPrimitive(f_lisp),SYSTEM_PKG); + Register(new ArraypPrimitive(f_lisp),SYSTEM_PKG); + Register(new ArefPrimitive(f_lisp),SYSTEM_PKG); Register(new AssocPrimitive(f_lisp),SYSTEM_PKG); Register(new AtomPrimitive(f_lisp),SYSTEM_PKG); *************** *** 221,224 **** --- 224,228 ---- Register(new GreaterThanPrimitive(f_lisp),SYSTEM_PKG); Register(new GreaterThanOrEqualPrimitive(f_lisp),SYSTEM_PKG); + Register(new SetfArefPrimitive(f_lisp),SYSTEM_PKG); Register(new SetfGethashPrimitive(f_lisp),SYSTEM_PKG); Register(new HashtablepPrimitive(f_lisp),SYSTEM_PKG); *************** *** 243,246 **** --- 247,251 ---- Register(new Macroexpand1Primitive(f_lisp),SYSTEM_PKG); Register(new MacroexpandPrimitive(f_lisp),SYSTEM_PKG); + Register(new MakeArrayPrimitive(f_lisp),SYSTEM_PKG); Register(new MakeHashTablePrimitive(f_lisp),SYSTEM_PKG); Register(new MaxPrimitive(f_lisp),SYSTEM_PKG); *************** *** 277,280 **** --- 282,287 ---- Register(new SecondPrimitive(f_lisp),SYSTEM_PKG); Register(new SetPrimitive(f_lisp),SYSTEM_PKG); + Register(new SetfCarPrimitive(f_lisp),SYSTEM_PKG); + Register(new SetfCdrPrimitive(f_lisp),SYSTEM_PKG); Register(new SetfSymbolFunctionPrimitive(f_lisp),SYSTEM_PKG); Register(new SetfSymbolPlistPrimitive(f_lisp),SYSTEM_PKG); --- NEW FILE: ArrayDimensionsPrimitive.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.compile; import org.jatha.Jatha; import org.jatha.machine.*; public class ArrayDimensionsPrimitive extends LispPrimitive { public ArrayDimensionsPrimitive(Jatha lisp) { super(lisp, "ARRAY-DIMENSIONS", 1); } public void Execute(SECDMachine machine) { machine.S.push(machine.S.pop().arrayDimensions()); machine.C.pop(); } } --- NEW FILE: SetfArefPrimitive.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.compile; import org.jatha.Jatha; import org.jatha.dynatype.*; import org.jatha.machine.*; public class SetfArefPrimitive extends LispPrimitive { public SetfArefPrimitive(Jatha lisp) { super(lisp, "SETF-AREF", 3); } public void Execute(SECDMachine machine) { LispValue value = machine.S.pop(); LispValue loc = machine.S.pop(); LispValue arr = machine.S.pop(); machine.S.push(arr.setf_aref(loc, value)); machine.C.pop(); } } |
From: Timothy M. <tm...@us...> - 2008-07-02 05:29:59
|
Update of /cvsroot/jatha/jatha/src/org/jatha In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv15981 Modified Files: Jatha.java Log Message: Added preliminary support for arrays. Index: Jatha.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/Jatha.java,v retrieving revision 1.50 retrieving revision 1.51 diff -C2 -d -r1.50 -r1.51 *** Jatha.java 10 Mar 2008 03:26:13 -0000 1.50 --- Jatha.java 2 Jul 2008 05:29:53 -0000 1.51 *************** *** 496,500 **** LispValue LOAD_VERBOSE; ! static long MAX_LIST_LENGTH_VALUE = 100000; boolean useGUI = true; // Whether or not to use GUI-based interaction. --- 496,500 ---- LispValue LOAD_VERBOSE; ! static long MAX_LIST_LENGTH_VALUE = 1000000; boolean useGUI = true; // Whether or not to use GUI-based interaction. |
From: Timothy M. <tm...@us...> - 2008-07-02 05:29:59
|
Update of /cvsroot/jatha/jatha/src/org/jatha/read In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv15981/read Modified Files: LispParser.java Log Message: Added preliminary support for arrays. Index: LispParser.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/read/LispParser.java,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** LispParser.java 5 Mar 2008 05:44:29 -0000 1.12 --- LispParser.java 2 Jul 2008 05:29:53 -0000 1.13 *************** *** 28,31 **** --- 28,32 ---- import java.math.BigInteger; + import java.util.regex.Pattern; import org.jatha.dynatype.*; import org.jatha.Jatha; *************** *** 987,994 **** /** * Does NOT recognize an isolated '+' or '-' as a real number. */ ! boolean REAL_token_p(String str) { String DECIMALchars = "."; --- 988,1002 ---- + private static final Pattern REAL_PATTERN = Pattern.compile("[-+]?[0-9]*\\.?[0-9]+([eE][-+]?[0-9]+)?"); + boolean REAL_token_p(String str) + { + return REAL_PATTERN.matcher(str).matches(); + } + + /** * Does NOT recognize an isolated '+' or '-' as a real number. */ ! boolean REAL_token_p_old(String str) { String DECIMALchars = "."; *************** *** 1017,1020 **** --- 1025,1029 ---- /* Check decimal digits. */ index = decimalPos + 1; + return(firstCharNotInSet(index, str, INTchars) == length); }; |
From: Timothy M. <tm...@us...> - 2008-03-16 06:18:22
|
Update of /cvsroot/jatha/jatha/src/org/jatha/compile In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv5162 Modified Files: LispCompiler.java Log Message: Fix for compiling primitive functions with zero args Index: LispCompiler.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/compile/LispCompiler.java,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** LispCompiler.java 11 Mar 2008 23:53:03 -0000 1.32 --- LispCompiler.java 16 Mar 2008 06:18:13 -0000 1.33 *************** *** 590,597 **** { LispValue rest = code; ! List<LispValue> list = args.toRandomAccess(); ! for (int i = list.size() - 1; i >= 0; i--) { ! rest = compile(list.get(i), valueList, rest); } return rest; --- 590,600 ---- { LispValue rest = code; ! if (args != f_lisp.NIL) { ! List<LispValue> list = args.toRandomAccess(); ! for (int i = list.size() - 1; i >= 0; i--) ! { ! rest = compile(list.get(i), valueList, rest); ! } } return rest; *************** *** 620,627 **** { LispValue rest = f_lisp.NIL; ! List<LispValue> list = l.toRandomAccess(); ! for (int i = list.size() - 1; i >= 0; i--) { ! rest = f_lisp.makeCons(f_lisp.makeList(QUOTE, list.get(i)), rest); } return rest; --- 623,633 ---- { LispValue rest = f_lisp.NIL; ! if (l != f_lisp.NIL) { ! List<LispValue> list = l.toRandomAccess(); ! for (int i = list.size() - 1; i >= 0; i--) ! { ! rest = f_lisp.makeCons(f_lisp.makeList(QUOTE, list.get(i)), rest); ! } } return rest; *************** *** 1120,1132 **** List<LispValue> list = args.toRandomAccess(); ! for (int i = list.size() - 1; i >= 0; i--) { ! code = f_lisp.makeCons(new ConsPrimitive(f_lisp), code); } code = f_lisp.makeCons(machine.NIL, code); LispValue rest = code; ! for (int i = list.size() - 1; i >= 0; i--) { ! rest = f_lisp.makeCons(machine.LDC, f_lisp.makeCons(list.get(i), rest)); } return rest; --- 1126,1144 ---- List<LispValue> list = args.toRandomAccess(); ! if (args != f_lisp.NIL) { ! for (int i = list.size() - 1; i >= 0; i--) ! { ! code = f_lisp.makeCons(new ConsPrimitive(f_lisp), code); ! } } code = f_lisp.makeCons(machine.NIL, code); LispValue rest = code; ! if (args != f_lisp.NIL) { ! for (int i = list.size() - 1; i >= 0; i--) ! { ! rest = f_lisp.makeCons(machine.LDC, f_lisp.makeCons(list.get(i), rest)); ! } } return rest; |
From: Timothy M. <tm...@us...> - 2008-03-11 23:53:11
|
Update of /cvsroot/jatha/jatha/src/org/jatha/dynatype In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv14301/org/jatha/dynatype Modified Files: LispValue.java StandardLispNumber.java StandardLispValue.java Log Message: Added EXPT function. Index: StandardLispNumber.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/StandardLispNumber.java,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** StandardLispNumber.java 21 May 2005 16:28:46 -0000 1.16 --- StandardLispNumber.java 11 Mar 2008 23:53:03 -0000 1.17 *************** *** 104,107 **** --- 104,126 ---- /** + * Calculate the object raised to the power of n. + */ + public LispValue expt(LispValue n) + { + boolean allIntegers = (this.basic_integerp() && n.basic_integerp()); + if (n instanceof LispNumber) + if (allIntegers) + { + return new StandardLispBignum(f_lisp, getBigIntegerValue().pow((int) ((LispNumber)n).getLongValue())); + } + else + { + return new StandardLispReal(f_lisp, StrictMath.pow(getDoubleValue(), ((LispNumber)n).getDoubleValue())); + } + else + throw new LispValueNotANumberException("The second argument to expt (" + n + ")"); + } + + /** * Compute the factorial of a non-negative integer. * Reals are truncated to the nearest integer. Index: StandardLispValue.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/StandardLispValue.java,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** StandardLispValue.java 10 Mar 2008 03:26:14 -0000 1.28 --- StandardLispValue.java 11 Mar 2008 23:53:03 -0000 1.29 *************** *** 587,590 **** --- 587,598 ---- /** + * Calculate the object raised to the power of n. + */ + public LispValue expt(LispValue n) + { + throw new LispValueNotANumberException("The argument to EXPT"); + } + + /** * Compute the factorial of a non-negative integer. * Reals are truncated to the nearest integer. Index: LispValue.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/LispValue.java,v retrieving revision 1.26 retrieving revision 1.27 diff -C2 -d -r1.26 -r1.27 *** LispValue.java 10 Mar 2008 03:26:14 -0000 1.26 --- LispValue.java 11 Mar 2008 23:53:03 -0000 1.27 *************** *** 394,397 **** --- 394,402 ---- /** + * Calculate the object raised to the power of n. + */ + public LispValue expt(LispValue n); + + /** * Compute the factorial of a non-negative integer. * Reals are truncated to the nearest integer. |
From: Timothy M. <tm...@us...> - 2008-03-11 23:53:11
|
Update of /cvsroot/jatha/jatha/src/org/jatha/compile In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv14301/org/jatha/compile Modified Files: LispCompiler.java Added Files: ExptPrimitive.java Log Message: Added EXPT function. Index: LispCompiler.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/compile/LispCompiler.java,v retrieving revision 1.31 retrieving revision 1.32 diff -C2 -d -r1.31 -r1.32 *** LispCompiler.java 10 Mar 2008 03:26:13 -0000 1.31 --- LispCompiler.java 11 Mar 2008 23:53:03 -0000 1.32 *************** *** 196,199 **** --- 196,200 ---- Register(new ExitPrimitive(f_lisp),SYSTEM_PKG); Register(new EvalPrimitive(f_lisp),SYSTEM_PKG); + Register(new ExptPrimitive(f_lisp),SYSTEM_PKG); Register(new FactorialPrimitive(f_lisp),SYSTEM_PKG); Register(new FboundpPrimitive(f_lisp),SYSTEM_PKG); --- NEW FILE: ExptPrimitive.java --- /* * Jatha - a Common LISP-compatible LISP library in Java. * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * * For further information, please contact Micheal Hewett at * he...@cs... * */ package org.jatha.compile; import org.jatha.Jatha; import org.jatha.dynatype.LispValue; import org.jatha.machine.*; public class ExptPrimitive extends LispPrimitive { public ExptPrimitive(Jatha lisp) { super(lisp, "EXPT", 2); } public void Execute(SECDMachine machine) { LispValue n = machine.S.pop(); LispValue x = machine.S.pop(); machine.S.push(x.expt(n)); machine.C.pop(); } } |
From: Timothy M. <tm...@us...> - 2008-03-11 23:53:11
|
Update of /cvsroot/jatha/jatha/src In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv14301 Modified Files: ChangeLog.txt Log Message: Added EXPT function. Index: ChangeLog.txt =================================================================== RCS file: /cvsroot/jatha/jatha/src/ChangeLog.txt,v retrieving revision 1.40 retrieving revision 1.41 diff -C2 -d -r1.40 -r1.41 *** ChangeLog.txt 10 Mar 2008 03:26:13 -0000 1.40 --- ChangeLog.txt 11 Mar 2008 23:53:03 -0000 1.41 *************** *** 2,5 **** --- 2,6 ---- Jatha 2.9.0 (released ?? ?? 2008) + (tm) Added new function EXPT. (tm) Improved support for parsing large quoted lists. (mh) Simplified internal representation of lambda lists (from Kensuke Matsuzaki) |
From: Micheal H. <mh...@us...> - 2008-03-10 03:26:19
|
Update of /cvsroot/jatha/jatha/src/org/jatha/dynatype In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv18945/src/org/jatha/dynatype Modified Files: LispValue.java StandardLispValue.java Log Message: Some enhancements for Java 1.5, Fixed grindef, small modification to lambda list processing Index: StandardLispValue.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/StandardLispValue.java,v retrieving revision 1.27 retrieving revision 1.28 diff -C2 -d -r1.27 -r1.28 *** StandardLispValue.java 9 Mar 2008 08:41:09 -0000 1.27 --- StandardLispValue.java 10 Mar 2008 03:26:14 -0000 1.28 *************** *** 124,128 **** * */ ! public abstract class StandardLispValue implements LispValue, Comparable // Base class for all the LISP data types { protected Jatha f_lisp = null; --- 124,128 ---- * */ ! public abstract class StandardLispValue implements LispValue // Base class for all the LISP data types { protected Jatha f_lisp = null; *************** *** 201,214 **** // Comparable interface. Uses case-insensitive string comparison ! public int compareTo(Object o) { ! if (o instanceof LispValue) ! return this.toStringSimple().compareTo(((LispValue)o).toStringSimple()); else return this.toStringSimple().compareTo(String.valueOf(o)); // Fix from Stephen Starkey, 21 April 2005 } // Implementation of Iterator interface ! public Iterator iterator() { return null; } --- 201,215 ---- // Comparable interface. Uses case-insensitive string comparison ! public int compareTo(LispValue o) { ! return this.toStringSimple().compareTo(o.toStringSimple()); ! /* else return this.toStringSimple().compareTo(String.valueOf(o)); // Fix from Stephen Starkey, 21 April 2005 + */ } // Implementation of Iterator interface ! public Iterator<LispValue> iterator() { return null; } *************** *** 240,246 **** * But also works for single values. */ ! public Collection toCollection() { ! ArrayList result = new ArrayList(1); result.add(this); return result; --- 241,247 ---- * But also works for single values. */ ! public Collection<LispValue> toCollection() { ! ArrayList<LispValue> result = new ArrayList<LispValue>(1); result.add(this); return result; *************** *** 252,265 **** * implement RandomAccess. */ ! public List toRandomAccess() { ! Collection collection = toCollection(); if (collection instanceof List && collection instanceof RandomAccess) { ! return (List) collection; } else { ! return new ArrayList(collection); } } --- 253,266 ---- * implement RandomAccess. */ ! public List<LispValue> toRandomAccess() { ! Collection<LispValue> collection = toCollection(); if (collection instanceof List && collection instanceof RandomAccess) { ! return (List<LispValue>) collection; } else { ! return new ArrayList<LispValue>(collection); } } *************** *** 484,491 **** buff.append(this.toStringSimple()); ! Iterator valuesIt = values.cdr().iterator(); while (valuesIt.hasNext()) { ! LispValue value = (LispValue) valuesIt.next(); if (value instanceof LispString) buff.append(value.toStringSimple()); --- 485,492 ---- buff.append(this.toStringSimple()); ! Iterator<LispValue> valuesIt = values.cdr().iterator(); while (valuesIt.hasNext()) { ! LispValue value = valuesIt.next(); if (value instanceof LispString) buff.append(value.toStringSimple()); *************** *** 1173,1176 **** } ! }; ! --- 1174,1176 ---- } ! } Index: LispValue.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/dynatype/LispValue.java,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** LispValue.java 9 Mar 2008 08:41:09 -0000 1.25 --- LispValue.java 10 Mar 2008 03:26:14 -0000 1.26 *************** *** 40,44 **** * Time: 2:49:43 PM */ ! public interface LispValue extends Comparable { /* Interface copied from org.jatha.dyntatype.StandardLispValue. */ --- 40,44 ---- * Time: 2:49:43 PM */ ! public interface LispValue extends Comparable<LispValue> { /* Interface copied from org.jatha.dyntatype.StandardLispValue. */ *************** *** 157,164 **** // Comparable interface. Uses case-insensitive string comparison ! public int compareTo(Object o); // Implementation of Iterator interface ! public Iterator iterator(); --- 157,164 ---- // Comparable interface. Uses case-insensitive string comparison ! public int compareTo(LispValue o); // Implementation of Iterator interface ! public Iterator<LispValue> iterator(); *************** *** 184,193 **** * But also works for single values. */ ! public Collection toCollection(); /** * Returns the Lisp value as a List guaranteed to implement RandomAccess. */ ! public List toRandomAccess(); // @author Micheal S. Hewett he...@cs... --- 184,193 ---- * But also works for single values. */ ! public Collection<LispValue> toCollection(); /** * Returns the Lisp value as a List guaranteed to implement RandomAccess. */ ! public List<LispValue> toRandomAccess(); // @author Micheal S. Hewett he...@cs... |
From: Micheal H. <mh...@us...> - 2008-03-10 03:26:19
|
Update of /cvsroot/jatha/jatha/src/org/jatha In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv18945/src/org/jatha Modified Files: Jatha.java Log Message: Some enhancements for Java 1.5, Fixed grindef, small modification to lambda list processing Index: Jatha.java =================================================================== RCS file: /cvsroot/jatha/jatha/src/org/jatha/Jatha.java,v retrieving revision 1.49 retrieving revision 1.50 diff -C2 -d -r1.49 -r1.50 *** Jatha.java 5 Mar 2008 05:44:28 -0000 1.49 --- Jatha.java 10 Mar 2008 03:26:13 -0000 1.50 *************** *** 1,5 **** /** * Jatha - a Common LISP-compatible LISP library in Java. ! * Copyright (C) 1997-2005 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or --- 1,5 ---- /** * Jatha - a Common LISP-compatible LISP library in Java. ! * Copyright (C) 1997-2008 Micheal Scott Hewett * * This library is free software; you can redistribute it and/or *************** *** 103,110 **** private String VERSION_NAME = "Jatha"; private int VERSION_MAJOR = 2; ! private int VERSION_MINOR = 8; private int VERSION_MICRO = 0; private String VERSION_TYPE = ""; ! private String VERSION_DATE = "25 Apr 2007"; private String VERSION_URL = "http://jatha.sourceforge.net/"; --- 103,110 ---- private String VERSION_NAME = "Jatha"; private int VERSION_MAJOR = 2; ! private int VERSION_MINOR = 9; private int VERSION_MICRO = 0; private String VERSION_TYPE = ""; ! private String VERSION_DATE = "16 Mar 2008"; private String VERSION_URL = "http://jatha.sourceforge.net/"; *************** *** 564,598 **** * Returns the program name, e.g. Algernon. */ ! public String getVersionName() { return VERSION_NAME; }; /** * Returns the date of this version as a string: "nn MONTH yyyy". */ ! public String getVersionDate() { return VERSION_DATE; }; /** * Returns a URL where you can find info about Algernon. */ ! public String getVersionURL() { return VERSION_URL; }; /** * Returns the type of release: "production", "beta" or "alpha". */ ! public String getVersionType() { return VERSION_TYPE; }; /** * Returns the major version number, that is, 1 in version 1.2.3. */ ! public int getVersionMajor() { return VERSION_MAJOR; }; /** * Returns the minor version number, that is, 2 in version 1.2.3. */ ! public int getVersionMinor() { return VERSION_MINOR; }; /** * Returns the micro version number, that is, 3 in version 1.2.3. */ ! public int getVersionMicro() { return VERSION_MICRO; }; void showHelp() --- 564,598 ---- * Returns the program name, e.g. Algernon. */ ! public String getVersionName() { return VERSION_NAME; } /** * Returns the date of this version as a string: "nn MONTH yyyy". */ ! public String getVersionDate() { return VERSION_DATE; } /** * Returns a URL where you can find info about Algernon. */ ! public String getVersionURL() { return VERSION_URL; } /** * Returns the type of release: "production", "beta" or "alpha". */ ! public String getVersionType() { return VERSION_TYPE; } /** * Returns the major version number, that is, 1 in version 1.2.3. */ ! public int getVersionMajor() { return VERSION_MAJOR; } /** * Returns the minor version number, that is, 2 in version 1.2.3. */ ! public int getVersionMinor() { return VERSION_MINOR; } /** * Returns the micro version number, that is, 3 in version 1.2.3. */ ! public int getVersionMicro() { return VERSION_MICRO; } void showHelp() *************** *** 958,963 **** LispValue code, value; ! final LispValue varNames = parseVarNames(vars); ! final LispValue varValues = parseVarValues(vars); try { --- 958,963 ---- LispValue code, value; ! final LispValue varNames = parseVarNames_new(vars); ! final LispValue varValues = parseVarValues_new(vars); try { *************** *** 993,996 **** --- 993,997 ---- * Expects a list with this format (((A 13) (C 7))((X "Zeta"))) and returns a list with this format ((A C)(X)) */ + /* private LispValue parseVarNames(final LispValue vars) { LispValue outp = NIL; *************** *** 998,1006 **** return outp; ! for(final Iterator iter = vars.iterator();iter.hasNext();) { ! final LispValue current = (LispValue)iter.next(); LispValue inner = NIL; ! for(final Iterator iter2 = current.iterator();iter2.hasNext();) { ! final LispValue currInt = (LispValue)iter2.next(); inner = makeCons(currInt.car(),inner); } --- 999,1007 ---- return outp; ! for(final Iterator<LispValue> iter = vars.iterator();iter.hasNext();) { ! final LispValue current = iter.next(); LispValue inner = NIL; ! for(final Iterator<LispValue> iter2 = current.iterator();iter2.hasNext();) { ! final LispValue currInt = iter2.next(); inner = makeCons(currInt.car(),inner); } *************** *** 1009,1013 **** return outp.nreverse(); } ! /** * Not sure why parseVarNames has such a complicated structure. --- 1010,1015 ---- return outp.nreverse(); } ! */ ! /** * Not sure why parseVarNames has such a complicated structure. *************** *** 1021,1027 **** return outp; ! for (final Iterator iter = vars.iterator(); iter.hasNext();) { ! final LispValue current = (LispValue)iter.next(); outp = makeCons(current.car(), outp); } --- 1023,1029 ---- return outp; ! for (final Iterator<LispValue> iter = vars.iterator(); iter.hasNext();) { ! final LispValue current = iter.next(); outp = makeCons(current.car(), outp); } *************** *** 1041,1047 **** return outp; ! for (final Iterator iter = vars.iterator(); iter.hasNext();) { ! final LispValue current = (LispValue)iter.next(); outp = makeCons(current.cdr(), outp); } --- 1043,1049 ---- return outp; ! for (final Iterator<LispValue> iter = vars.iterator(); iter.hasNext();) { ! final LispValue current = iter.next(); outp = makeCons(current.cdr(), outp); } *************** *** 1053,1056 **** --- 1055,1059 ---- * Expects a list with this format (((A 13) (C 7))((X "Zeta"))) and returns a list with this format ((13 7)("Zeta")) */ + /* private LispValue parseVarValues(final LispValue vars) { LispValue outp = NIL; *************** *** 1058,1066 **** return outp; ! for(final Iterator iter = vars.iterator();iter.hasNext();) { ! final LispValue current = (LispValue)iter.next(); LispValue inner = NIL; ! for(final Iterator iter2 = current.iterator();iter2.hasNext();) { ! final LispValue currInt = (LispValue)iter2.next(); inner = makeCons(currInt.cdr(),inner); } --- 1061,1069 ---- return outp; ! for(final Iterator<LispValue> iter = vars.iterator();iter.hasNext();) { ! final LispValue current = iter.next(); LispValue inner = NIL; ! for(final Iterator<LispValue> iter2 = current.iterator();iter2.hasNext();) { ! final LispValue currInt = iter2.next(); inner = makeCons(currInt.cdr(),inner); } *************** *** 1069,1088 **** return outp.nreverse(); } ! void readEvalPrintLoop() { ! LispValue input, code, value, prompt; ! LispValue STAR, STARSTAR, STARSTARSTAR; boolean validInput; LispValue oldPackageSymbolValue = PACKAGE_SYMBOL.symbol_value(); // Need to allow *TOP-LEVEL-PROMPT* to change this. ! prompt = makeString("Jatha " + PACKAGE_SYMBOL.symbol_value().toString() + "> "); ! ! STAR = EVAL.intern("*"); ! STARSTAR = EVAL.intern("**"); ! STARSTARSTAR = EVAL.intern("***"); STAR.setf_symbol_value(NIL); --- 1072,1086 ---- return outp.nreverse(); } ! */ void readEvalPrintLoop() { ! LispValue input, code, value, myprompt; boolean validInput; LispValue oldPackageSymbolValue = PACKAGE_SYMBOL.symbol_value(); // Need to allow *TOP-LEVEL-PROMPT* to change this. ! myprompt = makeString("Jatha " + PACKAGE_SYMBOL.symbol_value().toString() + "> "); STAR.setf_symbol_value(NIL); *************** *** 1098,1107 **** if (oldPackageSymbolValue != PACKAGE_SYMBOL.symbol_value()) { ! prompt = makeString("Jatha " + PACKAGE_SYMBOL.symbol_value().toString() + "> "); oldPackageSymbolValue = PACKAGE_SYMBOL.symbol_value(); } System.out.println(); ! prompt.princ(); System.out.flush(); --- 1096,1105 ---- if (oldPackageSymbolValue != PACKAGE_SYMBOL.symbol_value()) { ! myprompt = makeString("Jatha " + PACKAGE_SYMBOL.symbol_value().toString() + "> "); oldPackageSymbolValue = PACKAGE_SYMBOL.symbol_value(); } System.out.println(); ! myprompt.princ(); System.out.flush(); *************** *** 1208,1212 **** * Contributed by Stephen Starkey. */ ! public LispValue load(Reader in) throws IOException, CompilerException { boolean verbose = LOAD_VERBOSE.symbol_value() != NIL; --- 1206,1210 ---- * Contributed by Stephen Starkey. */ ! public LispValue load(Reader in) throws CompilerException { boolean verbose = LOAD_VERBOSE.symbol_value() != NIL; *************** *** 1220,1224 **** */ public LispValue load(Reader in, boolean verbose) ! throws IOException, CompilerException { // System.err.println("Loading: verbose is " + verbose); --- 1218,1222 ---- */ public LispValue load(Reader in, boolean verbose) ! throws CompilerException { // System.err.println("Loading: verbose is " + verbose); *************** *** 1282,1291 **** System.err.println(";; *** File not found: " + filename); return NIL; - } catch (IOException e) { - if (useGUI) - LISTENER.message(";; *** Error closing file: " + filename); - else - System.err.println("Error closing file " + filename); - return T; } catch (CompilerException ce) { if (useGUI) --- 1280,1283 ---- *************** *** 1293,1296 **** --- 1285,1294 ---- else System.err.println("Error while reading file " + filename + ":\n" + ce.toString()); + } catch (Exception e) { + if (useGUI) + LISTENER.message(";; *** Error closing file: " + filename); + else + System.err.println("Error closing file " + filename); + return T; } return NIL; *************** *** 1314,1323 **** try { return load(new StringReader(string), verbose); - } catch (IOException e) { - if (useGUI) - LISTENER.message(";; *** Error handling input string."); - else - System.err.println("Error handling input string."); - return T; } catch (CompilerException ce) { if (useGUI) --- 1312,1315 ---- *************** *** 1325,1328 **** --- 1317,1327 ---- else System.err.println("Error in input: " + ce.toString()); + } catch (Exception e) { + if (useGUI) + LISTENER.message(";; *** Error handling input string: " + e.getMessage()); + else + System.err.println("Error handling input string: " + e.getMessage()); + e.printStackTrace(); + return T; } return NIL; *************** *** 1419,1423 **** String matchStr = ((LispString)(str)).getValue().toUpperCase(); ! Iterator iter; LispValue symb; LispString sname; --- 1418,1422 ---- String matchStr = ((LispString)(str)).getValue().toUpperCase(); ! Iterator<LispValue> iter; LispValue symb; LispString sname; *************** *** 1430,1434 **** while (iter.hasNext()) { ! symb = ((LispValue)(iter.next())); sname = (LispString)(symb.symbol_name()); symbstr = sname.getValue().toUpperCase(); --- 1429,1433 ---- while (iter.hasNext()) { ! symb = (iter.next()); sname = (LispString)(symb.symbol_name()); symbstr = sname.getValue().toUpperCase(); *************** *** 1599,1603 **** * */ ! public LispConsOrNil makeList(Collection elements) { // Use array so as to iterate from the end to the beginning. --- 1598,1602 ---- * */ ! public LispConsOrNil makeList(Collection<LispValue> elements) { // Use array so as to iterate from the end to the beginning. *************** *** 1637,1641 **** */ ! public LispConsOrNil makeAppendList(Collection elements) { if (elements.size() == 0) --- 1636,1640 ---- */ ! public LispConsOrNil makeAppendList(Collection<LispValue> elements) { if (elements.size() == 0) *************** *** 1643,1649 **** LispValue result = NIL; ! for (Iterator iterator = elements.iterator(); iterator.hasNext();) { ! LispValue o = (LispValue) iterator.next(); result = result.append(o); } --- 1642,1648 ---- LispValue result = NIL; ! for (Iterator<LispValue> iterator = elements.iterator(); iterator.hasNext();) { ! LispValue o = iterator.next(); result = result.append(o); } *************** *** 1659,1663 **** */ ! public LispConsOrNil makeNconcList(Collection elements) { if (elements.size() == 0) --- 1658,1662 ---- */ ! public LispConsOrNil makeNconcList(Collection<LispValue> elements) { if (elements.size() == 0) *************** *** 1665,1671 **** LispValue result = NIL; ! for (Iterator iterator = elements.iterator(); iterator.hasNext();) { ! LispValue o = (LispValue) iterator.next(); result = result.nconc(o); } --- 1664,1670 ---- LispValue result = NIL; ! for (Iterator<LispValue> iterator = elements.iterator(); iterator.hasNext();) { ! LispValue o = iterator.next(); result = result.nconc(o); } *************** *** 1702,1706 **** public LispInteger makeInteger(int value) { ! return new StandardLispInteger(this, (long) value); } --- 1701,1705 ---- public LispInteger makeInteger(int value) { ! return new StandardLispInteger(this, value); } *************** *** 1764,1768 **** public LispReal makeReal(float value) { ! return new StandardLispReal(this, (double) value); } --- 1763,1767 ---- public LispReal makeReal(float value) { ! return new StandardLispReal(this, value); } *************** *** 1927,1932 **** else if (right.basic_null()) return makeList(LIST, left); ! else if (right.basic_consp() && (! right.car().equal(LIST).basic_null())); return makeList(CONS, left, right); } --- 1926,1933 ---- else if (right.basic_null()) return makeList(LIST, left); ! else if (right.basic_consp() && (! right.car().equal(LIST).basic_null())) return makeList(CONS, left, right); + else + return expr; // ?? (mh) 9 Mar 2008. The previous "if" had a wayward semi-colon at the end, and thus was not working correctly. I don't really know what should be returned here. } |