GScheme-20050303.tar

This commit is contained in:
Lassi Kortela 2022-08-05 12:28:41 +03:00
parent 81e8afedce
commit b87ebad788
57 changed files with 4430 additions and 3751 deletions

171
#EnvWindow.m# Normal file
View File

@ -0,0 +1,171 @@
#import "EnvWindow.h"
#import "VScheme.h"
@implementation EnvWindow
#define WIDTH 300
#define HEIGHT 200
static int count = 0;
- initWithEnv:(Environment *)env
{
NSWindow *window;
Environment *layer; int lind;
NSRect contentRect = {{0, 0}, {WIDTH, HEIGHT}};
NSRect winRect =
{{250+(count%12)*24, 100+(count%12)*24}, {WIDTH, HEIGHT}};
NSRect textRect;
unsigned int style = NSTitledWindowMask | NSClosableWindowMask |
NSMiniaturizableWindowMask | NSResizableWindowMask;
NSString *title =
[NSString stringWithFormat:@"Scheme Env. # %d", ++count];
length = [env chainLength];
names = NSZoneMalloc([self zone], length*sizeof(id));
values = NSZoneMalloc([self zone], length*sizeof(id));
NSAutoreleasePool *pool = [NSAutoreleasePool new];
for(lind=length-1, layer = env; lind>=0; lind--){
NSMapTable *data = [layer data];
names[lind] = [NSMutableArray arrayWithArray:[data allKeys]];
[names[lind] sortUsingSelector:@selector(compare:)];
[names[lind] retain];
values[lind] = [NSMutableArray arrayWithCapacity:[names[lind] count]];
[values[lind] retain];
NSMapEnumerator en = [names[lind] objectEnumerator];
id key, val;
while(NSNextMapEnumeratorPair(&enumerator, (void**)&key, (void**)&val)){
id obj = NSMapGet(data, key);
[values[lind] addObject:[VScheme valToString:obj]];
}
layer = [layer parent];
}
[pool release];
[self initWithContentRect:winRect
styleMask:style
backing:NSBackingStoreRetained
defer:NO];
[self setMinSize:NSMakeSize(WIDTH, HEIGHT)];
[self setReleasedWhenClosed:YES];
NSTableColumn *nameColumn, *valueColumn;
nameColumn =
[(NSTableColumn *)[NSTableColumn alloc]
initWithIdentifier: @"Name"];
[nameColumn setEditable: NO];
[[nameColumn headerCell] setStringValue: @"Name"];
[nameColumn setMinWidth:WIDTH/2];
valueColumn =
[(NSTableColumn *)[NSTableColumn alloc]
initWithIdentifier: @"Value"];
[valueColumn setEditable: NO];
[[valueColumn headerCell] setStringValue: @"Value"];
[valueColumn setMinWidth:WIDTH/2];
table =
[[NSTableView alloc] initWithFrame:contentRect];
[table addTableColumn:nameColumn]; RELEASE(nameColumn);
[table addTableColumn:valueColumn]; RELEASE(valueColumn);
current=length-1;
[table setDataSource:self];
scrollView = [[NSScrollView alloc] initWithFrame:contentRect];
[scrollView setHasHorizontalScroller:YES];
[scrollView setHasVerticalScroller:YES];
[scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
[[scrollView contentView]
setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
[[scrollView contentView] setAutoresizesSubviews:YES];
[table setFrameSize:[scrollView contentSize]];
[scrollView setDocumentView:table];
[self setContentView:scrollView];
// RELEASE(scrollView);
[self setTitle:title];
[self display];
[self makeKeyAndOrderFront:nil];
return self;
}
- up:(id)sender
{
if(!current){
NSBeep();
}
else{
current--;
[table reloadData];
}
return self;
}
- down:(id)sender
{
if(current==length-1){
NSBeep();
}
else{
current++;
[table reloadData];
}
return self;
}
- (int)numberOfRowsInTableView:(NSTableView *)aTableView
{
return [names[current] count];
}
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex
{
if(rowIndex>=[names[current] count]){
return nil;
}
if([[aTableColumn identifier] isEqualToString:@"Name"]){
return [names[current] objectAtIndex:rowIndex];
}
else{
return [values[current] objectAtIndex:rowIndex];
}
}
- (void)dealloc
{
int ind;
[table release];
[scrollView release];
for(ind=0; ind<length; ind++){
// NSLog(@"%@ %d %d\n", self, ind, [tables[ind] retainCount]);
[names[ind] release];
[values[ind] release];
}
NSZoneFree([self zone], names);
NSZoneFree([self zone], values);
[super dealloc];
}
@end

View File

@ -27,19 +27,21 @@
#import <Foundation/NSData.h> #import <Foundation/NSData.h>
#import <Foundation/NSAttributedString.h> #import <Foundation/NSAttributedString.h>
#import <AppKit/NSDocument.h> #import <AppKit/NSDocument.h>
#import <AppKit/NSTextView.h>
#import "SCMTextView.h"
@interface Document : NSDocument @interface Document : NSDocument
{ {
NSTextView *tview; NSScrollView *sview;
SCMTextView *tview;
NSString *progstr; NSString *progstr;
BOOL readOnly; BOOL readOnly;
} }
- init; - init;
- (void)dealloc; - (void)textDidChange:(NSNotification *)textObject;
- (void)makeWindowControllers; - (void)makeWindowControllers;
- evaluate:(id)sender; - evaluate:(id)sender;
@ -48,6 +50,8 @@
- (BOOL)loadDataRepresentation:(NSData *)data ofType:(NSString *)aType; - (BOOL)loadDataRepresentation:(NSData *)data ofType:(NSString *)aType;
- (BOOL)readFromFile:(NSString *)fileName ofType:(NSString *)docType; - (BOOL)readFromFile:(NSString *)fileName ofType:(NSString *)docType;
- (BOOL)writeToFile:(NSString *)fileName ofType:(NSString *)docType; - (BOOL)writeToFile:(NSString *)fullDocumentPath ofType:(NSString *)docType
originalFile:(NSString *)fullOriginalDocumentPath
saveOperation:(NSSaveOperationType)saveOperationType;
@end @end

View File

@ -26,6 +26,7 @@
*/ */
#include <AppKit/AppKit.h> #include <AppKit/AppKit.h>
#include <AppKit/NSWindowController.h> #include <AppKit/NSWindowController.h>
#include "Document.h" #include "Document.h"
#include "SCMTextView.h" #include "SCMTextView.h"
@ -43,10 +44,9 @@
return [super init]; return [super init];
} }
- (void)dealloc - (void)textDidChange:(NSNotification *)textObject
{ {
// RELEASE (tview); [self updateChangeCount: NSChangeDone];
[super dealloc];
} }
- (NSData *)dataRepresentationOfType:(NSString *)aType - (NSData *)dataRepresentationOfType:(NSString *)aType
@ -58,7 +58,6 @@
NSString *msg = [NSString stringWithFormat: @"Unknown type: %@", NSString *msg = [NSString stringWithFormat: @"Unknown type: %@",
[aType uppercaseString]]; [aType uppercaseString]];
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil); NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
// [msg autorelease];
return nil; return nil;
} }
} }
@ -73,8 +72,7 @@
NSString *msg = [NSString stringWithFormat: @"Unknown type: %@", NSString *msg = [NSString stringWithFormat: @"Unknown type: %@",
[aType uppercaseString]]; [aType uppercaseString]];
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil); NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
// [msg autorelease]; return NO;
return NO;
} }
return YES; return YES;
@ -90,29 +88,31 @@
readOnly = YES; readOnly = YES;
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil); NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
// [msg autorelease]; }
}
return [super readFromFile:fileName ofType:docType]; return [super readFromFile:fileName ofType:docType];
} }
- (BOOL)writeToFile:(NSString *)fileName ofType:(NSString *)docType - (BOOL)writeToFile:(NSString *)fullDocumentPath ofType:(NSString *)docType
originalFile:(NSString *)fullOriginalDocumentPath
saveOperation:(NSSaveOperationType)saveOperationType;
{ {
BOOL result = [super writeToFile:fileName ofType:docType]; BOOL result =
if(result==YES && readOnly==YES){ [super writeToFile:fullDocumentPath ofType:docType
originalFile:fullOriginalDocumentPath
saveOperation:saveOperationType];
if(result==YES && readOnly==YES && saveOperationType==NSSaveAsOperation){
NSString *msg = [NSString stringWithFormat: @"File now writable: %@", NSString *msg = [NSString stringWithFormat: @"File now writable: %@",
fileName]; fullDocumentPath];
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil); NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
// [msg autorelease];
readOnly = NO; readOnly = NO;
[tview setEditable:YES]; [tview setEditable:YES];
} }
else if(result==NO){ else if(result==NO){
NSString *msg = [NSString stringWithFormat: @"Write failed: %@", NSString *msg = [NSString stringWithFormat: @"Write failed: %@",
fileName]; fullDocumentPath];
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil); NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
// [msg autorelease];
} }
return result; return result;
@ -136,12 +136,19 @@ extern NSWindow *interpreterWindow;
res = [vm processString:progstr mode:MODE_EVALUATE]; res = [vm processString:progstr mode:MODE_EVALUATE];
if(res==NO){ if(res==NO){
int errpos = [vm errpos];
if(errpos!=-1){
[tview selectLineAtPos:errpos];
}
NSRunAlertPanel(@"Error", [vm errmsg], NSRunAlertPanel(@"Error", [vm errmsg],
@"Ok", nil, nil); @"Ok", nil, nil);
} }
else{ else{
[interpreterWindow makeKeyAndOrderFront:self]; [interpreterWindow makeKeyAndOrderFront:self];
} }
return self;
} }
- (void) makeWindowControllers - (void) makeWindowControllers
@ -150,88 +157,89 @@ extern NSWindow *interpreterWindow;
NSWindow *win = [self makeWindow]; NSWindow *win = [self makeWindow];
controller = [[NSWindowController alloc] initWithWindow: win]; controller = [[NSWindowController alloc] initWithWindow: win];
// RELEASE (win); RELEASE (win);
[self addWindowController:controller]; [self addWindowController:controller];
// RELEASE(controller); RELEASE(controller);
// We have to do this ourself, as there is currently no nib file // We have to do this ourself, as there is currently no nib file
[self windowControllerDidLoadNib:controller]; [self windowControllerDidLoadNib:controller];
} }
@end @end
int shiftPos = 0;
#define WREP 7
@implementation Document (Private) @implementation Document (Private)
static int shiftPos = 0;
#define WREP 7
- (NSWindow*)makeWindow - (NSWindow*)makeWindow
{ {
NSWindow *window; NSWindow *window;
NSScrollView *scrollView; NSScrollView *scrollView;
NSTextView *textView; SCMTextView *textView;
NSRect scrollViewRect = {{0, 0}, {470, 400}}; NSRect scrollViewRect = {{0, 0}, {470, 400}};
NSRect winRect = {{100+25*(shiftPos%WREP), 100+25*(shiftPos%WREP)}, NSRect winRect = {{100+25*(shiftPos%WREP), 100+25*(shiftPos%WREP)},
{470, 400}}; {470, 400}};
NSRect textRect; NSRect textRect;
unsigned int style = NSTitledWindowMask | NSClosableWindowMask | unsigned int style = NSTitledWindowMask | NSClosableWindowMask |
NSMiniaturizableWindowMask | NSResizableWindowMask; NSMiniaturizableWindowMask | NSResizableWindowMask;
shiftPos++; shiftPos++;
// This is expected to be retained, as it would normaly come from a // This is expected to be retained, as it would normaly come from a
// nib file, where the owner would retain it. // nib file, where the owner would retain it.
window = [[NSWindow alloc] initWithContentRect: winRect window = [[NSWindow alloc] initWithContentRect: winRect
styleMask: style styleMask: style
backing: NSBackingStoreRetained backing: NSBackingStoreRetained
defer: NO]; defer: NO];
[window setMinSize:NSMakeSize(300, 300)]; [window setMinSize:NSMakeSize(300, 300)];
[window setReleasedWhenClosed:YES];
scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect]; scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
[scrollView setHasHorizontalScroller: NO]; [scrollView setHasHorizontalScroller: NO];
[scrollView setHasVerticalScroller: YES]; [scrollView setHasVerticalScroller: YES];
[scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable]; [scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
[[scrollView contentView] setAutoresizingMask: NSViewHeightSizable [[scrollView contentView] setAutoresizingMask: NSViewHeightSizable
| NSViewWidthSizable]; | NSViewWidthSizable];
[[scrollView contentView] setAutoresizesSubviews:YES]; [[scrollView contentView] setAutoresizesSubviews:YES];
sview = scrollView;
// Build up the text network // Build up the text network
textRect = [[scrollView contentView] frame]; textRect = [[scrollView contentView] frame];
textView = [[SCMTextView alloc] initWithFrame: textRect]; textView = [[SCMTextView alloc] initWithFrame: textRect];
[textView setBackgroundColor: [NSColor whiteColor]]; [textView setBackgroundColor: [NSColor whiteColor]];
[textView setString:progstr]; [textView setString:progstr];
[textView setFont:[NSFont userFixedPitchFontOfSize:12]]; [textView setFont:[NSFont userFixedPitchFontOfSize:12]];
[textView setEditable:(readOnly==NO ? YES : NO)]; [textView setEditable:(readOnly==NO ? YES : NO)];
[textView setDelegate: self]; [textView setDelegate: self];
[textView setHorizontallyResizable: NO]; [textView setHorizontallyResizable: NO];
[textView setVerticallyResizable: YES]; [textView setVerticallyResizable: YES];
[textView setMinSize: NSMakeSize (0, 0)]; [textView setMinSize: NSMakeSize (0, 0)];
[textView setMaxSize: NSMakeSize (1E7, 1E7)]; [textView setMaxSize: NSMakeSize (1E7, 1E7)];
[textView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable]; [textView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
[[textView textContainer] setContainerSize: NSMakeSize (textRect.size.width, [[textView textContainer] setContainerSize: NSMakeSize (textRect.size.width,
1e7)]; 1e7)];
[[textView textContainer] setWidthTracksTextView: YES]; [[textView textContainer] setWidthTracksTextView: YES];
// Store the text view in an ivar // Store the text view in an ivar
tview = textView; tview = textView;
[scrollView setDocumentView: textView]; [scrollView setDocumentView: textView];
// RELEASE(textView); RELEASE(textView);
[window setContentView: scrollView]; [window setContentView: scrollView];
// RELEASE(scrollView); RELEASE(scrollView);
// Make the Document the delegate of the window // Make the Document the delegate of the window
[window setDelegate: self]; [window setDelegate: self];
[window setTitle:[self displayName]];
// Make the text view the first responder // Make the text view the first responder
[window makeFirstResponder:textView]; [window makeFirstResponder:textView];
[window display]; [window display];
[window orderFront: nil]; [window orderFront: nil];
return window; return window;
} }
@end @end

View File

@ -8,9 +8,11 @@
int current; int current;
int length; int length;
id *forms; id *names;
id *values;
NSScrollView *scrollView; NSScrollView *scrollView;
NSTableView *table;
} }
- initWithEnv:(Environment *)env; - initWithEnv:(Environment *)env;
@ -18,7 +20,13 @@
- up:(id)sender; - up:(id)sender;
- down:(id)sender; - down:(id)sender;
- releaseForms; - (int)numberOfRowsInTableView:(NSTableView *)aTableView;
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex;
- (void)dealloc;
@end @end

View File

