GScheme-20020806.tar
This commit is contained in:
commit
81e8afedce
|
|
@ -0,0 +1,53 @@
|
|||
/* Document.h Subclass of NSDocument for GScheme application
|
||||
|
||||
Copyright (C) 2000 Free Software Foundation, Inc.
|
||||
|
||||
Author: Fred Kiefer <fredkiefer@gmx.de>
|
||||
Date: 2000.
|
||||
|
||||
Adapted by: Marko Riedel <mriedel@neuearbeit.de>.
|
||||
Date: 2002.
|
||||
|
||||
This file is part of GNUstep.
|
||||
|
||||
This program 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.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
*/
|
||||
#import <Foundation/NSData.h>
|
||||
#import <Foundation/NSAttributedString.h>
|
||||
#import <AppKit/NSDocument.h>
|
||||
#import <AppKit/NSTextView.h>
|
||||
|
||||
@interface Document : NSDocument
|
||||
{
|
||||
NSTextView *tview;
|
||||
NSString *progstr;
|
||||
BOOL readOnly;
|
||||
}
|
||||
|
||||
- init;
|
||||
|
||||
- (void)dealloc;
|
||||
|
||||
- (void)makeWindowControllers;
|
||||
|
||||
- evaluate:(id)sender;
|
||||
|
||||
- (NSData *)dataRepresentationOfType:(NSString *)aType;
|
||||
- (BOOL)loadDataRepresentation:(NSData *)data ofType:(NSString *)aType;
|
||||
|
||||
- (BOOL)readFromFile:(NSString *)fileName ofType:(NSString *)docType;
|
||||
- (BOOL)writeToFile:(NSString *)fileName ofType:(NSString *)docType;
|
||||
|
||||
@end
|
||||
|
|
@ -0,0 +1,237 @@
|
|||
/* Document.m Subclass of NSDocument for GScheme application
|
||||
|
||||
Copyright (C) 2000 Free Software Foundation, Inc.
|
||||
|
||||
Author: Fred Kiefer <fredkiefer@gmx.de>
|
||||
Date: 2000.
|
||||
|
||||
Adapted by: Marko Riedel <mriedel@neuearbeit.de>.
|
||||
Date: 2002.
|
||||
|
||||
This file is part of GNUstep.
|
||||
|
||||
This program 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.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
*/
|
||||
#include <AppKit/AppKit.h>
|
||||
#include <AppKit/NSWindowController.h>
|
||||
#include "Document.h"
|
||||
#include "SCMTextView.h"
|
||||
|
||||
@interface Document (Private)
|
||||
|
||||
- (NSWindow*)makeWindow;
|
||||
|
||||
@end
|
||||
|
||||
@implementation Document
|
||||
|
||||
- init
|
||||
{
|
||||
progstr = @"\n";
|
||||
return [super init];
|
||||
}
|
||||
|
||||
- (void)dealloc
|
||||
{
|
||||
// RELEASE (tview);
|
||||
[super dealloc];
|
||||
}
|
||||
|
||||
- (NSData *)dataRepresentationOfType:(NSString *)aType
|
||||
{
|
||||
if(aType==nil || [aType isEqualToString:@"scm"]){
|
||||
return [[tview string] dataUsingEncoding:NSASCIIStringEncoding];
|
||||
}
|
||||
else{
|
||||
NSString *msg = [NSString stringWithFormat: @"Unknown type: %@",
|
||||
[aType uppercaseString]];
|
||||
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
|
||||
// [msg autorelease];
|
||||
return nil;
|
||||
}
|
||||
}
|
||||
|
||||
- (BOOL)loadDataRepresentation:(NSData *)data ofType:(NSString *)aType
|
||||
{
|
||||
if([aType isEqualToString:@"scm"]){
|
||||
progstr = [NSString stringWithCString:[data bytes]
|
||||
length:[data length]];
|
||||
}
|
||||
else{
|
||||
NSString *msg = [NSString stringWithFormat: @"Unknown type: %@",
|
||||
[aType uppercaseString]];
|
||||
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
|
||||
// [msg autorelease];
|
||||
return NO;
|
||||
}
|
||||
|
||||
return YES;
|
||||
}
|
||||
|
||||
|
||||
- (BOOL)readFromFile:(NSString *)fileName ofType:(NSString *)docType
|
||||
{
|
||||
NSFileManager *manager = [NSFileManager defaultManager];
|
||||
if([manager isWritableFileAtPath:fileName]==NO){
|
||||
NSString *msg = [NSString stringWithFormat: @"File is read only: %@",
|
||||
fileName];
|
||||
readOnly = YES;
|
||||
|
||||
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
|
||||
// [msg autorelease];
|
||||
}
|
||||
|
||||
return [super readFromFile:fileName ofType:docType];
|
||||
}
|
||||
|
||||
- (BOOL)writeToFile:(NSString *)fileName ofType:(NSString *)docType
|
||||
{
|
||||
BOOL result = [super writeToFile:fileName ofType:docType];
|
||||
if(result==YES && readOnly==YES){
|
||||
NSString *msg = [NSString stringWithFormat: @"File now writable: %@",
|
||||
fileName];
|
||||
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
|
||||
// [msg autorelease];
|
||||
|
||||
readOnly = NO;
|
||||
[tview setEditable:YES];
|
||||
}
|
||||
else if(result==NO){
|
||||
NSString *msg = [NSString stringWithFormat: @"Write failed: %@",
|
||||
fileName];
|
||||
NSRunAlertPanel(@"Alert", msg, @"Ok", nil, nil);
|
||||
// [msg autorelease];
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
extern VScheme *vm;
|
||||
extern NSWindow *interpreterWindow;
|
||||
|
||||
- evaluate:(id)sender
|
||||
{
|
||||
BOOL res;
|
||||
SCMInteractive *intView =
|
||||
[[interpreterWindow contentView] documentView];
|
||||
NSString *suffix = [intView getSuffix];
|
||||
|
||||
if([suffix length]>0){
|
||||
[intView appendString:@"\n> "];
|
||||
}
|
||||
|
||||
progstr = [tview string];
|
||||
res = [vm processString:progstr mode:MODE_EVALUATE];
|
||||
|
||||
if(res==NO){
|
||||
NSRunAlertPanel(@"Error", [vm errmsg],
|
||||
@"Ok", nil, nil);
|
||||
}
|
||||
else{
|
||||
[interpreterWindow makeKeyAndOrderFront:self];
|
||||
}
|
||||
}
|
||||
|
||||
- (void) makeWindowControllers
|
||||
{
|
||||
NSWindowController *controller;
|
||||
NSWindow *win = [self makeWindow];
|
||||
|
||||
controller = [[NSWindowController alloc] initWithWindow: win];
|
||||
// RELEASE (win);
|
||||
[self addWindowController:controller];
|
||||
// RELEASE(controller);
|
||||
|
||||
// We have to do this ourself, as there is currently no nib file
|
||||
[self windowControllerDidLoadNib:controller];
|
||||
}
|
||||
|
||||
|
||||
@end
|
||||
|
||||
@implementation Document (Private)
|
||||
|
||||
static int shiftPos = 0;
|
||||
#define WREP 7
|
||||
|
||||
- (NSWindow*)makeWindow
|
||||
{
|
||||
NSWindow *window;
|
||||
NSScrollView *scrollView;
|
||||
NSTextView *textView;
|
||||
NSRect scrollViewRect = {{0, 0}, {470, 400}};
|
||||
NSRect winRect = {{100+25*(shiftPos%WREP), 100+25*(shiftPos%WREP)},
|
||||
{470, 400}};
|
||||
NSRect textRect;
|
||||
unsigned int style = NSTitledWindowMask | NSClosableWindowMask |
|
||||
NSMiniaturizableWindowMask | NSResizableWindowMask;
|
||||
shiftPos++;
|
||||
|
||||
// This is expected to be retained, as it would normaly come from a
|
||||
// nib file, where the owner would retain it.
|
||||
window = [[NSWindow alloc] initWithContentRect: winRect
|
||||
styleMask: style
|
||||
backing: NSBackingStoreRetained
|
||||
defer: NO];
|
||||
[window setMinSize:NSMakeSize(300, 300)];
|
||||
|
||||
scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
|
||||
[scrollView setHasHorizontalScroller: NO];
|
||||
[scrollView setHasVerticalScroller: YES];
|
||||
[scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
|
||||
[[scrollView contentView] setAutoresizingMask: NSViewHeightSizable
|
||||
| NSViewWidthSizable];
|
||||
[[scrollView contentView] setAutoresizesSubviews:YES];
|
||||
|
||||
// Build up the text network
|
||||
textRect = [[scrollView contentView] frame];
|
||||
textView = [[SCMTextView alloc] initWithFrame: textRect];
|
||||
|
||||
[textView setBackgroundColor: [NSColor whiteColor]];
|
||||
|
||||
[textView setString:progstr];
|
||||
[textView setFont:[NSFont userFixedPitchFontOfSize:12]];
|
||||
[textView setEditable:(readOnly==NO ? YES : NO)];
|
||||
|
||||
[textView setDelegate: self];
|
||||
[textView setHorizontallyResizable: NO];
|
||||
[textView setVerticallyResizable: YES];
|
||||
[textView setMinSize: NSMakeSize (0, 0)];
|
||||
[textView setMaxSize: NSMakeSize (1E7, 1E7)];
|
||||
[textView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
|
||||
[[textView textContainer] setContainerSize: NSMakeSize (textRect.size.width,
|
||||
1e7)];
|
||||
[[textView textContainer] setWidthTracksTextView: YES];
|
||||
// Store the text view in an ivar
|
||||
tview = textView;
|
||||
|
||||
[scrollView setDocumentView: textView];
|
||||
// RELEASE(textView);
|
||||
[window setContentView: scrollView];
|
||||
// RELEASE(scrollView);
|
||||
|
||||
// Make the Document the delegate of the window
|
||||
[window setDelegate: self];
|
||||
|
||||
// Make the text view the first responder
|
||||
[window makeFirstResponder:textView];
|
||||
[window display];
|
||||
[window orderFront: nil];
|
||||
|
||||
return window;
|
||||
}
|
||||
|
||||
|
||||
@end
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
#import "SchemeTypes.h"
|
||||
|
||||
@interface EnvWindow : NSWindow
|
||||
{
|
||||
int current;
|
||||
int length;
|
||||
|
||||
id *forms;
|
||||
|
||||
NSScrollView *scrollView;
|
||||
}
|
||||
|
||||
- initWithEnv:(Environment *)env;
|
||||
|
||||
- up:(id)sender;
|
||||
- down:(id)sender;
|
||||
|
||||
- releaseForms;
|
||||
|
||||
@end
|
||||
|
||||
|
|
@ -0,0 +1,134 @@
|
|||
|
||||
#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 scrollViewRect = {{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]; current=length-1;
|
||||
forms = NSZoneMalloc([self zone], length*sizeof(id));
|
||||
|
||||
for(lind=length-1, layer = env; lind>=0; lind--){
|
||||
NSMutableDictionary *data = [layer data];
|
||||
NSMutableArray *keys;
|
||||
NSEnumerator *en;
|
||||
id key, form;
|
||||
|
||||
keys = [NSMutableArray arrayWithCapacity:1];
|
||||
[keys setArray:[data allKeys]];
|
||||
[keys sortUsingSelector:@selector(compare:)];
|
||||
|
||||
en = [keys objectEnumerator];
|
||||
|
||||
|
||||
forms[lind] = form =
|
||||
[[NSForm alloc] initWithFrame:scrollViewRect];
|
||||
while((key = [en nextObject])!=nil){
|
||||
id obj = [data objectForKey:key];
|
||||
id ctitle = [NSString stringWithFormat:@" %@ ", key];
|
||||
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];
|
||||
}
|
||||
|
||||
[self initWithContentRect:winRect
|
||||
styleMask:style
|
||||
backing:NSBackingStoreRetained
|
||||
defer:NO];
|
||||
[self setMinSize:NSMakeSize(WIDTH, HEIGHT)];
|
||||
[self setReleasedWhenClosed:YES];
|
||||
|
||||
scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
|
||||
[scrollView setHasHorizontalScroller:YES];
|
||||
[scrollView setHasVerticalScroller:YES];
|
||||
[scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
|
||||
[[scrollView contentView] setAutoresizingMask: NSViewHeightSizable
|
||||
| NSViewWidthSizable];
|
||||
[[scrollView contentView] setAutoresizesSubviews:YES];
|
||||
|
||||
[scrollView setDocumentView:forms[current]];
|
||||
|
||||
[self setContentView:scrollView];
|
||||
// RELEASE(scrollView);
|
||||
|
||||
[self setTitle:title];
|
||||
[self display];
|
||||
[self makeKeyAndOrderFront:nil];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- up:(id)sender
|
||||
{
|
||||
if(!current){
|
||||
NSBeep();
|
||||
}
|
||||
else{
|
||||
NSRect bounds = [forms[current] bounds];
|
||||
current--;
|
||||
[forms[current] setEntryWidth:bounds.size.width];
|
||||
[scrollView setDocumentView:forms[current]];
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- down:(id)sender
|
||||
{
|
||||
if(current==length-1){
|
||||
NSBeep();
|
||||
}
|
||||
else{
|
||||
NSRect bounds = [forms[current] bounds];
|
||||
current++;
|
||||
[forms[current] setEntryWidth:bounds.size.width];
|
||||
[scrollView setDocumentView:forms[current]];
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- releaseForms
|
||||
{
|
||||
int ind;
|
||||
|
||||
[scrollView setDocumentView:nil];
|
||||
[scrollView release];
|
||||
|
||||
for(ind=0; ind<length; ind++){
|
||||
// NSLog(@"%@ %d %d\n", self, ind, [forms[ind] retainCount]);
|
||||
[forms[ind] release];
|
||||
}
|
||||
|
||||
NSZoneFree([self zone], forms);
|
||||
return self;
|
||||
}
|
||||
@end
|
||||
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
|
||||
GNUSTEP_INSTALLATION_DIR = $(GNUSTEP_SYSTEM_ROOT)
|
||||
|
||||
GNUSTEP_MAKEFILES = $(GNUSTEP_SYSTEM_ROOT)/Makefiles
|
||||
|
||||
include $(GNUSTEP_MAKEFILES)/common.make
|
||||
|
||||
# The application to be compiled
|
||||
APP_NAME = GScheme
|
||||
|
||||
# The Objective-C source files to be compiled
|
||||
|
||||
GScheme_OBJC_FILES = SchemeTypes.m \
|
||||
Primitive.m \
|
||||
VScheme.m \
|
||||
Document.m \
|
||||
EnvWindow.m \
|
||||
SCMTextView.m \
|
||||
scheme.lex.m \
|
||||
scheme.tab.m \
|
||||
SchemeDelegate.m \
|
||||
main.m
|
||||
|
||||
SHARED_CFLAGS += -g
|
||||
AUXILIARY_TOOL_LIBS += -lfl
|
||||
|
||||
# The Resource files to be copied into the app's resources directory
|
||||
GScheme_RESOURCE_FILES = Scheme/*
|
||||
|
||||
-include GNUmakefile.preamble
|
||||
|
||||
-include GNUmakefile.local
|
||||
|
||||
include $(GNUSTEP_MAKEFILES)/application.make
|
||||
|
||||
-include GNUmakefile.postamble
|
||||
|
||||
|
|
@ -0,0 +1,218 @@
|
|||
#!/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 "$@"
|
||||
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
[Desktop Entry]
|
||||
Encoding=UTF-8
|
||||
Type=Application
|
||||
Version=GScheme 0.1
|
||||
Name=GScheme
|
||||
Exec=openapp GScheme.app
|
||||
#TryExec=GScheme.app
|
||||
MimeType=
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
{
|
||||
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
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
|
|
@ -0,0 +1,109 @@
|
|||
|
||||
(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)))))))
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
(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)))))))
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
{
|
||||
ApplicationName = "GScheme";
|
||||
ApplicationDescription = "A scheme interpreter";
|
||||
ApplicationRelease = "GScheme 0.1";
|
||||
FullVersionID = "0.1, June 2002";
|
||||
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";
|
||||
NSTypes = (
|
||||
{
|
||||
NSName = "scm";
|
||||
NSHumanReadableName = "Scheme program";
|
||||
NSUnixExtensions = ("scm");
|
||||
NSDOSExtensions = ("scm");
|
||||
NSRole = Editor;
|
||||
NSDocumentClass = Document;
|
||||
}
|
||||
);
|
||||
}
|
||||
|
|
@ -0,0 +1,249 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
#import <math.h>
|
||||
|
||||
#import "SchemeTypes.h"
|
||||
#import "EnvWindow.h"
|
||||
|
||||
#define PRIM_CLASS_PREF @"PRM"
|
||||
|
||||
BOOL isBoolean(id item);
|
||||
BOOL isChar(id item);
|
||||
BOOL isInt(id item);
|
||||
BOOL isDouble(id item);
|
||||
BOOL isSymbol(id item);
|
||||
BOOL isString(id item);
|
||||
BOOL isPair(id item);
|
||||
BOOL isVector(id item);
|
||||
BOOL isTriple(id item);
|
||||
BOOL isPrimitive(id item);
|
||||
BOOL isClosure(id item);
|
||||
BOOL isThunk(id item);
|
||||
BOOL isFalse(id item);
|
||||
|
||||
BOOL isEqual(id itema, id itemb);
|
||||
|
||||
typedef enum {
|
||||
NT_INTEGERS,
|
||||
NT_DOUBLE,
|
||||
NT_OTHER
|
||||
} NUMTYPE;
|
||||
|
||||
@interface Primitive : SCMType
|
||||
{
|
||||
id value;
|
||||
NSString *errmsg;
|
||||
}
|
||||
|
||||
- init;
|
||||
|
||||
- (NUMTYPE)checkArgsNumeric:(NSMutableArray *)args offset:(int)offs;
|
||||
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
|
||||
- (NSString *)primName;
|
||||
- value;
|
||||
- errmsg;
|
||||
|
||||
@end
|
||||
|
||||
@interface PRMVectorPred : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMPairPred : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMNullPred : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMZeroPred : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMNumberPred : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMEqPred : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMNot : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMNumEqual : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMNumLT : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMNumGT : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMPlus : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMTimes : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMMinus : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMDivide : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMQuotient : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMRemainder : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMList : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMCons : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMCar : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMCdr : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMSetCar : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMSetCdr : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMDisplay : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMNewline : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMDrawMove : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMDrawLine : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMDrawColor : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMSin : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMCos : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMASin : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMACos : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMSqrt : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMMakeVector : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMListToVector : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMVectorToList : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMVectorLength : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMVectorRef : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMVectorSet : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMVectorFill : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
|
||||
@interface PRMBrowseEnvironment : Primitive
|
||||
- (NSString *)primName;
|
||||
- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs;
|
||||
@end
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,31 @@
|
|||
|
||||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
#import "VScheme.h"
|
||||
|
||||
@interface SCMTextView : NSTextView
|
||||
|
||||
- (void)insertText:(id)aString;
|
||||
|
||||
@end
|
||||
|
||||
@interface SCMInteractive : SCMTextView
|
||||
{
|
||||
int lastRetrieved;
|
||||
}
|
||||
|
||||
- (id)initWithFrame:(NSRect)frameRect;
|
||||
|
||||
- (void)insertText:(id)aString;
|
||||
|
||||
- placeCursorAtEnd;
|
||||
|
||||
- (NSString *)getSuffix;
|
||||
- (void)setString:(NSString *)aString;
|
||||
- (void)appendString:(NSString *)aString;
|
||||
|
||||
- (void)keyDown:(NSEvent *)theEvent;
|
||||
|
||||
@end
|
||||
|
||||
|
|
@ -0,0 +1,155 @@
|
|||
|
||||
#import "SCMTextView.h"
|
||||
#import "SchemeDelegate.h"
|
||||
|
||||
|
||||
@implementation SCMTextView
|
||||
|
||||
- (void)insertText:(id)aString
|
||||
{
|
||||
int inslen = [aString length];
|
||||
unichar ch = [aString characterAtIndex:0];
|
||||
NSString *modified = @"", *single;
|
||||
|
||||
if(inslen == 1 && ch==NSNewlineCharacter){
|
||||
NSString *data = [self string];
|
||||
NSRange range = [self selectedRange];
|
||||
NSCharacterSet *charset =
|
||||
[NSCharacterSet whitespaceAndNewlineCharacterSet];
|
||||
int pos = range.location;
|
||||
BOOL newline = NO;
|
||||
|
||||
while(pos>0){
|
||||
pos--;
|
||||
if([data characterAtIndex:pos]==NSNewlineCharacter){
|
||||
newline = YES;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if(newline == YES){
|
||||
int len = 0; int max = [data length];
|
||||
while(pos+len<max &&
|
||||
[charset characterIsMember:
|
||||
(ch = [data characterAtIndex:(pos+len)])]){
|
||||
single = [[NSString alloc] initWithCharacters:&ch length:1];
|
||||
modified = [modified stringByAppendingString:single];
|
||||
// [single autorelease];
|
||||
|
||||
len++;
|
||||
}
|
||||
|
||||
return [super insertText:modified];
|
||||
}
|
||||
}
|
||||
else if(inslen==1 && ch==NSTabCharacter){
|
||||
ch = ' ';
|
||||
single = [[NSString alloc] initWithCharacters:&ch length:1];
|
||||
modified = [modified stringByAppendingString:single];
|
||||
modified = [modified stringByAppendingString:single];
|
||||
// [single autorelease];
|
||||
return [super insertText:modified];
|
||||
}
|
||||
|
||||
return [super insertText:aString];
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation SCMInteractive
|
||||
|
||||
- (id)initWithFrame:(NSRect)frameRect
|
||||
{
|
||||
lastRetrieved = 0;
|
||||
return [super initWithFrame:frameRect];
|
||||
}
|
||||
|
||||
|
||||
- (void)insertText:(id)aString
|
||||
{
|
||||
if([self selectedRange].location<lastRetrieved){
|
||||
return;
|
||||
}
|
||||
|
||||
[super insertText:aString];
|
||||
}
|
||||
|
||||
- placeCursorAtEnd
|
||||
{
|
||||
NSRange range = { [[self string] length], 0 };
|
||||
[self setSelectedRange:range];
|
||||
return self;
|
||||
}
|
||||
|
||||
- (NSString *)getSuffix
|
||||
{
|
||||
NSString *str = [super string];
|
||||
NSString *suffix = [str substringFromIndex:lastRetrieved];
|
||||
|
||||
lastRetrieved = [str length];
|
||||
return suffix;
|
||||
}
|
||||
|
||||
- (void)setString:(NSString *)aString
|
||||
{
|
||||
lastRetrieved = [aString length];
|
||||
[super setString:aString];
|
||||
}
|
||||
|
||||
- (void)appendString:(NSString *)aString
|
||||
{
|
||||
unsigned int len = [[super string] length];
|
||||
NSRange range = {len, 0};
|
||||
|
||||
lastRetrieved += [aString length];
|
||||
[self replaceCharactersInRange:range withString:aString];
|
||||
}
|
||||
|
||||
- (void)keyDown:(NSEvent *)theEvent
|
||||
{
|
||||
NSString *chars = [theEvent characters];
|
||||
unsigned modifiers = [theEvent modifierFlags];
|
||||
int len = [chars length];
|
||||
unichar ch = [chars characterAtIndex:0];
|
||||
BOOL rep = [theEvent isARepeat];
|
||||
|
||||
if((ch==NSNewlineCharacter || ch==NSCarriageReturnCharacter) &&
|
||||
len==1 && (modifiers & NSControlKeyMask)){
|
||||
BOOL res = [[self delegate] processString:[self getSuffix]
|
||||
mode:MODE_INTERACTIVE];
|
||||
if(res==NO){
|
||||
NSRunAlertPanel(@"Error", [[self delegate] errmsg],
|
||||
@"Ok", nil, nil);
|
||||
}
|
||||
return;
|
||||
}
|
||||
else if(ch==NSBackspaceCharacter &&
|
||||
(len==1 || rep==YES) &&
|
||||
[self selectedRange].location<lastRetrieved+len){
|
||||
NSBeep();
|
||||
return;
|
||||
}
|
||||
else if(ch==NSDeleteFunctionKey &&
|
||||
(len==1 || rep==YES) &&
|
||||
[self selectedRange].location<lastRetrieved){
|
||||
NSBeep();
|
||||
return;
|
||||
}
|
||||
|
||||
return [super keyDown:theEvent];
|
||||
}
|
||||
|
||||
- (void)delete:(id)sender
|
||||
{
|
||||
NSRange range = [self rangeForUserTextChange];
|
||||
if(range.location != NSNotFound &&
|
||||
range.location >= lastRetrieved){
|
||||
[super delete:sender];
|
||||
}
|
||||
else{
|
||||
NSBeep();
|
||||
}
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
|
|
@ -0,0 +1,109 @@
|
|||
|
||||
(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)))))))
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
(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)))))))
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
|
||||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
#import <AppKit/NSDocumentController.h>
|
||||
|
||||
#import "Document.h"
|
||||
#import "VScheme.h"
|
||||
#import "SCMTextView.h"
|
||||
|
||||
@interface SchemeDelegate : NSObject
|
||||
{
|
||||
SCMInteractive *intTextView;
|
||||
NSTextView *statTextView;
|
||||
|
||||
NSMutableArray *imageWindows;
|
||||
NSMutableArray *envWindows;
|
||||
}
|
||||
|
||||
- (void)applicationWillFinishLaunching:(NSNotification *)not;
|
||||
- (void)applicationDidFinishLaunching:(NSNotification *)not;
|
||||
|
||||
- makeInterpreterWindow;
|
||||
- makeStatisticsWindow;
|
||||
|
||||
- input:(NSString *)data;
|
||||
- output:(NSString *)data;
|
||||
- result:(id)item;
|
||||
- statistics:(NSString *)stats;
|
||||
|
||||
- imageWindow:(NSWindow *)window;
|
||||
- envWindow:(NSWindow *)window;
|
||||
|
||||
- closeImageWindows:(id)sender;
|
||||
- closeEnvWindows:(id)sender;
|
||||
|
||||
|
||||
- reset:(id)sender;
|
||||
|
||||
@end
|
||||
|
|
@ -0,0 +1,462 @@
|
|||
|
||||
#import "SchemeDelegate.h"
|
||||
|
||||
VScheme *vm = nil;
|
||||
|
||||
|
||||
@implementation SchemeDelegate : NSObject
|
||||
|
||||
- (void)applicationWillFinishLaunching:(NSNotification *)not
|
||||
{
|
||||
// CREATE_AUTORELEASE_POOL(pool);
|
||||
NSMenu *menu;
|
||||
NSMenu *info;
|
||||
NSMenu *file;
|
||||
NSMenu *scheme;
|
||||
NSMenu *env;
|
||||
NSMenu *edit;
|
||||
NSMenu *print;
|
||||
NSMenu *services;
|
||||
NSMenu *windows;
|
||||
|
||||
// Create the app menu
|
||||
menu = [NSMenu new];
|
||||
|
||||
[menu addItemWithTitle: @"Info"
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
|
||||
[menu addItemWithTitle: @"File"
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
|
||||
[menu addItemWithTitle: @"Edit"
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
|
||||
[menu addItemWithTitle: @"Windows"
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
|
||||
[menu addItemWithTitle: @"Scheme"
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
|
||||
[menu addItemWithTitle: @"Environment"
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
|
||||
[menu addItemWithTitle: @"Services"
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
|
||||
[menu addItemWithTitle: @"Hide"
|
||||
action: @selector(hide:)
|
||||
keyEquivalent: @"h"];
|
||||
|
||||
[menu addItemWithTitle: @"Quit"
|
||||
action: @selector(terminate:)
|
||||
keyEquivalent: @"q"];
|
||||
|
||||
// Create the scheme submenu
|
||||
scheme = [NSMenu new];
|
||||
[menu setSubmenu: scheme
|
||||
forItem: [menu itemWithTitle: @"Scheme"]];
|
||||
|
||||
[scheme addItemWithTitle: @"Reset"
|
||||
action: @selector(reset:)
|
||||
keyEquivalent: @"+"];
|
||||
|
||||
[scheme addItemWithTitle: @"Evaluate"
|
||||
action: @selector(evaluate:)
|
||||
keyEquivalent: @"#"];
|
||||
|
||||
// Create the environment submenu
|
||||
env = [NSMenu new];
|
||||
[menu setSubmenu: env
|
||||
forItem: [menu itemWithTitle: @"Environment"]];
|
||||
|
||||
[env addItemWithTitle: @"Up"
|
||||
action: @selector(up:)
|
||||
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..."
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
*/
|
||||
[info addItemWithTitle: @"Help"
|
||||
action: @selector (orderFrontHelpPanel:)
|
||||
keyEquivalent: @"?"];
|
||||
// RELEASE(info);
|
||||
|
||||
// Create the file submenu
|
||||
file = [NSMenu new];
|
||||
[menu setSubmenu: file
|
||||
forItem: [menu itemWithTitle: @"File"]];
|
||||
|
||||
[file addItemWithTitle: @"Open Document"
|
||||
action: @selector(openDocument:)
|
||||
keyEquivalent: @"o"];
|
||||
|
||||
[file addItemWithTitle: @"New Document"
|
||||
action: @selector(newDocument:)
|
||||
keyEquivalent: @"n"];
|
||||
|
||||
[file addItemWithTitle: @"Save"
|
||||
action: @selector(saveDocument:)
|
||||
keyEquivalent: @"s"];
|
||||
|
||||
[file addItemWithTitle: @"Save To..."
|
||||
action: @selector(saveDocumentTo:)
|
||||
keyEquivalent: @"t"];
|
||||
|
||||
[file addItemWithTitle: @"Save As..."
|
||||
action: @selector(saveDocumentAs:)
|
||||
keyEquivalent: @"S"];
|
||||
|
||||
[file addItemWithTitle: @"Save All"
|
||||
action: @selector(saveDocumentAll:)
|
||||
keyEquivalent: @""];
|
||||
|
||||
[file addItemWithTitle: @"Revert to Saved"
|
||||
action: @selector(revertDocumentToSaved:)
|
||||
keyEquivalent: @"u"];
|
||||
|
||||
[file addItemWithTitle: @"Close"
|
||||
action: @selector(close)
|
||||
keyEquivalent: @""];
|
||||
|
||||
[file addItemWithTitle: @"Insert File..."
|
||||
action: @selector(insertFile:)
|
||||
keyEquivalent: @""];
|
||||
|
||||
// RELEASE(file);
|
||||
|
||||
// Create the edit submenu
|
||||
edit = [NSMenu new];
|
||||
[menu setSubmenu: edit
|
||||
forItem: [menu itemWithTitle: @"Edit"]];
|
||||
|
||||
[edit addItemWithTitle: @"Cut"
|
||||
action: @selector(cut:)
|
||||
keyEquivalent: @"x"];
|
||||
|
||||
[edit addItemWithTitle: @"Copy"
|
||||
action: @selector(copy:)
|
||||
keyEquivalent: @"c"];
|
||||
|
||||
[edit addItemWithTitle: @"Paste"
|
||||
action: @selector(paste:)
|
||||
keyEquivalent: @"v"];
|
||||
|
||||
[edit addItemWithTitle: @"Delete"
|
||||
action: @selector(delete:)
|
||||
keyEquivalent: @""];
|
||||
/*
|
||||
[edit addItemWithTitle: @"Undelete"
|
||||
action: NULL
|
||||
keyEquivalent: @""];
|
||||
*/
|
||||
[edit addItemWithTitle: @"Select All"
|
||||
action: @selector(selectAll:)
|
||||
keyEquivalent: @"a"];
|
||||
// RELEASE(edit);
|
||||
|
||||
// Create the windows submenu
|
||||
windows = [NSMenu new];
|
||||
[menu setSubmenu: windows
|
||||
forItem: [menu itemWithTitle: @"Windows"]];
|
||||
|
||||
[windows addItemWithTitle: @"Arrange"
|
||||
action: @selector(arrangeInFront:)
|
||||
keyEquivalent: @""];
|
||||
|
||||
[windows addItemWithTitle: @"Miniaturize"
|
||||
action: @selector(performMiniaturize:)
|
||||
keyEquivalent: @"m"];
|
||||
|
||||
[windows addItemWithTitle: @"Close"
|
||||
action: @selector(performClose:)
|
||||
keyEquivalent: @"w"];
|
||||
|
||||
[windows addItemWithTitle: @"Close image windows"
|
||||
action: @selector(closeImageWindows:)
|
||||
keyEquivalent: @"W"];
|
||||
|
||||
[windows addItemWithTitle: @"Close environment windows"
|
||||
action: @selector(closeEnvWindows:)
|
||||
keyEquivalent: @""];
|
||||
|
||||
[NSApp setWindowsMenu: windows];
|
||||
// RELEASE(windows);
|
||||
|
||||
// Create the service submenu
|
||||
services = [NSMenu new];
|
||||
[menu setSubmenu: services
|
||||
forItem: [menu itemWithTitle: @"Services"]];
|
||||
|
||||
[NSApp setServicesMenu: services];
|
||||
// RELEASE(services);
|
||||
|
||||
[NSApp setMainMenu: menu];
|
||||
// RELEASE(menu);
|
||||
|
||||
imageWindows = [NSMutableArray arrayWithCapacity:1];
|
||||
[imageWindows retain];
|
||||
|
||||
envWindows = [NSMutableArray arrayWithCapacity:1];
|
||||
[envWindows retain];
|
||||
|
||||
// RELEASE(pool);
|
||||
}
|
||||
|
||||
- (void)applicationDidFinishLaunching: (NSNotification *)not;
|
||||
{
|
||||
vm = [[VScheme alloc] init];
|
||||
[vm setDelegate:self];
|
||||
|
||||
[self makeStatisticsWindow];
|
||||
[self makeInterpreterWindow];
|
||||
|
||||
// Make the DocumentController the delegate of the application,
|
||||
// as this is the only way I know to bring it into the responder chain
|
||||
[NSApp setDelegate:[NSDocumentController sharedDocumentController]];
|
||||
}
|
||||
|
||||
NSWindow *interpreterWindow = nil;
|
||||
|
||||
- makeInterpreterWindow
|
||||
{
|
||||
NSWindow *window;
|
||||
NSScrollView *scrollView;
|
||||
SCMInteractive *textView;
|
||||
NSRect scrollViewRect = {{0, 0}, {470, 400}};
|
||||
NSRect winRect = {{250, 100}, {470, 400}};
|
||||
NSRect textRect;
|
||||
unsigned int style = NSTitledWindowMask |
|
||||
NSMiniaturizableWindowMask | NSResizableWindowMask;
|
||||
|
||||
// This is expected to be retained, as it would normaly come from a
|
||||
// nib file, where the owner would retain it.
|
||||
window = [[NSWindow alloc] initWithContentRect: winRect
|
||||
styleMask: style
|
||||
backing: NSBackingStoreRetained
|
||||
defer: NO];
|
||||
[window setMinSize:NSMakeSize(300, 300)];
|
||||
|
||||
scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
|
||||
[scrollView setHasHorizontalScroller: NO];
|
||||
[scrollView setHasVerticalScroller: YES];
|
||||
[scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
|
||||
[[scrollView contentView] setAutoresizingMask: NSViewHeightSizable
|
||||
| NSViewWidthSizable];
|
||||
[[scrollView contentView] setAutoresizesSubviews:YES];
|
||||
|
||||
// Build up the text network
|
||||
textRect = [[scrollView contentView] frame];
|
||||
textView = [[SCMInteractive alloc] initWithFrame: textRect];
|
||||
|
||||
[textView setBackgroundColor: [NSColor whiteColor]];
|
||||
|
||||
[textView setString:GSCHEME];
|
||||
[textView appendString:@"> "];
|
||||
[textView setFont:[NSFont userFixedPitchFontOfSize:12]];
|
||||
|
||||
[textView setDelegate:vm];
|
||||
[textView setHorizontallyResizable: NO];
|
||||
[textView setVerticallyResizable: YES];
|
||||
[textView setMinSize: NSMakeSize(0, 0)];
|
||||
[textView setMaxSize: NSMakeSize(1E7, 1E7)];
|
||||
[textView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
|
||||
[[textView textContainer]
|
||||
setContainerSize:NSMakeSize(textRect.size.width, 1e7)];
|
||||
|
||||
|
||||
[[textView textContainer] setWidthTracksTextView: YES];
|
||||
// Store the text view in an ivar
|
||||
intTextView = textView;
|
||||
|
||||
[scrollView setDocumentView: textView];
|
||||
// RELEASE(textView);
|
||||
[window setContentView: scrollView];
|
||||
// RELEASE(scrollView);
|
||||
|
||||
// Make the Document the delegate of the window
|
||||
[window setDelegate: self];
|
||||
|
||||
[window setTitle:@"GScheme"];
|
||||
[window display];
|
||||
[window makeKeyAndOrderFront:nil];
|
||||
// Make the text view the first responder
|
||||
[textView placeCursorAtEnd];
|
||||
[window makeFirstResponder:textView];
|
||||
|
||||
interpreterWindow = window;
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- makeStatisticsWindow
|
||||
{
|
||||
NSWindow *window;
|
||||
NSScrollView *scrollView;
|
||||
SCMInteractive *textView;
|
||||
NSRect scrollViewRect = {{0, 0}, {470, 400}};
|
||||
NSRect winRect = {{450, 75}, {470, 400}};
|
||||
NSRect textRect;
|
||||
unsigned int style = NSTitledWindowMask |
|
||||
NSMiniaturizableWindowMask | NSResizableWindowMask;
|
||||
|
||||
// This is expected to be retained, as it would normaly come from a
|
||||
// nib file, where the owner would retain it.
|
||||
window = [[NSWindow alloc] initWithContentRect: winRect
|
||||
styleMask: style
|
||||
backing: NSBackingStoreRetained
|
||||
defer: NO];
|
||||
[window setMinSize:NSMakeSize(300, 300)];
|
||||
|
||||
scrollView = [[NSScrollView alloc] initWithFrame: scrollViewRect];
|
||||
[scrollView setHasHorizontalScroller: NO];
|
||||
[scrollView setHasVerticalScroller: YES];
|
||||
[scrollView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
|
||||
[[scrollView contentView] setAutoresizingMask: NSViewHeightSizable
|
||||
| NSViewWidthSizable];
|
||||
[[scrollView contentView] setAutoresizesSubviews:YES];
|
||||
|
||||
// Build up the text network
|
||||
textRect = [[scrollView contentView] frame];
|
||||
textView = [[NSTextView alloc] initWithFrame: textRect];
|
||||
|
||||
[textView setBackgroundColor: [NSColor whiteColor]];
|
||||
|
||||
[textView setString:GSCHEME];
|
||||
[textView setEditable:NO];
|
||||
[textView setFont:[NSFont userFixedPitchFontOfSize:12]];
|
||||
|
||||
[textView setDelegate:vm];
|
||||
[textView setHorizontallyResizable: NO];
|
||||
[textView setVerticallyResizable: YES];
|
||||
[textView setMinSize: NSMakeSize(0, 0)];
|
||||
[textView setMaxSize: NSMakeSize(1E7, 1E7)];
|
||||
[textView setAutoresizingMask: NSViewHeightSizable | NSViewWidthSizable];
|
||||
[[textView textContainer]
|
||||
setContainerSize:NSMakeSize(textRect.size.width, 1e7)];
|
||||
|
||||
|
||||
[[textView textContainer] setWidthTracksTextView: YES];
|
||||
// Store the text view in an ivar
|
||||
statTextView = textView;
|
||||
|
||||
[scrollView setDocumentView: textView];
|
||||
// RELEASE(textView);
|
||||
[window setContentView: scrollView];
|
||||
// RELEASE(scrollView);
|
||||
|
||||
// Make the Document the delegate of the window
|
||||
[window setDelegate: self];
|
||||
|
||||
// Make the text view the first responder
|
||||
// [window makeFirstResponder:textView];
|
||||
[window setTitle:@"GScheme Statistics"];
|
||||
[window display];
|
||||
[window orderFront:nil];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- input:(NSString *)data
|
||||
{
|
||||
[intTextView appendString:data];
|
||||
return self;
|
||||
}
|
||||
|
||||
- output:(NSString *)data
|
||||
{
|
||||
[intTextView appendString:data];
|
||||
return self;
|
||||
}
|
||||
|
||||
- result:(id)item
|
||||
{
|
||||
[intTextView appendString:@"\n"];
|
||||
[intTextView appendString:[VScheme valToString:item]];
|
||||
[intTextView appendString:@"\n> "];
|
||||
[intTextView placeCursorAtEnd];
|
||||
return self;
|
||||
}
|
||||
|
||||
- statistics:(NSString *)stats
|
||||
{
|
||||
NSString *sofar = [statTextView string];
|
||||
[statTextView setString:[sofar stringByAppendingString:stats]];
|
||||
return self;
|
||||
}
|
||||
|
||||
- reset:(id)sender
|
||||
{
|
||||
[vm reset:self];
|
||||
|
||||
[intTextView setString:GSCHEME];
|
||||
[intTextView appendString:@"> "];
|
||||
[intTextView placeCursorAtEnd];
|
||||
[[intTextView window] makeFirstResponder:intTextView];
|
||||
|
||||
[statTextView setString:GSCHEME];
|
||||
}
|
||||
|
||||
- imageWindow:(NSWindow *)window
|
||||
{
|
||||
[imageWindows addObject:window];
|
||||
[window setDelegate:self];
|
||||
return self;
|
||||
}
|
||||
|
||||
- envWindow:(NSWindow *)window
|
||||
{
|
||||
[envWindows addObject:window];
|
||||
[window setDelegate:self];
|
||||
return self;
|
||||
}
|
||||
|
||||
- (void)windowWillClose:(NSNotification *)aNotification
|
||||
{
|
||||
NSWindow *win = [aNotification object];
|
||||
|
||||
if([imageWindows containsObject:win]==YES){
|
||||
[imageWindows removeObject:win];
|
||||
}
|
||||
else if([envWindows containsObject:win]==YES){
|
||||
[envWindows removeObject:win];
|
||||
[win releaseForms];
|
||||
}
|
||||
}
|
||||
|
||||
- closeImageWindows:(id)sender
|
||||
{
|
||||
[imageWindows
|
||||
makeObjectsPerformSelector:@selector(close)];
|
||||
return self;
|
||||
}
|
||||
|
||||
- closeEnvWindows:(id)sender
|
||||
{
|
||||
[envWindows
|
||||
makeObjectsPerformSelector:@selector(close)];
|
||||
return self;
|
||||
}
|
||||
|
||||
@end
|
||||
|
|
@ -0,0 +1,316 @@
|
|||
#import <Foundation/Foundation.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) \
|
||||
((_item)!=nil && ((id)(_item))!=(id)[NSNull null] && \
|
||||
[(_item) isKindOfClass:[SCMType class]])
|
||||
|
||||
@interface SCMType : NSObject
|
||||
{
|
||||
int mark;
|
||||
}
|
||||
|
||||
+ (int)allocatedAfterGC;
|
||||
+ (int)totalAllocated;
|
||||
+ (int)nextMark;
|
||||
|
||||
+ runGC;
|
||||
|
||||
+ alloc;
|
||||
|
||||
|
||||
+ addToMarkables:(id)item;
|
||||
+ removeFromMarkables:(id)item;
|
||||
+ currentMarkForMarkables;
|
||||
|
||||
- (int)mark;
|
||||
- setMark:(int)newMark;
|
||||
- setMarkToCurrent;
|
||||
|
||||
- (void)free;
|
||||
@end
|
||||
|
||||
// type name fix by Matt Rice
|
||||
@interface Boolean : SCMType
|
||||
{
|
||||
BOOL value;
|
||||
}
|
||||
|
||||
- initSCMBoolean:(BOOL)val;
|
||||
- (BOOL)boolVal;
|
||||
|
||||
@end
|
||||
|
||||
@interface Char : SCMType
|
||||
{
|
||||
char value;
|
||||
}
|
||||
|
||||
|
||||
- initSCMChar:(char)val;
|
||||
- (char)charVal;
|
||||
|
||||
@end
|
||||
|
||||
@interface Int : SCMType
|
||||
{
|
||||
long int value;
|
||||
}
|
||||
|
||||
|
||||
- initSCMInt:(long int)val;
|
||||
- (long int)intVal;
|
||||
- (double)doubleVal;
|
||||
|
||||
@end
|
||||
|
||||
@interface Double : SCMType
|
||||
{
|
||||
double value;
|
||||
}
|
||||
|
||||
|
||||
- initSCMDouble:(double)val;
|
||||
- (double)doubleVal;
|
||||
|
||||
@end
|
||||
|
||||
@interface Symbol : SCMType
|
||||
{
|
||||
NSString *value;
|
||||
}
|
||||
|
||||
- initSCMSymbol:(char *)val;
|
||||
- (NSString *)symVal;
|
||||
|
||||
- (void)free;
|
||||
@end
|
||||
|
||||
@interface String : SCMType
|
||||
{
|
||||
NSString *value;
|
||||
}
|
||||
|
||||
- initSCMString:(char *)val;
|
||||
- (NSString *)strVal;
|
||||
|
||||
- (void)free;
|
||||
@end
|
||||
|
||||
@interface Pair : SCMType
|
||||
{
|
||||
id car;
|
||||
id cdr;
|
||||
}
|
||||
|
||||
+ (int)length:(Pair *)list;
|
||||
|
||||
+ newCar:(id)carval Cdr:(id)cdrval;
|
||||
- initCar:(id)carval Cdr:(id)cdrval;
|
||||
|
||||
- car;
|
||||
- cdr;
|
||||
|
||||
- setcar:(id)carval;
|
||||
- setcdr:(id)cdrval;
|
||||
|
||||
- setMarkToCurrent;
|
||||
|
||||
@end
|
||||
|
||||
@interface Vector : SCMType
|
||||
{
|
||||
id *data;
|
||||
unsigned count;
|
||||
}
|
||||
|
||||
+ newFromList:(Pair *)list;
|
||||
+ newWithItem:(id)item count:(int)cval;
|
||||
|
||||
- initWithList:(Pair *)list;
|
||||
- initWithItem:(id)item count:(int)cval;
|
||||
|
||||
- (id *)entries;
|
||||
- (unsigned)count;
|
||||
|
||||
- setMarkToCurrent;
|
||||
|
||||
- (void)free;
|
||||
|
||||
@end
|
||||
|
||||
|
||||
@interface Closure : SCMType
|
||||
{
|
||||
id args;
|
||||
id body;
|
||||
id env;
|
||||
}
|
||||
|
||||
+ newArgs:(id)argsval Body:(id)codes Env:(id)envval;
|
||||
- initArgs:(id)argsval Body:(id)codes Env:(id)envval;
|
||||
|
||||
- args;
|
||||
- body;
|
||||
- env;
|
||||
|
||||
- setMarkToCurrent;
|
||||
|
||||
@end
|
||||
|
||||
@interface Thunk : SCMType
|
||||
{
|
||||
int argp;
|
||||
int envp;
|
||||
int codep;
|
||||
}
|
||||
|
||||
+ newArgp:(int)argpval Envp:(int)envpval Codep:(int)codepval;
|
||||
|
||||
- initArgp:(int)argpval Envp:(int)envpval Codep:(int)codepval;
|
||||
|
||||
- (int)argp;
|
||||
- setArgp:(int)argpval;
|
||||
|
||||
- (int)envp;
|
||||
- setEnvp:(int)envpval;
|
||||
|
||||
- (int)codep;
|
||||
- setCodep:(int)envpval;
|
||||
|
||||
@end
|
||||
|
||||
@interface Environment : SCMType
|
||||
{
|
||||
Environment *parent;
|
||||
NSMutableDictionary *data;
|
||||
}
|
||||
|
||||
+ newParent:(Environment *)par Data:(NSMutableDictionary *)entries;
|
||||
- initParent:(Environment *)par Data:(NSMutableDictionary *)entries;
|
||||
|
||||
- (int)chainLength;
|
||||
|
||||
- (NSMutableDictionary *)lookup:(NSString *)sym;
|
||||
|
||||
- (Environment *)parent;
|
||||
- (NSMutableDictionary *)data;
|
||||
|
||||
- setMarkToCurrent;
|
||||
|
||||
- (void)free;
|
||||
|
||||
@end
|
||||
|
||||
typedef enum {
|
||||
FORM_TOP = 0,
|
||||
FORM_DEFINE1,
|
||||
FORM_DEFINE2,
|
||||
FORM_SET,
|
||||
FORM_LAMBDA1,
|
||||
FORM_LAMBDA2,
|
||||
FORM_QUOTE,
|
||||
FORM_BINDING,
|
||||
FORM_LET,
|
||||
FORM_LETSTAR,
|
||||
FORM_LETREC,
|
||||
FORM_IF1,
|
||||
FORM_IF2,
|
||||
FORM_AND,
|
||||
FORM_OR,
|
||||
FORM_BEGIN,
|
||||
FORM_APPLY,
|
||||
FORM_CASE,
|
||||
FORM_SCOND1,
|
||||
FORM_SCOND2,
|
||||
FORM_SCOND3,
|
||||
FORM_COND,
|
||||
FORM_CALLCC
|
||||
} FORMTYPE;
|
||||
|
||||
@interface Triple : SCMType
|
||||
{
|
||||
int tag;
|
||||
id items[3];
|
||||
}
|
||||
|
||||
+ newTag:(int)tagval;
|
||||
+ newTag:(int)tagval IntArg1:(int)arg1;
|
||||
+ newTag:(int)tagval Arg1:(id)arg1;
|
||||
+ newTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2;
|
||||
+ newTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2 Arg3:(id)arg3;
|
||||
|
||||
- initTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2 Arg3:(id)arg3;
|
||||
|
||||
- (int)tag;
|
||||
- (int)intarg1;
|
||||
- setIntArg1:(int)val;
|
||||
|
||||
- arg1;
|
||||
- arg2;
|
||||
- arg3;
|
||||
|
||||
- setMarkToCurrent;
|
||||
|
||||
@end
|
||||
|
||||
|
||||
typedef enum {
|
||||
IN_TO_ARGS = 0,
|
||||
IN_LOOKUP,
|
||||
IN_CHECK_PTC,
|
||||
IN_POP_ENV,
|
||||
IN_POP_ARGS,
|
||||
IN_APPLIC,
|
||||
IN_LIST_APPLIC,
|
||||
IN_DEFINE,
|
||||
IN_SET,
|
||||
IN_CLOSURE,
|
||||
IN_IF,
|
||||
IN_LAYER,
|
||||
IN_MEMQ,
|
||||
IN_DUP_ARG,
|
||||
IN_EXCH_ARGS,
|
||||
IN_STATE_TO_THUNK,
|
||||
IN_MARK_THUNK,
|
||||
INSTR_COUNT
|
||||
} INSTRUCTION;
|
||||
|
||||
@interface ByteCodes : SCMType
|
||||
{
|
||||
NSMutableArray *data;
|
||||
}
|
||||
|
||||
+ new;
|
||||
- initWithMutableArray:(NSMutableArray *)theData;
|
||||
|
||||
|
||||
- prependTriple:(Triple *)theTriple;
|
||||
- addTriple:(Triple *)theTriple;
|
||||
|
||||
- appendByteCodes:(ByteCodes *)codes;
|
||||
|
||||
- (NSMutableArray *)codes;
|
||||
|
||||
- setMarkToCurrent;
|
||||
|
||||
- (void)free;
|
||||
|
||||
@end
|
||||
|
||||
|
|
@ -0,0 +1,864 @@
|
|||
|
||||
#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
|
||||
|
||||
static int allocatedAfterGC = 0;
|
||||
static NSMutableSet *scmobjects = nil;
|
||||
static NSMutableSet *scmmarkables = nil;
|
||||
static int currentMark = -1;
|
||||
static int totalAllocated = 0;
|
||||
|
||||
|
||||
+ (int)allocatedAfterGC
|
||||
{
|
||||
return allocatedAfterGC;
|
||||
}
|
||||
|
||||
+ (int)totalAllocated
|
||||
{
|
||||
return totalAllocated;
|
||||
}
|
||||
|
||||
+ (int)nextMark
|
||||
{
|
||||
currentMark++;
|
||||
return currentMark;
|
||||
}
|
||||
|
||||
+ addToMarkables:(id)item
|
||||
{
|
||||
NSValue *entry =
|
||||
[NSValue valueWithBytes:&item objCType:@encode(id)];
|
||||
|
||||
if(scmmarkables==nil){
|
||||
scmmarkables = [NSMutableSet setWithCapacity:1];
|
||||
[scmmarkables retain];
|
||||
}
|
||||
|
||||
[scmmarkables addObject:entry];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
+ removeFromMarkables:(id)item
|
||||
{
|
||||
NSValue *entry =
|
||||
[NSValue valueWithBytes:&item objCType:@encode(id)];
|
||||
|
||||
if(scmmarkables==nil){
|
||||
scmmarkables = [NSMutableSet setWithCapacity:1];
|
||||
[scmmarkables retain];
|
||||
}
|
||||
|
||||
[scmmarkables removeObject:entry];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
+ currentMarkForMarkables
|
||||
{
|
||||
NSEnumerator *enumerator;
|
||||
NSValue *curval;
|
||||
id markable;
|
||||
|
||||
if(scmmarkables==nil){
|
||||
scmmarkables = [NSMutableSet setWithCapacity:1];
|
||||
}
|
||||
enumerator = [scmmarkables objectEnumerator];
|
||||
|
||||
while((curval = (NSValue *)[enumerator nextObject])!=nil){
|
||||
[curval getValue:&markable];
|
||||
if(MARKABLE(markable)){
|
||||
[markable setMarkToCurrent];
|
||||
}
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
+ runGC
|
||||
{
|
||||
NSMutableSet *nextobjects = [NSMutableSet setWithCapacity:1];
|
||||
NSEnumerator *enumerator = [scmobjects objectEnumerator];
|
||||
// NSValue *curval;
|
||||
SCMType *current;
|
||||
|
||||
while((current = (SCMType *)[enumerator nextObject])!=nil){
|
||||
// [curval getValue:¤t];
|
||||
if([current mark]!=currentMark){
|
||||
[current free];
|
||||
}
|
||||
else{
|
||||
[nextobjects addObject:current]; // curval];
|
||||
}
|
||||
}
|
||||
|
||||
[scmobjects release];
|
||||
|
||||
scmobjects = nextobjects;
|
||||
[scmobjects retain];
|
||||
|
||||
allocatedAfterGC = totalAllocated = [scmobjects count];
|
||||
}
|
||||
|
||||
+ alloc
|
||||
{
|
||||
id inst = [super alloc];
|
||||
/* NSValue *entry =
|
||||
[NSValue valueWithBytes:&inst objCType:@encode(id)]; */
|
||||
|
||||
if(scmobjects==nil){
|
||||
scmobjects = [NSMutableSet setWithCapacity:1];
|
||||
[scmobjects retain];
|
||||
}
|
||||
|
||||
[scmobjects addObject:inst]; // entry];
|
||||
totalAllocated++;
|
||||
|
||||
return [inst setMark:-1];
|
||||
}
|
||||
|
||||
|
||||
- (int)mark
|
||||
{
|
||||
return mark;
|
||||
}
|
||||
|
||||
- setMark:(int)newMark
|
||||
{
|
||||
mark = newMark;
|
||||
return self;
|
||||
}
|
||||
|
||||
- setMarkToCurrent
|
||||
{
|
||||
mark = currentMark;
|
||||
return self;
|
||||
}
|
||||
|
||||
|
||||
- (void)free
|
||||
{
|
||||
int count = [self retainCount];
|
||||
|
||||
while(count>2){ // count>1 (leave one release for the set)
|
||||
count--;
|
||||
[self release];
|
||||
}
|
||||
|
||||
[super release];
|
||||
}
|
||||
@end
|
||||
|
||||
@implementation Pair
|
||||
|
||||
+ (int)length:(Pair *)list
|
||||
{
|
||||
return (list==(Pair *)[NSNull null] ?
|
||||
0 : 1+[self length:[list cdr]]);
|
||||
}
|
||||
|
||||
+ newCar:(id)carval Cdr:(id)cdrval
|
||||
{
|
||||
return [[super alloc] initCar:carval Cdr:cdrval];
|
||||
}
|
||||
|
||||
- initCar:(id)carval Cdr:(id)cdrval
|
||||
{
|
||||
car = carval; [car retain];
|
||||
cdr = cdrval; [cdr retain];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
|
||||
- car
|
||||
{
|
||||
return car;
|
||||
}
|
||||
|
||||
- cdr
|
||||
{
|
||||
return cdr;
|
||||
}
|
||||
|
||||
- setcar:(id)carval
|
||||
{
|
||||
car = carval; [car retain];
|
||||
return self;
|
||||
}
|
||||
|
||||
- setcdr:(id)cdrval
|
||||
{
|
||||
cdr = cdrval; [cdr retain];
|
||||
return self;
|
||||
}
|
||||
|
||||
- setMarkToCurrent
|
||||
{
|
||||
if([self mark]==currentMark){
|
||||
return;
|
||||
}
|
||||
|
||||
[super setMarkToCurrent];
|
||||
if(MARKABLE(car)){
|
||||
[car setMarkToCurrent];
|
||||
}
|
||||
if(MARKABLE(cdr)){
|
||||
[cdr setMarkToCurrent];
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
|
||||
@end
|
||||
|
||||
@implementation Vector
|
||||
|
||||
+ newFromList:(Pair *)list
|
||||
{
|
||||
return [[super alloc]
|
||||
initWithList:list];
|
||||
}
|
||||
|
||||
+ newWithItem:(id)item count:(int)cval
|
||||
{
|
||||
return [[super alloc]
|
||||
initWithItem:item count:cval];
|
||||
}
|
||||
|
||||
|
||||
- initWithList:(Pair *)list
|
||||
{
|
||||
Pair *current = list;
|
||||
int index = 0, length = [Pair length:list];
|
||||
|
||||
count = length;
|
||||
data = NSZoneMalloc([self zone], length*sizeof(id));
|
||||
|
||||
while(isPair(current)){
|
||||
data[index] = [current car]; [data[index++] retain];
|
||||
current = [current cdr];
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- initWithItem:(id)item count:(int)cval
|
||||
{
|
||||
count = cval;
|
||||
data = NSZoneMalloc([self zone], cval*sizeof(id));
|
||||
|
||||
while(cval--){
|
||||
data[cval] = item; [item retain];
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
|
||||
- (id *)entries
|
||||
{
|
||||
return data;
|
||||
}
|
||||
|
||||
- (unsigned)count
|
||||
{
|
||||
return count;
|
||||
}
|
||||
|
||||
- setMarkToCurrent
|
||||
{
|
||||
int index;
|
||||
|
||||
if([self mark]==currentMark){
|
||||
return;
|
||||
}
|
||||
|
||||
[super setMarkToCurrent];
|
||||
|
||||
for(index=0; index<count; index++){
|
||||
id obj = data[index];
|
||||
if(MARKABLE(obj)){
|
||||
[obj setMarkToCurrent];
|
||||
}
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
|
||||
- (void)free
|
||||
{
|
||||
NSZoneFree([self zone], data);
|
||||
[super free];
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation Closure
|
||||
|
||||
+ newArgs:(id)argsval Body:(id)codes Env:(id)envval
|
||||
{
|
||||
return [[super alloc]
|
||||
initArgs:argsval Body:codes Env:envval];
|
||||
}
|
||||
|
||||
- initArgs:(id)argsval Body:(id)codes Env:(id)envval
|
||||
{
|
||||
[super init];
|
||||
args = argsval; [args retain];
|
||||
body = codes; [body retain];
|
||||
env = envval; [env retain];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- args
|
||||
{
|
||||
return args;
|
||||
}
|
||||
|
||||
- body
|
||||
{
|
||||
return body;
|
||||
}
|
||||
|
||||
- env
|
||||
{
|
||||
return env;
|
||||
}
|
||||
|
||||
- setMarkToCurrent
|
||||
{
|
||||
if([self mark]==currentMark){
|
||||
return;
|
||||
}
|
||||
|
||||
[super setMarkToCurrent];
|
||||
if(MARKABLE(args)){
|
||||
[args setMarkToCurrent];
|
||||
}
|
||||
if(MARKABLE(body)){
|
||||
[body setMarkToCurrent];
|
||||
}
|
||||
if(MARKABLE(env)){
|
||||
[env setMarkToCurrent];
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation Thunk
|
||||
|
||||
+ newArgp:(int)argpval Envp:(int)envpval Codep:(int)codepval
|
||||
{
|
||||
return [[super alloc]
|
||||
initArgp:argpval Envp:envpval Codep:codepval];
|
||||
}
|
||||
|
||||
- initArgp:(int)argpval Envp:(int)envpval Codep:(int)codepval
|
||||
{
|
||||
argp = argpval;
|
||||
envp = envpval;
|
||||
codep = codepval;
|
||||
return self;
|
||||
}
|
||||
|
||||
- (int)argp
|
||||
{
|
||||
return argp;
|
||||
}
|
||||
|
||||
- setArgp:(int)argpval
|
||||
{
|
||||
argp = argpval;
|
||||
return self;
|
||||
}
|
||||
|
||||
- (int)envp
|
||||
{
|
||||
return envp;
|
||||
}
|
||||
|
||||
- setEnvp:(int)envpval
|
||||
{
|
||||
envp = envpval;
|
||||
return self;
|
||||
}
|
||||
|
||||
- (int)codep
|
||||
{
|
||||
return codep;
|
||||
}
|
||||
|
||||
- setCodep:(int)codepval
|
||||
{
|
||||
codep = codepval;
|
||||
return self;
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
|
||||
|
||||
@implementation Environment
|
||||
|
||||
+ newParent:(Environment *)par Data:(NSMutableDictionary *)entries
|
||||
{
|
||||
return [[super alloc]
|
||||
initParent:par Data:entries];
|
||||
}
|
||||
|
||||
- initParent:(Environment *)par Data:(NSMutableDictionary *)entries
|
||||
{
|
||||
[super init];
|
||||
|
||||
parent = par;
|
||||
[parent retain];
|
||||
|
||||
data = entries; // [entries mutableCopy];
|
||||
[data retain];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- (int)chainLength
|
||||
{
|
||||
return (parent==nil ? 1 : 1+[parent chainLength]);
|
||||
}
|
||||
|
||||
- (NSMutableDictionary *)lookup:(NSString *)sym
|
||||
{
|
||||
if([data objectForKey:sym]!=nil){
|
||||
return data;
|
||||
}
|
||||
|
||||
return (parent==nil ? nil : [parent lookup:sym]);
|
||||
}
|
||||
|
||||
- (Environment *)parent
|
||||
{
|
||||
return parent;
|
||||
}
|
||||
|
||||
- (NSMutableDictionary *)data
|
||||
{
|
||||
return data;
|
||||
}
|
||||
|
||||
- setMarkToCurrent
|
||||
{
|
||||
NSEnumerator *enumerator = [data objectEnumerator];
|
||||
id item;
|
||||
|
||||
if([self mark]==currentMark){
|
||||
return;
|
||||
}
|
||||
|
||||
[super setMarkToCurrent];
|
||||
while((item = [enumerator nextObject])!=nil){
|
||||
if(MARKABLE(item)){
|
||||
[item setMarkToCurrent];
|
||||
}
|
||||
}
|
||||
|
||||
if(MARKABLE(parent)){
|
||||
[parent setMarkToCurrent];
|
||||
}
|
||||
|
||||
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
|
||||
{
|
||||
GSIMapEmptyMap(&(((GSMDictPtr)data)->map));
|
||||
while([data retainCount]>1){
|
||||
[data release];
|
||||
}
|
||||
|
||||
[super free];
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
|
||||
@implementation Triple
|
||||
|
||||
+ newTag:(int)tagval
|
||||
{
|
||||
return [[super alloc]
|
||||
initTag:tagval
|
||||
Arg1:nil Arg2:nil Arg3:nil];
|
||||
}
|
||||
|
||||
+ newTag:(int)tagval IntArg1:(int)arg1;
|
||||
{
|
||||
NSNumber *num = [NSNumber numberWithInt:arg1];
|
||||
return [[super alloc]
|
||||
initTag:tagval
|
||||
Arg1:num Arg2:nil Arg3:nil];
|
||||
}
|
||||
|
||||
+ newTag:(int)tagval Arg1:(id)arg1
|
||||
{
|
||||
return [[super alloc]
|
||||
initTag:tagval
|
||||
Arg1:arg1 Arg2:nil Arg3:nil];
|
||||
}
|
||||
|
||||
+ newTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2
|
||||
{
|
||||
return [[super alloc]
|
||||
initTag:tagval
|
||||
Arg1:arg1 Arg2:arg2 Arg3:nil];
|
||||
}
|
||||
|
||||
+ newTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2 Arg3:(id)arg3
|
||||
{
|
||||
return [[super alloc]
|
||||
initTag:tagval
|
||||
Arg1:arg1 Arg2:arg2 Arg3:arg3];
|
||||
}
|
||||
|
||||
|
||||
- initTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2 Arg3:(id)arg3
|
||||
{
|
||||
tag = tagval;
|
||||
|
||||
items[0] = arg1; [arg1 retain];
|
||||
items[1] = arg2; [arg2 retain];
|
||||
items[2] = arg3; [arg3 retain];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- (int)tag
|
||||
{
|
||||
return tag;
|
||||
}
|
||||
|
||||
- (int)intarg1
|
||||
{
|
||||
return [items[0] intValue];
|
||||
}
|
||||
|
||||
- setIntArg1:(int)val
|
||||
{
|
||||
items[0] = [NSNumber numberWithInt:val];
|
||||
return self;
|
||||
}
|
||||
|
||||
- arg1
|
||||
{
|
||||
return items[0];
|
||||
}
|
||||
|
||||
- arg2
|
||||
{
|
||||
return items[1];
|
||||
}
|
||||
|
||||
- arg3
|
||||
{
|
||||
return items[2];
|
||||
}
|
||||
|
||||
- setMarkToCurrent
|
||||
{
|
||||
if([self mark]==currentMark){
|
||||
return;
|
||||
}
|
||||
|
||||
[super setMarkToCurrent];
|
||||
if(MARKABLE(items[0])){
|
||||
[items[0] setMarkToCurrent];
|
||||
}
|
||||
if(MARKABLE(items[1])){
|
||||
[items[1] setMarkToCurrent];
|
||||
}
|
||||
if(MARKABLE(items[2])){
|
||||
[items[2] setMarkToCurrent];
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation Boolean
|
||||
|
||||
- initSCMBoolean:(BOOL)val
|
||||
{
|
||||
[super init];
|
||||
value = val;
|
||||
return self;
|
||||
}
|
||||
|
||||
- (BOOL)boolVal
|
||||
{
|
||||
return value;
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation Char
|
||||
|
||||
- initSCMChar:(char)val
|
||||
{
|
||||
[super init];
|
||||
value = val;
|
||||
return self;
|
||||
}
|
||||
|
||||
- (char)charVal
|
||||
{
|
||||
return value;
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation Int
|
||||
|
||||
- initSCMInt:(long int)val
|
||||
{
|
||||
[super init];
|
||||
value = val;
|
||||
return self;
|
||||
}
|
||||
|
||||
- (long int)intVal
|
||||
{
|
||||
return value;
|
||||
}
|
||||
|
||||
- (double)doubleVal
|
||||
{
|
||||
return (double)value;
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation Double
|
||||
|
||||
- initSCMDouble:(double)val
|
||||
{
|
||||
[super init];
|
||||
value = val;
|
||||
return self;
|
||||
}
|
||||
|
||||
- (double)doubleVal
|
||||
{
|
||||
return value;
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation Symbol
|
||||
|
||||
- initSCMSymbol:(char *)val
|
||||
{
|
||||
[super init];
|
||||
value = [NSString stringWithCString:val];
|
||||
[value retain];
|
||||
return self;
|
||||
}
|
||||
|
||||
- (NSString *)symVal
|
||||
{
|
||||
return value;
|
||||
}
|
||||
|
||||
- (void)free
|
||||
{
|
||||
[value release];
|
||||
[super free];
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation String
|
||||
|
||||
- initSCMString:(char *)val
|
||||
{
|
||||
char *cp, *buf, *from, *to;
|
||||
int len = strlen(val);
|
||||
|
||||
[super init];
|
||||
|
||||
cp = strdup(val); from = cp+1; cp[len-1] = 0;
|
||||
buf = to = malloc(len-1);
|
||||
|
||||
while(*from){
|
||||
if(*from == '\\'){
|
||||
from++;
|
||||
}
|
||||
*to++ = *from++;
|
||||
}
|
||||
*to = 0;
|
||||
|
||||
value = [NSString stringWithCString:buf];
|
||||
[value retain];
|
||||
|
||||
free(buf);
|
||||
free(cp);
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- (NSString *)strVal
|
||||
{
|
||||
return value;
|
||||
}
|
||||
|
||||
- (void)free
|
||||
{
|
||||
[value release];
|
||||
[super free];
|
||||
}
|
||||
|
||||
@end
|
||||
|
||||
@implementation ByteCodes
|
||||
|
||||
+ new
|
||||
{
|
||||
id inst = [super alloc];
|
||||
[inst initWithMutableArray:[NSMutableArray arrayWithCapacity:1]];
|
||||
return inst;
|
||||
}
|
||||
|
||||
- initWithMutableArray:(NSMutableArray *)theData
|
||||
{
|
||||
[super init];
|
||||
data = theData;
|
||||
[data retain];
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
- prependTriple:(Triple *)theTriple
|
||||
{
|
||||
[data prependObjWRP:theTriple];
|
||||
return self;
|
||||
}
|
||||
|
||||
- addTriple:(Triple *)theTriple
|
||||
{
|
||||
[data addObjWRP:theTriple];
|
||||
return self;
|
||||
}
|
||||
|
||||
- appendByteCodes:(ByteCodes *)codes
|
||||
{
|
||||
[data addObjectsFromArray:[codes codes]];
|
||||
return self;
|
||||
}
|
||||
|
||||
|
||||
- (NSMutableArray *)codes
|
||||
{
|
||||
return data;
|
||||
}
|
||||
|
||||
- setMarkToCurrent
|
||||
{
|
||||
int index, count = [data count];
|
||||
|
||||
if([self mark]==currentMark){
|
||||
return;
|
||||
}
|
||||
|
||||
[super setMarkToCurrent];
|
||||
|
||||
for(index=0; index<count; index++){
|
||||
id obj = [data objectAtIndex:index];
|
||||
if(MARKABLE(obj)){
|
||||
[obj setMarkToCurrent];
|
||||
}
|
||||
}
|
||||
|
||||
return self;
|
||||
}
|
||||
|
||||
@interface GSMutableArray : NSMutableArray
|
||||
{
|
||||
@public
|
||||
id *_contents_array;
|
||||
unsigned _count;
|
||||
unsigned _capacity;
|
||||
int _grow_factor;
|
||||
}
|
||||
@end
|
||||
|
||||
typedef struct {
|
||||
@defs(GSMutableArray)
|
||||
} *GSMArrayPtr;
|
||||
|
||||
- (void)free
|
||||
{
|
||||
((GSMArrayPtr)data)->_count = 0;
|
||||
while([data retainCount]>1){
|
||||
[data release];
|
||||
}
|
||||
|
||||
[super free];
|
||||
}
|
||||
|
||||
@end
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
{
|
||||
NOTE = "Automatically generated, do not edit!";
|
||||
NSExecutable = "TestScheme";
|
||||
NSMainNibFile = "";
|
||||
NSPrincipalClass = "NSApplication";
|
||||
}
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
[Desktop Entry]
|
||||
Encoding=UTF-8
|
||||
Type=Application
|
||||
Exec=openapp TestScheme.app
|
||||
#TryExec=TestScheme.app
|
||||
|
|
@ -0,0 +1,218 @@
|
|||
#!/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 "$@"
|
||||
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
|
||||
|
||||
GScheme
|
||||
|
||||
A GNUstep-aware scheme interpreter. Includes many examples, e.g. the
|
||||
sieve of Erathostenes to compute primes, a Koch curve plotter, graphs
|
||||
of various functions etc. GScheme is fully tail recursive. The garbage
|
||||
collector bypasses GNUstep's retain/release mechanism in order to deal
|
||||
with circular data structures.
|
||||
|
||||
GScheme is document-based and you can edit more than one file at the
|
||||
same time.
|
||||
|
||||
Speed leaves something to be desired as there is a lot of overhead due
|
||||
to Objective C.
|
||||
|
||||
Press Ctrl-Return in the interpreter window to evaluate the last form
|
||||
that you have entered.
|
||||
|
||||
Special forms implemented include
|
||||
|
||||
define, set!, lambda,
|
||||
if, and, or
|
||||
begin, apply,
|
||||
quote, case, cond,
|
||||
let, let, letrec,
|
||||
call-with-current-continuation
|
||||
|
||||
Primitives implemented include
|
||||
|
||||
+, *, -, /, =, >, <,
|
||||
draw-move, draw-line, draw-color,
|
||||
sin, cos, sqrt,
|
||||
quotient, remainder, not,
|
||||
zero?, pair?, number?, eqv?, eq?,
|
||||
cons, car, cdr, list, null?,
|
||||
set-car!, set-cdr!,
|
||||
display, newline
|
||||
|
||||
There is a library of additional primitives that are loaded on start-up.
|
||||
|
|
@ -0,0 +1,120 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
#import "SchemeTypes.h"
|
||||
#import "Primitive.h"
|
||||
|
||||
#define GSCHEME @"GScheme by Marko Riedel, mriedel@neuearbeit.de\n"
|
||||
|
||||
typedef enum {
|
||||
MODE_INTERACTIVE,
|
||||
MODE_EVALUATE,
|
||||
MODE_LOAD
|
||||
} PROCESS_MODE;
|
||||
|
||||
typedef enum {
|
||||
DRAW_MOVE,
|
||||
DRAW_LINE,
|
||||
DRAW_COLOR
|
||||
} DRAW_INST;
|
||||
|
||||
typedef struct _DrawInst {
|
||||
DRAW_INST what;
|
||||
union {
|
||||
NSPoint coord;
|
||||
float color[3];
|
||||
} data;
|
||||
} DrawInst;
|
||||
|
||||
@interface VScheme : NSObject
|
||||
{
|
||||
BOOL errflag;
|
||||
NSString *errmsg;
|
||||
|
||||
NSMutableArray *codeStack;
|
||||
NSMutableArray *pcStack;
|
||||
NSMutableArray *argStack;
|
||||
NSMutableArray *envStack;
|
||||
|
||||
id curcodes;
|
||||
int curpc;
|
||||
|
||||
NSString *output;
|
||||
|
||||
int maxcode, maxpc, maxarg, maxenv;
|
||||
|
||||
id delegate;
|
||||
|
||||
BOOL atImgStart;
|
||||
NSPoint imgMin, imgMax;
|
||||
NSMutableArray *imgCodes;
|
||||
|
||||
long int curRecDepth, maxRecDepth;
|
||||
}
|
||||
|
||||
+ (NSString *)valToString:(id)item seen:(NSMutableSet *)mem;
|
||||
+ (NSString *)valToString:(id)item;
|
||||
|
||||
+ printInstr:(Triple *)instr;
|
||||
+ printCodes:(NSMutableArray *)codes;
|
||||
|
||||
- init;
|
||||
|
||||
- delegate;
|
||||
- setDelegate:(id)aDelegate;
|
||||
|
||||
- makeStartEnvironment;
|
||||
|
||||
- (int)maxcode;
|
||||
- (int)maxpc;
|
||||
- (int)maxarg;
|
||||
- (int)maxenv;
|
||||
|
||||
- resetStacks;
|
||||
- reset:(id)sender;
|
||||
|
||||
- appendToOutput:(NSString *)data;
|
||||
- (NSString *)output;
|
||||
- clearOutput;
|
||||
|
||||
- recordImgInst:(DrawInst)inst;
|
||||
- clearImage;
|
||||
- produceImage;
|
||||
|
||||
- (NSMutableArray *)argStack;
|
||||
- (NSMutableArray *)envStack;
|
||||
- (NSMutableArray *)codeStack;
|
||||
|
||||
- (BOOL)errflag;
|
||||
- (NSString *)errmsg;
|
||||
|
||||
- args2list:(int)lower;
|
||||
|
||||
- pushCodes:(NSMutableArray *)codes;
|
||||
- (BOOL)run:(ByteCodes *)prog;
|
||||
|
||||
- special:(id)data output:(ByteCodes *)codes popenv:(int)ec;
|
||||
- sequence:(id)data output:(ByteCodes *)codes popenv:(int)ec;
|
||||
- compile:(id)data output:(ByteCodes *)codes popenv:(int)ec;
|
||||
|
||||
- (BOOL)compile:(id)data output:(ByteCodes *)codes;
|
||||
|
||||
- (BOOL)processString:(NSString *)data mode:(PROCESS_MODE)pmode;
|
||||
|
||||
@end
|
||||
|
||||
@interface SCMImageView : NSView
|
||||
{
|
||||
NSImage *image;
|
||||
}
|
||||
|
||||
- (id)initWithFrame:(NSRect)frameRect;
|
||||
|
||||
- (NSImage *)image;
|
||||
- setImage:(NSImage *)anImage;
|
||||
|
||||
- (void)drawRect:(NSRect)aRect;
|
||||
|
||||
@end
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
|
||||
(define l1 (list-n 500))
|
||||
|
||||
(define access-list
|
||||
(lambda (l n)
|
||||
(if (zero? n) l
|
||||
(access-list (cdr l) (- n 1)))))
|
||||
(set-cdr! (access-list l1 250) '())
|
||||
|
||||
(define l2 (list-n 500))
|
||||
|
||||
(define vectors
|
||||
(lambda (mx)
|
||||
(map (lambda (n) (make-vector n n))
|
||||
(list-n mx))))
|
||||
|
||||
(vectors 100)
|
||||
|
||||
(list-n 1000)
|
||||
|
||||
(vectors 200)
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(and) (and #t #f)
|
||||
(and
|
||||
(begin (display 1) #t)
|
||||
(begin (display 2) #f)
|
||||
(begin (display 3) #f))
|
||||
(or) (or #f #t)
|
||||
(or
|
||||
(begin (display 1) #f)
|
||||
(begin (display 2) #t)
|
||||
(begin (display 3) #t))
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
|
||||
(define reduce
|
||||
(lambda (op base l)
|
||||
(if (null? l)
|
||||
(begin (browse-environment) base)
|
||||
(op (car l) (reduce op base (cdr l))))))
|
||||
|
||||
(reduce + 0 '(2 3 4))
|
||||
|
||||
|
||||
(define factit
|
||||
(lambda (n)
|
||||
(letrec
|
||||
((fit
|
||||
(lambda (n acc)
|
||||
(if (= n 0)
|
||||
(begin
|
||||
(browse-environment) acc)
|
||||
(fit (- n 1) (* n acc))))))
|
||||
(fit n 1))))
|
||||
|
||||
(factit 6)
|
||||
|
||||
(define rec
|
||||
(lambda (n stop)
|
||||
(display n) (newline)
|
||||
(if (= n 0)
|
||||
(begin
|
||||
(browse-environment)
|
||||
(stop 0))
|
||||
(begin
|
||||
(rec (- n 1) stop)
|
||||
(display n) (newline)))))
|
||||
|
||||
(rec 6 (lambda (x) '()))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
(define rec
|
||||
(lambda (n stop)
|
||||
(display n) (newline)
|
||||
(if (= n 0) (stop 0)
|
||||
(begin
|
||||
(rec (- n 1) stop)
|
||||
(display n) (newline)))))
|
||||
(rec 6 (lambda (x) '()))
|
||||
(call-with-current-continuation
|
||||
(lambda (t) (rec 6 t)))
|
||||
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
(define jumper
|
||||
(lambda (n m)
|
||||
(letrec
|
||||
((rec
|
||||
(lambda (n m jump)
|
||||
(if (= n 0) (jump '())
|
||||
(if (= n m)
|
||||
(call-with-current-continuation
|
||||
(lambda (t) (rec (- n 1) m t)))
|
||||
(rec (- n 1) m jump)))
|
||||
(display n) (newline))))
|
||||
(rec n m (lambda (v) v)))))
|
||||
(jumper 10 3)
|
||||
(jumper 6 4)
|
||||
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
(case (* 2 3)
|
||||
((2 3 5 7) 'prime)
|
||||
((1 4 6 8 9) 'composite))
|
||||
(case (car '(c d))
|
||||
((a) 'a)
|
||||
((b) 'b))
|
||||
(case (car '(c d))
|
||||
((a e i o u) 'vowel)
|
||||
((w y) 'semivowel)
|
||||
(else 'consonant))
|
||||
(case 'a
|
||||
((b c) (display "not reached") (newline) 'b)
|
||||
((a d) (display "reached") (newline) 'a))
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
|
||||
|
||||
(for-each display
|
||||
'(#\( #\" #\' #\a #\space #\b #\tab #\c #\)))
|
||||
|
||||
;;; from comp.lang.scheme
|
||||
|
||||
(let ((x (list 1)) (y (list 2)))
|
||||
(for-each display
|
||||
(list "Before: " "x = " (car x) " and y = " (car y)
|
||||
#\newline))
|
||||
(set-car! (if #t x y) 3.1415)
|
||||
(for-each display
|
||||
(list "After: " "x = " (car x) " and y = " (car y)
|
||||
#\newline)))
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
|
||||
(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))))
|
||||
(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)
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
(define a '(1 2 (3 4) (5 6) 7 8))
|
||||
|
||||
(set-cdr! (car (cdr (cdr a))) (cdr a))
|
||||
(begin (display a) (newline))
|
||||
|
||||
(set-cdr! (cdr (cdr (cdr (cdr (cdr a))))) a)
|
||||
(begin (display a) (newline))
|
||||
|
||||
(define v (make-vector 5 '()))
|
||||
(vector-set! v 2 v)
|
||||
(begin (display v) (newline))
|
||||
|
||||
(define a '(1 2))
|
||||
(define v (make-vector 2))
|
||||
(set-cdr! a v)
|
||||
(vector-set! v 0 a)
|
||||
|
||||
a
|
||||
v
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
;;; library required
|
||||
|
||||
(cond ((> 3 2) (display 'here) (newline) 'greater)
|
||||
((< 3 2) (display 'there) (newline) 'less))
|
||||
(cond ((> 3 3) 'greater)
|
||||
((< 3 3) 'less)
|
||||
(else 'equal))
|
||||
(cond
|
||||
(#f 'not-reached)
|
||||
((assq 'c '((a 1) (b 2) (c 3))) => cdr))
|
||||
|
||||
;;; syntax errors
|
||||
;;; (cond ())
|
||||
;;; (cond (else 'a) (else 'b))
|
||||
;;; (cond (#t =>))
|
||||
|
||||
(define testcond
|
||||
(lambda (l)
|
||||
(cond
|
||||
((assq 'a l) => (lambda (p) (set-car! p 'd)))
|
||||
((assq 'b l) => (lambda (p) (set-car! p 'e)))
|
||||
((assq 'c l) => (lambda (p) (set-car! p 'f))))))
|
||||
|
||||
(define l '((a 1) (b 2) (c 3)))
|
||||
(testcond l)
|
||||
(testcond l)
|
||||
(testcond l)
|
||||
l
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
|
||||
(define r
|
||||
(lambda (n)
|
||||
(if (= n 0) '()
|
||||
(r (- n 1)))))
|
||||
|
||||
|
||||
(r 10)
|
||||
|
||||
|
||||
(r -10)
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
;;; library required
|
||||
|
||||
(define l '(a (1 2 (3 4) 5) b))
|
||||
(memv 'a l)
|
||||
(memv '(1 2 (3 4) 5) l)
|
||||
(member '(1 2 (3 4) 5) l)
|
||||
(define k '((a 1) (b 2) ((((a))) 3)))
|
||||
(assq 'a k)
|
||||
(assq '(((a))) k)
|
||||
(assoc '(((a))) k)
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
(define factorial
|
||||
(lambda (n)
|
||||
(if (= 0 n) 1
|
||||
(* n (factorial (- n 1))))))
|
||||
|
||||
(factorial 6)
|
||||
|
||||
(define factit
|
||||
(lambda (n)
|
||||
(letrec
|
||||
((fit
|
||||
(lambda (n acc)
|
||||
(if (= n 0) acc (fit (- n 1) (* n acc))))))
|
||||
(fit n 1))))
|
||||
|
||||
(factit 6)
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
(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))
|
||||
(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)
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(define count
|
||||
(let ((c 0)) (lambda () (set! c (+ 1 c)) c)))
|
||||
(count) (count) (count)
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
|
||||
(define (a proc)
|
||||
(proc 5))
|
||||
|
||||
(letrec
|
||||
((res '()))
|
||||
(a
|
||||
(lambda (arg)
|
||||
(if (< arg 0)
|
||||
(set! res (- arg))
|
||||
(set! res arg)))))
|
||||
|
|
@ -0,0 +1,109 @@
|
|||
|
||||
(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)))))))
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
;;; library required
|
||||
|
||||
(reverse '(a b c d e f))
|
||||
|
||||
(filter '(1 2 a b 3 c 4 5 d e f) number?)
|
||||
|
||||
(define l '(1 2 3 4 5))
|
||||
(append l '(6 7 8))
|
||||
(append l '(6 7 8) '(9 10 11))
|
||||
(append l '(6 7 8 (9 10 11)))
|
||||
(append l 6)
|
||||
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
|
||||
(define (a x y . rest ) (+ x y (apply * rest)))
|
||||
(a 1 2 3 4 5)
|
||||
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
(define plotter
|
||||
(lambda (f res x1 x2 y1 y2)
|
||||
(let* ((dx (- x2 x1)) (dy (- y2 y1)) (delta (/ dx res)))
|
||||
(letrec
|
||||
((scaled
|
||||
(lambda (f x y)
|
||||
(f
|
||||
(* res (/ (- x x1) dx))
|
||||
(* res (/ (- y y1) dy)))))
|
||||
(plotit
|
||||
(lambda (x)
|
||||
(scaled draw-line x (f x))
|
||||
(if (< x x2) (plotit (+ x delta))))))
|
||||
(draw-color 0 0 0)
|
||||
(scaled draw-move 0 y1)
|
||||
(scaled draw-line 0 y2)
|
||||
(scaled draw-move x1 0)
|
||||
(scaled draw-line x2 0)
|
||||
(draw-color 255 0 0)
|
||||
(scaled draw-move x1 (f x1))
|
||||
(plotit x1)))))
|
||||
|
||||
(plotter (lambda (x) (* x x x)) 70 -5.0 5.0 -50.0 50.0)
|
||||
(plotter sin 50 -5.0 5.0 -1.0 1.0)
|
||||
(plotter (lambda (x) (* x (sin x))) 100 -25.0 25.0 -25.0 25.0)
|
||||
(plotter (lambda (x) (+ (* x x) (* -5 x) 6)) 80 -1.0 5.0 -3.0 10.0)
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
(define primes
|
||||
;;; 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)
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
|
||||
(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 showqueens
|
||||
(lambda (n)
|
||||
(allqueens
|
||||
n (lambda (sol) (display sol) (newline)))))
|
||||
|
||||
(showqueens 4)
|
||||
|
||||
(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 printunique
|
||||
(lambda (n)
|
||||
(for-each
|
||||
(lambda (sol)
|
||||
(let ((vect (make-vector (* n n) #\.)))
|
||||
(for-each
|
||||
(lambda (col)
|
||||
(vector-set!
|
||||
vect
|
||||
(- (+ (* n (- n (list-ref sol (- col 1)))) col) 1)
|
||||
#\*))
|
||||
(list-n n))
|
||||
(for-each
|
||||
(lambda (pos)
|
||||
(display (vector-ref vect (- pos 1)))
|
||||
(display #\space)
|
||||
(if (zero? (remainder pos n)) (newline)))
|
||||
(reverse (list-n (* n n))))
|
||||
(newline)))
|
||||
(queens n))))
|
||||
|
||||
(printunique 5)
|
||||
|
||||
(define values
|
||||
(lambda (n)
|
||||
(map length
|
||||
(map (lambda (k)
|
||||
(display k) (newline) (queens k))
|
||||
(reverse (list-n n))))))
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
(define reduce
|
||||
(lambda (op base l)
|
||||
(if (null? l) base
|
||||
(op (car l) (reduce op base (cdr l))))))
|
||||
(reduce + 0 '(2 3 4))
|
||||
(reduce * 1 '(2 3 4))
|
||||
(reduce cons '() '(2 3 4))
|
||||
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
(define rootfinder
|
||||
(let ((epsilon 1e-8))
|
||||
(lambda (p a b)
|
||||
(let ((mid (/ (+ a b) 2.0)))
|
||||
(if (< (- b a) epsilon) mid
|
||||
(let
|
||||
((s1 (if (> (p a) 0) 'pos 'neg))
|
||||
(s2 (if (> (p mid) 0) 'pos 'neg)))
|
||||
(if (eq? s1 s2)
|
||||
(rootfinder p mid b)
|
||||
(rootfinder p a mid))))))))
|
||||
|
||||
(define sqrteq
|
||||
(lambda (a)
|
||||
(lambda (x)
|
||||
(- (* x x) a))))
|
||||
|
||||
(define r5 (rootfinder (sqrteq 5) 0 5))
|
||||
r5
|
||||
(* r5 r5)
|
||||
|
||||
(define cbrteq
|
||||
(lambda (a)
|
||||
(lambda (x)
|
||||
(- (* x x x) a))))
|
||||
|
||||
(define cr7 (rootfinder (cbrteq 7) 0 7))
|
||||
cr7
|
||||
(* cr7 cr7 cr7)
|
||||
|
||||
(define pi (rootfinder (lambda (x) (cos (/ x 2))) 3 4))
|
||||
pi
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
(define a
|
||||
(lambda (x)
|
||||
(lambda (y)
|
||||
(+ x y))))
|
||||
|
||||
|
||||
(define a5 (a 5))
|
||||
(define a7 (a 7))
|
||||
|
||||
|
||||
(a5 4)
|
||||
(a7 2)
|
||||
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
(define tailrec
|
||||
(lambda (n)
|
||||
(display n) (newline)
|
||||
(if (= n 0) '()
|
||||
(tailrec (- n 1)))))
|
||||
(tailrec 5)
|
||||
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
/* main.m: Main Body of GNUstep GScheme demo application
|
||||
|
||||
Copyright (C) 2000 Free Software Foundation, Inc.
|
||||
|
||||
Author: Fred Kiefer <fredkiefer@gmx.de>
|
||||
Date: 2000.
|
||||
|
||||
Adapted by: Marko Riedel <mriedel@neuearbeit.de>.
|
||||
Date: 2002.
|
||||
|
||||
This file is part of GNUstep.
|
||||
|
||||
This program 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.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
*/
|
||||
#import <locale.h>
|
||||
#import <stdio.h>
|
||||
#import <stdlib.h>
|
||||
|
||||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
#import <AppKit/NSDocumentController.h>
|
||||
|
||||
#import "Document.h"
|
||||
#import "VScheme.h"
|
||||
#import "SCMTextView.h"
|
||||
#import "SchemeDelegate.h"
|
||||
|
||||
|
||||
BOOL yyschemeerrflag;
|
||||
yyerror(char *s) /* Called by yyparse on error */
|
||||
{
|
||||
yyschemeerrflag = YES;
|
||||
}
|
||||
|
||||
int
|
||||
main(int argc, const char **argv, char** env)
|
||||
{
|
||||
NSAutoreleasePool *pool = [NSAutoreleasePool new];
|
||||
NSApplication *theApp;
|
||||
|
||||
GSDebugAllocationActive(YES);
|
||||
|
||||
theApp = [NSApplication sharedApplication];
|
||||
[theApp setDelegate:[SchemeDelegate new]];
|
||||
|
||||
setlocale(LC_NUMERIC, "C");
|
||||
printf("locale %s\n", setlocale(LC_NUMERIC, NULL));
|
||||
|
||||
NSApplicationMain(argc, argv);
|
||||
[pool release];
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,210 @@
|
|||
%{
|
||||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
#import "SchemeTypes.h"
|
||||
|
||||
#define YYSTYPE id
|
||||
|
||||
#include "scheme.tab.m.h"
|
||||
|
||||
int yyinputline;
|
||||
char *yyinputstr, *yyinputstart;
|
||||
int yysofar;
|
||||
|
||||
#define YY_INPUT(buf,result,max_size) \
|
||||
{ \
|
||||
int c = *yyinputstr++; \
|
||||
result = (!c) ? YY_NULL : (buf[0] = c, 1); \
|
||||
}
|
||||
%}
|
||||
|
||||
SIGN "+"|"-"
|
||||
DIGIT [0-9]
|
||||
FRAC "."{DIGIT}+
|
||||
EXPONENT {SIGN}?[eE]{SIGN}?{DIGIT}+
|
||||
LETTER [a-zA-Z]
|
||||
SYMEXTRA [-+*/><=!?]
|
||||
SYMSPECIAL ">="|"<="
|
||||
|
||||
STRING "\""([^\n\"\\]|"\\\\"|"\\\"")*"\""
|
||||
|
||||
%%
|
||||
|
||||
";".[^\n]*$ { /* skip comments */
|
||||
yyinputline++;
|
||||
yysofar += yyleng;
|
||||
}
|
||||
|
||||
"'" {
|
||||
yysofar += yyleng; return QUOTECHAR;
|
||||
}
|
||||
|
||||
"=>" {
|
||||
yysofar += yyleng; return ARROW;
|
||||
}
|
||||
|
||||
"quote" {
|
||||
yysofar += yyleng; return QUOTE;
|
||||
}
|
||||
|
||||
"call-with-current-continuation" {
|
||||
yysofar += yyleng; return CALLCC;
|
||||
}
|
||||
|
||||
"apply" {
|
||||
yysofar += yyleng; return APPLY;
|
||||
}
|
||||
|
||||
"define" {
|
||||
yysofar += yyleng; return DEFINE;
|
||||
}
|
||||
|
||||
"set!" {
|
||||
yysofar += yyleng; return SET;
|
||||
}
|
||||
|
||||
"lambda" {
|
||||
yysofar += yyleng; return LAMBDA;
|
||||
}
|
||||
|
||||
"if" {
|
||||
yysofar += yyleng; return IF;
|
||||
}
|
||||
|
||||
"begin" {
|
||||
yysofar += yyleng; return BEGINTOK;
|
||||
}
|
||||
|
||||
"and" {
|
||||
yysofar += yyleng; return AND;
|
||||
}
|
||||
|
||||
"or" {
|
||||
yysofar += yyleng; return OR;
|
||||
}
|
||||
|
||||
"case" {
|
||||
yysofar += yyleng; return CASE;
|
||||
}
|
||||
|
||||
"cond" {
|
||||
yysofar += yyleng; return COND;
|
||||
}
|
||||
|
||||
"else" {
|
||||
yysofar += yyleng; return ELSE;
|
||||
}
|
||||
|
||||
"let" {
|
||||
yysofar += yyleng; return LET;
|
||||
}
|
||||
|
||||
"let*" {
|
||||
yysofar += yyleng; return LETSTAR;
|
||||
}
|
||||
|
||||
"letrec" {
|
||||
yysofar += yyleng; return LETREC;
|
||||
}
|
||||
|
||||
"#"[tf] {
|
||||
BOOL val = (yytext[1]=='t' ? YES : NO);
|
||||
yylval = [[Boolean alloc] initSCMBoolean:val];
|
||||
yysofar += yyleng; return BOOLEAN;
|
||||
}
|
||||
|
||||
"#\\"("newline"|"space"|"tab"|[^\n\t ]) {
|
||||
char val;
|
||||
if(!strcmp(yytext, "#\\newline")){
|
||||
val = '\n';
|
||||
}
|
||||
else if(!strcmp(yytext, "#\\tab")){
|
||||
val = '\t';
|
||||
}
|
||||
else if(!strcmp(yytext, "#\\space")){
|
||||
val = ' ';
|
||||
}
|
||||
else{
|
||||
val = yytext[2];
|
||||
}
|
||||
|
||||
yylval = [[Char alloc] initSCMChar:val];
|
||||
yysofar += yyleng; return CHAR;
|
||||
}
|
||||
|
||||
{SIGN}?{DIGIT}*{FRAC} {
|
||||
double val;
|
||||
sscanf(yytext, "%le", &val);
|
||||
yylval = [[Double alloc] initSCMDouble:val];
|
||||
yysofar += yyleng; return DOUBLE;
|
||||
}
|
||||
|
||||
{SIGN}?{DIGIT}+"." {
|
||||
double val;
|
||||
sscanf(yytext, "%le", &val);
|
||||
yylval = [[Double alloc] initSCMDouble:val];
|
||||
yysofar += yyleng; return DOUBLE;
|
||||
}
|
||||
|
||||
{SIGN}?{DIGIT}+{EXPONENT} {
|
||||
double val;
|
||||
sscanf(yytext, "%le", &val);
|
||||
yylval = [[Double alloc] initSCMDouble:val];
|
||||
yysofar += yyleng; return DOUBLE;
|
||||
}
|
||||
|
||||
{SIGN}?{DIGIT}*{FRAC}{EXPONENT} {
|
||||
double val;
|
||||
sscanf(yytext, "%le", &val);
|
||||
yylval = [[Double alloc] initSCMDouble:val];
|
||||
yysofar += yyleng; return DOUBLE;
|
||||
}
|
||||
|
||||
{SIGN}?{DIGIT}+ {
|
||||
long int val;
|
||||
sscanf(yytext, "%ld", &val);
|
||||
yylval = [[Int alloc] initSCMInt:val];
|
||||
yysofar += yyleng; return INTEGER;
|
||||
}
|
||||
|
||||
{SYMSPECIAL}|{SYMEXTRA} {
|
||||
yylval = [[Symbol alloc] initSCMSymbol:yytext];
|
||||
yysofar += yyleng; return SYMBOL;
|
||||
}
|
||||
|
||||
|
||||
{LETTER}({LETTER}|{DIGIT}|{SYMEXTRA}|"?"|"*")* {
|
||||
yylval = [[Symbol alloc] initSCMSymbol:yytext];
|
||||
yysofar += yyleng; return SYMBOL;
|
||||
}
|
||||
|
||||
{STRING} {
|
||||
yylval = [[String alloc] initSCMString:yytext];
|
||||
yysofar += yyleng; return STRING;
|
||||
}
|
||||
|
||||
"#(" {
|
||||
yysofar += yyleng; return LVECTPAREN;
|
||||
}
|
||||
|
||||
"(" {
|
||||
yysofar += yyleng; return LPAREN;
|
||||
}
|
||||
|
||||
")" {
|
||||
yysofar += yyleng; return RPAREN;
|
||||
}
|
||||
|
||||
"." {
|
||||
yysofar += yyleng; return DOT;
|
||||
}
|
||||
|
||||
[ \t]+ yysofar += yyleng; /* eat up whitespace */
|
||||
|
||||
"\n" yysofar += yyleng; yyinputline++;
|
||||
|
||||
. printf( "Unrecognized character: %s\n", yytext); yysofar += yyleng;
|
||||
|
||||
%%
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,34 @@
|
|||
#ifndef YYSTYPE
|
||||
#define YYSTYPE int
|
||||
#endif
|
||||
#define LPAREN 257
|
||||
#define LVECTPAREN 258
|
||||
#define RPAREN 259
|
||||
#define DEFINE 260
|
||||
#define SET 261
|
||||
#define LAMBDA 262
|
||||
#define BEGINTOK 263
|
||||
#define AND 264
|
||||
#define OR 265
|
||||
#define CASE 266
|
||||
#define COND 267
|
||||
#define ELSE 268
|
||||
#define ARROW 269
|
||||
#define CALLCC 270
|
||||
#define APPLY 271
|
||||
#define IF 272
|
||||
#define LET 273
|
||||
#define LETSTAR 274
|
||||
#define LETREC 275
|
||||
#define DOT 276
|
||||
#define INTEGER 277
|
||||
#define CHAR 278
|
||||
#define BOOLEAN 279
|
||||
#define DOUBLE 280
|
||||
#define SYMBOL 281
|
||||
#define STRING 282
|
||||
#define QUOTECHAR 283
|
||||
#define QUOTE 284
|
||||
|
||||
|
||||
extern YYSTYPE yylval;
|
||||
|
|
@ -0,0 +1,369 @@
|
|||
%{
|
||||
#import "SchemeTypes.h"
|
||||
|
||||
#define YYSTYPE id
|
||||
|
||||
YYSTYPE yyresult;
|
||||
int yyinputitem;
|
||||
|
||||
extern int yysofar;
|
||||
extern NSMutableArray *positions;
|
||||
%}
|
||||
|
||||
%token LPAREN
|
||||
%token LVECTPAREN
|
||||
%token RPAREN
|
||||
|
||||
%token DEFINE
|
||||
%token SET
|
||||
%token LAMBDA
|
||||
|
||||
%token BEGINTOK
|
||||
|
||||
%token AND
|
||||
%token OR
|
||||
|
||||
%token CASE
|
||||
%token COND
|
||||
%token ELSE
|
||||
%token ARROW
|
||||
|
||||
%token CALLCC
|
||||
|
||||
%token APPLY
|
||||
|
||||
%token IF
|
||||
|
||||
%token LET
|
||||
%token LETSTAR
|
||||
%token LETREC
|
||||
|
||||
%token DOT
|
||||
|
||||
%token INTEGER
|
||||
%token CHAR
|
||||
%token BOOLEAN
|
||||
%token DOUBLE
|
||||
%token SYMBOL
|
||||
%token STRING
|
||||
|
||||
%token QUOTECHAR
|
||||
%token QUOTE
|
||||
|
||||
%%
|
||||
|
||||
top: /* empty */ {
|
||||
yyresult =
|
||||
$$ = [NSNull null];
|
||||
}
|
||||
| topitem top {
|
||||
yyresult =
|
||||
$$ = [Triple newTag:FORM_TOP Arg1:$1 Arg2:$2];
|
||||
yyinputitem++;
|
||||
}
|
||||
;
|
||||
|
||||
topitem: LPAREN DEFINE SYMBOL form RPAREN {
|
||||
NSValue *entry =
|
||||
[NSValue valueWithRange:NSMakeRange(yysofar, 0)];
|
||||
|
||||
$$ = [Triple newTag:FORM_DEFINE1 Arg1:$3 Arg2:$4];
|
||||
|
||||
[positions addObject:entry];
|
||||
}
|
||||
| LPAREN DEFINE nonemptysymlist sequence RPAREN {
|
||||
NSValue *entry =
|
||||
[NSValue valueWithRange:NSMakeRange(yysofar, 0)];
|
||||
|
||||
$$ = [Triple newTag:FORM_DEFINE2 Arg1:$3 Arg2:$4];
|
||||
|
||||
[positions addObject:entry];
|
||||
}
|
||||
| form {
|
||||
NSValue *entry =
|
||||
[NSValue valueWithRange:NSMakeRange(yysofar, 0)];
|
||||
|
||||
$$ = $1;
|
||||
|
||||
[positions addObject:entry];
|
||||
}
|
||||
;
|
||||
|
||||
sequence: form {
|
||||
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
|
||||
}
|
||||
| form sequence {
|
||||
$$ = [Pair newCar:$1 Cdr:$2];
|
||||
}
|
||||
;
|
||||
|
||||
revsequence: form {
|
||||
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
|
||||
}
|
||||
| revsequence form {
|
||||
$$ = [Pair newCar:$2 Cdr:$1];
|
||||
}
|
||||
;
|
||||
|
||||
form: INTEGER {
|
||||
$$ = $1;
|
||||
}
|
||||
| CHAR {
|
||||
$$ = $1;
|
||||
}
|
||||
| BOOLEAN {
|
||||
$$ = $1;
|
||||
}
|
||||
| DOUBLE {
|
||||
$$ = $1;
|
||||
}
|
||||
| SYMBOL {
|
||||
$$ = $1;
|
||||
}
|
||||
| STRING {
|
||||
$$ = $1;
|
||||
}
|
||||
| list {
|
||||
$$ = $1;
|
||||
}
|
||||
| vector {
|
||||
$$ = $1;
|
||||
}
|
||||
| lambda {
|
||||
$$ = $1;
|
||||
}
|
||||
| if {
|
||||
$$ = $1;
|
||||
}
|
||||
| let {
|
||||
$$ = $1;
|
||||
}
|
||||
| letstar {
|
||||
$$ = $1;
|
||||
}
|
||||
| letrec {
|
||||
$$ = $1;
|
||||
}
|
||||
| quote {
|
||||
$$ = $1;
|
||||
}
|
||||
| apply {
|
||||
$$ = $1;
|
||||
}
|
||||
| set {
|
||||
$$ = $1;
|
||||
}
|
||||
| begin {
|
||||
$$ = $1;
|
||||
}
|
||||
| and {
|
||||
$$ = $1;
|
||||
}
|
||||
| or {
|
||||
$$ = $1;
|
||||
}
|
||||
| case {
|
||||
$$ = $1;
|
||||
}
|
||||
| cond {
|
||||
$$ = $1;
|
||||
}
|
||||
| callcc {
|
||||
$$ = $1;
|
||||
}
|
||||
|
||||
callcc: LPAREN CALLCC form RPAREN {
|
||||
$$ = [Triple newTag:FORM_CALLCC Arg1:$3];
|
||||
}
|
||||
|
||||
singlecase: LPAREN LPAREN sequence RPAREN sequence RPAREN {
|
||||
$$ = [Pair newCar:$3 Cdr:$5];
|
||||
}
|
||||
|
||||
singlecond: LPAREN form RPAREN {
|
||||
$$ = [Triple newTag:FORM_SCOND1 Arg1:$2];
|
||||
}
|
||||
| LPAREN form sequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_SCOND2 Arg1:$2 Arg2:$3];
|
||||
}
|
||||
| LPAREN form ARROW form RPAREN {
|
||||
$$ = [Triple newTag:FORM_SCOND3 Arg1:$2 Arg2:$4];
|
||||
}
|
||||
|
||||
elsecasecond: LPAREN ELSE sequence RPAREN {
|
||||
$$ = [Pair newCar:[NSNull null] Cdr:$3];
|
||||
}
|
||||
|
||||
cases: singlecase {
|
||||
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
|
||||
}
|
||||
| cases singlecase {
|
||||
$$ = [Pair newCar:$2 Cdr:$1];
|
||||
}
|
||||
;
|
||||
|
||||
conditions: singlecond {
|
||||
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
|
||||
}
|
||||
| conditions singlecond {
|
||||
$$ = [Pair newCar:$2 Cdr:$1];
|
||||
}
|
||||
;
|
||||
|
||||
case: LPAREN CASE form cases RPAREN {
|
||||
$$ = [Triple newTag:FORM_CASE Arg1:$3 Arg2:$4];
|
||||
}
|
||||
| LPAREN CASE form cases elsecasecond RPAREN {
|
||||
$$ = [Triple newTag:FORM_CASE Arg1:$3
|
||||
Arg2:[Pair newCar:$5 Cdr:$4]];
|
||||
}
|
||||
|
||||
cond: LPAREN COND conditions RPAREN {
|
||||
$$ = [Triple newTag:FORM_COND Arg1:$3];
|
||||
}
|
||||
| LPAREN COND conditions elsecasecond RPAREN {
|
||||
$$ = [Triple newTag:FORM_COND Arg1:[Pair newCar:$4 Cdr:$3]];
|
||||
}
|
||||
|
||||
and: LPAREN AND revsequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_AND Arg1:$3];
|
||||
}
|
||||
| LPAREN AND RPAREN {
|
||||
$$ = [Triple newTag:FORM_AND Arg1:[NSNull null]];
|
||||
}
|
||||
|
||||
or: LPAREN OR revsequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_OR Arg1:$3];
|
||||
}
|
||||
| LPAREN OR RPAREN {
|
||||
$$ = [Triple newTag:FORM_OR Arg1:[NSNull null]];
|
||||
}
|
||||
|
||||
begin: LPAREN BEGINTOK sequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_BEGIN Arg1:$3];
|
||||
}
|
||||
|
||||
set: LPAREN SET SYMBOL form RPAREN {
|
||||
$$ = [Triple newTag:FORM_SET Arg1:$3 Arg2:$4];
|
||||
}
|
||||
|
||||
apply: LPAREN APPLY form form RPAREN {
|
||||
$$ = [Triple newTag:FORM_APPLY Arg1:$3 Arg2:$4];
|
||||
}
|
||||
|
||||
if: LPAREN IF form form RPAREN {
|
||||
$$ = [Triple newTag:FORM_IF1 Arg1:$3 Arg2:$4];
|
||||
}
|
||||
| LPAREN IF form form form RPAREN {
|
||||
$$ = [Triple newTag:FORM_IF2 Arg1:$3 Arg2:$4 Arg3:$5];
|
||||
}
|
||||
|
||||
lambda: LPAREN LAMBDA SYMBOL sequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_LAMBDA1 Arg1:$3 Arg2:$4];
|
||||
}
|
||||
| LPAREN LAMBDA symlist sequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_LAMBDA2 Arg1:$3 Arg2:$4];
|
||||
}
|
||||
|
||||
quote: QUOTECHAR form {
|
||||
$$ = [Triple newTag:FORM_QUOTE Arg1:$2];
|
||||
}
|
||||
| LPAREN QUOTE form RPAREN {
|
||||
$$ = [Triple newTag:FORM_QUOTE Arg1:$3];
|
||||
}
|
||||
|
||||
|
||||
singlebinding: LPAREN SYMBOL form RPAREN {
|
||||
$$ = [Triple newTag:FORM_BINDING Arg1:$2 Arg2:$3];
|
||||
}
|
||||
|
||||
listofbindings: singlebinding {
|
||||
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
|
||||
}
|
||||
| singlebinding listofbindings {
|
||||
$$ = [Pair newCar:$1 Cdr:$2];
|
||||
}
|
||||
|
||||
let: LPAREN LET LPAREN listofbindings RPAREN sequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_LET Arg1:$4 Arg2:$6];
|
||||
}
|
||||
|
||||
letstar: LPAREN LETSTAR LPAREN listofbindings RPAREN sequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_LETSTAR Arg1:$4 Arg2:$6];
|
||||
}
|
||||
|
||||
letrec: LPAREN LETREC LPAREN listofbindings RPAREN sequence RPAREN {
|
||||
$$ = [Triple newTag:FORM_LETREC Arg1:$4 Arg2:$6];
|
||||
}
|
||||
|
||||
emptylist: LPAREN RPAREN {
|
||||
$$ = [NSNull null];
|
||||
}
|
||||
;
|
||||
|
||||
nonemptylistdata: form {
|
||||
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
|
||||
}
|
||||
| form DOT form {
|
||||
$$ = [Pair newCar:$1 Cdr:$3];
|
||||
}
|
||||
| form nonemptylistdata {
|
||||
$$ = [Pair newCar:$1 Cdr:$2];
|
||||
}
|
||||
;
|
||||
|
||||
nonemptyvectdata: form {
|
||||
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
|
||||
}
|
||||
| form nonemptyvectdata {
|
||||
$$ = [Pair newCar:$1 Cdr:$2];
|
||||
}
|
||||
;
|
||||
|
||||
nonemptylist: LPAREN nonemptylistdata RPAREN {
|
||||
$$ = $2;
|
||||
}
|
||||
;
|
||||
|
||||
list: nonemptylist {
|
||||
$$ = $1;
|
||||
}
|
||||
| emptylist {
|
||||
$$ = $1;
|
||||
}
|
||||
;
|
||||
|
||||
vector: LVECTPAREN nonemptyvectdata RPAREN {
|
||||
$$ = [Vector newFromList:$2];
|
||||
}
|
||||
| LVECTPAREN RPAREN {
|
||||
$$ = [Vector newFromList:(Pair *)[NSNull null]];
|
||||
}
|
||||
;
|
||||
|
||||
nonemptysymlistdata: SYMBOL {
|
||||
$$ = [Pair newCar:$1 Cdr:[NSNull null]];
|
||||
}
|
||||
| SYMBOL DOT SYMBOL {
|
||||
$$ = [Pair newCar:$1 Cdr:$3];
|
||||
}
|
||||
| SYMBOL nonemptysymlistdata {
|
||||
$$ = [Pair newCar:$1 Cdr:$2];
|
||||
}
|
||||
;
|
||||
|
||||
nonemptysymlist: LPAREN nonemptysymlistdata RPAREN {
|
||||
$$ = $2;
|
||||
}
|
||||
;
|
||||
|
||||
symlist: nonemptysymlist {
|
||||
$$ = $1;
|
||||
}
|
||||
| emptylist {
|
||||
$$ = $1;
|
||||
}
|
||||
;
|
||||
|
||||
%%
|
||||
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
|
||||
(define l1 (list-n 500))
|
||||
|
||||
(define access-list
|
||||
(lambda (l n)
|
||||
(if (zero? n) l
|
||||
(access-list (cdr l) (- n 1)))))
|
||||
;; (set-cdr! (access-list l1 250) '())
|
||||
|
||||
(define l2 (list-n 500))
|
||||
|
||||
;; (list-n 100)
|
||||
|
||||
(list-n 1000)
|
||||
|
||||
;; (list-n 200)
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
|
||||
(define l1 (list-n 500))
|
||||
|
||||
(define access-list
|
||||
(lambda (l n)
|
||||
(if (zero? n) l
|
||||
(access-list (cdr l) (- n 1)))))
|
||||
(set-cdr! (access-list l1 250) '())
|
||||
|
||||
(define l2 (list-n 500))
|
||||
|
||||
;; (list-n 100)
|
||||
|
||||
(list-n 1000)
|
||||
|
||||
;; (list-n 200)
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
void *state;
|
||||
Class cl;
|
||||
|
||||
while((cl = objc_next_class(&state))){
|
||||
NSLog(@"%@\n", NSStringFromClass(cl));
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
NSMutableSet *strset = [NSMutableSet setWithCapacity:1];
|
||||
NSString
|
||||
*str1 = [NSString stringWithCString:"abcd"],
|
||||
*str2 = [NSString stringWithCString:"abcd"];
|
||||
|
||||
[strset addObject:str1];
|
||||
|
||||
NSLog(@"%@ %@ %@\n", str1, str2,
|
||||
[strset member:@"abcd"]);
|
||||
}
|
||||
|
|
@ -0,0 +1 @@
|
|||
flex scheme.flex
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
gcc classes.m \
|
||||
-DGNUSTEP -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 \
|
||||
-DGNU_RUNTIME=1 -DGNUSTEP_BASE_LIBRARY=1 -fPIC -g -DGSWARN \
|
||||
-DGSDIAGNOSE -O2 -fgnu-runtime -I. -fgnu-runtime \
|
||||
-I/usr/GNUstep/System/Headers \
|
||||
-I/home/gnustep/GNUstep/Headers/gnustep \
|
||||
-I/usr/GNUstep/Local/Headers/gnustep \
|
||||
-I/usr/GNUstep/Network/Headers/gnustep \
|
||||
-I/usr/GNUstep/System/Headers/gnustep \
|
||||
-I/home/gnustep/GNUstep/Headers/ix86/linux-gnu \
|
||||
-I/home/gnustep/GNUstep/Headers \
|
||||
-I/usr/GNUstep/Local/Headers/ix86/linux-gnu \
|
||||
-I/usr/GNUstep/Local/Headers \
|
||||
-I/usr/GNUstep/Network/Headers/ix86/linux-gnu \
|
||||
-I/usr/GNUstep/Network/Headers \
|
||||
-I/usr/GNUstep/System/Headers/ix86/linux-gnu \
|
||||
-I/usr/GNUstep/System/Headers \
|
||||
-L/home/gnustep/GNUstep/Libraries/ix86/linux-gnu/gnu-gnu-gnu \
|
||||
-L/home/gnustep/GNUstep/Libraries/ix86/linux-gnu \
|
||||
-L/usr/GNUstep/Local/Libraries/ix86/linux-gnu/gnu-gnu-gnu \
|
||||
-L/usr/GNUstep/Local/Libraries/ix86/linux-gnu \
|
||||
-L/usr/GNUstep/Network/Libraries/ix86/linux-gnu/gnu-gnu-gnu \
|
||||
-L/usr/GNUstep/Network/Libraries/ix86/linux-gnu \
|
||||
-L/usr/GNUstep/System/Libraries/ix86/linux-gnu/gnu-gnu-gnu \
|
||||
-L/usr/GNUstep/System/Libraries/ix86/linux-gnu -lgnustep-gui \
|
||||
-lgnustep-base -lobjc -lpthread -lz -lgmp -ldl -lm -lfl
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
gcc testscheme.m SchemeTypes.m scheme.tab.m scheme.lex.m \
|
||||
-DGNUSTEP -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 \
|
||||
-DGNU_RUNTIME=1 -DGNUSTEP_BASE_LIBRARY=1 -fPIC -g -DGSWARN \
|
||||
-DGSDIAGNOSE -O2 -fgnu-runtime -I. -fgnu-runtime \
|
||||
-I/usr/GNUstep/System/Headers \
|
||||
-I/home/gnustep/GNUstep/Headers/gnustep \
|
||||
-I/usr/GNUstep/Local/Headers/gnustep \
|
||||
-I/usr/GNUstep/Network/Headers/gnustep \
|
||||
-I/usr/GNUstep/System/Headers/gnustep \
|
||||
-I/home/gnustep/GNUstep/Headers/ix86/linux-gnu \
|
||||
-I/home/gnustep/GNUstep/Headers \
|
||||
-I/usr/GNUstep/Local/Headers/ix86/linux-gnu \
|
||||
-I/usr/GNUstep/Local/Headers \
|
||||
-I/usr/GNUstep/Network/Headers/ix86/linux-gnu \
|
||||
-I/usr/GNUstep/Network/Headers \
|
||||
-I/usr/GNUstep/System/Headers/ix86/linux-gnu \
|
||||
-I/usr/GNUstep/System/Headers \
|
||||
-L/home/gnustep/GNUstep/Libraries/ix86/linux-gnu/gnu-gnu-gnu \
|
||||
-L/home/gnustep/GNUstep/Libraries/ix86/linux-gnu \
|
||||
-L/usr/GNUstep/Local/Libraries/ix86/linux-gnu/gnu-gnu-gnu \
|
||||
-L/usr/GNUstep/Local/Libraries/ix86/linux-gnu \
|
||||
-L/usr/GNUstep/Network/Libraries/ix86/linux-gnu/gnu-gnu-gnu \
|
||||
-L/usr/GNUstep/Network/Libraries/ix86/linux-gnu \
|
||||
-L/usr/GNUstep/System/Libraries/ix86/linux-gnu/gnu-gnu-gnu \
|
||||
-L/usr/GNUstep/System/Libraries/ix86/linux-gnu -lgnustep-gui \
|
||||
-lgnustep-base -lobjc -lpthread -lz -lgmp -ldl -lm -lfl
|
||||
Binary file not shown.
|
|
@ -0,0 +1,13 @@
|
|||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
char buf[128];
|
||||
|
||||
while(gets(buf)!=NULL){
|
||||
double val;
|
||||
sscanf(buf, "%le", &val);
|
||||
printf("got %le\n", val);
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
NSMutableSet *strset = [NSMutableSet setWithCapacity:1];
|
||||
NSString
|
||||
*str1 = [NSString stringWithCString:"abcd"],
|
||||
*str2 = [NSString stringWithCString:"abcd"];
|
||||
|
||||
[strset addObject:str1];
|
||||
|
||||
NSLog(@"%@ %@ %@\n", str1, str2,
|
||||
[strset member:@"abcd"]);
|
||||
}
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
#import <AppKit/AppKit.h>
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
NSMutableSet *strset = [NSMutableSet setWithCapacity:1];
|
||||
NSString
|
||||
*str1 = [NSString stringWithCString:"abcd"],
|
||||
*str2 = [NSString stringWithCString:"abcd"];
|
||||
|
||||
[strset addObject:str1];
|
||||
|
||||
NSLog(@"%@ %@ %@\n", str1, str2,
|
||||
[strset member:str2]);
|
||||
}
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
|
||||
/*
|
||||
test scheme parser
|
||||
by marko riedel, mriedel@neuearbeit.de
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "schemenode.h"
|
||||
|
||||
extern scmnodeptr yylval;
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
yyparse();
|
||||
print(yylval);
|
||||
}
|
||||
|
|
@ -0,0 +1,186 @@
|
|||
|
||||
/*
|
||||
test scheme parser
|
||||
by marko riedel, mriedel@neuearbeit.de
|
||||
*/
|
||||
|
||||
#include <locale.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#import "SchemeTypes.h"
|
||||
#import "VScheme.h"
|
||||
|
||||
id yyresult;
|
||||
|
||||
|
||||
static char *forms[] = {
|
||||
"top",
|
||||
"define1", "define2", "set",
|
||||
"lambda1", "lambda2",
|
||||
"quote", "binding",
|
||||
"let", "let*", "letrec",
|
||||
"if1", "if2",
|
||||
"and", "or",
|
||||
"begin", "apply",
|
||||
"case", "scond1", "scond2", "scond3", "cond",
|
||||
"callcc"
|
||||
};
|
||||
|
||||
void print_tree(id item, int indent)
|
||||
{
|
||||
int pos;
|
||||
|
||||
for(pos=0; pos<indent; pos++){
|
||||
putchar(' ');
|
||||
}
|
||||
|
||||
|
||||
if(item==[NSNull null]){
|
||||
puts("'()");
|
||||
}
|
||||
else if([item isKindOfClass:[Boolean class]]){
|
||||
printf("BOOL: %s\n", (![item boolVal] ? "NO" : "YES"));
|
||||
}
|
||||
else if([item isKindOfClass:[Char class]]){
|
||||
char c = [item charVal];
|
||||
if(c=='\n'){
|
||||
printf("CHAR: <\\newline>\n");
|
||||
}
|
||||
else if(c=='\t'){
|
||||
printf("CHAR: <\\tab>\n");
|
||||
}
|
||||
else if(c==' '){
|
||||
printf("CHAR: <\\space>\n");
|
||||
}
|
||||
else{
|
||||
printf("CHAR: <%c>\n", c);
|
||||
}
|
||||
}
|
||||
else if([item isKindOfClass:[Int class]]){
|
||||
printf("INT: %ld\n", [item intVal]);
|
||||
}
|
||||
else if([item isKindOfClass:[Double class]]){
|
||||
printf("DOUBLE: %le\n", [item doubleVal]);
|
||||
}
|
||||
else if([item isKindOfClass:[Symbol class]]){
|
||||
printf("SYMBOL: <%s>\n", [[item symVal] cString]);
|
||||
}
|
||||
else if([item isKindOfClass:[String class]]){
|
||||
printf("STRING: <%s>\n", [[item strVal] cString]);
|
||||
}
|
||||
else if([item isKindOfClass:[Closure class]]){
|
||||
printf("CLOSURE %s\n",
|
||||
[[VScheme valToString:[item args]] cString]);
|
||||
}
|
||||
else if([item isKindOfClass:[Primitive class]]){
|
||||
printf("PRIMITIVE\n");
|
||||
}
|
||||
else if([item isKindOfClass:[Thunk class]]){
|
||||
printf("THUNK %d %d %d\n", [item argp], [item envp], [item codep]);
|
||||
}
|
||||
else if([item isKindOfClass:[Pair class]]){
|
||||
printf("PAIR %s\n", [[VScheme valToString:item] cString]);
|
||||
}
|
||||
else if([item isKindOfClass:[NSMutableArray class]]){
|
||||
printf("CODES: %u\n", [item count]);
|
||||
}
|
||||
else{
|
||||
printf("FORM %s\n", forms[[item tag]]);
|
||||
if([item arg1]!=nil){
|
||||
print_tree([item arg1], indent+1);
|
||||
}
|
||||
if([item arg2]!=nil){
|
||||
print_tree([item arg2], indent+1);
|
||||
}
|
||||
if([item arg3]!=nil){
|
||||
print_tree([item arg3], indent+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void print_scheme_item(id item)
|
||||
{
|
||||
print_tree(item, 0);
|
||||
}
|
||||
|
||||
|
||||
|
||||
yyerror(char *s) /* Called by yyparse on error */
|
||||
{
|
||||
printf ("%s\n", s);
|
||||
}
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
NSAutoreleasePool *pool = [NSAutoreleasePool new];
|
||||
NSApplication *theApp;
|
||||
VScheme *vm;
|
||||
id forms, item;
|
||||
|
||||
GSDebugAllocationActive(YES);
|
||||
|
||||
vm = [[VScheme alloc] init];
|
||||
|
||||
theApp = [NSApplication sharedApplication];
|
||||
// [theApp run];
|
||||
|
||||
setlocale(LC_NUMERIC, "C");
|
||||
printf("locale %s\n", setlocale(LC_NUMERIC, NULL));
|
||||
|
||||
yyparse();
|
||||
// print_scheme_item(yyresult);
|
||||
[vm setSource:yyresult];
|
||||
|
||||
forms = yyresult;
|
||||
while(forms!=[NSNull null]){
|
||||
NSMutableArray *codes = [NSMutableArray arrayWithCapacity:1];
|
||||
BOOL err = [vm compile:[forms arg1] output:codes];
|
||||
print_scheme_item([forms arg1]);
|
||||
if(err==NO){
|
||||
[VScheme printCodes:codes];
|
||||
[vm clearOutput];
|
||||
if([vm run:codes]==YES){
|
||||
id stack = [vm argStack], envs = [vm envStack],
|
||||
code = [vm codeStack];
|
||||
int count = 0;
|
||||
while(count<[stack count]){
|
||||
printf("stack %d: ", count);
|
||||
print_scheme_item([stack objectAtIndex:count++]);
|
||||
}
|
||||
|
||||
printf("code: %d (%d) pc: %d args: %d (%d) envs: %d (%d):",
|
||||
[code count], [vm maxcode],
|
||||
[vm maxpc],
|
||||
[stack count], [vm maxarg],
|
||||
[envs count], [vm maxenv]);
|
||||
|
||||
count=0;
|
||||
while(count<[envs count]){
|
||||
id env = [envs objectAtIndex:count++];
|
||||
printf("(%d)", [env chainLength]);
|
||||
}
|
||||
putchar('\n');
|
||||
|
||||
printf("OUTPUT\n%s\n", [[vm output] cString]);
|
||||
|
||||
[vm resetStacks];
|
||||
}
|
||||
else{
|
||||
printf("run time error: %s\n", [[vm errmsg] cString]);
|
||||
}
|
||||
}
|
||||
else{
|
||||
printf("compilation failed: %s\n", [[vm errmsg] cString]);
|
||||
}
|
||||
|
||||
|
||||
[codes removeAllObjects];
|
||||
|
||||
forms = [forms arg2];
|
||||
}
|
||||
|
||||
// [pool release];
|
||||
|
||||
return 0;
|
||||
}
|
||||
Loading…
Reference in New Issue