Hi,

I've been spending some quality time with jolt2, and here are some
basic patches I needed to get things working.

$ cd function/jolt2
$ make # builds jolt2
$ make test # runs sanaras.k
$ make test-old # runs function/examples with jolt2
$ cd ../examples2/bunnu
$ make test

test-old just helps show where jolt2 is missing a few features.  So
far only select, slotnames (of course), x-drawing, and x-event work
correctly.

I only found two little problems with ColaParser:

* Hexadecimal and binary literals weren't being parsed correctly (the
'0' in '0x' would always get sucked up by the decimal parser, and '0b'
wasn't yet implemented).

* Character literals ($c, $\n, etc) weren't implemented.

The rest of this patch is a baby step towards fixing
function/examples.  I'll update it as I get more working (if I have to
break any of the tests' compatibility with jolt-burg, I will first
copy them into examples2).

Have fun,

-- 
Michael FIG <[EMAIL PROTECTED]> //\
   http://michael.fig.org/    \//

Get jolt2 and examples2 to work.

diff -r 5ce56e3ea99b function/examples/cairo/Makefile
--- a/function/examples/cairo/Makefile	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/examples/cairo/Makefile	Mon Apr 14 23:18:32 2008 -0600
@@ -6,7 +6,7 @@ run test : cairolib.so .FORCE
 	$(JOLT) boot.k main.k
 
 cairolib.so : cairolib.st
-	$(IDC) $(CAIROINC) -I../../objects -s $<
+	$(IDC) -g -k $(CAIROINC) -I../../objects -s $<
 
 clean : .FORCE
 	rm -f *~ *.so *.o
diff -r 5ce56e3ea99b function/examples/cairo/libcairo.k
--- a/function/examples/cairo/libcairo.k	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/examples/cairo/libcairo.k	Mon Apr 14 23:18:32 2008 -0600
@@ -1,5 +1,4 @@
 (dlopen "libcairo")
-(define cairolib (dlopen "cairolib"))
-((_dlsym cairolib "__id__init__"))
+[Object _import: "cairolib"]
 
 (define libcairo	(import "libcairo"))
diff -r 5ce56e3ea99b function/examples/regexp/Makefile
--- a/function/examples/regexp/Makefile	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/examples/regexp/Makefile	Mon Apr 14 23:18:32 2008 -0600
@@ -12,55 +12,55 @@ test1 : .FORCE
 test1 : .FORCE
 	time egrep   'break|continue|for|while|switch|case|return|static|extern' < tests/test.c | tee out.e | wc -l
 	time $(GREP) 'break|continue|for|while|switch|case|return|static|extern' < tests/test.c | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 test2 : .FORCE
 	time egrep   'd?e?l?t?a?' < tests/termcap | tee out.e | wc -l
 	time $(GREP) 'd?e?l?t?a?' < tests/termcap | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 test3 : .FORCE
 	time egrep   'd?e+l*t?a+' < tests/termcap | tee out.e | wc -l
 	time $(GREP) 'd?e+l*t?a+' < tests/termcap | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 test4 : .FORCE
 	time egrep   'd?e+l*t?a+' < tests/termcap | tee out.e | wc -l
 	time $(GREP) 'd?e+l*t?a+' < tests/termcap | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 test5 : .FORCE
 	time egrep   'p[aeiou]t'  < tests/termcap | tee out.e | wc -l
 	time $(GREP) 'p[aeiou]t'  < tests/termcap | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 test6 : .FORCE
 	time egrep   'p[^aeiou]t' < tests/termcap | tee out.e | wc -l
 	time $(GREP) 'p[^aeiou]t' < tests/termcap | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 test7 : .FORCE
 	time egrep   '19[0-9]+'   < tests/termcap | tee out.e | wc -l
 	time $(GREP) '19[0-9]+'   < tests/termcap | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 test8 : .FORCE
 	time egrep   '19[^0-9]+'  < tests/termcap | tee out.e | wc -l
 	time $(GREP) '19[^0-9]+'  < tests/termcap | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 test9 : .FORCE
 	time egrep   '..a.....b'  < tests/termcap | tee out.e | wc -l
 	time $(GREP) '..a.....b'  < tests/termcap | tee out.p | wc -l
-	diff out.e out.p
+	cmp out.e out.p && echo "Success!"
 	rm out.e out.p
 
 
diff -r 5ce56e3ea99b function/jolt2/ColaGrammar.st
--- a/function/jolt2/ColaGrammar.st	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/jolt2/ColaGrammar.st	Mon Apr 14 23:18:32 2008 -0600
@@ -84,13 +84,15 @@ ColaParsingGrammar	:= [ Grammar new ]
 	at: #_		put: ( _ := ( (#space parse | #comment parse) zeroMore ) ).
     g	at: #digit	put: '0-9'			parseClass;
 	at: #hex	put: 'A-Fa-f'			parseClass;
+	at: #bit	put: '01'			parseClass;
 	at: #alpha	put: 'a-zA-Z_'			parseClass;
 	at: #other	put: '-+!#$%&*./:<=>[EMAIL PROTECTED]|~'	parseClass.
     g	at: #identifier	put: ( ( #alpha parse | #other parse ) , ( #alpha parse | #digit parse | #other parse ) zeroMore ) textResult <- [:p | p result asSymbol].
-    g	at: #decimal	put: ( #digit parse oneMore textResult							<- [:p | p result inject: 0 into: [:n :c | n * 10 + c digitValue]] );	
-	at: #heximal	put: ( ( '0x' parse , ( #digit parse | #hex parse ) oneMore ) textResult		<- [:p | p result inject: 0 into: [:n :c | n * 16 + c digitValue]] );
+    g	at: #decimal	put: ( #digit parse oneMore textResult							<- [:p | p result inject: 0 into: [:n :c | n * 10 + c digitValue]] );
+	at: #heximal	put: ( '0x' parse , ( ( #digit parse | #hex parse ) oneMore ) textResult		<- [:p | p result inject: 0 into: [:n :c | n * 16 + c digitValue]] );
+	at: #binimal	put: ( '0b' parse , ( ( #bit parse ) oneMore ) textResult				<- [:p | p result inject: 0 into: [:n :c | n * 2 + c digitValue]] );
 	at: #posfloat	put: ( #decimal parse -> 0 , '.' parse , ( #digit parse oneMore textResult ) -> 1	<- [:p | ([EMAIL PROTECTED] reverseInject: 0.0 into: [:n :c | n / 10.0 + c digitValue]) / 10.0 + ([EMAIL PROTECTED])] );
-	at: #posnumber	put: ( #decimal parse | #heximal parse | #posfloat parse );
+	at: #posnumber	put: ( #heximal parse | #binimal parse | #posfloat parse | #decimal parse );
 	at: #number	put: ( ( '-' parse          , #posnumber parse						<- [:p | p result negated] )
 			     | ( '+' parse zeroMore , #posnumber parse ) ).
     g	at: #plainChar	put: ( PeAny textResult <- [:p | p last] );
@@ -99,7 +101,8 @@ ColaParsingGrammar	:= [ Grammar new ]
 			     | ( '\\' parse <- [$\\] ) );
 	at: #escapeSeq	put: ( '\\' parse , ( #escapeChar parse | #plainChar parse ) );
 	at: #char	put: ( #escapeSeq parse | #plainChar parse ).
-    g	at: #string	put: ( '"' parse , ( ( '"' parse not , #char parse ) zeroMore ->0 ) , '"' parse <- [:p | ([EMAIL PROTECTED]) asString] ).
+    g	at: #string	put: ( '"' parse , ( ( '"' parse not , #char parse ) zeroMore ->0 ) , '"' parse <- [:p | ([EMAIL PROTECTED]) asString] );
+	at: #litchar	put: ( '$' parse , #char parse ).
     g	at: #list	put: ( '(' parse , ( ( _ , #expr parse ) zeroMore ->0 ) , _ , ')' parse <- [:p | ([EMAIL PROTECTED]) asExpression] ).
     g	at: #quotation	put: ( ( '''' parse , _ , #expr parse	<- [:p | Expression with: #quote with: p result] )
 			     | ( '`'  parse , _ , #expr parse	<- [:p | Expression with: #quasiquote with: p result] )
@@ -124,7 +127,7 @@ ColaParsingGrammar	:= [ Grammar new ]
     "grammar syntax"
     g	at: #grammar	put: ( '{' parse , _ , ( ColaParsingGrammar-#grammar ) , '}' parse ).
     "cola syntax"
-    g	at: #atom	put: ( #number parse | #identifier parse | #string parse | #grammar parse );
+    g	at: #atom	put: ( #number parse | #litchar parse | #identifier parse | #string parse | #grammar parse );
 	at: #expr	put: ( #atom parse | #list parse | #quotation parse | #send parse );
 	at: #expression	put: _ , ( #expr parse | #eof parse | #error parse ).
 ]
diff -r 5ce56e3ea99b function/jolt2/Compiler.st
--- a/function/jolt2/Compiler.st	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/jolt2/Compiler.st	Mon Apr 14 23:18:32 2008 -0600
@@ -919,7 +919,7 @@ Compiler xEvaluate: form
 
 Compiler errorUndefined: aSymbol	[ self error: 'undefined: ', aSymbol ]
 Compiler errorSyntax: form		[ self error: 'syntax error: ', form printString ]