@ -12,7 +12,7 @@ static int count = 0;
{ {
NSWindow *window; NSWindow *window;
Environment *layer; int lind; Environment *layer; int lind;
NSRect scrollViewRect = {{0, 0}, {WIDTH, HEIGHT}}; NSRect contentRect = {{0, 0}, {WIDTH, HEIGHT}};
NSRect winRect = NSRect winRect =
{{250+(count%12)*24, 100+(count%12)*24}, {WIDTH, HEIGHT}}; {{250+(count%12)*24, 100+(count%12)*24}, {WIDTH, HEIGHT}};
NSRect textRect; NSRect textRect;
@ -21,43 +21,34 @@ static int count = 0;
NSString *title = NSString *title =
[NSString stringWithFormat:@"Scheme Env. # %d", ++count]; [NSString stringWithFormat:@"Scheme Env. # %d", ++count];
length = [env chainLength]; current=length-1; length = [env chainLength];
forms = NSZoneMalloc([self zone], length*sizeof(id)); names = NSZoneMalloc([self zone], length*sizeof(id));
values = NSZoneMalloc([self zone], length*sizeof(id));
NSAutoreleasePool *pool = [NSAutoreleasePool new];
for(lind=length-1, layer = env; lind>=0; lind--){ for(lind=length-1, layer = env; lind>=0; lind--){
NSMutableDictionary *data = [layer data]; NSMapTable *data = [layer data];
NSMutableArray *keys;
NSEnumerator *en;
id key, form;
keys = [NSMutableArray arrayWithCapacity:1]; names[lind] = [NSMutableArray arrayWithArray:NSAllMapTableKeys(data)];
[keys setArray:[data allKeys]]; [names[lind] sortUsingSelector:@selector(compare:)];
[keys sortUsingSelector:@selector(compare:)]; [names[lind] retain];
en = [keys objectEnumerator]; values[lind] = [NSMutableArray arrayWithCapacity:[names[lind] count]];
[values[lind] retain];
NSEnumerator *en = [names[lind] objectEnumerator];
forms[lind] = form = id key;
[[NSForm alloc] initWithFrame:scrollViewRect];
while((key = [en nextObject])!=nil){ while((key = [en nextObject])!=nil){
id obj = [data objectForKey:key]; id obj = NSMapGet(data, key);
id ctitle = [NSString stringWithFormat:@" %@ ", key]; [values[lind] addObject:[VScheme valToString:obj]];
id cell = [form addEntry:ctitle];
[cell setEditable:NO];
[cell setEnabled:NO];
[cell setStringValue:[VScheme valToString:obj]];
} }
[form setEntryWidth:WIDTH];
[form setAutosizesCells:YES];
[form setAutoresizingMask:NSViewWidthSizable];
// [form retain];
layer = [layer parent]; layer = [layer parent];
} }
[pool release];
[self initWithContentRect:winRect [self initWithContentRect:winRect
styleMask:style styleMask:style
backing:NSBackingStoreRetained backing:NSBackingStoreRetained
@ -65,15 +56,41 @@ static int count = 0;
[self setMinSize:NSMakeSize(WIDTH, HEIGHT)]; [self setMinSize:NSMakeSize(WIDTH, HEIGHT)];
[self setReleasedWhenClosed:YES]; [self setReleasedWhenClosed:YES];
scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
NSTableColumn *nameColumn, *valueColumn;
nameColumn =
[(NSTableColumn *)[NSTableColumn alloc]
initWithIdentifier: @"Name"];
[nameColumn setEditable: NO];
[[nameColumn headerCell] setStringValue: @"Name"];
[nameColumn setMinWidth:WIDTH/2];
valueColumn =
[(NSTableColumn *)[NSTableColumn alloc]
initWithIdentifier: @"Value"];
[valueColumn setEditable: NO];
[[valueColumn headerCell] setStringValue: @"Value"];
[valueColumn setMinWidth:WIDTH/2];
table =
[[NSTableView alloc] initWithFrame:contentRect];
[table addTableColumn:nameColumn]; RELEASE(nameColumn);
[table addTableColumn:valueColumn]; RELEASE(valueColumn);
current=length-1;
[table setDataSource:self];
scrollView = [[NSScrollView alloc] initWithFrame:contentRect];
[scrollView setHasHorizontalScroller:YES]; [scrollView setHasHorizontalScroller:YES];
[scrollView setHasVerticalScroller:YES]; [scrollView setHasVerticalScroller:YES];
[scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable]; [scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
[[scrollView contentView] setAutoresizingMask: NSViewHeightSizable [[scrollView contentView]
| NSViewWidthSizable]; setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
[[scrollView contentView] setAutoresizesSubviews:YES]; [[scrollView contentView] setAutoresizesSubviews:YES];
[scrollView setDocumentView:forms[current]]; [table setFrameSize:[scrollView contentSize]];
[scrollView setDocumentView:table];
[self setContentView:scrollView]; [self setContentView:scrollView];
// RELEASE(scrollView); // RELEASE(scrollView);
@ -91,10 +108,8 @@ static int count = 0;
NSBeep(); NSBeep();
} }
else{ else{
NSRect bounds = [forms[current] bounds];
current--; current--;
[forms[current] setEntryWidth:bounds.size.width]; [table reloadData];
[scrollView setDocumentView:forms[current]];
} }
return self; return self;
@ -106,29 +121,51 @@ static int count = 0;
NSBeep(); NSBeep();
} }
else{ else{
NSRect bounds = [forms[current] bounds];
current++; current++;
[forms[current] setEntryWidth:bounds.size.width]; [table reloadData];
[scrollView setDocumentView:forms[current]];
} }
return self; return self;
} }
- releaseForms - (int)numberOfRowsInTableView:(NSTableView *)aTableView
{
return [names[current] count];
}
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex
{
if(rowIndex>=[names[current] count]){
return nil;
}
if([[aTableColumn identifier] isEqualToString:@"Name"]){
return [names[current] objectAtIndex:rowIndex];
}
else{
return [values[current] objectAtIndex:rowIndex];
}
}
- (void)dealloc
{ {
int ind; int ind;
[scrollView setDocumentView:nil]; [table release];
[scrollView release]; [scrollView release];
for(ind=0; ind<length; ind++){ for(ind=0; ind<length; ind++){
// NSLog(@"%@ %d %d\n", self, ind, [forms[ind] retainCount]); // NSLog(@"%@ %d %d\n", self, ind, [tables[ind] retainCount]);
[forms[ind] release]; [names[ind] release];
[values[ind] release];
} }
NSZoneFree([self zone], forms); NSZoneFree([self zone], names);
return self; NSZoneFree([self zone], values);
[super dealloc];
} }
@end @end

View File

