[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/smalltalk-mode 89b685f: Add sample code for testing pur
From: |
Stefan Monnier |
Subject: |
[elpa] externals/smalltalk-mode 89b685f: Add sample code for testing purposes |
Date: |
Sun, 14 Apr 2019 18:01:42 -0400 (EDT) |
branch: externals/smalltalk-mode
commit 89b685f157c79df493aacd2e4cb283daf1177fc5
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
Add sample code for testing purposes
---
indent-bang-test.st | 279 ++++++++++++++++++++++++++++++++++++++++++++++++++++
indent-test.st | 144 +++++++++++++++++++++++++++
2 files changed, 423 insertions(+)
diff --git a/indent-bang-test.st b/indent-bang-test.st
new file mode 100644
index 0000000..3c8191b
--- /dev/null
+++ b/indent-bang-test.st
@@ -0,0 +1,279 @@
+"======================================================================
+|
+| Lisp interpreter written in Smalltalk
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Written by Aoki Atsushi and Nishihara Satoshi.
+| Modified by Paolo Bonzini (removed GUI and compiler for subset of Smalltalk).
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk 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, or (at your option) any later version.
+|
+| GNU Smalltalk 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
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+SequenceableCollection subclass: #LispList
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Examples-Lisp'!
+
+LispList subclass: #LispCons
+ instanceVariableNames: 'head tail '
+ classVariableNames: 'VerticalLevel HorizontalLevel '
+ poolDictionaries: ''
+ category: 'Examples-Lisp'!
+
+LispList subclass: #LispNil
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Examples-Lisp'!
+
+
+!LispList class methodsFor: 'copyright'!
+
+copyright
+ ^'Copyright (C) 1995-1998 AOKI Atsushi, All Rights Reserved.'!
+
+system
+ ^'Goodies'!
+
+version
+ ^'003'! !
+
+!LispList class methodsFor: 'instance creation'!
+
+cell
+ ^self subclassResponsibility!
+
+head: headObject
+ ^self subclassResponsibility!
+
+head: headObject tail: tailObject
+ ^self subclassResponsibility!
+
+list: anArray
+ "LispCons list: #(1 2 3 4)"
+
+ | size list |
+ size := anArray size.
+ list := self null.
+ size
+ to: 1
+ by: -1
+ do: [:i | list := self head: (anArray at: i)
+ tail: list].
+ ^list!
+
+new: anInteger
+ "LispCons new: 5"
+
+ | newList |
+ newList := self null.
+ anInteger timesRepeat: [newList := self head: self null tail: newList].
+ ^newList!
+
+null
+ ^self subclassResponsibility!
+
+with: anObject
+ "LispCons with: 1"
+
+ ^self head: anObject!
+
+with: firstObject with: secondObject
+ "LispCons with: 1 with: 2"
+
+ ^self head: firstObject tail: (self with: secondObject)!
+
+with: firstObject with: secondObject with: thirdObject
+ "LispCons with: 1 with: 2 with: 3"
+
+ ^self head: firstObject tail: (self with: secondObject with: thirdObject)!
+
+with: firstObject with: secondObject with: thirdObject with: fourthObject
+ "LispCons with: 1 with: 2 with: 3 with: 4"
+
+ ^self head: firstObject tail: (self
+ with: secondObject
+ with: thirdObject
+ with: fourthObject)! !
+
+!LispList methodsFor: 'accessing'!
+
+at: indexInteger put: anObject
+ ^self subscriptOutOfBoundsError: indexInteger!
+
+size
+ | tally |
+ tally := 0.
+ self do: [:each | tally := tally + 1].
+ ^tally! !
+
+!LispList methodsFor: 'private'!
+
+subscriptOutOfBoundsError: index
+ ^self error: 'subscript out of bounds: ' , index printString! !
+
+!LispList methodsFor: 'testing'!
+
+isCons
+ ^self null not!
+
+null
+ ^false! !
+
+
+
+!LispCons class methodsFor: 'class initialization'!
+
+initialize
+ "LispCons initialize."
+
+ HorizontalLevel := VerticalLevel := nil! !
+
+!LispCons class methodsFor: 'copyright'!
+
+copyright
+ ^'Copyright (C) 1995-1998 AOKI Atsushi, All Rights Reserved.'!
+
+system
+ ^'Goodies'!
+
+version
+ ^'003'! !
+
+!LispCons class methodsFor: 'examples'!
+
+example1
+ "LispCons example1."
+
+ | list |
+ list := LispCons list: #(1 2 3 4 5 6 7 8 9 10 ).
+ Transcript nl; show: list printString.
+ ^list!
+
+example2
+ "LispCons example2."
+
+ | null list |
+ null := LispCons null.
+ list := LispCons list: #(1 2 ).
+ list := LispCons head: list tail: null.
+ list := LispCons head: list tail: null.
+ Transcript nl; show: list printString.
+ ^list!
+
+example3
+ "LispCons example3."
+
+ | x y z |
+ x := LispCons list: #(1 2 3 ).
+ y := LispCons list: #(4 5 6 ).
+ z := LispCons list: #(1 2 3 4 5 6 ).
+ Transcript nl; show: '(setq x ''(1 2 3)) => ' , x printString.
+ Transcript nl; show: '(setq y ''(4 5 6)) => ' , y printString.
+ Transcript nl; show: '(setq z ''(1 2 3 4 5 6)) => ' , z printString.
+ Transcript nl; show: '(append x y) => ' , (x append: y) printString.
+ Transcript nl; show: '(length z) => ' , z length printString.
+ Transcript nl; show: '(member 3 z) => ' , (z member: 3) printString.
+ Transcript nl; show: '(nth 4 z) => ' , (z nth: 4) printString.
+ ^z!
+
+example4
+ "LispCons example4."
+
+ | list |
+ list := LispCons list: #(1 2 ).
+ list := LispCons head: list tail: (LispCons list: #(3 4 )).
+ list := LispCons head: list tail: (LispCons list: #(5 6 )).
+ Transcript nl; show: list saveString.
+ ^list!
+
+example5
+ "LispCons example5."
+
+ | list |
+ list := LispCons loadFrom: '
+ (PetriNet Aoki
+ (Place p1 p2 p3 p4 p5)
+ (Transition t1 t2 t3 t4 t5)
+ (InputFunction
+ (t1 p1 p2 p3 p4 p5)
+ (t2 . p4)
+ (t3 . p5))
+ (OutputFunction
+ (t1 p1 p2 p3 p4 p5)
+ (t2 . p4)
+ (t3 . p5))
+ (Marking {#(1 2 3 4 5)})))'.
+ Transcript nl; show: list saveString.
+ ^list!
+
+example6
+ "LispCons example6."
+
+ | list |
+ list := LispCons loadFrom: '(aaa bbb ccc)'.
+ Transcript nl; show: list saveString.
+ ^list!
+
+example7
+ "LispCons example7."
+
+ | list |
+ list := LispCons loadFrom: ' `(`(1 2 `3) . `4 ) '.
+ Transcript nl; show: list saveString.
+ ^list! !
+
+!LispCons class methodsFor: 'instance creation'!
+
+cell
+ ^super new head: self null tail: self null!
+
+head: headObject
+ ^super new head: headObject tail: self null!
+
+head: headObject tail: tailObject
+ ^super new head: headObject tail: tailObject!
+
+list: anArray
+ | size list |
+ size := anArray size.
+ list := self null.
+ size
+ to: 1
+ by: -1
+ do: [:i | list := self head: (anArray at: i)
+ tail: list].
+ ^list!
+
+loadFrom: aStream
+ "by nishis, 1998/04/19 07:51"
+
+ | list |
+ list := LispParser parse: aStream.
+ ^list!
+
+new
+ ^self cell!
+
+null
+ ^LispNil null! !
diff --git a/indent-test.st b/indent-test.st
new file mode 100644
index 0000000..d5ecf1a
--- /dev/null
+++ b/indent-test.st
@@ -0,0 +1,144 @@
+"======================================================================
+|
+| Smalltalk package installer
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007-2019 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk 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, or (at your option) any later version.
+|
+| GNU Smalltalk 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
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+[PackageLoader fileInPackage: 'NetClients'] on: Error do: [:ex | ex return].
+
+
+DynamicVariable subclass: CurrentCommand [
+]
+
+
+Package extend [
+ srcdir [
+ ^self baseDirectories last
+ ]
+
+ isStarPackageBody [
+ ^self baseDirectories first isKindOf: VFS.ArchiveFile
+ ]
+
+ starFileName [
+ | dir |
+ self isStarPackageBody ifFalse: [ self halt ].
+ ^self baseDirectories first asString
+ ]
+
+ runCommand: aCommand [
+ self isStarPackageBody
+ ifTrue: [ aCommand runOnStar: self ]
+ ifFalse: [ aCommand runOnPackage: self ]
+ ]
+]
+
+Kernel.PackageContainer subclass: StarPackageFile [
+ | name |
+
+ StarPackageFile class >> on: aFile [
+ ^self new file: aFile; yourself
+ ]
+
+ StarPackageFile class >> on: aFile name: aString [
+ ^self new file: aFile; name: aString; yourself
+ ]
+
+ baseDirectoriesFor: aPackage [
+ ^self file zip
+ ]
+
+ name [
+ ^name
+ ]
+
+ name: aString [
+ name := aString
+ ]
+
+ refresh: loadDate [
+ | package |
+ package := Kernel.StarPackage file: self file.
+ name isNil ifFalse: [ package name: self name ].
+ self packages at: package name put: package loadedPackage
+ ]
+]
+
+Kernel.PackageContainer subclass: RemotePackageFile [
+ RemotePackageFile class >> on: aFile [
+ ^self new file: aFile; yourself
+ ]
+
+ testPackageValidity: package [ ]
+
+ refresh: loadDate [
+ | file |
+ self file withReadStreamDo: [ :fileStream |
+ self parse: fileStream ]
+ ]
+]
+
+Kernel.PackageContainer subclass: PackageFile [
+ | srcdir |
+
+ PackageFile class >> on: aFile [
+ ^self new file: aFile; yourself
+ ]
+
+ srcdir [
+ ^srcdir
+ ]
+
+ srcdir: aString [
+ srcdir := aString
+ ]
+
+ baseDirectoriesFor: aPackage [
+ | srcdirFile builddirPrefix |
+ self srcdir isNil ifTrue: [ ^{ file path } ].
+
+ "See if the file is in srcdir or builddir. In any case, we want to
+ look for files first in the builddir, and secondarily in srcdir."
+ srcdirFile := self file pathFrom: self srcdir.
+ builddirPrefix := Directory working pathFrom: self srcdir.
+ ^(srcdirFile startsWith: builddirPrefix, Directory pathSeparatorString)
+ ifFalse: [ {
+ "file is in srcdir."
+ (File name: srcdirFile) parent.
+ self file parent } ]
+ ifTrue: [ {
+ "file is in builddir."
+ self file parent.
+ (self srcdir / (self file pathFrom: Directory working)) parent
} ]
+ ]
+
+ refresh: loadDate [
+ | file |
+ self file withReadStreamDo: [ :fileStream |
+ self parse: fileStream ]
+ ]
+]
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/smalltalk-mode 89b685f: Add sample code for testing purposes,
Stefan Monnier <=