Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
abcl
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
abcl
abcl
Commits
6ffc708d
Commit
6ffc708d
authored
Feb 13, 2010
by
vvoutilainen@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Reindentation.
parent
bce37355
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
140 additions
and
164 deletions
+140
-164
src/org/armedbear/lisp/Do.java
src/org/armedbear/lisp/Do.java
+140
-164
No files found.
src/org/armedbear/lisp/Do.java
View file @
6ffc708d
...
...
@@ -35,180 +35,156 @@ package org.armedbear.lisp;
import
static
org
.
armedbear
.
lisp
.
Lisp
.*;
public
final
class
Do
{
// ### do
private
static
final
SpecialOperator
DO
=
new
sf_do
();
private
static
final
class
sf_do
extends
SpecialOperator
{
sf_do
()
{
super
(
Symbol
.
DO
,
"varlist endlist &body body"
);
}
@Override
public
LispObject
execute
(
LispObject
args
,
Environment
env
)
public
final
class
Do
{
// ### do
private
static
final
SpecialOperator
DO
=
new
sf_do
();
private
static
final
class
sf_do
extends
SpecialOperator
{
sf_do
()
{
super
(
Symbol
.
DO
,
"varlist endlist &body body"
);
}
{
return
_do
(
args
,
env
,
false
);
}
@Override
public
LispObject
execute
(
LispObject
args
,
Environment
env
)
{
return
_do
(
args
,
env
,
false
);
}
};
// ### do*
private
static
final
SpecialOperator
DO_STAR
=
new
sf_do_star
();
private
static
final
class
sf_do_star
extends
SpecialOperator
{
sf_do_star
()
{
super
(
Symbol
.
DO_STAR
,
"varlist endlist &body body"
);
}
@Override
public
LispObject
execute
(
LispObject
args
,
Environment
env
)
// ### do*
private
static
final
SpecialOperator
DO_STAR
=
new
sf_do_star
();
private
static
final
class
sf_do_star
extends
SpecialOperator
{
sf_do_star
()
{
super
(
Symbol
.
DO_STAR
,
"varlist endlist &body body"
);
}
@Override
public
LispObject
execute
(
LispObject
args
,
Environment
env
)
{
return
_do
(
args
,
env
,
true
);
}
{
return
_do
(
args
,
env
,
true
);
}
};
private
static
final
LispObject
_do
(
LispObject
args
,
Environment
env
,
boolean
sequential
)
private
static
final
LispObject
_do
(
LispObject
args
,
Environment
env
,
boolean
sequential
)
{
LispObject
varlist
=
args
.
car
();
LispObject
second
=
args
.
cadr
();
LispObject
end_test_form
=
second
.
car
();
LispObject
result_forms
=
second
.
cdr
();
LispObject
body
=
args
.
cddr
();
// Process variable specifications.
final
int
numvars
=
varlist
.
length
();
Symbol
[]
vars
=
new
Symbol
[
numvars
];
LispObject
[]
initforms
=
new
LispObject
[
numvars
];
LispObject
[]
stepforms
=
new
LispObject
[
numvars
];
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
final
LispObject
varspec
=
varlist
.
car
();
if
(
varspec
instanceof
Cons
)
{
vars
[
i
]
=
checkSymbol
(
varspec
.
car
());
initforms
[
i
]
=
varspec
.
cadr
();
// Is there a step form?
if
(
varspec
.
cddr
()
!=
NIL
)
stepforms
[
i
]
=
varspec
.
caddr
();
}
else
{
// Not a cons, must be a symbol.
vars
[
i
]
=
checkSymbol
(
varspec
);
initforms
[
i
]
=
NIL
;
}
varlist
=
varlist
.
cdr
();
}
final
LispThread
thread
=
LispThread
.
currentThread
();
final
SpecialBindingsMark
mark
=
thread
.
markSpecialBindings
();
// Process declarations.
{
LispObject
varlist
=
args
.
car
();
LispObject
second
=
args
.
cadr
();
LispObject
end_test_form
=
second
.
car
();
LispObject
result_forms
=
second
.
cdr
();
LispObject
body
=
args
.
cddr
();
// Process variable specifications.
final
int
numvars
=
varlist
.
length
();
Symbol
[]
vars
=
new
Symbol
[
numvars
];
LispObject
[]
initforms
=
new
LispObject
[
numvars
];
LispObject
[]
stepforms
=
new
LispObject
[
numvars
];
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
final
LispObject
varspec
=
varlist
.
car
();
if
(
varspec
instanceof
Cons
)
{
vars
[
i
]
=
checkSymbol
(
varspec
.
car
());
initforms
[
i
]
=
varspec
.
cadr
();
// Is there a step form?
if
(
varspec
.
cddr
()
!=
NIL
)
stepforms
[
i
]
=
varspec
.
caddr
();
}
else
{
// Not a cons, must be a symbol.
vars
[
i
]
=
checkSymbol
(
varspec
);
initforms
[
i
]
=
NIL
;
}
varlist
=
varlist
.
cdr
();
}
final
LispThread
thread
=
LispThread
.
currentThread
();
final
SpecialBindingsMark
mark
=
thread
.
markSpecialBindings
();
// Process declarations.
final
LispObject
bodyAndDecls
=
parseBody
(
body
,
false
);
LispObject
specials
=
parseSpecials
(
bodyAndDecls
.
NTH
(
1
));
body
=
bodyAndDecls
.
car
();
final
LispObject
bodyAndDecls
=
parseBody
(
body
,
false
);
LispObject
specials
=
parseSpecials
(
bodyAndDecls
.
NTH
(
1
));
body
=
bodyAndDecls
.
car
();
Environment
ext
=
new
Environment
(
env
);
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
Symbol
var
=
vars
[
i
];
LispObject
value
=
eval
(
initforms
[
i
],
(
sequential
?
ext
:
env
),
thread
);
ext
=
new
Environment
(
ext
);
if
(
specials
!=
NIL
&&
memq
(
var
,
specials
))
thread
.
bindSpecial
(
var
,
value
);
else
if
(
var
.
isSpecialVariable
())
thread
.
bindSpecial
(
var
,
value
);
else
ext
.
bind
(
var
,
value
);
}
LispObject
list
=
specials
;
while
(
list
!=
NIL
)
{
ext
.
declareSpecial
(
checkSymbol
(
list
.
car
()));
list
=
list
.
cdr
();
}
// Look for tags.
LispObject
localTags
=
preprocessTagBody
(
body
,
ext
);
LispObject
blockId
=
new
LispObject
();
try
{
// Implicit block.
ext
.
addBlock
(
NIL
,
blockId
);
while
(
true
)
{
// Execute body.
// Test for termination.
if
(
eval
(
end_test_form
,
ext
,
thread
)
!=
NIL
)
break
;
Environment
ext
=
new
Environment
(
env
);
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
Symbol
var
=
vars
[
i
];
LispObject
value
=
eval
(
initforms
[
i
],
(
sequential
?
ext
:
env
),
thread
);
ext
=
new
Environment
(
ext
);
if
(
specials
!=
NIL
&&
memq
(
var
,
specials
))
thread
.
bindSpecial
(
var
,
value
);
else
if
(
var
.
isSpecialVariable
())
thread
.
bindSpecial
(
var
,
value
);
else
ext
.
bind
(
var
,
value
);
}
LispObject
list
=
specials
;
while
(
list
!=
NIL
)
{
ext
.
declareSpecial
(
checkSymbol
(
list
.
car
()));
list
=
list
.
cdr
();
}
// Look for tags.
LispObject
localTags
=
preprocessTagBody
(
body
,
ext
);
LispObject
blockId
=
new
LispObject
();
try
{
// Implicit block.
ext
.
addBlock
(
NIL
,
blockId
);
while
(
true
)
{
// Execute body.
// Test for termination.
if
(
eval
(
end_test_form
,
ext
,
thread
)
!=
NIL
)
break
;
processTagBody
(
body
,
localTags
,
ext
);
processTagBody
(
body
,
localTags
,
ext
);
// Update variables.
if
(
sequential
)
{
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
LispObject
step
=
stepforms
[
i
];
if
(
step
!=
null
)
{
Symbol
symbol
=
vars
[
i
];
LispObject
value
=
eval
(
step
,
ext
,
thread
);
if
(
symbol
.
isSpecialVariable
()
||
ext
.
isDeclaredSpecial
(
symbol
))
thread
.
rebindSpecial
(
symbol
,
value
);
else
ext
.
rebind
(
symbol
,
value
);
}
}
}
else
{
// Evaluate step forms.
LispObject
results
[]
=
new
LispObject
[
numvars
];
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
LispObject
step
=
stepforms
[
i
];
if
(
step
!=
null
)
{
LispObject
result
=
eval
(
step
,
ext
,
thread
);
results
[
i
]
=
result
;
}
}
// Update variables.
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
if
(
results
[
i
]
!=
null
)
{
Symbol
symbol
=
vars
[
i
];
LispObject
value
=
results
[
i
];
if
(
symbol
.
isSpecialVariable
()
||
ext
.
isDeclaredSpecial
(
symbol
))
thread
.
rebindSpecial
(
symbol
,
value
);
else
ext
.
rebind
(
symbol
,
value
);
}
}
}
if
(
interrupted
)
handleInterrupt
();
}
LispObject
result
=
progn
(
result_forms
,
ext
,
thread
);
return
result
;
}
catch
(
Return
ret
)
{
if
(
ret
.
getBlock
()
==
blockId
)
{
return
ret
.
getResult
();
}
throw
ret
;
}
finally
{
thread
.
resetSpecialBindings
(
mark
);
ext
.
inactive
=
true
;
}
}
if
(
sequential
)
{
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
LispObject
step
=
stepforms
[
i
];
if
(
step
!=
null
)
{
Symbol
symbol
=
vars
[
i
];
LispObject
value
=
eval
(
step
,
ext
,
thread
);
if
(
symbol
.
isSpecialVariable
()
||
ext
.
isDeclaredSpecial
(
symbol
))
thread
.
rebindSpecial
(
symbol
,
value
);
else
ext
.
rebind
(
symbol
,
value
);
}
}
}
else
{
// Evaluate step forms.
LispObject
results
[]
=
new
LispObject
[
numvars
];
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
LispObject
step
=
stepforms
[
i
];
if
(
step
!=
null
)
{
LispObject
result
=
eval
(
step
,
ext
,
thread
);
results
[
i
]
=
result
;
}
}
// Update variables.
for
(
int
i
=
0
;
i
<
numvars
;
i
++)
{
if
(
results
[
i
]
!=
null
)
{
Symbol
symbol
=
vars
[
i
];
LispObject
value
=
results
[
i
];
if
(
symbol
.
isSpecialVariable
()
||
ext
.
isDeclaredSpecial
(
symbol
))
thread
.
rebindSpecial
(
symbol
,
value
);
else
ext
.
rebind
(
symbol
,
value
);
}
}
}
if
(
interrupted
)
handleInterrupt
();
}
LispObject
result
=
progn
(
result_forms
,
ext
,
thread
);
return
result
;
}
catch
(
Return
ret
)
{
if
(
ret
.
getBlock
()
==
blockId
)
{
return
ret
.
getResult
();
}
throw
ret
;
}
finally
{
thread
.
resetSpecialBindings
(
mark
);
ext
.
inactive
=
true
;
}
}
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment