added:
authorClaus Gittinger <cg@exept.de>
Sun, 08 Aug 2010 17:16:23 +0200
changeset 2469 67e364844a2b
parent 2468 36c571b96063
child 2470 0b735c9bc90e
added: #readLispFrom: #realLispAtomFrom: #realLispListFrom: changed: #first #head #rest #tail
Cons.st
--- a/Cons.st	Sun Aug 08 15:21:30 2010 +0200
+++ b/Cons.st	Sun Aug 08 17:16:23 2010 +0200
@@ -98,6 +98,73 @@
     "
 ! !
 
+!Cons class methodsFor:'sExpressions'!
+
+readLispFrom:aStream
+    aStream skipSeparators.
+    aStream peek ==$; ifTrue:[
+        "/ comment
+        aStream skipLine.
+        thisContext restart
+    ].
+
+    aStream peek ==$( ifTrue:[
+        ^ self realLispListFrom:aStream
+    ].
+    ^ self realLispAtomFrom:aStream
+
+    "
+     self readLispFrom:('(cons 1 2)' readStream).
+    "
+
+    "Created: / 08-08-2010 / 17:07:49 / cg"
+!
+
+realLispAtomFrom:aStream
+    |atom|
+
+    aStream skipSeparators.
+    aStream peek isDigit ifTrue:[
+        ^ Number readFrom:aStream
+    ].
+    atom := aStream upToMatching:[:ch | ch isSeparator or:[ch = $( or:[ch = $)]]].
+    ^ atom asSymbol
+
+    "
+     self readLispFrom:('(cons 1 2)' readStream).
+    "
+
+    "Created: / 08-08-2010 / 17:15:18 / cg"
+!
+
+realLispListFrom:aStream
+    |first this prev element|
+
+    aStream next.   "/ the leading '('
+    [
+        aStream skipSeparators.
+        aStream peek ~= $)
+    ] whileTrue:[
+        element := self readLispFrom:aStream.
+        this := Cons car:element cdr:nil.
+        prev isNil ifTrue:[
+            first := this
+        ] ifFalse:[
+            prev cdr:this.
+        ].
+        prev := this.
+    ].
+
+    aStream next.   "/ the trailing ')'
+    ^ first.
+
+    "
+     self readLispFrom:('(cons 1 2)' readStream).
+    "
+
+    "Modified: / 08-08-2010 / 17:15:54 / cg"
+! !
+
 !Cons methodsFor:'accessing'!
 
 at:n
@@ -135,13 +202,17 @@
 first
     "return the head, first or car - whatever you wonna call it"
 
-    ^ self car
+    ^ car
+
+    "Modified: / 08-08-2010 / 17:04:23 / cg"
 !
 
 head
     "return the head, first or car - whatever you wonna call it"
 
-    ^ self car
+    ^ car
+
+    "Modified: / 08-08-2010 / 17:04:20 / cg"
 !
 
 last
@@ -179,9 +250,11 @@
 !
 
 rest
-    "return the head, first or car - whatever you wonna call it"
+    "return the tail, rest or cdr - whatever you wonna call it"
 
-    ^ self cdr
+    ^ cdr
+
+    "Modified: / 08-08-2010 / 17:04:48 / cg"
 !
 
 reversed
@@ -227,9 +300,11 @@
 !
 
 tail
-    "return the tail, second or cdr - whatever you wonna call it"
+    "return the tail, rest or cdr - whatever you wonna call it"
 
-    ^ self cdr
+    ^ cdr
+
+    "Modified: / 08-08-2010 / 17:04:59 / cg"
 ! !
 
 !Cons methodsFor:'accessing - basic'!
@@ -468,9 +543,9 @@
 !Cons class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/Cons.st,v 1.11 2010-05-18 08:25:55 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/Cons.st,v 1.12 2010-08-08 15:16:23 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic2/Cons.st,v 1.11 2010-05-18 08:25:55 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/Cons.st,v 1.12 2010-08-08 15:16:23 cg Exp $'
 ! !