-Compiler errorArgumentCount: form	[ self error: 'wrong number of aguments: ', form printString ]
+Compiler errorArgumentCount: form	[ self error: 'wrong number of arguments: ', form printString ]
 Compiler errorLoop: form		[ self error: 'no loop: ', form printString ]
 
 "----------------------------------------------------------------"
diff -r 5ce56e3ea99b function/jolt2/Makefile
--- a/function/jolt2/Makefile	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/jolt2/Makefile	Mon Apr 14 23:18:32 2008 -0600
@@ -28,7 +28,10 @@ all : main$(OBJEXT)
 all : main$(OBJEXT)
 
 test : main$(OBJEXT) .FORCE
-	./main$(OBJEXT) boot.k sanaras.k
+	./main$(OBJEXT) -L../jolt-burg boot.k sanaras.k
+
+test-old: main$(OBJEXT) .FORCE
+	cd ../examples && $(MAKE) test JOLT="../../jolt2/main$(OBJEXT) -L../../jolt-burg"
 
 .SUFFIXES :
 
diff -r 5ce56e3ea99b function/jolt2/Options.st
--- a/function/jolt2/Options.st	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/jolt2/Options.st	Mon Apr 14 23:18:32 2008 -0600
@@ -20,13 +20,15 @@
 
 { import: Objects }
 
-Options : Object ( verbose compile list libdir )
+Options : Object ( verbose compile list libdir progdir )
 
 Options verbose		[ ^verbose ]
 Options compile		[ ^compile ]
 Options list		[ ^list ]
 Options libdir: aString	[  libdir := aString ]
 Options libdir		[ ^libdir ]
+Options progdir: aDir	[  progdir := aDir ]
+Options progdir		[ ^progdir ]
 
 Options new
 [
diff -r 5ce56e3ea99b function/jolt2/boot.k
--- a/function/jolt2/boot.k	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/jolt2/boot.k	Mon Apr 14 23:18:32 2008 -0600
@@ -191,16 +191,22 @@
 		    | error )
       } match: node]))
 
-;; methods
-
-(define add-method	; type selector implementation
-  (lambda (type selector implementation)
-    [[type _vtable] methodAt: selector put: implementation with: 0]))
-
-(syntax define-send ; selector type args... expr
-  (lambda (form compiler)
-    (let ((selector [form second])
-	  (type     [form third])
-	  (args     [form copyFrom: '3 to: [[form size] - '2]])
-	  (expr     [form last]))
-      `(add-method ,type ,selector (lambda (_closure _self self ,@args) ,expr)))))
+(load "syntax.k")
+(load "debug.k")
+(load "object.k")
+
+(define *package-list* [IdentitySet new])
+
+(define %require
+  (lambda (package)
+    (or [*package-list* includes: [package asSymbol]]
+	(let ()
+	  (load [[[package asString] , '".k"] _stringValue])
+	  [*package-list* add: [package asSymbol]]))))
+
+(syntax require
+  (lambda (node comp)
+    (let ((requires [WriteStream on: [Expression new: '8]]))
+      (for (i '1 2 [[node size] - '1])
+	[requires nextPut: `(%require ,[node at: i])])
+      `(let () ,@[requires contents]))))
diff -r 5ce56e3ea99b function/jolt2/main.st
--- a/function/jolt2/main.st	Mon Apr 14 21:44:31 2008 -0600
+++ b/function/jolt2/main.st	Mon Apr 14 23:18:32 2008 -0600
@@ -91,7 +91,10 @@ ColaEvaluator map: aBlock
 
 ColaEvaluator readFileNamed: fileName
 [
-    self readFile: (fileName = '-' ifTrue: [StdIn] ifFalse: [File open: fileName])
+    self readFile: (fileName = '-' ifTrue: [StdIn]
+    	 	   	     ifFalse: [((File openIfPresent: fileName)
+			     	        ifNil: [File openIfPresent: Options progdir, '/', fileName])
+					ifNil: [File open: Options libdir, '/', fileName]])
 ]
 
 ColaEvaluator readFile: aFile
@@ -110,6 +113,7 @@ ColaEvaluator readFile: aFile
 [
     | done |
     "ColaFunctionGrammar println."
+    Options progdir: (OS argumentAt: 0) dirname.
     Options libdir: '.'.
     OS arguments do: [:arg | (Options parseOption: arg) ifFalse: [ColaEvaluator readFileNamed: (done := arg)]].
     done ifFalse: [ColaEvaluator readFile: StdIn].
_______________________________________________
fonc mailing list
fonc@vpri.org
http://vpri.org/mailman/listinfo/fonc

Reply via email to