@ -25,7 +25,7 @@ SHARED_CFLAGS += -g
AUXILIARY_TOOL_LIBS += -lfl AUXILIARY_TOOL_LIBS += -lfl
# The Resource files to be copied into the app's resources directory # The Resource files to be copied into the app's resources directory
GScheme_RESOURCE_FILES = Scheme/* GScheme_RESOURCE_FILES = Scheme/* Icons/*
-include GNUmakefile.preamble -include GNUmakefile.preamble

View File

@ -1,218 +0,0 @@
#!/bin/sh
#
# Copyright (C) 1999 Free Software Foundation, Inc.
#
# Author: Adam Fedor <fedor@gnu.org>
# Date: May 1999
#
# This file is part of the GNUstep Makefile Package.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# You should have received a copy of the GNU General Public
# License along with this library; see the file COPYING.LIB.
# If not, write to the Free Software Foundation,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# This is a shell script which attempts to find the GNUstep executable
# of the same name based on the current host and library_combo.
#--------------------------------------------------------------------------
# Main body
#--------------------------------------------------------------------------
if [ -z "$EXEEXT" ]; then
EXEEXT=
fi
if [ -z "$LIBRARY_COMBO" ]; then
LIBRARY_COMBO=gnu-gnu-gnu
fi
# Process arguments
app=$0
show_available_platforms=0
show_relative_path=0
show_full_path=0
while true
do
case $1 in
--script-help)
echo usage: `basename $0` [--library-combo=...]
echo " [--available-platforms][--full-executable-path]"
echo " [--relative-executable-path] [arguments...]"
echo
echo " --library-combo=... specifies a GNUstep backend to use."
echo " It overrides the default LIBRARY_COMBO environment variable."
echo
echo " --available-platforms displays a list of valid exec hosts"
echo " --full-executable-path displays full path to executable"
echo " --relative-executable-path displays subdirectory path"
echo " arguments... are the arguments to the application."
exit 0
;;
--library-combo=*)
LIBRARY_COMBO=`echo $1 | sed 's/--library-combo=//'`
shift
;;
--available-platforms)
show_available_platforms=1
exit 0
;;
--full-executable-path)
show_full_path=1
break
;;
--relative-executable-path)
show_relative_path=1
break
;;
*)
break;;
esac
done
if [ "$LIBRARY_COMBO" = nx ]; then
LIBRARY_COMBO=nx-nx-nx
elif [ "$LIBRARY_COMBO" = gnu ]; then
LIBRARY_COMBO=gnu-gnu-gnu
elif [ "$LIBRARY_COMBO" = fd ]; then
LIBRARY_COMBO=gnu-fd-gnu
fi
export LIBRARY_COMBO
# Find path to ourself
app=`echo $app | sed 's%/*$%%'`
dir=`dirname $app`
case $app in
/*) # An absolute path.
full_appname=$dir;;
*/*) # A relative path
full_appname=`(cd $dir; pwd)`;;
*) # A path that needs to be searched
if [ -n $GNUSTEP_PATHPREFIX_LIST ]; then
SPATH=$GNUSTEP_PATHPREFIX_LIST
else
SPATH=$PATH
fi
SPATH=.:$SPATH
IFS=:
for path_dir in $SPATH; do
if [ -d $path_dir/$dir ]; then
full_appname=`(cd $path_dir/$dir; pwd)`
break;
fi
if [ -d $path_dir/Applications/$dir ]; then
full_appname=`(cd $path_dir/Applications/$dir; pwd)`
break;
fi
done;;
esac
if [ -z "$full_appname" ]; then
echo "Can't find absolute path for $app! Please specify full path when"
echo "invoking executable"
exit 1
fi
#
# get base app name
#
app=`echo $app | sed 's/\.[a-z]*$//'`
app=`basename $app`
appname=
if [ -f "$full_appname/Resources/Info-gnustep.plist" ]; then
# -n disable auto-print (for portability reasons)
# /^ *NSExecutable *=/ matches every line beginning with
# zero or more spaces, followed by 'NSExecutable', followed by zero or
# more spaces, followed by '='
# to this line we apply the following commands:
# s/"//g; which deletes all " in the line.
# s/^ *NSExecutable *= *\([^ ;]*\) *;.*/\1/p;
# which replaces 'NSExecutable = Gorm; ' with 'Gorm', then, because
# of the 'p' at the end, prints out the result
# q; which quits sed since we know there must be only a single line
# to replace.
appname=`sed -n -e '/^ *NSExecutable *=/ \
{s/"//g; s/^ *NSExecutable *= *\([^ ;]*\) *;.*/\1/p; q;}' \
"$full_appname/Resources/Info-gnustep.plist"`
fi
if [ -z "$appname" ]; then
appname=$app
fi
appname="$appname$EXEEXT"
if [ $show_available_platforms = 1 ]; then
cd $full_appname
#available_platforms
exit 0
fi
#
# Determine the host information
#
if [ -z "$GNUSTEP_HOST" ]; then
GNUSTEP_HOST=`(cd /tmp; $GNUSTEP_SYSTEM_ROOT/Makefiles/config.guess)`
GNUSTEP_HOST=`(cd /tmp; $GNUSTEP_SYSTEM_ROOT/Makefiles/config.sub $GNUSTEP_HOST)`
export GNUSTEP_HOST
fi
if [ -z "$GNUSTEP_HOST_CPU" ]; then
GNUSTEP_HOST_CPU=`$GNUSTEP_SYSTEM_ROOT/Makefiles/cpu.sh $GNUSTEP_HOST`
GNUSTEP_HOST_CPU=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_cpu.sh $GNUSTEP_HOST_CPU`
export GNUSTEP_HOST_CPU
fi
if [ -z "$GNUSTEP_HOST_VENDOR" ]; then
GNUSTEP_HOST_VENDOR=`$GNUSTEP_SYSTEM_ROOT/Makefiles/vendor.sh $GNUSTEP_HOST`
GNUSTEP_HOST_VENDOR=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_vendor.sh $GNUSTEP_HOST_VENDOR`
export GNUSTEP_HOST_VENDOR
fi
if [ -z "$GNUSTEP_HOST_OS" ]; then
GNUSTEP_HOST_OS=`$GNUSTEP_SYSTEM_ROOT/Makefiles/os.sh $GNUSTEP_HOST`
GNUSTEP_HOST_OS=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_os.sh $GNUSTEP_HOST_OS`
export GNUSTEP_HOST_OS
fi
#
# Make sure the executable is there
#
if [ -x $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/$appname ]; then
relative_path=$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/$appname
elif [ -x $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$appname ]; then
relative_path=$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$appname
elif [ -x $full_appname/$GNUSTEP_HOST_CPU/$appname ]; then
relative_path=$GNUSTEP_HOST_CPU/$appname
elif [ $appname != $app -a -x $full_appname/$appname ]; then
relative_path=$appname
else
echo "$full_appname application does not have a binary for this kind of machine/operating system ($GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS)."
exit 1
fi
if [ $show_relative_path = 1 ]; then
echo $relative_path
exit 0
fi
if [ $show_full_path = 1 ]; then
echo $full_appname/$relative_path
exit 0
fi
if [ "$LIBRARY_COMBO" = nx-nx-nx -a $GNUSTEP_HOST_OS = nextstep4 ]; then
if [ -f "$full_appname/library_paths.openapp" ]; then
additional_library_paths="`cat $full_appname/library_paths.openapp`"
fi
else
if [ -f "$full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/library_paths.openapp" ]; then
additional_library_paths="`cat $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/library_paths.openapp`"
fi
fi
# Load up LD_LIBRARY_PATH
. $GNUSTEP_SYSTEM_ROOT/Makefiles/ld_lib_path.sh
exec $full_appname/$relative_path "$@"

View File

@ -1,8 +0,0 @@
[Desktop Entry]
Encoding=UTF-8
Type=Application
Version=GScheme 0.1
Name=GScheme
Exec=openapp GScheme.app
#TryExec=GScheme.app
MimeType=

View File

@ -1,29 +0,0 @@
{
ApplicationDescription = "A scheme interpreter";
ApplicationName = GScheme;
ApplicationRelease = "GScheme 0.1";
Authors = (
"Marko Riedel <mriedel@neuearbeit.de>"
);
Copyright = "Copyright (C) 2002 Free Software Foundation, Inc.";
CopyrightDescription = "This program is released under the GNU General Public License";
FullVersionID = "0.1, June 2002";
NOTE = "Automatically generated, do not edit!";
NSExecutable = GScheme;
NSMainNibFile = "";
NSPrincipalClass = NSApplication;
NSTypes = (
{
NSDOSExtensions = (
scm
);
NSDocumentClass = Document;
NSHumanReadableName = "Scheme program";
NSName = scm;
NSRole = Editor;
NSUnixExtensions = (
scm
);
}
);
}

View File

@ -1,109 +0,0 @@
(define vector
(lambda args
(list->vector args)))
(define list-n
(lambda (n)
(if (zero? n) '()
(cons n (list-n (- n 1))))))
(define list-ref
(lambda (l n)
(if (zero? n)
(car l)
(list-ref (cdr l) (- n 1)))))
(define length
(lambda (l)
(if (or (null? l) (not (pair? l))) 0
(+ 1 (length (cdr l))))))
(define filter
(lambda (l f)
(if (null? l) '()
(if (f (car l))
(cons (car l) (filter (cdr l) f))
(filter (cdr l) f)))))
(define reverse
(letrec
((rev
(lambda (l acc)
(if (null? l) acc
(rev (cdr l) (cons (car l) acc))))))
(lambda (l)
(rev l '()))))
(define append
(lambda (l . ls)
(if (null? l)
(if (pair? ls)
(if (pair? (cdr ls))
(apply append ls)
(car ls)) ls)
(cons (car l)
(apply append (cons (cdr l) ls))))))
(define eqv? eq?)
(define equal?
(lambda (obj1 obj2)
(if (and (pair? obj1) (pair? obj2))
(and (equal? (car obj1) (car obj2))
(equal? (cdr obj1) (cdr obj2)))
(if (or (pair? obj1) (pair? obj2)) #f
(eqv? obj1 obj2)))))
(define memgeneric
(lambda (obj l pred)
(if (null? l) '()
(if (pred obj (car l)) l
(memgeneric obj (cdr l) pred)))))
(define memq
(lambda (obj l) (memgeneric obj l eq?)))
(define memv
(lambda (obj l) (memgeneric obj l eqv?)))
(define member
(lambda (obj l) (memgeneric obj l equal?)))
(define association
(lambda (obj l pred)
(if (null? l) #f
(if (and (pair? (car l))
(pred obj (car (car l))))
(car l)
(association obj (cdr l) pred)))))
(define assq
(lambda (obj l) (association obj l eq?)))
(define assv
(lambda (obj l) (association obj l eqv?)))
(define assoc
(lambda (obj l) (association obj l equal?)))
(define map-over-single-list
(lambda (p l)
(if (null? l) '()
(cons (p (car l))
(map-over-single-list p (cdr l))))))
(define map
(lambda (proc . lists)
(if (memq '() lists) '()
(cons
(apply proc
(map-over-single-list car lists))
(apply map
(cons proc (map-over-single-list cdr lists)))))))
(define for-each
(lambda (proc . lists)
(if (memq '() lists) '()
(begin
(apply proc
(map-over-single-list car lists))
(apply for-each
(cons proc (map-over-single-list cdr lists)))))))

View File

@ -1,103 +0,0 @@
(define list-n
(lambda (n)
(if (zero? n) '()
(cons n (list-n (- n 1))))))
(define list-ref
(lambda (l n)
(if (zero? n)
(car l)
(list-ref (cdr l) (- n 1)))))
(define length
(lambda (l)
(if (or (null? l) (not (pair? l))) 0
(+ 1 (length (cdr l))))))
(define filter
(lambda (l f)
(if (null? l) '()
(if (f (car l))
(cons (car l) (filter (cdr l) f))
(filter (cdr l) f)))))
(define reverse
(letrec
((rev
(lambda (l acc)
(if (null? l) acc
(rev (cdr l) (cons (car l) acc))))))
(lambda (l)
(rev l '()))))
(define append
(lambda (l . ls)
(if (null? l)
(if (pair? ls)
(if (pair? (cdr ls))
(apply append ls)
(car ls)) ls)
(cons (car l)
(apply append (cons (cdr l) ls))))))
(define eqv? eq?)
(define equal?
(lambda (obj1 obj2)
(if (and (pair? obj1) (pair? obj2))
(and (equal? (car obj1) (car obj2))
(equal? (cdr obj1) (cdr obj2)))
(if (or (pair? obj1) (pair? obj2)) #f
(eqv? obj1 obj2)))))
(define memgeneric
(lambda (obj l pred)
(if (null? l) '()
(if (pred obj (car l)) l
(memgeneric obj (cdr l) pred)))))
(define memq
(lambda (obj l) (memgeneric obj l eq?)))
(define memv
(lambda (obj l) (memgeneric obj l eqv?)))
(define member
(lambda (obj l) (memgeneric obj l equal?)))
(define association
(lambda (obj l pred)
(if (null? l) #f
(if (and (pair? (car l))
(pred obj (car (car l))))
(car l)
(association obj (cdr l) pred)))))
(define assq
(lambda (obj l) (association obj l eq?)))
(define assv
(lambda (obj l) (association obj l eqv?)))
(define assoc
(lambda (obj l) (association obj l equal?)))
(define map-over-single-list
(lambda (p l)
(if (null? l) '()
(cons (p (car l))
(map-over-single-list p (cdr l))))))
(define map
(lambda (proc . lists)
(if (memq '() lists) '()
(cons
(apply proc
(map-over-single-list car lists))
(apply map
(cons proc (map-over-single-list cdr lists)))))))
(define for-each
(lambda (proc . lists)
(if (memq '() lists) '()
(begin
(apply proc
(map-over-single-list car lists))
(apply for-each
(cons proc (map-over-single-list cdr lists)))))))

View File

@ -1,11 +1,12 @@
{ {
ApplicationName = "GScheme"; ApplicationName = "GScheme";
ApplicationDescription = "A scheme interpreter"; ApplicationDescription = "A scheme interpreter";
ApplicationRelease = "GScheme 0.1"; ApplicationRelease = "GScheme 0.5";
FullVersionID = "0.1, June 2002"; FullVersionID = "0.5, January 2005";
Authors = ("Marko Riedel <mriedel@neuearbeit.de>"); Authors = ("Marko Riedel <mriedel@neuearbeit.de>");
Copyright = "Copyright (C) 2002 Free Software Foundation, Inc."; Copyright = "Copyright (C) 2005 Free Software Foundation, Inc.";
CopyrightDescription = "This program is released under the GNU General Public License"; CopyrightDescription = "This program is released under the GNU General Public License";
NSIcon = "GScheme.tiff";
NSTypes = ( NSTypes = (
{ {
NSName = "scm"; NSName = "scm";

BIN
Icons/GScheme.tiff Normal file

Binary file not shown.

BIN
Icons/lambda1.tiff Normal file

Binary file not shown.

6
NOTES Normal file
View File

@ -0,0 +1,6 @@
wrp
retaincount loop
external
paste
stop button
env browser

View File

@ -18,6 +18,7 @@ BOOL isPair(id item);
BOOL isVector(id item); BOOL isVector(id item);
BOOL isTriple(id item); BOOL isTriple(id item);
BOOL isPrimitive(id item); BOOL isPrimitive(id item);
BOOL isEval(id item);
BOOL isClosure(id item); BOOL isClosure(id item);
BOOL isThunk(id item); BOOL isThunk(id item);
BOOL isFalse(id item); BOOL isFalse(id item);
@ -118,6 +119,11 @@ typedef enum {
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs; - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end @end
@interface PRMRandom : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMQuotient : Primitive @interface PRMQuotient : Primitive
- (NSString *)primName; - (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs; - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@ -183,6 +189,41 @@ typedef enum {
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs; - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end @end
@interface PRMDrawCircle : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMFillCircle : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMDrawRect : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMFillRect : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMDrawFont : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMDrawString : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMDrawShow : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMSin : Primitive @interface PRMSin : Primitive
- (NSString *)primName; - (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs; - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@ -193,6 +234,26 @@ typedef enum {
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs; - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end @end
@interface PRMTan : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMExp : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMLog : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMATan : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMASin : Primitive @interface PRMASin : Primitive
- (NSString *)primName; - (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs; - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@ -243,7 +304,76 @@ typedef enum {
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs; - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end @end
@interface PRMSymToStr : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMStrToSym : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMStringSize : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMStringLength : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMCharToInt : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMIntToChar : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMStringRef : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMListToStr : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMStrToList : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMStringAppend : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMMakeString : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMNumberToStr : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMFormat : Primitive
- (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end
@interface PRMBrowseEnvironment : Primitive @interface PRMBrowseEnvironment : Primitive
- (NSString *)primName; - (NSString *)primName;
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs; - (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
@end @end
@interface PRMEval : Primitive
- (NSString *)primName;
@end

File diff suppressed because it is too large Load Diff

View File

@ -4,6 +4,13 @@
#import "VScheme.h" #import "VScheme.h"
@interface NSTextView (Misc)
- placeCursorAtEnd;
- selectLineAtPos:(int)pos;
@end
@interface SCMTextView : NSTextView @interface SCMTextView : NSTextView
- (void)insertText:(id)aString; - (void)insertText:(id)aString;
@ -18,8 +25,8 @@
- (id)initWithFrame:(NSRect)frameRect; - (id)initWithFrame:(NSRect)frameRect;
- (void)insertText:(id)aString; - (void)insertText:(id)aString;
- (void)paste:(id)sender;
- placeCursorAtEnd;
- (NSString *)getSuffix; - (NSString *)getSuffix;
- (void)setString:(NSString *)aString; - (void)setString:(NSString *)aString;

View File

@ -2,6 +2,28 @@
#import "SCMTextView.h" #import "SCMTextView.h"
#import "SchemeDelegate.h" #import "SchemeDelegate.h"
@implementation NSTextView (Misc)
- placeCursorAtEnd
{
NSRange range = { [[self string] length], 0 };
[self setSelectedRange:range];
return self;
}
- selectLineAtPos:(int)pos
{
NSString *data = [self string];
unsigned startInd, endInd;
[data getLineStart:&startInd end:&endInd
contentsEnd:NULL forRange:NSMakeRange(pos, 0)];
[self setSelectedRange:NSMakeRange(startInd, endInd-startInd)];
return self;
}
@end
@implementation SCMTextView @implementation SCMTextView
@ -68,17 +90,21 @@
- (void)insertText:(id)aString - (void)insertText:(id)aString
{ {
if([self selectedRange].location<lastRetrieved){ if([self selectedRange].location<lastRetrieved){
return; NSRange range = { [[self string] length], 0 };
[self setSelectedRange:range];
} }
[super insertText:aString]; [super insertText:aString];
} }
- placeCursorAtEnd - (void)paste:(id)sender
{ {
NSRange range = { [[self string] length], 0 }; if([self selectedRange].location<lastRetrieved){
[self setSelectedRange:range]; NSRange range = { [[self string] length], 0 };
return self; [self setSelectedRange:range];
}
[super paste:sender];
} }
- (NSString *)getSuffix - (NSString *)getSuffix
@ -115,10 +141,18 @@
if((ch==NSNewlineCharacter || ch==NSCarriageReturnCharacter) && if((ch==NSNewlineCharacter || ch==NSCarriageReturnCharacter) &&
len==1 && (modifiers & NSControlKeyMask)){ len==1 && (modifiers & NSControlKeyMask)){
BOOL res = [[self delegate] processString:[self getSuffix] NSString *sfx = [self getSuffix];
mode:MODE_INTERACTIVE];
NSPasteboard *pb = [NSPasteboard generalPasteboard];
[pb declareTypes:[NSArray arrayWithObject:NSStringPboardType]
owner:nil];
[pb setString:sfx forType:NSStringPboardType];
BOOL res =
[[self delegate] processString:sfx
mode:MODE_INTERACTIVE];
if(res==NO){ if(res==NO){
NSRunAlertPanel(@"Error", [[self delegate] errmsg], NSRunAlertPanel(@"Error", [(VScheme *)[self delegate] errmsg],
@"Ok", nil, nil); @"Ok", nil, nil);
} }
return; return;

View File

@ -107,3 +107,46 @@
(map-over-single-list car lists)) (map-over-single-list car lists))
(apply for-each (apply for-each
(cons proc (map-over-single-list cdr lists))))))) (cons proc (map-over-single-list cdr lists)))))))
(define pow (lambda (x y) (exp (* y (log x)))))
(define caar (lambda (p) (car (car p))))
(define cadr (lambda (p) (car (cdr p))))
(define cdar (lambda (p) (cdr (car p))))
(define cddr (lambda (p) (cdr (cdr p))))
(define caaar (lambda (p) (car (car (car p)))))
(define caadr (lambda (p) (car (car (cdr p)))))
(define cadar (lambda (p) (car (cdr (car p)))))
(define caddr (lambda (p) (car (cdr (cdr p)))))
(define cdaar (lambda (p) (cdr (car (car p)))))
(define cdadr (lambda (p) (cdr (car (cdr p)))))
(define cddar (lambda (p) (cdr (cdr (car p)))))
(define cdddr (lambda (p) (cdr (cdr (cdr p)))))
(define min-max
(lambda (pred args)
(letrec
((iter
(lambda (l m)
(if (null? l) m
(iter (cdr l)
(if (pred (car l) m) (car l) m))))))
(iter (cdr args) (car args)))))
(define min
(lambda args
(min-max < args)))
(define max
(lambda args
(min-max > args)))
(define make-range
(lambda (a b)
(if (= a b) (list a)
(cons
a (make-range (+ 1 a) b)))))

View File

@ -1,3 +1,9 @@
(define vector
(lambda args
(list->vector args)))
(define list-n (define list-n
(lambda (n) (lambda (n)
(if (zero? n) '() (if (zero? n) '()
@ -101,3 +107,41 @@
(map-over-single-list car lists)) (map-over-single-list car lists))
(apply for-each (apply for-each
(cons proc (map-over-single-list cdr lists))))))) (cons proc (map-over-single-list cdr lists)))))))
(define pow (lambda (x y) (exp (* y (log x)))))
(define caar (lambda (p) (car (car p))))
(define cadr (lambda (p) (car (cdr p))))
(define cdar (lambda (p) (cdr (car p))))
(define cddr (lambda (p) (cdr (cdr p))))
(define caaar (lambda (p) (car (car (car p)))))
(define caadr (lambda (p) (car (car (cdr p)))))
(define cadar (lambda (p) (car (cdr (car p)))))
(define caddr (lambda (p) (car (cdr (cdr p)))))
(define cdaar (lambda (p) (cdr (car (car p)))))
(define cdadr (lambda (p) (cdr (car (cdr p)))))
(define cddar (lambda (p) (cdr (cdr (car p)))))
(define cdddr (lambda (p) (cdr (cdr (cdr p)))))
(define min-max
(lambda (pred args)
(letrec
((iter
(lambda (l m)
(if (null? l) m
(iter (cdr l)
(if (pred (car l) m) (car l) m))))))
(iter (cdr args) (car args)))))
(define min
(lambda args
(min-max < args)))
(define max
(lambda args
(min-max > args)))

View File

@ -14,13 +14,19 @@
NSMutableArray *imageWindows; NSMutableArray *imageWindows;
NSMutableArray *envWindows; NSMutableArray *envWindows;
NSPanel *interruptPanel;
} }
- (void)applicationWillFinishLaunching:(NSNotification *)not; - (void)applicationWillFinishLaunching:(NSNotification *)not;
- (void)applicationDidFinishLaunching:(NSNotification *)not; - (void)applicationDidFinishLaunching:(NSNotification *)not;
- makeInterpreterWindow; - makeInterpreterWindow;
- makeStatisticsWindow; - makeStatisticsPanel;
- makeInterruptPanel;
- (NSPanel *)interruptPanel;
- input:(NSString *)data; - input:(NSString *)data;
- output:(NSString *)data; - output:(NSString *)data;
@ -35,5 +41,7 @@
- reset:(id)sender; - reset:(id)sender;
- addExternal:(id)sender;
- evaluateExternal:(id)sender;
@end @end

View File

@ -9,219 +9,224 @@ VScheme *vm = nil;
- (void)applicationWillFinishLaunching:(NSNotification *)not - (void)applicationWillFinishLaunching:(NSNotification *)not
{ {
// CREATE_AUTORELEASE_POOL(pool); // CREATE_AUTORELEASE_POOL(pool);
NSMenu *menu; NSMenu *menu, *info, *file, *scheme, *external, *env,
NSMenu *info; *edit, *print, *services, *windows;
NSMenu *file;
NSMenu *scheme;
NSMenu *env;
NSMenu *edit;
NSMenu *print;
NSMenu *services;
NSMenu *windows;
// Create the app menu // Create the app menu
menu = [NSMenu new]; menu = [NSMenu new];
[menu addItemWithTitle: @"Info" [menu addItemWithTitle: @"Info"
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
[menu addItemWithTitle: @"File" [menu addItemWithTitle: @"File"
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
[menu addItemWithTitle: @"Edit" [menu addItemWithTitle: @"Edit"
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
[menu addItemWithTitle: @"Windows" [menu addItemWithTitle: @"Windows"
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
[menu addItemWithTitle: @"Scheme" [menu addItemWithTitle: @"Scheme"
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
[menu addItemWithTitle: @"Environment" [menu addItemWithTitle: @"Environment"
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
[menu addItemWithTitle: @"Services" [menu addItemWithTitle: @"Services"
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
[menu addItemWithTitle: @"Hide" [menu addItemWithTitle: @"Hide"
action: @selector(hide:) action: @selector(hide:)
keyEquivalent: @"h"]; keyEquivalent: @"h"];
[menu addItemWithTitle: @"Quit" [menu addItemWithTitle: @"Quit"
action: @selector(terminate:) action: @selector(terminate:)
keyEquivalent: @"q"]; keyEquivalent: @"q"];
// Create the scheme submenu // Create the scheme submenu
scheme = [NSMenu new]; scheme = [NSMenu new];
[menu setSubmenu: scheme [menu setSubmenu: scheme
forItem: [menu itemWithTitle: @"Scheme"]]; forItem: [menu itemWithTitle: @"Scheme"]];
[scheme addItemWithTitle: @"Reset" [scheme addItemWithTitle: @"Reset"
action: @selector(reset:) action: @selector(reset:)
keyEquivalent: @"+"]; keyEquivalent: @"+"];
[scheme addItemWithTitle: @"Evaluate" [scheme addItemWithTitle: @"Evaluate"
action: @selector(evaluate:) action: @selector(evaluate:)
keyEquivalent: @"#"]; keyEquivalent: @"#"];
// Create the environment submenu [scheme addItemWithTitle: @"Evaluate external"
env = [NSMenu new]; action:NULL
[menu setSubmenu: env keyEquivalent: @""];
forItem: [menu itemWithTitle: @"Environment"]];
[env addItemWithTitle: @"Up" external = [NSMenu new];
action: @selector(up:) [scheme setSubmenu: external
keyEquivalent: @""]; forItem: [scheme itemWithTitle: @"Evaluate external"]];
[external addItemWithTitle: @"Add external"
action: @selector(addExternal:)
keyEquivalent: @""];
[env addItemWithTitle: @"Down"
action: @selector(down:)
keyEquivalent: @""];
// Create the info submenu // Create the environment submenu
info = [NSMenu new]; env = [NSMenu new];
[menu setSubmenu: info [menu setSubmenu: env
forItem: [menu itemWithTitle: @"Info"]]; forItem: [menu itemWithTitle: @"Environment"]];
[info addItemWithTitle: @"Info Panel..." [env addItemWithTitle: @"Up"
action: @selector(orderFrontStandardInfoPanel:) action: @selector(up:)
keyEquivalent: @""]; keyEquivalent: @""];
[env addItemWithTitle: @"Down"
action: @selector(down:)
keyEquivalent: @""];
// Create the info submenu
info = [NSMenu new];
[menu setSubmenu: info
forItem: [menu itemWithTitle: @"Info"]];
[info addItemWithTitle: @"Info Panel..."
action: @selector(orderFrontStandardInfoPanel:)
keyEquivalent: @""];
/* /*
[info addItemWithTitle: @"Preferences..." [info addItemWithTitle: @"Preferences..."
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
*/ */
[info addItemWithTitle: @"Help" [info addItemWithTitle: @"Help"
action: @selector (orderFrontHelpPanel:) action: @selector (orderFrontHelpPanel:)
keyEquivalent: @"?"]; keyEquivalent: @"?"];
// RELEASE(info); // RELEASE(info);
// Create the file submenu // Create the file submenu
file = [NSMenu new]; file = [NSMenu new];
[menu setSubmenu: file [menu setSubmenu: file
forItem: [menu itemWithTitle: @"File"]]; forItem: [menu itemWithTitle: @"File"]];
[file addItemWithTitle: @"Open Document" [file addItemWithTitle: @"Open Document"
action: @selector(openDocument:) action: @selector(openDocument:)
keyEquivalent: @"o"]; keyEquivalent: @"o"];
[file addItemWithTitle: @"New Document" [file addItemWithTitle: @"New Document"
action: @selector(newDocument:) action: @selector(newDocument:)
keyEquivalent: @"n"]; keyEquivalent: @"n"];
[file addItemWithTitle: @"Save" [file addItemWithTitle: @"Save"
action: @selector(saveDocument:) action: @selector(saveDocument:)
keyEquivalent: @"s"]; keyEquivalent: @"s"];
[file addItemWithTitle: @"Save To..." [file addItemWithTitle: @"Save To..."
action: @selector(saveDocumentTo:) action: @selector(saveDocumentTo:)
keyEquivalent: @"t"]; keyEquivalent: @"t"];
[file addItemWithTitle: @"Save As..." [file addItemWithTitle: @"Save As..."
action: @selector(saveDocumentAs:) action: @selector(saveDocumentAs:)
keyEquivalent: @"S"]; keyEquivalent: @"S"];
[file addItemWithTitle: @"Save All" [file addItemWithTitle: @"Save All"
action: @selector(saveDocumentAll:) action: @selector(saveDocumentAll:)
keyEquivalent: @""]; keyEquivalent: @""];
[file addItemWithTitle: @"Revert to Saved" [file addItemWithTitle: @"Revert to Saved"
action: @selector(revertDocumentToSaved:) action: @selector(revertDocumentToSaved:)
keyEquivalent: @"u"]; keyEquivalent: @"u"];
[file addItemWithTitle: @"Close" [file addItemWithTitle: @"Close"
action: @selector(close) action: @selector(close)
keyEquivalent: @""]; keyEquivalent: @""];
[file addItemWithTitle: @"Insert File..." [file addItemWithTitle: @"Insert File..."
action: @selector(insertFile:) action: @selector(insertFile:)
keyEquivalent: @""]; keyEquivalent: @""];
// RELEASE(file); // RELEASE(file);
// Create the edit submenu // Create the edit submenu
edit = [NSMenu new]; edit = [NSMenu new];
[menu setSubmenu: edit [menu setSubmenu: edit
forItem: [menu itemWithTitle: @"Edit"]]; forItem: [menu itemWithTitle: @"Edit"]];
[edit addItemWithTitle: @"Cut" [edit addItemWithTitle: @"Cut"
action: @selector(cut:) action: @selector(cut:)
keyEquivalent: @"x"]; keyEquivalent: @"x"];
[edit addItemWithTitle: @"Copy" [edit addItemWithTitle: @"Copy"
action: @selector(copy:) action: @selector(copy:)
keyEquivalent: @"c"]; keyEquivalent: @"c"];
[edit addItemWithTitle: @"Paste" [edit addItemWithTitle: @"Paste"
action: @selector(paste:) action: @selector(paste:)
keyEquivalent: @"v"]; keyEquivalent: @"v"];
[edit addItemWithTitle: @"Delete" [edit addItemWithTitle: @"Delete"
action: @selector(delete:) action: @selector(delete:)
keyEquivalent: @""]; keyEquivalent: @""];
/* /*
[edit addItemWithTitle: @"Undelete" [edit addItemWithTitle: @"Undelete"
action: NULL action: NULL
keyEquivalent: @""]; keyEquivalent: @""];
*/ */
[edit addItemWithTitle: @"Select All" [edit addItemWithTitle: @"Select All"
action: @selector(selectAll:) action: @selector(selectAll:)
keyEquivalent: @"a"]; keyEquivalent: @"a"];
// RELEASE(edit); // RELEASE(edit);
// Create the windows submenu // Create the windows submenu
windows = [NSMenu new]; windows = [NSMenu new];
[menu setSubmenu: windows [menu setSubmenu: windows
forItem: [menu itemWithTitle: @"Windows"]]; forItem: [menu itemWithTitle: @"Windows"]];
[windows addItemWithTitle: @"Arrange" [windows addItemWithTitle: @"Arrange"
action: @selector(arrangeInFront:) action: @selector(arrangeInFront:)
keyEquivalent: @""]; keyEquivalent: @""];
[windows addItemWithTitle: @"Miniaturize" [windows addItemWithTitle: @"Miniaturize"
action: @selector(performMiniaturize:) action: @selector(performMiniaturize:)
keyEquivalent: @"m"]; keyEquivalent: @"m"];
[windows addItemWithTitle: @"Close" [windows addItemWithTitle: @"Close"
action: @selector(performClose:) action: @selector(performClose:)
keyEquivalent: @"w"]; keyEquivalent: @"w"];
[windows addItemWithTitle: @"Close image windows" [windows addItemWithTitle: @"Close image windows"
action: @selector(closeImageWindows:) action: @selector(closeImageWindows:)
keyEquivalent: @"W"]; keyEquivalent: @"W"];
[windows addItemWithTitle: @"Close environment windows" [windows addItemWithTitle: @"Close environment windows"
action: @selector(closeEnvWindows:) action: @selector(closeEnvWindows:)
keyEquivalent: @""]; keyEquivalent: @""];
[NSApp setWindowsMenu: windows]; [NSApp setWindowsMenu: windows];
// RELEASE(windows); // RELEASE(windows);
// Create the service submenu // Create the service submenu
services = [NSMenu new]; services = [NSMenu new];
[menu setSubmenu: services [menu setSubmenu: services
forItem: [menu itemWithTitle: @"Services"]]; forItem: [menu itemWithTitle: @"Services"]];
[NSApp setServicesMenu: services]; [NSApp setServicesMenu: services];
// RELEASE(services); // RELEASE(services);
[NSApp setMainMenu: menu]; [NSApp setMainMenu: menu];
// RELEASE(menu); // RELEASE(menu);
imageWindows = [NSMutableArray arrayWithCapacity:1]; imageWindows = [NSMutableArray arrayWithCapacity:1];
[imageWindows retain]; [imageWindows retain];
envWindows = [NSMutableArray arrayWithCapacity:1]; envWindows = [NSMutableArray arrayWithCapacity:1];
[envWindows retain]; [envWindows retain];
// RELEASE(pool); // RELEASE(pool);
} }
- (void)applicationDidFinishLaunching: (NSNotification *)not; - (void)applicationDidFinishLaunching: (NSNotification *)not;
@ -229,7 +234,8 @@ VScheme *vm = nil;
vm = [[VScheme alloc] init]; vm = [[VScheme alloc] init];
[vm setDelegate:self]; [vm setDelegate:self];
[self makeStatisticsWindow]; [self makeStatisticsPanel];
[self makeInterruptPanel];
[self makeInterpreterWindow]; [self makeInterpreterWindow];
// Make the DocumentController the delegate of the application, // Make the DocumentController the delegate of the application,
@ -239,6 +245,7 @@ VScheme *vm = nil;
NSWindow *interpreterWindow = nil; NSWindow *interpreterWindow = nil;
- makeInterpreterWindow - makeInterpreterWindow
{ {
NSWindow *window; NSWindow *window;
@ -310,9 +317,9 @@ NSWindow *interpreterWindow = nil;
return self; return self;
} }
- makeStatisticsWindow - makeStatisticsPanel
{ {
NSWindow *window; NSPanel *panel;
NSScrollView *scrollView; NSScrollView *scrollView;
SCMInteractive *textView; SCMInteractive *textView;
NSRect scrollViewRect = {{0, 0}, {470, 400}}; NSRect scrollViewRect = {{0, 0}, {470, 400}};
@ -323,11 +330,11 @@ NSWindow *interpreterWindow = nil;
// This is expected to be retained, as it would normaly come from a // This is expected to be retained, as it would normaly come from a
// nib file, where the owner would retain it. // nib file, where the owner would retain it.
window = [[NSWindow alloc] initWithContentRect: winRect panel = [[NSPanel alloc] initWithContentRect: winRect
styleMask: style styleMask: style
backing: NSBackingStoreRetained backing: NSBackingStoreRetained
defer: NO]; defer: NO];
[window setMinSize:NSMakeSize(300, 300)]; [panel setMinSize:NSMakeSize(300, 300)];
scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect]; scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
[scrollView setHasHorizontalScroller: NO]; [scrollView setHasHorizontalScroller: NO];
@ -363,21 +370,53 @@ NSWindow *interpreterWindow = nil;
[scrollView setDocumentView: textView]; [scrollView setDocumentView: textView];
// RELEASE(textView); // RELEASE(textView);
[window setContentView: scrollView]; [panel setContentView: scrollView];
// RELEASE(scrollView); // RELEASE(scrollView);
// Make the Document the delegate of the window // Make the Document the delegate of the panel
[window setDelegate: self]; [panel setDelegate: self];
[panel setWorksWhenModal:NO];
// Make the text view the first responder // Make the text view the first responder
// [window makeFirstResponder:textView]; // [panel makeFirstResponder:textView];
[window setTitle:@"GScheme Statistics"]; [panel setTitle:@"GScheme Statistics"];
[window display]; [panel display];
[window orderFront:nil]; [panel orderFront:nil];
return self; return self;
} }
#define IPCWIDTH 100
#define IPCHEIGHT 30
- makeInterruptPanel
{
interruptPanel =
[[NSPanel alloc]
initWithContentRect:NSMakeRect(0, 0, IPCWIDTH, IPCHEIGHT)
styleMask:NSBorderlessWindowMask
backing:NSBackingStoreBuffered
defer:NO];
[interruptPanel setReleasedWhenClosed:NO];
NSButton *stopper;
stopper = [NSButton new];
[stopper setTitle:@"Stop"];
[stopper setTarget:vm];
[stopper setAction:@selector(interrupt:)];
[interruptPanel setContentView:stopper];
return self;
}
- (NSPanel *)interruptPanel
{
return interruptPanel;
}
- input:(NSString *)data - input:(NSString *)data
{ {
[intTextView appendString:data]; [intTextView appendString:data];
@ -387,6 +426,7 @@ NSWindow *interpreterWindow = nil;
- output:(NSString *)data - output:(NSString *)data
{ {
[intTextView appendString:data]; [intTextView appendString:data];
[intTextView placeCursorAtEnd];
return self; return self;
} }
@ -402,7 +442,12 @@ NSWindow *interpreterWindow = nil;
- statistics:(NSString *)stats - statistics:(NSString *)stats
{ {
NSString *sofar = [statTextView string]; NSString *sofar = [statTextView string];
[statTextView setString:[sofar stringByAppendingString:stats]]; [statTextView
replaceCharactersInRange:NSMakeRange([sofar length], 0)
withString:stats];
[statTextView placeCursorAtEnd];
return self; return self;
} }
@ -418,6 +463,67 @@ NSWindow *interpreterWindow = nil;
[statTextView setString:GSCHEME]; [statTextView setString:GSCHEME];
} }
- addExternal:(id)sender
{
NSOpenPanel *openPanel = [NSOpenPanel openPanel];
[openPanel setTitle:@"Add external"];
[openPanel setAllowsMultipleSelection:NO];
[openPanel setPrompt:@"File:"];
[openPanel setCanChooseDirectories:NO];
if([openPanel
runModalForTypes:
[NSArray arrayWithObject:@"scm"]]==NSOKButton){
[[sender menu] addItemWithTitle:[openPanel filename]
action:@selector(evaluateExternal:)
keyEquivalent: @""];
}
return self;
}
extern VScheme *vm;
extern NSWindow *interpreterWindow;
extern int errno;
- evaluateExternal:(id)sender
{
SCMInteractive *intView =
[[interpreterWindow contentView] documentView];
NSString *suffix = [intView getSuffix];
if([suffix length]>0){
[intView appendString:@"\n> "];
}
NSString *progstr;
if((progstr =
[NSString stringWithContentsOfFile:[sender title]])==nil){
NSString *msg = @"Load failed";
if(errno){
char *estr = strerror(errno);
msg = [msg stringByAppendingFormat:@": %s", estr];
}
NSRunAlertPanel(@"Error", msg, @"Ok", nil, nil);
return self;
}
BOOL res = [vm processString:progstr mode:MODE_EVALUATE];
if(res==NO){
NSRunAlertPanel(@"Error", [vm errmsg],
@"Ok", nil, nil);
}
else{
[interpreterWindow makeKeyAndOrderFront:self];
}
return self;
}
- imageWindow:(NSWindow *)window - imageWindow:(NSWindow *)window
{ {
[imageWindows addObject:window]; [imageWindows addObject:window];
@ -441,21 +547,20 @@ NSWindow *interpreterWindow = nil;
} }
else if([envWindows containsObject:win]==YES){ else if([envWindows containsObject:win]==YES){
[envWindows removeObject:win]; [envWindows removeObject:win];
[win releaseForms];
} }
} }
- closeImageWindows:(id)sender - closeImageWindows:(id)sender
{ {
[imageWindows NSArray *cwins = [NSArray arrayWithArray:imageWindows];
makeObjectsPerformSelector:@selector(close)]; [cwins makeObjectsPerformSelector:@selector(close)];
return self; return self;
} }
- closeEnvWindows:(id)sender - closeEnvWindows:(id)sender
{ {
[envWindows NSArray *cwins = [NSArray arrayWithArray:envWindows];
makeObjectsPerformSelector:@selector(close)]; [cwins makeObjectsPerformSelector:@selector(close)];
return self; return self;
} }

View File

@ -2,27 +2,13 @@
#import <AppKit/AppKit.h> #import <AppKit/AppKit.h>
@interface NSMutableArray (Wrap)
- (void)prependObjWRP:(id)anObject;
- (void)addObjWRP:(id)anObject;
- (void)replaceObjWRPAtIndex:(unsigned)index withObject:(id)anObject;
@end
@interface NSMutableDictionary (Wrap)
- (void)setObjWRP:(id)anObject forKey:(id)aKey;
@end
#define MARKABLE(_item) \ #define MARKABLE(_item) \
((_item)!=nil && ((id)(_item))!=(id)[NSNull null] && \ ((_item)!=nil && ((id)(_item))!=(id)[NSNull null] && \
[(_item) isKindOfClass:[SCMType class]]) [(_item) isKindOfClass:[SCMType class]])
@interface SCMType : NSObject @interface SCMType : NSObject
{ {
@protected
int mark; int mark;
} }
@ -107,6 +93,7 @@
NSString *value; NSString *value;
} }
- initSCMStringLEX:(char *)val;
- initSCMString:(char *)val; - initSCMString:(char *)val;
- (NSString *)strVal; - (NSString *)strVal;
@ -199,18 +186,18 @@
@interface Environment : SCMType @interface Environment : SCMType
{ {
Environment *parent; Environment *parent;
NSMutableDictionary *data; NSMapTable *data;
} }
+ newParent:(Environment *)par Data:(NSMutableDictionary *)entries; + newParent:(Environment *)par Data:(NSMapTable *)entries;
- initParent:(Environment *)par Data:(NSMutableDictionary *)entries; - initParent:(Environment *)par Data:(NSMapTable *)entries;
- (int)chainLength; - (int)chainLength;
- (NSMutableDictionary *)lookup:(NSString *)sym; - (NSMapTable *)lookup:(NSString *)sym;
- (Environment *)parent; - (Environment *)parent;
- (NSMutableDictionary *)data; - (NSMapTable *)data;
- setMarkToCurrent; - setMarkToCurrent;
@ -294,11 +281,16 @@ typedef enum {
@interface ByteCodes : SCMType @interface ByteCodes : SCMType
{ {
NSMutableArray *data; unsigned int capacity;
unsigned int length;
id *data;
BOOL root;
id source;
} }
+ new; + new;
- initWithMutableArray:(NSMutableArray *)theData; - init;
- prependTriple:(Triple *)theTriple; - prependTriple:(Triple *)theTriple;
@ -306,10 +298,17 @@ typedef enum {
- appendByteCodes:(ByteCodes *)codes; - appendByteCodes:(ByteCodes *)codes;
- (NSMutableArray *)codes; - (id *)codes;
- (unsigned int)length;
- setMarkToCurrent; - setMarkToCurrent;
- (BOOL)root;
- setRoot:(BOOL)rflag;
- source;
- setSource:(id)src;
- (void)free; - (void)free;
@end @end

View File

@ -1,42 +1,6 @@
#import "SchemeTypes.h" #import "SchemeTypes.h"
@implementation NSMutableArray (Wrap)
- (void)addObjWRP:(id)anObject
{
[anObject retain];
[self addObject:anObject];
return;
}
- (void)replaceObjWRPAtIndex:(unsigned)index withObject:(id)anObject
{
[anObject retain];
[self replaceObjectAtIndex:index withObject:anObject];
return;
}
- (void)prependObjWRP:(id)anObject
{
[anObject retain];
[self insertObject:anObject atIndex:0];
return;
}
@end
@implementation NSMutableDictionary (Wrap)
- (void)setObjWRP:(id)anObject forKey:(id)aKey
{
[anObject retain];
[self setObject:anObject forKey:aKey];
return;
}
@end
@implementation SCMType @implementation SCMType
static int allocatedAfterGC = 0; static int allocatedAfterGC = 0;
@ -233,11 +197,11 @@ static int totalAllocated = 0;
- setMarkToCurrent - setMarkToCurrent
{ {
if([self mark]==currentMark){ if(mark==currentMark){
return; return;
} }
[super setMarkToCurrent]; mark = currentMark;
if(MARKABLE(car)){ if(MARKABLE(car)){
[car setMarkToCurrent]; [car setMarkToCurrent];
} }
@ -309,11 +273,11 @@ static int totalAllocated = 0;
{ {
int index; int index;
if([self mark]==currentMark){ if(mark==currentMark){
return; return;
} }
[super setMarkToCurrent]; mark = currentMark;
for(index=0; index<count; index++){ for(index=0; index<count; index++){
id obj = data[index]; id obj = data[index];
@ -369,11 +333,11 @@ static int totalAllocated = 0;
- setMarkToCurrent - setMarkToCurrent
{ {
if([self mark]==currentMark){ if(mark==currentMark){
return; return;
} }
[super setMarkToCurrent]; mark = currentMark;
if(MARKABLE(args)){ if(MARKABLE(args)){
[args setMarkToCurrent]; [args setMarkToCurrent];
} }
@ -444,13 +408,13 @@ static int totalAllocated = 0;
@implementation Environment @implementation Environment
+ newParent:(Environment *)par Data:(NSMutableDictionary *)entries + newParent:(Environment *)par Data:(NSMapTable *)entries
{ {
return [[super alloc] return [[super alloc]
initParent:par Data:entries]; initParent:par Data:entries];
} }
- initParent:(Environment *)par Data:(NSMutableDictionary *)entries - initParent:(Environment *)par Data:(NSMapTable *)entries
{ {
[super init]; [super init];
@ -458,7 +422,7 @@ static int totalAllocated = 0;
[parent retain]; [parent retain];
data = entries; // [entries mutableCopy]; data = entries; // [entries mutableCopy];
[data retain]; // [data retain];
return self; return self;
} }
@ -468,13 +432,13 @@ static int totalAllocated = 0;
return (parent==nil ? 1 : 1+[parent chainLength]); return (parent==nil ? 1 : 1+[parent chainLength]);
} }
- (NSMutableDictionary *)lookup:(NSString *)sym - (NSMapTable *)lookup:(NSString *)sym
{ {
if([data objectForKey:sym]!=nil){ if(NSMapGet(data, sym)!=NULL){
return data; return data;
} }
return (parent==nil ? nil : [parent lookup:sym]); return (parent==nil ? NULL : [parent lookup:sym]);
} }
- (Environment *)parent - (Environment *)parent
@ -482,24 +446,27 @@ static int totalAllocated = 0;
return parent; return parent;
} }
- (NSMutableDictionary *)data - (NSMapTable *)data
{ {
return data; return data;
} }
- setMarkToCurrent - setMarkToCurrent
{ {
NSEnumerator *enumerator = [data objectEnumerator]; NSMapEnumerator enumerator = NSEnumerateMapTable(data);
id item; id item;
if([self mark]==currentMark){ if(mark==currentMark){
return; return;
} }
[super setMarkToCurrent]; mark = currentMark;
while((item = [enumerator nextObject])!=nil){
if(MARKABLE(item)){ id key, val;
[item setMarkToCurrent]; while(NSNextMapEnumeratorPair
(&enumerator, (void**)&key, (void**)&val)){
if(MARKABLE(val)){
[val setMarkToCurrent];
} }
} }
@ -510,28 +477,9 @@ static int totalAllocated = 0;
return self; return self;
} }
#define GSI_MAP_NOCLEAN 1
#include <base/GSIMap.h>
@interface GSMutableDictionary : NSDictionary
{
@public
GSIMapTable_t map;
}
@end
typedef struct {
@defs(GSMutableDictionary)
} *GSMDictPtr;
- (void)free - (void)free
{ {
GSIMapEmptyMap(&(((GSMDictPtr)data)->map)); NSFreeMapTable(data);
while([data retainCount]>1){
[data release];
}
[super free]; [super free];
} }
@ -549,7 +497,9 @@ typedef struct {
+ newTag:(int)tagval IntArg1:(int)arg1; + newTag:(int)tagval IntArg1:(int)arg1;
{ {
NSNumber *num = [NSNumber numberWithInt:arg1]; // NSNumber *num = [NSNumber numberWithInt:arg1];
Int *num = [[Int alloc] initSCMInt:arg1];
return [[super alloc] return [[super alloc]
initTag:tagval initTag:tagval
Arg1:num Arg2:nil Arg3:nil]; Arg1:num Arg2:nil Arg3:nil];
@ -581,9 +531,20 @@ typedef struct {
{ {
tag = tagval; tag = tagval;
items[0] = arg1; [arg1 retain]; items[0] = arg1;
items[1] = arg2; [arg2 retain]; if(arg1!=nil){
items[2] = arg3; [arg3 retain]; [arg1 retain];
}
items[1] = arg2;
if(arg2!=nil){
[arg2 retain];
}
items[2] = arg3;
if(arg3!=nil){
[arg3 retain];
}
return self; return self;
} }
@ -595,12 +556,14 @@ typedef struct {
- (int)intarg1 - (int)intarg1
{ {
return [items[0] intValue]; return [items[0] intVal];
} }
- setIntArg1:(int)val - setIntArg1:(int)val
{ {
items[0] = [NSNumber numberWithInt:val]; // items[0] = [NSNumber numberWithInt:val];
items[0] = [[Int alloc] initSCMInt:val];
[items[0] retain];
return self; return self;
} }
@ -621,11 +584,11 @@ typedef struct {
- setMarkToCurrent - setMarkToCurrent
{ {
if([self mark]==currentMark){ if(mark==currentMark){
return; return;
} }
[super setMarkToCurrent]; mark = currentMark;
if(MARKABLE(items[0])){ if(MARKABLE(items[0])){
[items[0] setMarkToCurrent]; [items[0] setMarkToCurrent];
} }
@ -715,8 +678,10 @@ typedef struct {
- initSCMSymbol:(char *)val - initSCMSymbol:(char *)val
{ {
[super init]; [super init];
value = [NSString stringWithCString:val]; value = [NSString stringWithCString:val];
[value retain]; [value retain];
return self; return self;
} }
@ -735,7 +700,7 @@ typedef struct {
@implementation String @implementation String
- initSCMString:(char *)val - initSCMStringLEX:(char *)val
{ {
char *cp, *buf, *from, *to; char *cp, *buf, *from, *to;
int len = strlen(val); int len = strlen(val);
@ -762,6 +727,16 @@ typedef struct {
return self; return self;
} }
- initSCMString:(char *)val
{
[super init];
value = [NSString stringWithCString:val];
[value retain];
return self;
}
- (NSString *)strVal - (NSString *)strVal
{ {
return value; return value;
@ -775,89 +750,143 @@ typedef struct {
@end @end
#define BASE_CAPACITY 16
@implementation ByteCodes @implementation ByteCodes
+ new + new
{ {
id inst = [super alloc]; id inst = [super alloc];
[inst initWithMutableArray:[NSMutableArray arrayWithCapacity:1]]; [inst init];
return inst; return inst;
} }
- initWithMutableArray:(NSMutableArray *)theData - init
{ {
[super init]; [super init];
data = theData;
[data retain]; capacity = BASE_CAPACITY;
length = 0;
data = (id *)NSZoneMalloc(NSDefaultMallocZone(), capacity*sizeof(id));
root = NO;
source = nil;
return self; return self;
} }
- prependTriple:(Triple *)theTriple - prependTriple:(Triple *)theTriple
{ {
[data prependObjWRP:theTriple]; if(length==capacity){
capacity *= 2;
data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
}
memmove(data+1, data, length*sizeof(id));
length++;
data[0] = theTriple;
[theTriple retain];
return self; return self;
} }
- addTriple:(Triple *)theTriple - addTriple:(Triple *)theTriple
{ {
[data addObjWRP:theTriple]; if(length==capacity){
capacity *= 2;
data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
}
data[length++] = theTriple;
[theTriple retain];
return self; return self;
} }
- appendByteCodes:(ByteCodes *)codes - appendByteCodes:(ByteCodes *)codes
{ {
[data addObjectsFromArray:[codes codes]]; unsigned int otherLength = [codes length];
id *otherData = [codes codes];
if(length+otherLength>capacity){
while(length+otherLength>capacity){
capacity *= 2;
}
data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
}
unsigned int pos;
for(pos=0; pos<otherLength; pos++){
data[length] = otherData[pos];
[data[length] retain];
length++;
}
return self; return self;
} }
- (NSMutableArray *)codes - (id *)codes
{ {
return data; return data;
} }
- (unsigned int)length
{
return length;
}
- setMarkToCurrent - setMarkToCurrent
{ {
int index, count = [data count]; if(mark==currentMark){
if([self mark]==currentMark){
return; return;
} }
[super setMarkToCurrent]; mark = currentMark;
for(index=0; index<count; index++){ unsigned int index;
id obj = [data objectAtIndex:index]; for(index=0; index<length; index++){
id obj = data[index];
if(MARKABLE(obj)){ if(MARKABLE(obj)){
[obj setMarkToCurrent]; [obj setMarkToCurrent];
} }
} }
if(MARKABLE(source)){
[source setMarkToCurrent];
}
return self; return self;
} }
@interface GSMutableArray : NSMutableArray - (BOOL)root
{ {
@public return root;
id *_contents_array;
unsigned _count;
unsigned _capacity;
int _grow_factor;
} }
@end
typedef struct { - setRoot:(BOOL)rflag
@defs(GSMutableArray) {
} *GSMArrayPtr; root = rflag;
return self;
}
- source
{
return source;
}
- setSource:(id)src
{
source = src;
[src retain];
return self;
}
- (void)free - (void)free
{ {
((GSMArrayPtr)data)->_count = 0; NSZoneFree(NSDefaultMallocZone(), data);
while([data retainCount]>1){
[data release];
}
[super free]; [super free];
} }

View File

@ -1,6 +0,0 @@
{
NOTE = "Automatically generated, do not edit!";
NSExecutable = "TestScheme";
NSMainNibFile = "";
NSPrincipalClass = "NSApplication";
}

View File

@ -1,5 +0,0 @@
[Desktop Entry]
Encoding=UTF-8
Type=Application
Exec=openapp TestScheme.app
#TryExec=TestScheme.app

View File

@ -1,218 +0,0 @@
#!/bin/sh
#
# Copyright (C) 1999 Free Software Foundation, Inc.
#
# Author: Adam Fedor <fedor@gnu.org>
# Date: May 1999
#
# This file is part of the GNUstep Makefile Package.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# You should have received a copy of the GNU General Public
# License along with this library; see the file COPYING.LIB.
# If not, write to the Free Software Foundation,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# This is a shell script which attempts to find the GNUstep executable
# of the same name based on the current host and library_combo.
#--------------------------------------------------------------------------
# Main body
#--------------------------------------------------------------------------
if [ -z "$EXEEXT" ]; then
EXEEXT=
fi
if [ -z "$LIBRARY_COMBO" ]; then
LIBRARY_COMBO=gnu-gnu-gnu
fi
# Process arguments
app=$0
show_available_platforms=0
show_relative_path=0
show_full_path=0
while true
do
case $1 in
--script-help)
echo usage: `basename $0` [--library-combo=...]
echo " [--available-platforms][--full-executable-path]"
echo " [--relative-executable-path] [arguments...]"
echo
echo " --library-combo=... specifies a GNUstep backend to use."
echo " It overrides the default LIBRARY_COMBO environment variable."
echo
echo " --available-platforms displays a list of valid exec hosts"
echo " --full-executable-path displays full path to executable"
echo " --relative-executable-path displays subdirectory path"
echo " arguments... are the arguments to the application."
exit 0
;;
--library-combo=*)
LIBRARY_COMBO=`echo $1 | sed 's/--library-combo=//'`
shift
;;
--available-platforms)
show_available_platforms=1
exit 0
;;
--full-executable-path)
show_full_path=1
break
;;
--relative-executable-path)
show_relative_path=1
break
;;
*)
break;;
esac
done
if [ "$LIBRARY_COMBO" = nx ]; then
LIBRARY_COMBO=nx-nx-nx
elif [ "$LIBRARY_COMBO" = gnu ]; then
LIBRARY_COMBO=gnu-gnu-gnu
elif [ "$LIBRARY_COMBO" = fd ]; then
LIBRARY_COMBO=gnu-fd-gnu
fi
export LIBRARY_COMBO
# Find path to ourself
app=`echo $app | sed 's%/*$%%'`
dir=`dirname $app`
case $app in
/*) # An absolute path.
full_appname=$dir;;
*/*) # A relative path
full_appname=`(cd $dir; pwd)`;;
*) # A path that needs to be searched
if [ -n $GNUSTEP_PATHPREFIX_LIST ]; then
SPATH=$GNUSTEP_PATHPREFIX_LIST
else
SPATH=$PATH
fi
SPATH=.:$SPATH
IFS=:
for path_dir in $SPATH; do
if [ -d $path_dir/$dir ]; then
full_appname=`(cd $path_dir/$dir; pwd)`
break;
fi
if [ -d $path_dir/Applications/$dir ]; then
full_appname=`(cd $path_dir/Applications/$dir; pwd)`
break;
fi
done;;
esac
if [ -z "$full_appname" ]; then
echo "Can't find absolute path for $app! Please specify full path when"
echo "invoking executable"
exit 1
fi
#
# get base app name
#
app=`echo $app | sed 's/\.[a-z]*$//'`
app=`basename $app`
appname=
if [ -f "$full_appname/Resources/Info-gnustep.plist" ]; then
# -n disable auto-print (for portability reasons)
# /^ *NSExecutable *=/ matches every line beginning with
# zero or more spaces, followed by 'NSExecutable', followed by zero or
# more spaces, followed by '='
# to this line we apply the following commands:
# s/"//g; which deletes all " in the line.
# s/^ *NSExecutable *= *\([^ ;]*\) *;.*/\1/p;
# which replaces 'NSExecutable = Gorm; ' with 'Gorm', then, because
# of the 'p' at the end, prints out the result
# q; which quits sed since we know there must be only a single line
# to replace.
appname=`sed -n -e '/^ *NSExecutable *=/ \
{s/"//g; s/^ *NSExecutable *= *\([^ ;]*\) *;.*/\1/p; q;}' \
"$full_appname/Resources/Info-gnustep.plist"`
fi
if [ -z "$appname" ]; then
appname=$app
fi
appname="$appname$EXEEXT"
if [ $show_available_platforms = 1 ]; then
cd $full_appname
#available_platforms
exit 0
fi
#
# Determine the host information
#
if [ -z "$GNUSTEP_HOST" ]; then
GNUSTEP_HOST=`(cd /tmp; $GNUSTEP_SYSTEM_ROOT/Makefiles/config.guess)`
GNUSTEP_HOST=`(cd /tmp; $GNUSTEP_SYSTEM_ROOT/Makefiles/config.sub $GNUSTEP_HOST)`
export GNUSTEP_HOST
fi
if [ -z "$GNUSTEP_HOST_CPU" ]; then
GNUSTEP_HOST_CPU=`$GNUSTEP_SYSTEM_ROOT/Makefiles/cpu.sh $GNUSTEP_HOST`
GNUSTEP_HOST_CPU=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_cpu.sh $GNUSTEP_HOST_CPU`
export GNUSTEP_HOST_CPU
fi
if [ -z "$GNUSTEP_HOST_VENDOR" ]; then
GNUSTEP_HOST_VENDOR=`$GNUSTEP_SYSTEM_ROOT/Makefiles/vendor.sh $GNUSTEP_HOST`
GNUSTEP_HOST_VENDOR=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_vendor.sh $GNUSTEP_HOST_VENDOR`
export GNUSTEP_HOST_VENDOR
fi
if [ -z "$GNUSTEP_HOST_OS" ]; then
GNUSTEP_HOST_OS=`$GNUSTEP_SYSTEM_ROOT/Makefiles/os.sh $GNUSTEP_HOST`
GNUSTEP_HOST_OS=`$GNUSTEP_SYSTEM_ROOT/Makefiles/clean_os.sh $GNUSTEP_HOST_OS`
export GNUSTEP_HOST_OS
fi
#
# Make sure the executable is there
#
if [ -x $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/$appname ]; then
relative_path=$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/$appname
elif [ -x $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$appname ]; then
relative_path=$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$appname
elif [ -x $full_appname/$GNUSTEP_HOST_CPU/$appname ]; then
relative_path=$GNUSTEP_HOST_CPU/$appname
elif [ $appname != $app -a -x $full_appname/$appname ]; then
relative_path=$appname
else
echo "$full_appname application does not have a binary for this kind of machine/operating system ($GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS)."
exit 1
fi
if [ $show_relative_path = 1 ]; then
echo $relative_path
exit 0
fi
if [ $show_full_path = 1 ]; then
echo $full_appname/$relative_path
exit 0
fi
if [ "$LIBRARY_COMBO" = nx-nx-nx -a $GNUSTEP_HOST_OS = nextstep4 ]; then
if [ -f "$full_appname/library_paths.openapp" ]; then
additional_library_paths="`cat $full_appname/library_paths.openapp`"
fi
else
if [ -f "$full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/library_paths.openapp" ]; then
additional_library_paths="`cat $full_appname/$GNUSTEP_HOST_CPU/$GNUSTEP_HOST_OS/$LIBRARY_COMBO/library_paths.openapp`"
fi
fi
# Load up LD_LIBRARY_PATH
. $GNUSTEP_SYSTEM_ROOT/Makefiles/ld_lib_path.sh
exec $full_appname/$relative_path "$@"

View File

@ -7,15 +7,21 @@
#define GSCHEME @"GScheme by Marko Riedel, mriedel@neuearbeit.de\n" #define GSCHEME @"GScheme by Marko Riedel, mriedel@neuearbeit.de\n"
typedef enum { typedef enum {
MODE_INTERACTIVE, MODE_INTERACTIVE = 0,
MODE_EVALUATE, MODE_EVALUATE,
MODE_LOAD MODE_LOAD
} PROCESS_MODE; } PROCESS_MODE;
typedef enum { typedef enum {
DRAW_MOVE, DRAW_MOVE = 0,
DRAW_LINE, DRAW_LINE,
DRAW_COLOR DRAW_COLOR,
DRAW_CIRCLE,
FILL_CIRCLE,
DRAW_RECT,
FILL_RECT,
DRAW_FONT,
DRAW_STRING
} DRAW_INST; } DRAW_INST;
typedef struct _DrawInst { typedef struct _DrawInst {
@ -23,11 +29,16 @@ typedef struct _DrawInst {
union { union {
NSPoint coord; NSPoint coord;
float color[3]; float color[3];
float radius;
NSFont *font;
NSString *string;
NSSize size;
} data; } data;
} DrawInst; } DrawInst;
@interface VScheme : NSObject @interface VScheme : NSObject
{ {
int errpos;
BOOL errflag; BOOL errflag;
NSString *errmsg; NSString *errmsg;
@ -36,10 +47,12 @@ typedef struct _DrawInst {
NSMutableArray *argStack; NSMutableArray *argStack;
NSMutableArray *envStack; NSMutableArray *envStack;
id curcodes; id *curcodes;
int curpc; int curpc;
int curlength;
NSString *output; BOOL hadOutput;
NSMutableString *output;
int maxcode, maxpc, maxarg, maxenv; int maxcode, maxpc, maxarg, maxenv;
@ -47,16 +60,18 @@ typedef struct _DrawInst {
BOOL atImgStart; BOOL atImgStart;
NSPoint imgMin, imgMax; NSPoint imgMin, imgMax;
NSPoint imgCur;
NSMutableArray *imgCodes; NSMutableArray *imgCodes;
NSFont *imgFont;
long int curRecDepth, maxRecDepth; BOOL interrupted;
} }
+ (NSString *)valToString:(id)item seen:(NSMutableSet *)mem; + (NSString *)valToString:(id)item seen:(NSMutableSet *)mem;
+ (NSString *)valToString:(id)item; + (NSString *)valToString:(id)item;
+ printInstr:(Triple *)instr; + printInstr:(Triple *)instr;
+ printCodes:(NSMutableArray *)codes; + printCodes:(ByteCodes *)codes;
- init; - init;
@ -77,6 +92,7 @@ typedef struct _DrawInst {
- (NSString *)output; - (NSString *)output;
- clearOutput; - clearOutput;
- (NSSize)stringAtCurrentFont:(NSString *)str;
- recordImgInst:(DrawInst)inst; - recordImgInst:(DrawInst)inst;
- clearImage; - clearImage;
- produceImage; - produceImage;
@ -86,12 +102,15 @@ typedef struct _DrawInst {
- (NSMutableArray *)codeStack; - (NSMutableArray *)codeStack;
- (BOOL)errflag; - (BOOL)errflag;
- (int)errpos;
- (NSString *)errmsg; - (NSString *)errmsg;
- args2list:(int)lower; - args2list:(int)lower;
- pushCodes:(NSMutableArray *)codes; - pushByteCodes:(ByteCodes *)bcodes;
- (BOOL)run:(ByteCodes *)prog;
- interrupt:(id)sender;
- (BOOL)run:(ByteCodes *)prog mode:(PROCESS_MODE)pmode;
- special:(id)data output:(ByteCodes *)codes popenv:(int)ec; - special:(id)data output:(ByteCodes *)codes popenv:(int)ec;
- sequence:(id)data output:(ByteCodes *)codes popenv:(int)ec; - sequence:(id)data output:(ByteCodes *)codes popenv:(int)ec;
@ -99,6 +118,7 @@ typedef struct _DrawInst {
- (BOOL)compile:(id)data output:(ByteCodes *)codes; - (BOOL)compile:(id)data output:(ByteCodes *)codes;
- parse:(NSString *)scmText;
- (BOOL)processString:(NSString *)data mode:(PROCESS_MODE)pmode; - (BOOL)processString:(NSString *)data mode:(PROCESS_MODE)pmode;
@end @end

714
VScheme.m

File diff suppressed because it is too large Load Diff

6
examples/allocate1.scm Normal file
View File

@ -0,0 +1,6 @@
(define print-it
(lambda ()
(display '(1 2 3))
(newline)
(print-it)))

6
examples/args1.scm Normal file
View File

@ -0,0 +1,6 @@
;; not enough arguments
(define p (lambda (x y) (+ x y)))
(p 6)

6
examples/args2.scm Normal file
View File

@ -0,0 +1,6 @@
;; too many arguments
(define p (lambda (x y) (+ x y)))
(p 6 7 8)

View File

@ -7,7 +7,6 @@
(reduce + 0 '(2 3 4)) (reduce + 0 '(2 3 4))
(define factit (define factit
(lambda (n) (lambda (n)
(letrec (letrec

33
examples/eval.scm Normal file
View File

@ -0,0 +1,33 @@
(define primes
(eval
;;; check for composite numbers by testing the
;;; most probable divisors first
'(let* ((start (list 2))
(end start))
(letrec
((composite?
(lambda (v l)
(let ((d (car l)))
(if (> (* d d) v) #f
(if (zero? (remainder v d)) #t
(composite? v (cdr l)))))))
(findnext
(lambda (v)
(if (composite? v start)
(findnext (+ v 1)) v))))
(lambda ()
(let* ((current (car end))
(next (findnext (+ current 1)))
(p (cons next '())))
(set-cdr! end p)
(set! end p)
current))))))
(define displayprimes
(lambda (n)
(if (not (zero? n))
(begin
(display (primes)) (newline)
(displayprimes (- n 1))))))
(displayprimes 14)

56
examples/eval1.scm Normal file
View File

@ -0,0 +1,56 @@
(define pi (* 2 (acos 0)))
(define res 200)
(define data
(letrec
((delta (/ (* 2 pi) res))
(vect (make-vector res))
(iter
(lambda (q)
(if (< q res)
(begin
(vector-set!
vect q
(cons (cos (* q delta))
(sin (* q delta))))
(let ((ev (eval '(iter (+ 1 q)))))
ev))))))
(iter 0)
vect))
(define draw-circle
(lambda (radius)
(letrec
((iter
(lambda (q)
(if (< q res)
(begin
(draw-line
(* radius (car (vector-ref data q)))
(* radius (cdr (vector-ref data q))))
(iter (+ 1 q)))))))
(draw-move radius 0)
(iter 0)
(draw-line radius 0))))
(define steps 8)
(define circles
(lambda (maxrad)
(letrec
((iter
(lambda (q)
(if (< q maxrad)
(begin
(draw-color 0 (/ (* 255.0 q) maxrad) 0)
(draw-circle q)
(iter (+ q steps)))))))
(iter 1))))
(circles 100)

View File

@ -107,3 +107,6 @@
(map-over-single-list car lists)) (map-over-single-list car lists))
(apply for-each (apply for-each
(cons proc (map-over-single-list cdr lists))))))) (cons proc (map-over-single-list cdr lists)))))))
(define pow (lambda (x y) (exp (* y (log x)))))

37
examples/mandel.scm Normal file
View File

@ -0,0 +1,37 @@
;; mandelbrot set
(define mandel
(lambda (rmin rmax imin imax res)
(letrec
((rdelta (- rmax rmin)) (idelta (- imax imin))
(rdelta1 (/ rdelta res)) (idelta1 (/ idelta res))
(pcolor
(lambda (re im cre cim n)
(if (or (> n 200) (> (+ (* re re) (* im im)) 4.0))
(let
((c (* 8 (remainder n 8)))
(x (* res (/ (- cre rmin) rdelta)))
(y (* res (/ (- cim imin) idelta))))
(draw-color
(* 255 (remainder n 2))
(* 255 (remainder (quotient n 2) 2))
(* 255 (remainder (quotient n 4) 2)))
(draw-move x y)
(draw-line (+ x 1) (+ y 1)))
(pcolor
(+ (- (* re re) (* im im)) cre)
(+ (* 2 re im) cim)
cre cim (+ 1 n)))))
(iter
(lambda (rep imp)
(if (> rep rmax)
(if (> imp imax) '()
(iter rmin (+ imp idelta1)))
(begin
(pcolor 0 0 rep imp 0)
(iter (+ rep rdelta1) imp))))))
(iter rmin imin))))
(mandel -1.5 0.5 -1.0 1.0 25)

8
examples/parse-error.scm Normal file
View File

@ -0,0 +1,8 @@
;; missing parenthesis
(define adder
(lambda (a)
(lambda (b)
(+ a b)))

55
examples/parse-error1.scm Normal file
View File

@ -0,0 +1,55 @@
(define pi (* 2 (acos 0)))
(define res 200)
(define data
(letrec
((delta (/ (* 2 pi) res))
(vect (make-vector res))
(iter extra-sym
(lambda (q)
(if (< q res)
(begin
(vector-set!
vect q
(cons (cos (* q delta))
(sin (* q delta))))
(iter (+ 1 q)))))))
(iter 0)
vect))
(define draw-circle
(lambda (radius)
(letrec
((iter
(lambda (q)
(if (< q res)
(begin
(draw-line
(* radius (car (vector-ref data q)))
(* radius (cdr (vector-ref data q))))
(iter (+ 1 q)))))))
(draw-move radius 0)
(iter 0)
(draw-line radius 0))))
(define steps 8)
(define circles
(lambda (maxrad)
(letrec
((iter
(lambda (q)
(if (< q maxrad)
(begin
(draw-color 0 (/ (* 255.0 q) maxrad) 0)
(draw-circle q)
(iter (+ q steps)))))))
(iter 1))))
(circles 100)

28
examples/parse-error2.scm Normal file
View File

@ -0,0 +1,28 @@
(define koch
(let ((s (/ (sqrt 3) 2 3)))
(lambda (res depth)
(letrec
((iter
(lambda (x1 y1 x2 y2 d)
(if (zero? d)
(draw-line x2 y2)
(let* ((dx (- x2 x1))
(dy (- y2 y1))
(^ test)
(thx (+ x1 (/ dx 3)))
(thy (+ y1 (/ dy 3)))
(thx2 (+ x1 (* 2 (/ dx 3))))
(thy2 (+ y1 (* 2 (/ dy 3))))
(mx (/ (+ x1 x2) 2))
(my (/ (+ y1 y2) 2))
(midx (+ mx (* (- dy) s)))
(midy (+ my (* dx s))))
(iter x1 y1 thx thy (- d 1))
(iter thx thy midx midy (- d 1))
(iter midx midy thx2 thy2 (- d 1))
(iter thx2 thy2 x2 y2 (- d 1)))))))
(draw-move 0 0)
(draw-color 0 255 0)
(iter 0 0 res 0 depth)))))
(koch 200 4)

View File

@ -0,0 +1,6 @@
(define testcond
(lambda (l)
(cond
((assq 'a l) => (lambda (p) (set-car! p 'd)))
((assq 'b l) extra-sym => (lambda (p) (set-car! p 'e)))
((assq 'c l) => (lambda (p) (set-car! p 'f))))))

View File

@ -0,0 +1,6 @@
;; an if with three alternatives
(if (zero? 4) 'a 'b 'c)
;; end

49
examples/plotfancy.scm Normal file
View File

@ -0,0 +1,49 @@
(define plotter
(lambda (fx res x1 x2 y1 y2)
(let* ((dx (- x2 x1)) (dy (- y2 y1)) (delta (/ dx res))
(fstr (format "~a" fx))
(f (eval (list 'lambda '(x) fx))))
(letrec
((scaled
(lambda (f x y)
(f
(* res (/ (- x x1) dx))
(* res (/ (- y y1) dy)))))
(scaled-d
(lambda (f x y xd yd)
(f
(+ xd (* res (/ (- x x1) dx)))
(+ yd (* res (/ (- y y1) dy))))))
(plotit
(lambda (x)
(scaled draw-line x (f x))
(if (< x x2) (plotit (+ x delta))))))
(draw-color 0 0 0)
(draw-font "Helvetica" 12)
(scaled draw-move 0 (* 1.1 y2)) (draw-string "y")
(scaled draw-move (* 1.1 x2) 0) (draw-string "x")
(draw-move
(- (/ res 2)
(/ (car (string-size fstr "Helvetica" 12)) 2))
(+ 30 res))
(draw-string (format "~a" fstr))
(scaled draw-move 0 y1)
(scaled draw-line 0 y2)
(scaled-d draw-move 0 y2 -5 -7)
(scaled draw-line 0 y2)
(scaled-d draw-move 0 y2 +5 -7)
(scaled draw-line 0 y2)
(scaled draw-move x1 0)
(scaled draw-line x2 0)
(scaled-d draw-move x2 0 -7 -5)
(scaled draw-line x2 0)
(scaled-d draw-move x2 0 -7 +5)
(scaled draw-line x2 0)
(draw-color 255 0 0)
(scaled draw-move x1 (f x1))
(plotit x1)))))
(plotter '(* x x x) 70 -5.0 5.0 -50.0 50.0)
(plotter '(sin x) 50 -5.0 5.0 -1.0 1.0)
(plotter '(* x (sin x)) 100 -25.0 25.0 -25.0 25.0)
(plotter '(+ (* x x) (* -5 x) 6) 80 -1.0 5.0 -3.0 10.0)

143
examples/qsort.scm Normal file
View File

@ -0,0 +1,143 @@
(define allperms
(lambda (n)
(if (= n 1) '((1))
(letrec
((allpos (list-n n))
(insert
(lambda (pos el l)
(if (= pos 1)
(cons el l)
(cons (car l)
(insert (- pos 1) el (cdr l))))))
(result '()))
(for-each
(lambda (p)
(for-each
(lambda (pos)
(set!
result
(cons
(insert pos n p) result)))
allpos))
(allperms (- n 1)))
result))))
(define make-cmp
(lambda ()
(let ((count 0))
(lambda (what . args)
(case what
((count) count)
((cmp)
(begin
(set! count (+ 1 count))
(< (car args) (cadr args)))))))))
(define qsort
(lambda (perm compare)
(if (null? perm) '()
(if (null? (cdr perm)) perm
(letrec
((pivot (car perm))
(left '()) (leftend '())
(right '()) (rightend '())
(split
(lambda (l)
(if (compare 'cmp (car l) pivot)
(if (null? leftend)
(begin
(set! left (list (car l)))
(set! leftend left))
(begin
(set-cdr! leftend (list (car l)))
(set! leftend (cdr leftend))))
(if (null? rightend)
(begin
(set! right (list (car l)))
(set! rightend right))
(begin
(set-cdr! rightend (list (car l)))
(set! rightend (cdr rightend)))))
(if (not (null? (cdr l))) (split (cdr l))))))
(split (cdr perm))
(append
(qsort left compare)
(list pivot)
(qsort right compare)))))))
(define qsort-stats
(lambda (n)
(map
(lambda (p)
(let ((c (make-cmp)))
(qsort p c)
(c 'count)))
(allperms n))))
(define ints2hist
(lambda (l)
(let* ((minv (apply min l))
(maxv (apply max l))
(v (make-vector (+ 1 (- maxv minv)) 0)))
(letrec
((iter
(lambda (l)
(if (not (null? l))
(begin
(vector-set!
v (- (car l) minv)
(+ 1 (vector-ref v (- (car l) minv))))
(iter (cdr l)))))))
(iter l)
(map
(lambda (pos)
(cons pos (vector-ref v (- pos minv))))
(make-range minv maxv))))))
(define drawhist
(lambda (h)
(letrec
((len (length h)) (total (* 1.0 (apply + (map cdr h))))
(mx (apply max (map cdr h))) (scale 400)
(colors
(list->vector
'((0 0 255) (0 255 0) (0 255 255)
(255 0 0) (255 0 255) (255 255 0))))
(bars
(lambda (pos h)
(let ((frac (/ (cdar h) total)))
(apply draw-color (vector-ref colors (remainder pos 6)))
(draw-move (* pos 40) 0)
(fill-rect 30 (* scale frac))
(if (not (null? (cdr h)))
(bars (+ 1 pos) (cdr h))))))
(labels
(lambda (pos h)
(draw-move (* pos 40) -20)
(draw-string (format "~a" (caar h)))
(if (not (null? (cdr h)))
(labels (+ 1 pos) (cdr h)))))
(values
(lambda (pos h)
(let ((frac (/ (cdar h) total)))
(draw-move (* pos 40) (+ 10 (* scale frac)))
(draw-string (format "~a" (cdar h)))
(if (not (null? (cdr h)))
(values (+ 1 pos) (cdr h)))))))
(bars 0 h)
(draw-color 0 0 0)
(labels 0 h)
(values 0 h)
(draw-move -40 0) (draw-line (* (+ 1 len) 40) 0)
(draw-move -20 -20) (draw-line -20 (* scale (/ mx total))))))
(define qhist
(lambda (n)
(drawhist (ints2hist (qsort-stats n)))))
(qhist 6)

181
examples/qsort1.scm Normal file
View File

@ -0,0 +1,181 @@
(define fact
(lambda (n)
(if (zero? n) 1
(* n (fact (- n 1))))))
(define allperms
(lambda (n)
(let ((f (fact n))
(res '()) (rm -1) (perm '()))
(letrec
((remove
(lambda (l pos)
(if (zero? pos)
(begin
(set! rm (car l))
(remove (cdr l) (- pos 1)))
(if (null? l) l
(cons (car l) (remove (cdr l) (- pos 1)))))))
(process
(lambda (v m dst src)
(if (zero? m)
(set! perm dst)
(let ((src1 (remove src (remainder v m))))
(process
(quotient v m)
(- m 1)
src1
(cons dst rm))))))
(iter
(lambda (v)
(if (< v f)
(begin
(process v n '() (make-range 1 n))
(set! res (cons perm res))
(iter (+ v 1)))))))
(iter 0) res))))
(define allperms
(lambda (n)
(if (= n 1) '((1))
(letrec
((allpos (list-n n))
(insert
(lambda (pos el l)
(if (= pos 1)
(cons el l)
(cons (car l)
(insert (- pos 1) el (cdr l))))))
(result '()))
(for-each
(lambda (p)
(for-each
(lambda (pos)
(set!
result
(cons
(insert pos n p) result)))
allpos))
(allperms (- n 1)))
result))))
(define make-cmp
(lambda ()
(let ((count 0))
(lambda (what . args)
(case what
((count) count)
((cmp)
(begin
(set! count (+ 1 count))
(< (car args) (cadr args)))))))))
(define qsort
(lambda (perm compare)
(if (null? perm) '()
(if (null? (cdr perm)) perm
(letrec
((pivot (car perm))
(left '()) (leftend '())
(right '()) (rightend '())
(split
(lambda (l)
(if (compare 'cmp (car l) pivot)
(if (null? leftend)
(begin
(set! left (list (car l)))
(set! leftend left))
(begin
(set-cdr! leftend (list (car l)))
(set! leftend (cdr leftend))))
(if (null? rightend)
(begin
(set! right (list (car l)))
(set! rightend right))
(begin
(set-cdr! rightend (list (car l)))
(set! rightend (cdr rightend)))))
(if (not (null? (cdr l))) (split (cdr l))))))
(split (cdr perm))
(append
(qsort left compare)
(list pivot)
(qsort right compare)))))))
(define qsort-stats
(lambda (n)
(map
(lambda (p)
(let ((c (make-cmp)))
(qsort p c)
(c 'count)))
(allperms n))))
(define ints2hist
(lambda (l)
(let* ((minv (apply min l))
(maxv (apply max l))
(v (make-vector (+ 1 (- maxv minv)) 0)))
(letrec
((iter
(lambda (l)
(if (not (null? l))
(begin
(vector-set!
v (- (car l) minv)
(+ 1 (vector-ref v (- (car l) minv))))
(iter (cdr l)))))))
(iter l)
(map
(lambda (pos)
(cons pos (vector-ref v (- pos minv))))
(make-range minv maxv))))))
(define drawhist
(lambda (h)
(letrec
((len (length h)) (total (* 1.0 (apply + (map cdr h))))
(mx (apply max (map cdr h))) (scale 400)
(colors
(list->vector
'((0 0 255) (0 255 0) (0 255 255)
(255 0 0) (255 0 255) (255 255 0))))
(bars
(lambda (pos h)
(let ((frac (/ (cdar h) total)))
(apply draw-color (vector-ref colors (remainder pos 6)))
(draw-move (* pos 40) 0)
(fill-rect 30 (* scale frac))
(if (not (null? (cdr h)))
(bars (+ 1 pos) (cdr h))))))
(labels
(lambda (pos h)
(draw-move (* pos 40) -20)
(draw-string (format "~a" (caar h)))
(if (not (null? (cdr h)))
(labels (+ 1 pos) (cdr h)))))
(values
(lambda (pos h)
(let ((frac (/ (cdar h) total)))
(draw-move (* pos 40) (+ 10 (* scale frac)))
(draw-string (format "~a" (cdar h)))
(if (not (null? (cdr h)))
(values (+ 1 pos) (cdr h)))))))
(bars 0 h)
(draw-color 0 0 0)
(labels 0 h)
(values 0 h)
(draw-move -40 0) (draw-line (* (+ 1 len) 40) 0)
(draw-move -20 -20) (draw-line -20 (* scale (/ mx total))))))
(define qhist
(lambda (n)
(drawhist (ints2hist (qsort-stats n)))))
(qhist 6)

98
examples/queenspic.scm Normal file
View File

@ -0,0 +1,98 @@
(define allqueens
(lambda (n doneproc)
(letrec
((diag1
(lambda (board col)
(if (null? board) '()
(cons (+ col (car board))
(diag1 (cdr board) (+ col 1))))))
(diag2
(lambda (board col)
(if (null? board) '()
(cons (- col (car board))
(diag2 (cdr board) (+ col 1))))))
(consistent?
(lambda (board col new)
(not
(or (member new board)
(member (+ col new)
(diag1 board 1))
(member (- col new)
(diag2 board 1))))))
(check
(lambda (board col)
(if (> col n) (doneproc board)
(for-each
(lambda (row)
(if (consistent? board col row)
(check (append board (list row))
(+ 1 col))))
(list-n n))))))
(check '() 1))))
(define queens
(lambda (n)
(letrec
((y-reflect reverse)
(rotate
(lambda (board)
(map
(lambda (row)
(- (+ 1 n) (length (member row board))))
(list-n n))))
(symmetries
(lambda (board)
(list
board
(rotate board)
(rotate (rotate board))
(rotate (rotate (rotate board)))
(y-reflect board)
(rotate (y-reflect board))
(rotate (rotate (y-reflect board)))
(rotate (rotate (rotate (y-reflect board)))))))
(result '())
(new?
(lambda (rlist sol)
(if (null? rlist) #t
(if (member sol (car rlist)) #f
(new? (cdr rlist) sol))))))
(allqueens
n
(lambda (sol)
(if (new? result sol)
(set! result (cons (symmetries sol) result)))))
(map car result))))
(define queenspic
(lambda (n)
(let* ((scale 30) (radius (/ scale 3)))
(for-each
(lambda (sol)
(letrec
((drawqueens
(lambda (pos sol)
(if (not (null? sol))
(begin
(draw-move pos (- (* (car sol) scale) (/ scale 2)))
(fill-circle radius)
(drawqueens (+ pos scale) (cdr sol))))))
(drawlines
(lambda (m)
(draw-move 0 (* m scale))
(draw-line (* n scale) (* m scale))
(draw-move (* m scale) 0)
(draw-line (* m scale) (* n scale))
(if (not (zero? m))
(drawlines (- m 1))))))
(draw-color 255 0 0)
(drawqueens 15 sol)
(draw-color 0 0 0)
(drawlines n)
(draw-show)))
(queens n)))))
(queenspic 5)

17
examples/randcircles.scm Normal file
View File

@ -0,0 +1,17 @@
(define randcircles
(lambda (n rmax lmax)
(let
((x (random lmax)) (y (random lmax))
(fill (random 2))
(radius (+ (/ rmax 2) (random (/ rmax 2)))))
(draw-color
(random 256)
(random 256)
(random 256))
(draw-move x y)
((if (zero? fill) draw-circle fill-circle) radius)
(if (not (zero? n))
(randcircles (- n 1) rmax lmax)))))
(randcircles 25 30 250)

28
examples/random.scm Normal file
View File

@ -0,0 +1,28 @@
(define randpoints
(lambda (count)
(letrec
((scale 20)
(points
(lambda (n)
(draw-move
(* (- count n) scale)
(* scale (random count)))
(fill-circle (/ scale 2))
(if (not (zero? n))
(points (- n 1)))))
(grid
(lambda (n)
(draw-move 0 (* scale n))
(draw-line (* scale count) (* scale n))
(if (not (zero? n))
(grid (- n 1))))))
(grid count)
(draw-move 0 0)
(draw-color 255 255 0)
(points count))))
(randpoints 15)
(randpoints 15.0)

18
examples/randrects.scm Normal file
View File

@ -0,0 +1,18 @@
(define randrects
(lambda (n rmax lmax)
(let
((x (random lmax)) (y (random lmax))
(fill (random 2))
(a (+ (/ rmax 2) (random (/ rmax 2))))
(b (+ (/ rmax 2) (random (/ rmax 2)))))
(draw-color
(random 256)
(random 256)
(random 256))
(draw-move x y)
((if (zero? fill) draw-rect fill-rect) a b)
(if (not (zero? n))
(randrects (- n 1) rmax lmax)))))
(randrects 25 60 250)

119
examples/strings.scm Normal file
View File

@ -0,0 +1,119 @@
(integer->char -20)
(integer->char 270)
(char->integer #\N)
(char->integer #\+)
(char->integer #\#)
(define table
(lambda (n)
(if (< n 128)
(begin
(display n) (display " ")
(display (integer->char n)) (display " ")
(display (char->integer (integer->char n)))
(newline)
(table (+ n 1))))))
(table 32)
(list->string '())
(list->string '(#\a #\b #\c))
(list->string '(#\a #\b . #\c))
(define test1
(lambda (n)
(let ((str
(list->string
(map
(lambda (pos)
(integer->char
(+ (char->integer #\A) pos -1)))
(reverse (list-n n))))))
(map
(lambda (pos)
(string-ref str (- pos 1)))
(reverse (list-n n))))))
(test1 5)
(test1 10)
(test1 20)
(define randletters
(lambda (n)
(if (zero? n) '()
(cons
(integer->char
(+ (char->integer #\A) (random 26)))
(randletters (- n 1))))))
(define test2
(lambda (len)
(let* ((r (randletters len))
(s (list->string r)))
(display r) (display " ")
(display s) (display " ")
(display (string->list s)) (newline))))
(test2 5)
(test2 10)
(test2 20)
(string-append)
(apply string-append
(map symbol->string '(one two three four five)))
(make-string 0)
(string->list (make-string 5))
(string->list (make-string 15))
(define test3
(lambda (len)
(if (zero? len) ""
(string-append
(make-string len)
(make-string
len
(integer->char
(+ (char->integer #\a) len -1)))
(test3 (- len 1))))))
(test3 1)
(test3 5)
(test3 7)
(number->string 123.456e7)
(number->string 678.456)
(map number->string (list-n 30))
(define test4
(lambda (base)
(map
(lambda (n)
(number->string n base))
(reverse (list-n 30)))))
(test4 2)
(test4 3)
(test4 8)
(test4 10)
(test4 12)
(test4 16)
(define test5
(lambda (base)
(map
(lambda (n)
(number->string (+ (- n) 1) base))
(reverse (list-n 30)))))
(test5 2)
(test5 3)
(test5 8)
(test5 10)
(test5 12)
(test5 16)

31
examples/text.scm Normal file
View File

@ -0,0 +1,31 @@
;; show some text
(define text
(lambda (fsclist)
(for-each
(lambda (fsc)
(let
((font (car fsc))
(size (cadr fsc))
(color (caddr fsc))
(pos 0))
(apply draw-color color)
(draw-font font size)
(for-each
(lambda (word)
(let ((dim (string-size word font size)))
(draw-move (- (/ (car dim) 2.0)) (* pos (cdr dim)))
(draw-string word)
(set! pos (- pos 1))))
(map
symbol->string
'(The quick brown fox jumps over the lazy dog)))
(draw-show))) fsclist)))
(text
'(("Courier" 36 (255 0 0))
("Helvetica-Bold" 24 (0 255 0))
("Lucida-Italic-Sans" 18 (0 0 255))))

1939
lex.yy.c

File diff suppressed because it is too large Load Diff

View File

@ -180,7 +180,7 @@ STRING "\""([^\n\"\\]|"\\\\"|"\\\"")*"\""
} }
{STRING} { {STRING} {
yylval = [[String alloc] initSCMString:yytext]; yylval = [[String alloc] initSCMStringLEX:yytext];
yysofar += yyleng; return STRING; yysofar += yyleng; return STRING;
} }

View File

@ -996,7 +996,7 @@ case 29:
YY_RULE_SETUP YY_RULE_SETUP
#line 182 "scheme.flex" #line 182 "scheme.flex"
{ {
yylval = [[String alloc] initSCMString:yytext]; yylval = [[String alloc] initSCMStringLEX:yytext];
yysofar += yyleng; return STRING; yysofar += yyleng; return STRING;
} }
YY_BREAK YY_BREAK

File diff suppressed because it is too large Load Diff

164
scheme.y
View File

@ -5,9 +5,10 @@
YYSTYPE yyresult; YYSTYPE yyresult;
int yyinputitem; int yyinputitem;
id yyresultform;
extern int yysofar; extern int yysofar;
extern NSMutableArray *positions; extern NSMutableArray *positionStack;
%} %}
%token LPAREN %token LPAREN
@ -53,12 +54,13 @@ extern NSMutableArray *positions;
%% %%
top: /* empty */ { top: /* empty */ {
yyresult = $$ = [NSNull null];
$$ = [NSNull null]; yyresultform = $$;
} }
| topitem top { | topitem top {
yyresult = $$ = [Triple newTag:FORM_TOP Arg1:$1 Arg2:$2];
$$ = [Triple newTag:FORM_TOP Arg1:$1 Arg2:$2]; yyresultform = $$;
yyinputitem++; yyinputitem++;
} }
; ;
@ -69,7 +71,7 @@ topitem: LPAREN DEFINE SYMBOL form RPAREN {
$$ = [Triple newTag:FORM_DEFINE1 Arg1:$3 Arg2:$4]; $$ = [Triple newTag:FORM_DEFINE1 Arg1:$3 Arg2:$4];
[positions addObject:entry]; [[positionStack lastObject] addObject:entry];
} }
| LPAREN DEFINE nonemptysymlist sequence RPAREN { | LPAREN DEFINE nonemptysymlist sequence RPAREN {
NSValue *entry = NSValue *entry =
@ -77,7 +79,7 @@ topitem: LPAREN DEFINE SYMBOL form RPAREN {
$$ = [Triple newTag:FORM_DEFINE2 Arg1:$3 Arg2:$4]; $$ = [Triple newTag:FORM_DEFINE2 Arg1:$3 Arg2:$4];
[positions addObject:entry]; [[positionStack lastObject] addObject:entry];
} }
| form { | form {
NSValue *entry = NSValue *entry =
@ -85,7 +87,7 @@ topitem: LPAREN DEFINE SYMBOL form RPAREN {
$$ = $1; $$ = $1;
[positions addObject:entry]; [[positionStack lastObject] addObject:entry];
} }
; ;
@ -105,6 +107,87 @@ revsequence: form {
} }
; ;
qform: INTEGER {
$$ = $1;
}
| CHAR {
$$ = $1;
}
| BOOLEAN {
$$ = $1;
}
| DOUBLE {
$$ = $1;
}
| SYMBOL {
$$ = $1;
}
| STRING {
$$ = $1;
}
| qlist {
$$ = $1;
}
| qvector {
$$ = $1;
}
| QUOTECHAR qform {
$$ = [Pair newCar:[[Symbol alloc] initSCMSymbol:"quote"]
Cdr:[Pair newCar:$2 Cdr:[NSNull null]]];
}
| ARROW {
$$ = [[Symbol alloc] initSCMSymbol:"=>"];
}
| QUOTE {
$$ = [[Symbol alloc] initSCMSymbol:"quote"];
}
| CALLCC {
$$ = [[Symbol alloc] initSCMSymbol:"call-with-current-continuation"];
}
| APPLY {
$$ = [[Symbol alloc] initSCMSymbol:"apply"];
}
| DEFINE {
$$ = [[Symbol alloc] initSCMSymbol:"define"];
}
| SET {
$$ = [[Symbol alloc] initSCMSymbol:"set!"];
}
| LAMBDA {
$$ = [[Symbol alloc] initSCMSymbol:"lambda"];
}
| IF {
$$ = [[Symbol alloc] initSCMSymbol:"if"];
}
| BEGINTOK {
$$ = [[Symbol alloc] initSCMSymbol:"begin"];
}
| AND {
$$ = [[Symbol alloc] initSCMSymbol:"and"];
}
| OR {
$$ = [[Symbol alloc] initSCMSymbol:"or"];
}
| CASE {
$$ = [[Symbol alloc] initSCMSymbol:"case"];
}
| COND {
$$ = [[Symbol alloc] initSCMSymbol:"cond"];
}
| ELSE {
$$ = [[Symbol alloc] initSCMSymbol:"else"];
}
| LET {
$$ = [[Symbol alloc] initSCMSymbol:"let"];
}
| LETSTAR {
$$ = [[Symbol alloc] initSCMSymbol:"let*"];
}
| LETREC {
$$ = [[Symbol alloc] initSCMSymbol:"letrec"];
}
;
form: INTEGER { form: INTEGER {
$$ = $1; $$ = $1;
} }
@ -171,14 +254,17 @@ form: INTEGER {
| callcc { | callcc {
$$ = $1; $$ = $1;
} }
;
callcc: LPAREN CALLCC form RPAREN { callcc: LPAREN CALLCC form RPAREN {
$$ = [Triple newTag:FORM_CALLCC Arg1:$3]; $$ = [Triple newTag:FORM_CALLCC Arg1:$3];
} }
;
singlecase: LPAREN LPAREN sequence RPAREN sequence RPAREN { singlecase: LPAREN LPAREN sequence RPAREN sequence RPAREN {
$$ = [Pair newCar:$3 Cdr:$5]; $$ = [Pair newCar:$3 Cdr:$5];
} }
;
singlecond: LPAREN form RPAREN { singlecond: LPAREN form RPAREN {
$$ = [Triple newTag:FORM_SCOND1 Arg1:$2]; $$ = [Triple newTag:FORM_SCOND1 Arg1:$2];
@ -189,10 +275,12 @@ singlecond: LPAREN form RPAREN {
| LPAREN form ARROW form RPAREN { | LPAREN form ARROW form RPAREN {
$$ = [Triple newTag:FORM_SCOND3 Arg1:$2 Arg2:$4]; $$ = [Triple newTag:FORM_SCOND3 Arg1:$2 Arg2:$4];
} }
;
elsecasecond: LPAREN ELSE sequence RPAREN { elsecasecond: LPAREN ELSE sequence RPAREN {
$$ = [Pair newCar:[NSNull null] Cdr:$3]; $$ = [Pair newCar:[NSNull null] Cdr:$3];
} }
;
cases: singlecase { cases: singlecase {
$$ = [Pair newCar:$1 Cdr:[NSNull null]]; $$ = [Pair newCar:$1 Cdr:[NSNull null]];
@ -217,6 +305,7 @@ case: LPAREN CASE form cases RPAREN {
$$ = [Triple newTag:FORM_CASE Arg1:$3 $$ = [Triple newTag:FORM_CASE Arg1:$3
Arg2:[Pair newCar:$5 Cdr:$4]]; Arg2:[Pair newCar:$5 Cdr:$4]];
} }
;
cond: LPAREN COND conditions RPAREN { cond: LPAREN COND conditions RPAREN {
$$ = [Triple newTag:FORM_COND Arg1:$3]; $$ = [Triple newTag:FORM_COND Arg1:$3];
@ -224,6 +313,7 @@ cond: LPAREN COND conditions RPAREN {
| LPAREN COND conditions elsecasecond RPAREN { | LPAREN COND conditions elsecasecond RPAREN {
$$ = [Triple newTag:FORM_COND Arg1:[Pair newCar:$4 Cdr:$3]]; $$ = [Triple newTag:FORM_COND Arg1:[Pair newCar:$4 Cdr:$3]];
} }
;
and: LPAREN AND revsequence RPAREN { and: LPAREN AND revsequence RPAREN {
$$ = [Triple newTag:FORM_AND Arg1:$3]; $$ = [Triple newTag:FORM_AND Arg1:$3];
@ -231,6 +321,7 @@ and: LPAREN AND revsequence RPAREN {
| LPAREN AND RPAREN { | LPAREN AND RPAREN {
$$ = [Triple newTag:FORM_AND Arg1:[NSNull null]]; $$ = [Triple newTag:FORM_AND Arg1:[NSNull null]];
} }
;
or: LPAREN OR revsequence RPAREN { or: LPAREN OR revsequence RPAREN {
$$ = [Triple newTag:FORM_OR Arg1:$3]; $$ = [Triple newTag:FORM_OR Arg1:$3];
@ -238,18 +329,22 @@ or: LPAREN OR revsequence RPAREN {
| LPAREN OR RPAREN { | LPAREN OR RPAREN {
$$ = [Triple newTag:FORM_OR Arg1:[NSNull null]]; $$ = [Triple newTag:FORM_OR Arg1:[NSNull null]];
} }
;
begin: LPAREN BEGINTOK sequence RPAREN { begin: LPAREN BEGINTOK sequence RPAREN {
$$ = [Triple newTag:FORM_BEGIN Arg1:$3]; $$ = [Triple newTag:FORM_BEGIN Arg1:$3];
} }
;
set: LPAREN SET SYMBOL form RPAREN { set: LPAREN SET SYMBOL form RPAREN {
$$ = [Triple newTag:FORM_SET Arg1:$3 Arg2:$4]; $$ = [Triple newTag:FORM_SET Arg1:$3 Arg2:$4];
} }
;
apply: LPAREN APPLY form form RPAREN { apply: LPAREN APPLY form form RPAREN {
$$ = [Triple newTag:FORM_APPLY Arg1:$3 Arg2:$4]; $$ = [Triple newTag:FORM_APPLY Arg1:$3 Arg2:$4];
} }
;
if: LPAREN IF form form RPAREN { if: LPAREN IF form form RPAREN {
$$ = [Triple newTag:FORM_IF1 Arg1:$3 Arg2:$4]; $$ = [Triple newTag:FORM_IF1 Arg1:$3 Arg2:$4];
@ -257,6 +352,7 @@ if: LPAREN IF form form RPAREN {
| LPAREN IF form form form RPAREN { | LPAREN IF form form form RPAREN {
$$ = [Triple newTag:FORM_IF2 Arg1:$3 Arg2:$4 Arg3:$5]; $$ = [Triple newTag:FORM_IF2 Arg1:$3 Arg2:$4 Arg3:$5];
} }
;
lambda: LPAREN LAMBDA SYMBOL sequence RPAREN { lambda: LPAREN LAMBDA SYMBOL sequence RPAREN {
$$ = [Triple newTag:FORM_LAMBDA1 Arg1:$3 Arg2:$4]; $$ = [Triple newTag:FORM_LAMBDA1 Arg1:$3 Arg2:$4];
@ -264,18 +360,20 @@ lambda: LPAREN LAMBDA SYMBOL sequence RPAREN {
| LPAREN LAMBDA symlist sequence RPAREN { | LPAREN LAMBDA symlist sequence RPAREN {
$$ = [Triple newTag:FORM_LAMBDA2 Arg1:$3 Arg2:$4]; $$ = [Triple newTag:FORM_LAMBDA2 Arg1:$3 Arg2:$4];
} }
;
quote: QUOTECHAR form { quote: QUOTECHAR qform {
$$ = [Triple newTag:FORM_QUOTE Arg1:$2]; $$ = [Triple newTag:FORM_QUOTE Arg1:$2];
} }
| LPAREN QUOTE form RPAREN { | LPAREN QUOTE qform RPAREN {
$$ = [Triple newTag:FORM_QUOTE Arg1:$3]; $$ = [Triple newTag:FORM_QUOTE Arg1:$3];
} }
;
singlebinding: LPAREN SYMBOL form RPAREN { singlebinding: LPAREN SYMBOL form RPAREN {
$$ = [Triple newTag:FORM_BINDING Arg1:$2 Arg2:$3]; $$ = [Triple newTag:FORM_BINDING Arg1:$2 Arg2:$3];
} }
;
listofbindings: singlebinding { listofbindings: singlebinding {
$$ = [Pair newCar:$1 Cdr:[NSNull null]]; $$ = [Pair newCar:$1 Cdr:[NSNull null]];
@ -283,18 +381,22 @@ listofbindings: singlebinding {
| singlebinding listofbindings { | singlebinding listofbindings {
$$ = [Pair newCar:$1 Cdr:$2]; $$ = [Pair newCar:$1 Cdr:$2];
} }
;
let: LPAREN LET LPAREN listofbindings RPAREN sequence RPAREN { let: LPAREN LET LPAREN listofbindings RPAREN sequence RPAREN {
$$ = [Triple newTag:FORM_LET Arg1:$4 Arg2:$6]; $$ = [Triple newTag:FORM_LET Arg1:$4 Arg2:$6];
} }
;
letstar: LPAREN LETSTAR LPAREN listofbindings RPAREN sequence RPAREN { letstar: LPAREN LETSTAR LPAREN listofbindings RPAREN sequence RPAREN {
$$ = [Triple newTag:FORM_LETSTAR Arg1:$4 Arg2:$6]; $$ = [Triple newTag:FORM_LETSTAR Arg1:$4 Arg2:$6];
} }
;
letrec: LPAREN LETREC LPAREN listofbindings RPAREN sequence RPAREN { letrec: LPAREN LETREC LPAREN listofbindings RPAREN sequence RPAREN {
$$ = [Triple newTag:FORM_LETREC Arg1:$4 Arg2:$6]; $$ = [Triple newTag:FORM_LETREC Arg1:$4 Arg2:$6];
} }
;
emptylist: LPAREN RPAREN { emptylist: LPAREN RPAREN {
$$ = [NSNull null]; $$ = [NSNull null];
@ -312,6 +414,17 @@ nonemptylistdata: form {
} }
; ;
qnonemptylistdata: qform {
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| qform DOT qform {
$$ = [Pair newCar:$1 Cdr:$3];
}
| qform qnonemptylistdata {
$$ = [Pair newCar:$1 Cdr:$2];
}
;
nonemptyvectdata: form { nonemptyvectdata: form {
$$ = [Pair newCar:$1 Cdr:[NSNull null]]; $$ = [Pair newCar:$1 Cdr:[NSNull null]];
} }
@ -320,11 +433,24 @@ nonemptyvectdata: form {
} }
; ;
qnonemptyvectdata: qform {
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| qform qnonemptyvectdata {
$$ = [Pair newCar:$1 Cdr:$2];
}
;
nonemptylist: LPAREN nonemptylistdata RPAREN { nonemptylist: LPAREN nonemptylistdata RPAREN {
$$ = $2; $$ = $2;
} }
; ;
qnonemptylist: LPAREN qnonemptylistdata RPAREN {
$$ = $2;
}
;
list: nonemptylist { list: nonemptylist {
$$ = $1; $$ = $1;
} }
@ -333,6 +459,14 @@ list: nonemptylist {
} }
; ;
qlist: qnonemptylist {
$$ = $1;
}
| emptylist {
$$ = $1;
}
;
vector: LVECTPAREN nonemptyvectdata RPAREN { vector: LVECTPAREN nonemptyvectdata RPAREN {
$$ = [Vector newFromList:$2]; $$ = [Vector newFromList:$2];
} }
@ -341,6 +475,14 @@ vector: LVECTPAREN nonemptyvectdata RPAREN {
} }
; ;
qvector: LVECTPAREN qnonemptyvectdata RPAREN {
$$ = [Vector newFromList:$2];
}
| LVECTPAREN RPAREN {
$$ = [Vector newFromList:(Pair *)[NSNull null]];
}
;
nonemptysymlistdata: SYMBOL { nonemptysymlistdata: SYMBOL {
$$ = [Pair newCar:$1 Cdr:[NSNull null]]; $$ = [Pair newCar:$1 Cdr:[NSNull null]];
} }