aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog18
-rw-r--r--src/algebra/strap/OUTFORM.lsp153
-rw-r--r--src/interp/compiler.boot12
-rw-r--r--src/interp/g-opt.boot10
-rw-r--r--src/interp/g-timer.boot6
-rw-r--r--src/interp/g-util.boot19
-rw-r--r--src/interp/i-object.boot4
-rw-r--r--src/interp/nruncomp.boot4
-rw-r--r--src/interp/slam.boot8
-rw-r--r--src/interp/wi1.boot2
10 files changed, 140 insertions, 96 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index cf12f64f..47342097 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,21 @@
+2011-01-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/compiler.boot (compForm1): Use %listlit form.
+ (compExpressionList): Likewise.
+ (compCons1): Likewise.
+ (compList): Likewise.
+ (compVector): Likewise.
+ * interp/g-timer.boot (timedEvaluate): Likewise.
+ * interp/wi1.boot: Likewise.
+ * interp/slam.boot: Likewise.
+ * interp/nruncomp.boot: Likewise.
+ * interp/i-object.boot: Likewise.
+ * interp/g-opt.boot (optMkRecord): Likewise.
+ (optRECORDCOPY): Likewise.
+ (optLIST): Remove.
+ (optListlit): New.
+ * interp/g-util.boot (optListlit): New. Expand %listlit forms.
+
2011-01-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/g-opt.boot (optMkRecord): Generate %makepair forms.
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index ddf4ab0c..dcf7b5d5 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -43,7 +43,7 @@
|OUTFORM;=;3$;10|))
(PUT '|OUTFORM;=;3$;10| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '= |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '= |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;coerce;2$;11|))
@@ -152,7 +152,7 @@
|OUTFORM;brace;2$;36|))
(PUT '|OUTFORM;brace;2$;36| '|SPADreplace|
- '(XLAM (|a|) (LIST 'BRACE |a|)))
+ '(XLAM (|a|) (|%listlit| 'BRACE |a|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;brace;L$;37|))
@@ -161,7 +161,7 @@
|OUTFORM;bracket;2$;38|))
(PUT '|OUTFORM;bracket;2$;38| '|SPADreplace|
- '(XLAM (|a|) (LIST 'BRACKET |a|)))
+ '(XLAM (|a|) (|%listlit| 'BRACKET |a|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;bracket;L$;39|))
@@ -170,7 +170,7 @@
|OUTFORM;paren;2$;40|))
(PUT '|OUTFORM;paren;2$;40| '|SPADreplace|
- '(XLAM (|a|) (LIST 'PAREN |a|)))
+ '(XLAM (|a|) (|%listlit| 'PAREN |a|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;paren;L$;41|))
@@ -179,25 +179,25 @@
|OUTFORM;sub;3$;42|))
(PUT '|OUTFORM;sub;3$;42| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'SUB |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'SUB |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;super;3$;43|))
(PUT '|OUTFORM;super;3$;43| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'SUPERSUB |a| " " |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'SUPERSUB |a| " " |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;presub;3$;44|))
(PUT '|OUTFORM;presub;3$;44| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'SUPERSUB |a| " " " " " " |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'SUPERSUB |a| " " " " " " |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;presuper;3$;45|))
(PUT '|OUTFORM;presuper;3$;45| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'SUPERSUB |a| " " " " |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'SUPERSUB |a| " " " " |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
|OUTFORM;scripts;$L$;46|))
@@ -209,7 +209,7 @@
|OUTFORM;hconcat;3$;48|))
(PUT '|OUTFORM;hconcat;3$;48| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'CONCAT |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'CONCAT |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;hconcat;L$;49|))
@@ -221,7 +221,7 @@
|OUTFORM;vconcat;3$;50|))
(PUT '|OUTFORM;vconcat;3$;50| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'VCONCAT |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'VCONCAT |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;vconcat;L$;51|))
@@ -233,129 +233,133 @@
|OUTFORM;~=;3$;52|))
(PUT '|OUTFORM;~=;3$;52| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '~= |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '~= |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;<;3$;53|))
(PUT '|OUTFORM;<;3$;53| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '< |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '< |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;>;3$;54|))
(PUT '|OUTFORM;>;3$;54| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '> |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '> |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;<=;3$;55|))
(PUT '|OUTFORM;<=;3$;55| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '<= |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '<= |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;>=;3$;56|))
(PUT '|OUTFORM;>=;3$;56| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '>= |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '>= |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;+;3$;57|))
(PUT '|OUTFORM;+;3$;57| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '+ |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '+ |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;-;3$;58|))
(PUT '|OUTFORM;-;3$;58| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '- |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '- |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;-;2$;59|))
-(PUT '|OUTFORM;-;2$;59| '|SPADreplace| '(XLAM (|a|) (LIST '- |a|)))
+(PUT '|OUTFORM;-;2$;59| '|SPADreplace|
+ '(XLAM (|a|) (|%listlit| '- |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;*;3$;60|))
(PUT '|OUTFORM;*;3$;60| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '* |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '* |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;/;3$;61|))
(PUT '|OUTFORM;/;3$;61| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '/ |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '/ |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;**;3$;62|))
(PUT '|OUTFORM;**;3$;62| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '** |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '** |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;div;3$;63|))
(PUT '|OUTFORM;div;3$;63| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '|div| |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '|div| |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;rem;3$;64|))
(PUT '|OUTFORM;rem;3$;64| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '|rem| |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '|rem| |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;quo;3$;65|))
(PUT '|OUTFORM;quo;3$;65| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '|quo| |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '|quo| |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;exquo;3$;66|))
(PUT '|OUTFORM;exquo;3$;66| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '|exquo| |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '|exquo| |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;and;3$;67|))
(PUT '|OUTFORM;and;3$;67| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '|and| |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '|and| |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;or;3$;68|))
(PUT '|OUTFORM;or;3$;68| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '|or| |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '|or| |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;not;2$;69|))
(PUT '|OUTFORM;not;2$;69| '|SPADreplace|
- '(XLAM (|a|) (LIST '|not| |a|)))
+ '(XLAM (|a|) (|%listlit| '|not| |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;SEGMENT;3$;70|))
(PUT '|OUTFORM;SEGMENT;3$;70| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'SEGMENT |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'SEGMENT |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;SEGMENT;2$;71|))
(PUT '|OUTFORM;SEGMENT;2$;71| '|SPADreplace|
- '(XLAM (|a|) (LIST 'SEGMENT |a|)))
+ '(XLAM (|a|) (|%listlit| 'SEGMENT |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;binomial;3$;72|))
(PUT '|OUTFORM;binomial;3$;72| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'BINOMIAL |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'BINOMIAL |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |OUTFORM;empty;$;73|))
+(PUT '|OUTFORM;empty;$;73| '|SPADreplace|
+ '(XLAM NIL (|%listlit| 'NOTHING)))
+
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
|OUTFORM;infix?;$B;74|))
@@ -381,19 +385,19 @@
|OUTFORM;string;2$;80|))
(PUT '|OUTFORM;string;2$;80| '|SPADreplace|
- '(XLAM (|a|) (LIST 'STRING |a|)))
+ '(XLAM (|a|) (|%listlit| 'STRING |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;quote;2$;81|))
(PUT '|OUTFORM;quote;2$;81| '|SPADreplace|
- '(XLAM (|a|) (LIST 'QUOTE |a|)))
+ '(XLAM (|a|) (|%listlit| 'QUOTE |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;overbar;2$;82|))
(PUT '|OUTFORM;overbar;2$;82| '|SPADreplace|
- '(XLAM (|a|) (LIST 'OVERBAR |a|)))
+ '(XLAM (|a|) (|%listlit| 'OVERBAR |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;dot;2$;83|))
@@ -413,60 +417,61 @@
|OUTFORM;overlabel;3$;87|))
(PUT '|OUTFORM;overlabel;3$;87| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'OVERLABEL |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'OVERLABEL |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;box;2$;88|))
-(PUT '|OUTFORM;box;2$;88| '|SPADreplace| '(XLAM (|a|) (LIST 'BOX |a|)))
+(PUT '|OUTFORM;box;2$;88| '|SPADreplace|
+ '(XLAM (|a|) (|%listlit| 'BOX |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;zag;3$;89|))
(PUT '|OUTFORM;zag;3$;89| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'ZAG |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'ZAG |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;root;2$;90|))
(PUT '|OUTFORM;root;2$;90| '|SPADreplace|
- '(XLAM (|a|) (LIST 'ROOT |a|)))
+ '(XLAM (|a|) (|%listlit| 'ROOT |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;root;3$;91|))
(PUT '|OUTFORM;root;3$;91| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'ROOT |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'ROOT |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;over;3$;92|))
(PUT '|OUTFORM;over;3$;92| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'OVER |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'OVER |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;slash;3$;93|))
(PUT '|OUTFORM;slash;3$;93| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'SLASH |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'SLASH |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;assign;3$;94|))
(PUT '|OUTFORM;assign;3$;94| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST '%LET |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| '%LET |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;label;3$;95|))
(PUT '|OUTFORM;label;3$;95| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'EQUATNUM |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'EQUATNUM |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;rarrow;3$;96|))
(PUT '|OUTFORM;rarrow;3$;96| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'RARROW |a| |b|)))
+ '(XLAM (|a| |b|) (|%listlit| 'RARROW |a| |b|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
|%Thing|)
@@ -479,14 +484,14 @@
|OUTFORM;sum;3$;99|))
(PUT '|OUTFORM;sum;3$;99| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'SIGMA |b| |a|)))
+ '(XLAM (|a| |b|) (|%listlit| 'SIGMA |b| |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
|%Thing|)
|OUTFORM;sum;4$;100|))
(PUT '|OUTFORM;sum;4$;100| '|SPADreplace|
- '(XLAM (|a| |b| |c|) (LIST 'SIGMA2 |b| |c| |a|)))
+ '(XLAM (|a| |b| |c|) (|%listlit| 'SIGMA2 |b| |c| |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;prod;2$;101|))
@@ -495,14 +500,14 @@
|OUTFORM;prod;3$;102|))
(PUT '|OUTFORM;prod;3$;102| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'PI |b| |a|)))
+ '(XLAM (|a| |b|) (|%listlit| 'PI |b| |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
|%Thing|)
|OUTFORM;prod;4$;103|))
(PUT '|OUTFORM;prod;4$;103| '|SPADreplace|
- '(XLAM (|a| |b| |c|) (LIST 'PI2 |b| |c| |a|)))
+ '(XLAM (|a| |b| |c|) (|%listlit| 'PI2 |b| |c| |a|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|OUTFORM;int;2$;104|))
@@ -515,16 +520,30 @@
|OUTFORM;int;4$;106|))
(PUT '|OUTFORM;int;4$;106| '|SPADreplace|
- '(XLAM (|a| |b| |c|) (LIST 'INTSIGN |b| |c| |a|)))
+ '(XLAM (|a| |b| |c|) (|%listlit| 'INTSIGN |b| |c| |a|)))
(PUT '|OUTFORM;postfix;3$;79| '|SPADreplace|
- '(XLAM (|a| |b|) (LIST 'CONCAT |b| |a|)))
+ '(XLAM (|a| |b|) (|%listlit| 'CONCAT |b| |a|)))
(PUT '|OUTFORM;dot;2$;83| '|SPADreplace|
- '(XLAM (|a|) (LIST 'SUPERSUB |a| " " '|.|)))
+ '(XLAM (|a|) (|%listlit| 'SUPERSUB |a| " " '|.|)))
(PUT '|OUTFORM;prime;2$;84| '|SPADreplace|
- '(XLAM (|a|) (LIST 'SUPERSUB |a| " " '|,|)))
+ '(XLAM (|a|) (|%listlit| 'SUPERSUB |a| " " '|,|)))
+
+(PUT '|OUTFORM;sum;2$;98| '|SPADreplace|
+ '(XLAM (|a|) (|%listlit| 'SIGMA (|%listlit| 'NOTHING) |a|)))
+
+(PUT '|OUTFORM;prod;2$;101| '|SPADreplace|
+ '(XLAM (|a|) (|%listlit| 'PI (|%listlit| 'NOTHING) |a|)))
+
+(PUT '|OUTFORM;int;2$;104| '|SPADreplace|
+ '(XLAM (|a|)
+ (|%listlit| 'INTSIGN #0=(|%listlit| 'NOTHING) #0# |a|)))
+
+(PUT '|OUTFORM;int;3$;105| '|SPADreplace|
+ '(XLAM (|a| |b|)
+ (|%listlit| 'INTSIGN |b| (|%listlit| 'NOTHING) |a|)))
(DEFUN |OUTFORM;doubleFloatFormat;2S;1| (|s| $)
(LET ((|ss| (|getShellEntry| $ 6)))
@@ -543,7 +562,7 @@
(|mathprint| |x|))
(DEFUN |OUTFORM;message;S$;7| (|s| $)
- (COND ((ZEROP (LENGTH |s|)) (|OUTFORM;empty;$;73| $)) (T |s|)))
+ (COND ((ZEROP (LENGTH |s|)) (LIST 'NOTHING)) (T |s|)))
(DEFUN |OUTFORM;messagePrint;SV;8| (|s| $)
(|mathprint| (|OUTFORM;message;S$;7| |s| $)))
@@ -618,18 +637,16 @@
((PLUSP |n|)
(|OUTFORM;vconcat;3$;50| " " (|OUTFORM;vspace;I$;28| (- |n| 1) $)
$))
- (T (|OUTFORM;empty;$;73| $))))
+ (T (LIST 'NOTHING))))
(DEFUN |OUTFORM;hspace;I$;29| (|n| $)
- (COND
- ((PLUSP |n|) (|fillerSpaces| |n|))
- (T (|OUTFORM;empty;$;73| $))))
+ (COND ((PLUSP |n|) (|fillerSpaces| |n|)) (T (LIST 'NOTHING))))
(DEFUN |OUTFORM;rspace;2I$;30| (|n| |m| $)
(SEQ (COND
((PLUSP |n|)
- (COND ((NOT (PLUSP |m|)) (EXIT (|OUTFORM;empty;$;73| $)))))
- (T (EXIT (|OUTFORM;empty;$;73| $))))
+ (COND ((NOT (PLUSP |m|)) (EXIT (LIST 'NOTHING)))))
+ (T (EXIT (LIST 'NOTHING))))
(EXIT (|OUTFORM;vconcat;3$;50| (|OUTFORM;hspace;I$;29| |n| $)
(|OUTFORM;rspace;2I$;30| |n| (- |m| 1) $) $))))
@@ -716,7 +733,7 @@
(DEFUN |OUTFORM;supersub;$L$;47| (|a| |l| $)
(SEQ (COND
((ODDP (LIST-LENGTH |l|))
- (SETQ |l| (APPEND |l| (LIST (|OUTFORM;empty;$;73| $))))))
+ (SETQ |l| (APPEND |l| (LIST (LIST 'NOTHING))))))
(EXIT (CONS 'ALTSUPERSUB (CONS |a| |l|)))))
(DEFUN |OUTFORM;hconcat;3$;48| (|a| |b| $)
@@ -817,7 +834,7 @@
(DECLARE (IGNORE $))
(LIST 'BINOMIAL |a| |b|))
-(DEFUN |OUTFORM;empty;$;73| ($) (LIST 'NOTHING))
+(DEFUN |OUTFORM;empty;$;73| ($) (DECLARE (IGNORE $)) (LIST 'NOTHING))
(DEFUN |OUTFORM;infix?;$B;74| (|a| $)
(LET ((|e| (COND
@@ -838,7 +855,7 @@
(DEFUN |OUTFORM;infix;$L$;77| (|a| |l| $)
(COND
- ((NULL |l|) (|OUTFORM;empty;$;73| $))
+ ((NULL |l|) (LIST 'NOTHING))
((NULL (CDR |l|)) (SPADCALL |l| (|getShellEntry| $ 78)))
((|OUTFORM;infix?;$B;74| |a| $) (CONS |a| |l|))
(T (|OUTFORM;hconcat;L$;49|
@@ -943,7 +960,8 @@
$)))))))))
(DEFUN |OUTFORM;sum;2$;98| (|a| $)
- (LIST 'SIGMA (|OUTFORM;empty;$;73| $) |a|))
+ (DECLARE (IGNORE $))
+ (LIST 'SIGMA (LIST 'NOTHING) |a|))
(DEFUN |OUTFORM;sum;3$;99| (|a| |b| $)
(DECLARE (IGNORE $))
@@ -954,7 +972,8 @@
(LIST 'SIGMA2 |b| |c| |a|))
(DEFUN |OUTFORM;prod;2$;101| (|a| $)
- (LIST 'PI (|OUTFORM;empty;$;73| $) |a|))
+ (DECLARE (IGNORE $))
+ (LIST 'PI (LIST 'NOTHING) |a|))
(DEFUN |OUTFORM;prod;3$;102| (|a| |b| $)
(DECLARE (IGNORE $))
@@ -965,10 +984,12 @@
(LIST 'PI2 |b| |c| |a|))
(DEFUN |OUTFORM;int;2$;104| (|a| $)
- (LIST 'INTSIGN (|OUTFORM;empty;$;73| $) (|OUTFORM;empty;$;73| $) |a|))
+ (DECLARE (IGNORE $))
+ (LIST 'INTSIGN (LIST 'NOTHING) (LIST 'NOTHING) |a|))
(DEFUN |OUTFORM;int;3$;105| (|a| |b| $)
- (LIST 'INTSIGN |b| (|OUTFORM;empty;$;73| $) |a|))
+ (DECLARE (IGNORE $))
+ (LIST 'INTSIGN |b| (LIST 'NOTHING) |a|))
(DEFUN |OUTFORM;int;4$;106| (|a| |b| |c| $)
(DECLARE (IGNORE $))
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 36d29900..635e4879 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -525,7 +525,7 @@ compForm1(form is [op,:argl],m,e) ==
compExpressionList(argl,m,e) ==
Tl:= [[.,.,e]:= comp(x,$Expression,e) or return "failed" for x in argl]
Tl="failed" => nil
- convert([["LIST",:[y.expr for y in Tl]],$Expression,e],m)
+ convert([['%listlit,:[y.expr for y in Tl]],$Expression,e],m)
compForm2(form is [op,:argl],m,e,modemapList) ==
sargl:= TAKE(# argl, $TriangleVariableList)
@@ -769,14 +769,14 @@ compCons(form,m,e) == compCons1(form,m,e) or compForm(form,m,e)
compCons1(["CONS",x,y],m,e) ==
[x,mx,e]:= comp(x,$EmptyMode,e) or return nil
- null y => convert([["LIST",x],["List",mx],e],m)
+ null y => convert([['%listlit,x],["List",mx],e],m)
yt:= [y,my,e]:= comp(y,$EmptyMode,e) or return nil
T:=
my is ["List",m',:.] =>
mr:= ["List",resolve(m',mx) or return nil]
yt':= convert(yt,mr) or return nil
[x,.,e]:= convert([x,mx,yt'.env],second mr) or return nil
- yt'.expr is ["LIST",:.] => [["LIST",x,:rest yt'.expr],mr,e]
+ yt'.expr is ['%listlit,:.] => [['%listlit,x,:rest yt'.expr],mr,e]
[["CONS",x,yt'.expr],mr,e]
[["CONS",x,y],["Pair",mx,my],e]
convert(T,m)
@@ -982,14 +982,14 @@ compList(l,m is ["List",mUnder],e) ==
null l => [NIL,m,e]
Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
Tl="failed" => nil
- T:= [["LIST",:[T.expr for T in Tl]],["List",mUnder],e]
+ T:= [['%listlit,:[T.expr for T in Tl]],["List",mUnder],e]
compVector: (%Form,%Mode,%Env) -> %Maybe %Triple
compVector(l,m is ["Vector",mUnder],e) ==
Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
Tl="failed" => nil
[["MAKE-ARRAY", #Tl, KEYWORD::ELEMENT_-TYPE, quoteForm getVMType mUnder,
- KEYWORD::INITIAL_-CONTENTS, ["LIST", :[T.expr for T in Tl]]],m,e]
+ KEYWORD::INITIAL_-CONTENTS, ['%listlit, :[T.expr for T in Tl]]],m,e]
--% MACROS
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 718c06aa..b0211eb4 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -296,7 +296,7 @@ compileTimeBindingOf u ==
name
optMkRecord ["mkRecord",:u] ==
- u is [x] => ["LIST",x]
+ u is [x] => ['%listlit,x]
#u=2 => ['%makepair,:u]
["VECTOR",:u]
@@ -420,7 +420,7 @@ optSETRECORDELT ["SETRECORDELT",name,ind,len,expr] ==
['%store,['%vref,name,ind],expr]
optRECORDCOPY ["RECORDCOPY",name,len] ==
- len = 1 => ["LIST",['%head,name]]
+ len = 1 => ['%listlit,['%head,name]]
len = 2 => ['%makepair,['%head,name],['%tail,name]]
["REPLACE",["MAKE_-VEC",len],name]
@@ -605,8 +605,8 @@ optTry form ==
form isnt ['try,e,hs,f] or not(isFloatableVMForm e) or f ~= nil => form
e
-optLIST form ==
- form is ["LIST"] => nil
+optListlit form ==
+ form is ['%listlit] => nil
form
optCollectVector form ==
@@ -794,7 +794,7 @@ for x in '( (%call optCall) _
(%imul optImul)_
(%2bit opt2bit)_
(%2bool opt2bool)_
- (LIST optLIST)_
+ (%listlit optListlit)_
(QSMINUS optQSMINUS)_
(SPADCALL optSPADCALL)_
(_| optSuchthat)_
diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot
index 786ab65d..7acf5804 100644
--- a/src/interp/g-timer.boot
+++ b/src/interp/g-timer.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -260,8 +260,8 @@ timedEVALFUN(code) ==
r
timedEvaluate code ==
- code is ["LIST",:a] and #a > 200 =>
- "append"/[eval ["LIST",:x] for x in splitIntoBlocksOf200 a]
+ code is ['%listlit,:a] and #a > 200 =>
+ "append"/[eval ['%listlit,:x] for x in splitIntoBlocksOf200 a]
eval code
displayHeapStatsIfWanted() ==
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 38882026..95b36c06 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -247,6 +247,12 @@ expandCollect ['%collect,:iters,body] ==
-- in reverse order.
expandLoop ['%loop,:iters,["%init",val,nil],body,["NREVERSE",val]]
+expandListlit(x is ['%listlit,:args]) ==
+ args := [expandToVMForm arg for arg in args]
+ args = nil => nil
+ and/[integer? arg or string? arg for arg in args] => quoteForm args
+ ['LIST,:args]
+
expandReturn(x is ['%return,.,y]) ==
$FUNNAME = nil => systemErrorHere ['expandReturn,x]
['RETURN_-FROM,$FUNNAME,expandToVMForm y]
@@ -560,7 +566,6 @@ for x in [
['%lthird, :'CADDR],
['%pair?, :'CONSP],
['%tail, :'CDR],
- ['%listlit, :'LIST],
-- binary list operations
['%lconcat, :'APPEND],
@@ -593,6 +598,7 @@ for x in [
++ Table of opcode-expander pairs.
for x in [
+ ['%listlit, :function expandListlit],
['%collect, :function expandCollect],
['%loop, :function expandLoop],
['%return, :function expandReturn],
@@ -701,7 +707,6 @@ isSharpVarWithNum x ==
atomic? x ==
not cons? x or x.op = 'QUOTE
-
--% Sub-domains information handlers
++ If `dom' is a subdomain, return its immediate super-domain.
@@ -767,7 +772,7 @@ isSubDomain(d1,d2) ==
--%
mkList u ==
- u => ["LIST",:u]
+ u => ['%listlit,:u]
nil
ELEMN(x, n, d) ==
@@ -1183,11 +1188,11 @@ isLetter c ==
-- the key function extracts the key from an item for comparison by pred
listSort(pred,list,:optional) ==
- NOT functionp pred => error "listSort: first arg must be a function"
- NOT LISTP list => error "listSort: second argument must be a list"
- null optional => mergeSort(pred,function Identity,list,# list)
+ not functionp pred => error "listSort: first arg must be a function"
+ not LISTP list => error "listSort: second argument must be a list"
+ optional = nil => mergeSort(pred,function Identity,list,# list)
key := first optional
- NOT functionp key => error "listSort: last arg must be a function"
+ not functionp key => error "listSort: last arg must be a function"
mergeSort(pred,key,list,# list)
-- non-destructive merge sort using NOT GGREATERP as predicate
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index 1d065fa4..93a4f261 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -145,7 +145,7 @@ asTupleNew0(eltType,listOfElts) ==
[#listOfElts,:makeSimpleArrayFromList(eltType,listOfElts)]
asTupleNewCode(eltType, size, listOfElts) ==
- ["asTupleNew", quoteForm getVMType eltType, size, ["LIST", :listOfElts]]
+ ["asTupleNew", quoteForm getVMType eltType, size, ['%listlit, :listOfElts]]
asTupleNewCode0(eltType,listForm) ==
["asTupleNew0", quoteForm getVMType eltType, listForm]
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index b922c7cd..8674d9b8 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -397,7 +397,7 @@ washFunctorBody form == main form where
stmts = nil => nil
rest stmts = nil => first stmts
["PROGN",:stmts]
- x is ["LIST"] => nil
+ x is ['%listlit] => nil
x
buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 3adb29c9..ce9c4ad4 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -280,7 +280,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
rotateCode:= [["%LET",p,q] for p in gsRev for q in [:rest gsRev,g]]
advanceCode:= ["%LET",gIndex,['ADD1,gIndex]]
- newTripleCode := ["LIST",sharpArg,:gsList]
+ newTripleCode := ['%listlit,sharpArg,:gsList]
newStateCode :=
null extraArguments => ["%store",["%dynval", MKQ stateNam],newTripleCode]
["HPUT",["%dynval", MKQ stateNam],extraArgumentCode,newTripleCode]
@@ -304,7 +304,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
mainFunction:= [nam,["LAM",margl,mbody]] where
margl:= [:argl,'envArg]
max:= gensym()
- tripleCode := ["CONS",n,["LIST",:initCode]]
+ tripleCode := ["CONS",n,['%listlit,:initCode]]
-- initialSetCode initializes the global variable if necessary and
-- also binds "stateVar" to its current value
@@ -332,9 +332,9 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
[auxfn,:argl,stateVar]]
phrase2:= [["%igt",sharpArg,["SETQ",max,["DIFFERENCE",max,k]]],
["ELT",stateVar,["QSADD1",["QSDIFFERENCE",k,["DIFFERENCE",sharpArg,max]]]]]
- phrase3:= [["%igt",sharpArg,n],[auxfn,:argl,["LIST",n,:initCode]]]
+ phrase3:= [["%igt",sharpArg,n],[auxfn,:argl,['%listlit,n,:initCode]]]
phrase4:= [["%igt",sharpArg,n-k],
- ["ELT",["LIST",:initCode],["QSDIFFERENCE",n,sharpArg]]]
+ ["ELT",['%listlit,:initCode],["QSDIFFERENCE",n,sharpArg]]]
phrase5:= ['%true,['recurrenceError,MKQ op,sharpArg]]
['PROGN,:preset,['COND,phrase1,phrase2,phrase3,phrase4,phrase5]]
if $verbose then
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index bc72afb4..88fd76ce 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -689,7 +689,7 @@ compList(l,m is ["List",mUnder],e) ==
Tl:= [[.,mUnder,e]:=
comp(x,mUnder,e) or return "failed" for i in 1.. for x in l]
Tl="failed" => nil
- T:= [["LIST",:[T.expr for T in Tl]],["List",mUnder],e]
+ T:= [['%listlit,:[T.expr for T in Tl]],["List",mUnder],e]
compVector(l,m is ["Vector",mUnder],e) ==
markImport m
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-30 23:54:42 +0000