├── .project ├── .properties ├── MakeALisp-Tests ├── MalAddTest.class.st ├── MalApplyFunctionTest.class.st ├── MalBoolAtomTest.class.st ├── MalBoolTest.class.st ├── MalConjTest.class.st ├── MalCountTest.class.st ├── MalDefTest.class.st ├── MalDerefTest.class.st ├── MalDivideTest.class.st ├── MalEmptyPredicateTest.class.st ├── MalEnvTest.class.st ├── MalEqualTest.class.st ├── MalFirstTest.class.st ├── MalFnPredicateTest.class.st ├── MalFunctionTest.class.st ├── MalHashMapTest.class.st ├── MalIntegerTest.class.st ├── MalKeywordFunctionTest.class.st ├── MalKeywordTest.class.st ├── MalListFunctionTest.class.st ├── MalListPredicateTest.class.st ├── MalListTest.class.st ├── MalMapFunctionTest.class.st ├── MalMetaFunctionTest.class.st ├── MalMultiplyTest.class.st ├── MalNilTest.class.st ├── MalNthTest.class.st ├── MalQuasiquoteTest.class.st ├── MalReadStringTest.class.st ├── MalReaderTest.class.st ├── MalRestTest.class.st ├── MalSeqTest.class.st ├── MalSpecialFormTest.class.st ├── MalStrTest.class.st ├── MalStringTest.class.st ├── MalSubtractTest.class.st ├── MalSwapTest.class.st ├── MalSymbolTest.class.st ├── MalTest.class.st ├── MalTokenizerTest.class.st ├── MalTryTest.class.st ├── MalVectorTest.class.st └── package.st ├── MakeALisp ├── Mal.class.st ├── MalAdd.class.st ├── MalApplyFunction.class.st ├── MalAssoc.class.st ├── MalAtom.class.st ├── MalAtomFunction.class.st ├── MalAtomPredicate.class.st ├── MalBool.class.st ├── MalBoolLiteral.class.st ├── MalCallable.class.st ├── MalClosure.class.st ├── MalConcat.class.st ├── MalConj.class.st ├── MalCons.class.st ├── MalContainsPredicate.class.st ├── MalContext.class.st ├── MalCount.class.st ├── MalDef.class.st ├── MalDefmacro.class.st ├── MalDeref.class.st ├── MalDissoc.class.st ├── MalDivide.class.st ├── MalDo.class.st ├── MalEmptyPredicate.class.st ├── MalEnv.class.st ├── MalEqual.class.st ├── MalError.class.st ├── MalEval.class.st ├── MalFalsePredicate.class.st ├── MalFirst.class.st ├── MalFn.class.st ├── MalFnPredicate.class.st ├── MalFunction.class.st ├── MalFunctionOneArg.class.st ├── MalGet.class.st ├── MalGreaterThan.class.st ├── MalGreaterThanOrEqual.class.st ├── MalHashMap.class.st ├── MalHashMapFunction.class.st ├── MalIf.class.st ├── MalInteger.class.st ├── MalKeys.class.st ├── MalKeyword.class.st ├── MalKeywordFunction.class.st ├── MalKeywordLiteral.class.st ├── MalKeywordPredicate.class.st ├── MalLessThan.class.st ├── MalLessThanOrEqual.class.st ├── MalLet.class.st ├── MalList.class.st ├── MalListFunction.class.st ├── MalListPredicate.class.st ├── MalLiteral.class.st ├── MalMacroPredicate.class.st ├── MalMacroexpand.class.st ├── MalMapFunction.class.st ├── MalMapPredicate.class.st ├── MalMetaFunction.class.st ├── MalMultiply.class.st ├── MalNil.class.st ├── MalNilLiteral.class.st ├── MalNilPredicate.class.st ├── MalNotCallable.class.st ├── MalNth.class.st ├── MalNumberLiteral.class.st ├── MalNumberPredicate.class.st ├── MalPrStr.class.st ├── MalPrintln.class.st ├── MalPrn.class.st ├── MalQuasiquote.class.st ├── MalQuote.class.st ├── MalReadLine.class.st ├── MalReadString.class.st ├── MalReader.class.st ├── MalReadlineFunction.class.st ├── MalReset.class.st ├── MalRest.class.st ├── MalSeq.class.st ├── MalSequentialPredicate.class.st ├── MalSlurp.class.st ├── MalSpecialForm.class.st ├── MalStep.class.st ├── MalStep0.class.st ├── MalStep1.class.st ├── MalStep2.class.st ├── MalStep3.class.st ├── MalStep4.class.st ├── MalStep5.class.st ├── MalStep6.class.st ├── MalStep7.class.st ├── MalStr.class.st ├── MalString.class.st ├── MalStringLiteral.class.st ├── MalStringPredicate.class.st ├── MalSubtract.class.st ├── MalSwap.class.st ├── MalSymbol.class.st ├── MalSymbolFunction.class.st ├── MalSymbolPredicate.class.st ├── MalSyntaxError.class.st ├── MalThrow.class.st ├── MalTimeMs.class.st ├── MalTokenizer.class.st ├── MalTruePredicate.class.st ├── MalTry.class.st ├── MalType.class.st ├── MalUnboundSymbol.class.st ├── MalVals.class.st ├── MalVector.class.st ├── MalVectorFunction.class.st ├── MalVectorPredicate.class.st ├── MalWithMeta.class.st ├── MalWrongArity.class.st └── package.st └── README.md /.project: -------------------------------------------------------------------------------- 1 | { 2 | 'srcDirectory' : '' 3 | } -------------------------------------------------------------------------------- /.properties: -------------------------------------------------------------------------------- 1 | { 2 | #format : #tonel 3 | } -------------------------------------------------------------------------------- /MakeALisp-Tests/MalAddTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalAddTest is a test class for testing the behavior of MalAdd 3 | " 4 | Class { 5 | #name : #MalAddTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalAddTest >> testCallWithContext [ 12 | | result | 13 | result := (Mal read: '(+ 0 1 1)') evalIn: MalContext default. 14 | self assert: result equals: (MalInteger withValue: 2) 15 | ] 16 | 17 | { #category : #tests } 18 | MalAddTest >> testCallWithContextTypeError [ 19 | | expr | 20 | expr := Mal read: '(+ 42 true)'. 21 | self should: [ expr evalIn: MalContext default ] raise: MalError 22 | ] 23 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalApplyFunctionTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalApplyFunctionTest is a test class for testing the behavior of MalApplyFunction 3 | " 4 | Class { 5 | #name : #MalApplyFunctionTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalApplyFunctionTest >> testCallWithCtx [ 12 | | ctx expr | 13 | expr := Mal read: '(apply + 1 2 (list 3 4))'. 14 | ctx := MalContext default. 15 | self assert: (expr evalIn: ctx) equals: (MalInteger withValue: 10) 16 | ] 17 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalBoolAtomTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalBoolAtomTest is a test class for testing the behavior of MalBoolAtom 3 | " 4 | Class { 5 | #name : #MalBoolAtomTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalBoolAtomTest >> testMatches [ 12 | self assert: (MalBoolLiteral matches: 'true') equals: true 13 | ] 14 | 15 | { #category : #tests } 16 | MalBoolAtomTest >> testMatchesFalse [ 17 | self assert: (MalBoolLiteral matches: 'false') equals: true 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalBoolTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I test methods on WMalBool objects. 3 | " 4 | Class { 5 | #name : #MalBoolTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalBoolTest >> testEvalIn [ 12 | | val | 13 | val := MalBool withValue: false. 14 | self assert: (val evalIn: nil) equals: val 15 | ] 16 | 17 | { #category : #tests } 18 | MalBoolTest >> testPrint [ 19 | | val| 20 | val := MalBool withValue: false. 21 | self assert: (val asReadableString) equals: 'false'. 22 | ] 23 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalConjTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalConjTest is a test class for testing the behavior of MalConj 3 | " 4 | Class { 5 | #name : #MalConjTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalConjTest >> testCallWithContext [ 12 | | result expected | 13 | result := (Mal read: '(conj [1] 2)') evalIn: MalContext default. 14 | expected := MalVector 15 | withValue: 16 | (OrderedCollection 17 | with: (MalInteger withValue: 1) 18 | with: (MalInteger withValue: 2)). 19 | self assert: result class equals: MalVector. 20 | self assert: result equals: expected 21 | ] 22 | 23 | { #category : #tests } 24 | MalConjTest >> testCallWithContextList [ 25 | | result expected | 26 | result := (Mal read: '(conj (list 1) 2)') evalIn: MalContext default. 27 | expected := MalList 28 | with: (MalInteger withValue: 2) 29 | with: (MalInteger withValue: 1). 30 | self assert: result equals: expected 31 | ] 32 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalCountTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalCountTest is a test class for testing the behavior of MalCount 3 | " 4 | Class { 5 | #name : #MalCountTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalCountTest >> testCallWithContext [ 12 | | args | 13 | args := OrderedCollection 14 | with: (MalList with: MalNil new). 15 | self 16 | assert: (MalCount new call: args withContext: nil) 17 | equals: (MalInteger withValue: 1) 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalDefTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalDefTest is a test class for testing the behavior of MalDef 3 | " 4 | Class { 5 | #name : #MalDefTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalDefTest >> testDefInClosure [ 12 | "Ensure def! still applies to the outer env." 13 | 14 | | result | 15 | result := (Mal read: '(do ((fn* () (def! x 1))) x)') evalIn: MalContext default. 16 | self assert: result equals: (MalInteger withValue: 1) 17 | ] 18 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalDerefTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalDerefTest is a test class for testing the behavior of MalDeref 3 | " 4 | Class { 5 | #name : #MalDerefTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalDerefTest >> testCallWithContext [ 12 | | result expr | 13 | expr := Mal read: '(do (def! e (atom {"+" +})) ((get @e "+") 7 8))'. 14 | result := expr evalIn: MalContext default. 15 | self assert: result equals: (MalInteger withValue: 15) 16 | ] 17 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalDivideTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A WMalDivideTest is a test class for testing the behavior of WMalDivide 3 | " 4 | Class { 5 | #name : #MalDivideTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #'tests-accessing' } 11 | MalDivideTest >> testCallWithContext [ 12 | | args | 13 | args := OrderedCollection 14 | with: (MalInteger withValue: 11) 15 | with: (MalInteger withValue: 5). 16 | self 17 | assert: (MalDivide new call: args withContext: nil) 18 | equals: (MalInteger withValue: 2) 19 | ] 20 | 21 | { #category : #'tests-accessing' } 22 | MalDivideTest >> testCallWithContextNotEnoughArgs [ 23 | | args | 24 | args := OrderedCollection new. 25 | self 26 | should: [ MalDivide new call: args withContext: nil ] 27 | raise: MalWrongArity 28 | ] 29 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalEmptyPredicateTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing the empty? function in MAL. 3 | " 4 | Class { 5 | #name : #MalEmptyPredicateTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalEmptyPredicateTest >> testCallWithContext [ 12 | | args | 13 | args := OrderedCollection 14 | with: (MalList new). 15 | self 16 | assert: (MalEmptyPredicate new call: args withContext: nil) 17 | equals: (MalBool withValue: true) 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalEnvTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A WMalEnvTest is a test class for testing the behavior of WMalEnv. 3 | " 4 | Class { 5 | #name : #MalEnvTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #'tests-setter' } 11 | MalEnvTest >> testAtPut [ 12 | | dict sym | 13 | dict := MalEnv new. 14 | sym := MalSymbol withValue: 'foo'. 15 | dict at: sym put: 123. 16 | self assert: (dict at: sym) equals: 123 17 | ] 18 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalEqualTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalEqualTest is a test class for testing the behavior of MalEqual 3 | " 4 | Class { 5 | #name : #MalEqualTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #test } 11 | MalEqualTest >> testCallWithContext [ 12 | | expr | 13 | expr := Mal read: '(= 1 2)'. 14 | self 15 | assert: (expr evalIn: MalContext default) 16 | equals: (MalBool withValue: false) 17 | ] 18 | 19 | { #category : #test } 20 | MalEqualTest >> testCallWithContextVector [ 21 | | expr | 22 | expr := Mal read: '(= 1 2)'. 23 | self 24 | assert: (expr evalIn: MalContext default) 25 | equals: (MalBool withValue: false) 26 | ] 27 | 28 | { #category : #test } 29 | MalEqualTest >> testCallWithContextVectorAndList [ 30 | | expr | 31 | expr := Mal read: '(= [] (list))'. 32 | self 33 | assert: (expr evalIn: MalContext default) 34 | equals: (MalBool withValue: true) 35 | ] 36 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalFirstTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalFirstTest is a test class for testing the behavior of MalFirst 3 | " 4 | Class { 5 | #name : #MalFirstTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalFirstTest >> testCallWithContext [ 12 | | expr | 13 | expr := Mal read: '(first (list 1))'. 14 | self 15 | assert: (expr evalIn: MalContext default) 16 | equals: (MalInteger withValue: 1) 17 | ] 18 | 19 | { #category : #tests } 20 | MalFirstTest >> testCallWithContextEmptyList [ 21 | | expr | 22 | expr := Mal read: '(first (list))'. 23 | self 24 | assert: (expr evalIn: MalContext default) 25 | equals: (MalNil new) 26 | ] 27 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalFnPredicateTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalFnPredicateTest is a test class for testing the behavior of MalFnPredicate 3 | " 4 | Class { 5 | #name : #MalFnPredicateTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalFnPredicateTest >> testCallWithContext [ 12 | | result expr | 13 | expr := Mal read: '(fn? +)'. 14 | result := expr evalIn: MalContext default. 15 | self assert: result equals: (MalBool withValue: true) 16 | ] 17 | 18 | { #category : #tests } 19 | MalFnPredicateTest >> testCallWithContextMacro [ 20 | | result expr | 21 | expr := Mal read: '(fn? cond)'. 22 | result := expr evalIn: MalContext default. 23 | self assert: result equals: (MalBool withValue: false) 24 | ] 25 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalFunctionTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalFunctionTest is a test class for testing the behavior of MalFunction 3 | " 4 | Class { 5 | #name : #MalFunctionTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalFunctionTest >> testSubclassesHaveUniqueNames [ 12 | | funcs | 13 | funcs := Dictionary new. 14 | MalFunction 15 | allSubclassesDo: [ :func | 16 | | matchingFuncs | 17 | matchingFuncs := funcs 18 | at: func malName 19 | ifAbsent: OrderedCollection new. 20 | matchingFuncs add: func. 21 | funcs at: func malName put: matchingFuncs ]. 22 | funcs 23 | associationsDo: [ :assoc | 24 | self 25 | assert: assoc value size = 1 26 | description: 27 | ('{1} classes with malName {2}' 28 | format: 29 | {assoc value size. 30 | assoc key}) ] 31 | ] 32 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalHashMapTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing how hash maps { foo bar } evaluate in MAL. 3 | " 4 | Class { 5 | #name : #MalHashMapTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalHashMapTest >> testEval [ 12 | | val expected | 13 | val := Mal read: '{:foo (+ 2 3)}'. 14 | expected := Mal read: '{:foo 5}'. 15 | self assert: (val evalIn: MalContext default) equals: expected 16 | ] 17 | 18 | { #category : #tests } 19 | MalHashMapTest >> testPrint [ 20 | | key value hashMap | 21 | key := MalString withValue: 'foo'. 22 | value := MalInteger withValue: 1. 23 | hashMap := MalHashMap withValue: (Dictionary with: key -> value). 24 | self assert: hashMap asReadableString equals: '{"foo" 1}' 25 | ] 26 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalIntegerTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A WMalIntegerTest is a test class for testing the behavior of WMalInteger 3 | " 4 | Class { 5 | #name : #MalIntegerTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalIntegerTest >> testEquality [ 12 | "Ensure = works as expected." 13 | 14 | | int1a int1b int2 | 15 | int1a := MalInteger withValue: 1. 16 | int1b := MalInteger withValue: 1. 17 | int2 := MalInteger withValue: 2. 18 | self assert: int1a = int1b. 19 | self assert: int1a ~= int2 20 | ] 21 | 22 | { #category : #tests } 23 | MalIntegerTest >> testPrint [ 24 | "Ensure we can convert to a printable representation." 25 | 26 | | int | 27 | int := MalInteger withValue: 123. 28 | self assert: int asReadableString equals: '123' 29 | ] 30 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalKeywordFunctionTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalKeywordFunctionTest is a test class for testing the behavior of MalKeywordFunction 3 | " 4 | Class { 5 | #name : #MalKeywordFunctionTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalKeywordFunctionTest >> testCallWithContext [ 12 | | ctx expr | 13 | expr := Mal read: '(keyword "foo")'. 14 | ctx := MalContext default. 15 | self assert: (expr evalIn: ctx) equals: (MalKeyword withValue: ':foo') 16 | ] 17 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalKeywordTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing equality and printing for :keywords. 3 | " 4 | Class { 5 | #name : #MalKeywordTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalKeywordTest >> testEquality [ 12 | "Ensure = works as expected." 13 | 14 | | k1 k2 | 15 | k1 := MalKeyword withValue: ':foo'. 16 | k2 := MalKeyword withValue: ':bar'. 17 | self assert: k1 = k1. 18 | self assert: k1 ~= k2 19 | ] 20 | 21 | { #category : #tests } 22 | MalKeywordTest >> testPrint [ 23 | "Ensure we can convert to a printable representation." 24 | 25 | | symValue | 26 | symValue := MalKeyword withValue: ':foo'. 27 | self assert: symValue asReadableString equals: ':foo' 28 | ] 29 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalListFunctionTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalListFunctionTest is a test class for testing the behavior of MalListFunction 3 | " 4 | Class { 5 | #name : #MalListFunctionTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalListFunctionTest >> testCallWithContext [ 12 | | args | 13 | args := OrderedCollection 14 | with: (MalInteger withValue: 2) 15 | with: (MalInteger withValue: 3). 16 | self 17 | assert: (MalListFunction new call: args withContext: nil) 18 | equals: (MalList withValue: args) 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalListPredicateTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing the list? function. 3 | " 4 | Class { 5 | #name : #MalListPredicateTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalListPredicateTest >> testCallArity [ 12 | | args | 13 | args := OrderedCollection new. 14 | self 15 | should: [ MalListPredicate new call: args withContext: nil ] 16 | raise: MalWrongArity 17 | ] 18 | 19 | { #category : #tests } 20 | MalListPredicateTest >> testCallNotList [ 21 | | args | 22 | args := OrderedCollection 23 | with: (MalInteger withValue: 1). 24 | self 25 | assert: (MalListPredicate new call: args withContext: nil) 26 | equals: (MalBool withValue: false) 27 | ] 28 | 29 | { #category : #tests } 30 | MalListPredicateTest >> testCallWithContext [ 31 | | args | 32 | args := OrderedCollection 33 | with: (MalList new). 34 | self 35 | assert: (MalListPredicate new call: args withContext: nil) 36 | equals: (MalBool withValue: true) 37 | ] 38 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalListTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing methods on MalList. 3 | " 4 | Class { 5 | #name : #MalListTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalListTest >> testEval [ 12 | "Evaluate a list." 13 | 14 | | val env ctx | 15 | val := Mal read: '(+ 1 (+ 2 3))'. 16 | env := Dictionary new 17 | at: '+' put: MalAdd new; 18 | yourself. 19 | ctx := MalContext new 20 | env: env; 21 | yourself. 22 | self assert: (val evalIn: ctx) equals: (MalInteger withValue: 6) 23 | ] 24 | 25 | { #category : #tests } 26 | MalListTest >> testEvalEmpty [ 27 | "Empty list should evaluate to itself." 28 | 29 | | val | 30 | val := Mal read: '()'. 31 | self assert: (val evalIn: nil) equals: val 32 | ] 33 | 34 | { #category : #tests } 35 | MalListTest >> testEvalMacro [ 36 | | expr ctx | 37 | expr := Mal read: '(do (defmacro! foo (fn* () `(if true 1 2))) (foo))'. 38 | ctx := MalContext default. 39 | self assert: (expr evalIn: ctx) equals: (MalInteger withValue: 1) 40 | ] 41 | 42 | { #category : #tests } 43 | MalListTest >> testEvalMacroThatReturnsAtom [ 44 | | expr ctx | 45 | expr := Mal 46 | read: '(do (defmacro! one (fn* () 1)) (one))'. 47 | ctx := MalContext default. 48 | self assert: (expr evalIn: ctx) equals: (MalInteger withValue: 1) 49 | ] 50 | 51 | { #category : #tests } 52 | MalListTest >> testPrint [ 53 | | val | 54 | val := MalList 55 | with: (MalInteger withValue: 1) 56 | with: (MalInteger withValue: 2). 57 | self assert: val asReadableString equals: '(1 2)' 58 | ] 59 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalMapFunctionTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalMapFunctionTest is a test class for testing the behavior of MalMapFunction 3 | " 4 | Class { 5 | #name : #MalMapFunctionTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalMapFunctionTest >> testCallWithContext [ 12 | | ctx expr | 13 | expr := Mal read: '(map (fn* [x] (+ x 1)) [1 2])'. 14 | ctx := MalContext default. 15 | self 16 | assert: (expr evalIn: ctx) 17 | equals: 18 | (MalList 19 | with: (MalInteger withValue: 2) 20 | with: (MalInteger withValue: 3)) 21 | ] 22 | 23 | { #category : #tests } 24 | MalMapFunctionTest >> testCallWithContextQuotedList [ 25 | | ctx expr t f | 26 | expr := Mal read: '(map (fn* (x) (symbol? x)) (list 1 (quote two) "three"))'. 27 | ctx := MalContext default. 28 | t := MalBool withValue: true. 29 | f := MalBool withValue: false. 30 | self 31 | assert: (expr evalIn: ctx) 32 | equals: 33 | (MalList 34 | with: f with: t with: f) 35 | ] 36 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalMetaFunctionTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalMetaFunctionTest is a test class for testing the behavior of MalMetaFunction 3 | " 4 | Class { 5 | #name : #MalMetaFunctionTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalMetaFunctionTest >> testCallWithContext [ 12 | | result | 13 | result := (Mal read: '(meta [1 2 3])') evalIn: MalContext default. 14 | self assert: result equals: (MalNil new) 15 | ] 16 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalMultiplyTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalMultiplyTest is a test class for testing the behavior of MalMultiply 3 | " 4 | Class { 5 | #name : #MalMultiplyTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalMultiplyTest >> testCallWithContext [ 12 | | args | 13 | args := OrderedCollection 14 | with: (MalInteger withValue: 2) 15 | with: (MalInteger withValue: 3). 16 | self 17 | assert: (MalMultiply new call: args withContext: nil) 18 | equals: (MalInteger withValue: 6) 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalNilTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Test evaluation and print for nil. 3 | " 4 | Class { 5 | #name : #MalNilTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalNilTest >> testEvalIn [ 12 | | nilValue | 13 | nilValue := MalNil new. 14 | self assert: (nilValue evalIn: nil) equals: nilValue 15 | ] 16 | 17 | { #category : #tests } 18 | MalNilTest >> testPrint [ 19 | "Ensure we can convert to a printable representation." 20 | 21 | | nilValue | 22 | nilValue := MalNil new. 23 | self assert: nilValue asReadableString equals: 'nil' 24 | ] 25 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalNthTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalNthTest is a test class for testing the behavior of MalNth 3 | " 4 | Class { 5 | #name : #MalNthTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalNthTest >> testCallWithContext [ 12 | | expr | 13 | expr := Mal read: '(nth (list 10 11 12) 1)'. 14 | self 15 | assert: (expr evalIn: MalContext default) 16 | equals: (MalInteger withValue: 11) 17 | ] 18 | 19 | { #category : #tests } 20 | MalNthTest >> testCallWithContextOutOfBounds [ 21 | | expr | 22 | expr := Mal read: '(nth (list 10 11 12) 42)'. 23 | self should: [expr evalIn: MalContext default] raise: MalError 24 | ] 25 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalQuasiquoteTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing evaluation of quasiquotation. 3 | " 4 | Class { 5 | #name : #MalQuasiquoteTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalQuasiquoteTest >> testQuasiquoteAtom [ 12 | | result | 13 | result := (Mal read: '`42') 14 | evalIn: MalContext default. 15 | self assert: result equals: (MalInteger withValue: 42) 16 | ] 17 | 18 | { #category : #tests } 19 | MalQuasiquoteTest >> testQuasiquoteList [ 20 | | result expected | 21 | result := (Mal read: '(quasiquote (1 2 3))') 22 | evalIn: MalContext default. 23 | expected := Mal read: '(1 2 3)'. 24 | self assert: result equals: expected 25 | ] 26 | 27 | { #category : #tests } 28 | MalQuasiquoteTest >> testQuasiquoteUnsplice [ 29 | | result expected | 30 | result := (Mal read: '(do (def! x ''(10 11)) `(1 ~@x 2))') 31 | evalIn: MalContext default. 32 | expected := Mal read: '(1 10 11 2)'. 33 | self assert: result equals: expected 34 | ] 35 | 36 | { #category : #tests } 37 | MalQuasiquoteTest >> testQuasiquoteVector [ 38 | | result expected | 39 | result := (Mal read: '`[1 foo]') 40 | evalIn: MalContext default. 41 | expected := Mal read: '(1 foo)'. 42 | self assert: result equals: expected 43 | ] 44 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalReadStringTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalReadStringTest is a test class for testing the behavior of MalReadString 3 | " 4 | Class { 5 | #name : #MalReadStringTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #test } 11 | MalReadStringTest >> testCallArgWithContext [ 12 | | expr expected | 13 | expr := Mal read: '(read-string "(1 foo)")'. 14 | expected := MalList 15 | with: (MalInteger withValue: 1) 16 | with: (MalSymbol withValue: 'foo'). 17 | self assert: (expr evalIn: MalContext default) equals: expected 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalReaderTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalReaderTest is a test class for testing the behavior of MalReader 3 | " 4 | Class { 5 | #name : #MalReaderTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalReaderTest >> testReadAll [ 12 | | parsed expected | 13 | parsed := MalReader readAll: '1 2'. 14 | expected := OrderedCollection 15 | with: (MalInteger withValue: 1) 16 | with: (MalInteger withValue: 2). 17 | self assert: parsed equals: expected 18 | ] 19 | 20 | { #category : #tests } 21 | MalReaderTest >> testReadAtom [ 22 | | parsed expected stream | 23 | stream := (OrderedCollection with: '123') readStream. 24 | parsed := MalReader readAtom: stream. 25 | expected := MalInteger withValue: 123. 26 | self assert: parsed equals: expected 27 | ] 28 | 29 | { #category : #tests } 30 | MalReaderTest >> testReadAtomFalse [ 31 | | parsed expected stream | 32 | stream := (OrderedCollection with: 'false') readStream. 33 | parsed := MalReader readAtom: stream. 34 | expected := MalBool withValue: false. 35 | self assert: parsed equals: expected 36 | ] 37 | 38 | { #category : #tests } 39 | MalReaderTest >> testReadAtomKeyword [ 40 | | parsed expected stream | 41 | stream := (OrderedCollection with: ':foo') readStream. 42 | parsed := MalReader readAtom: stream. 43 | expected := MalKeyword withValue: ':foo'. 44 | self assert: parsed equals: expected 45 | ] 46 | 47 | { #category : #tests } 48 | MalReaderTest >> testReadAtomNegativeNumber [ 49 | | parsed expected stream | 50 | stream := (OrderedCollection with: '-123') readStream. 51 | parsed := MalReader readAtom: stream. 52 | expected := MalInteger withValue: -123. 53 | self assert: parsed equals: expected 54 | ] 55 | 56 | { #category : #tests } 57 | MalReaderTest >> testReadAtomNil [ 58 | | parsed expected stream | 59 | stream := (OrderedCollection with: 'nil') readStream. 60 | parsed := MalReader readAtom: stream. 61 | expected := MalNil new. 62 | self assert: parsed equals: expected 63 | ] 64 | 65 | { #category : #tests } 66 | MalReaderTest >> testReadAtomString [ 67 | | parsed expected stream | 68 | stream := (OrderedCollection with: '"foo"') readStream. 69 | parsed := MalReader readAtom: stream. 70 | expected := MalString withValue: 'foo'. 71 | self assert: parsed equals: expected 72 | ] 73 | 74 | { #category : #tests } 75 | MalReaderTest >> testReadAtomStringWithEscapes [ 76 | | parsed expected stream | 77 | stream := (OrderedCollection with: '"foo\\bar\"baz\rbiz"') readStream. 78 | parsed := MalReader readAtom: stream. 79 | expected := MalString 80 | withValue: 81 | 'foo\bar"baz 82 | biz'. 83 | self assert: parsed equals: expected 84 | ] 85 | 86 | { #category : #tests } 87 | MalReaderTest >> testReadAtomSymbol [ 88 | | parsed expected stream | 89 | stream := (OrderedCollection with: 'abc-def3') readStream. 90 | parsed := MalReader readAtom: stream. 91 | expected := MalSymbol withValue: 'abc-def3'. 92 | self assert: parsed equals: expected 93 | ] 94 | 95 | { #category : #tests } 96 | MalReaderTest >> testReadAtomTrue [ 97 | | parsed expected stream | 98 | stream := (OrderedCollection with: 'true') readStream. 99 | parsed := MalReader readAtom: stream. 100 | expected := MalBool withValue: true. 101 | self assert: parsed equals: expected 102 | ] 103 | 104 | { #category : #tests } 105 | MalReaderTest >> testReadString [ 106 | | parsed | 107 | parsed := MalReader readString: '123'. 108 | self assert: parsed equals: (MalInteger withValue: 123) 109 | ] 110 | 111 | { #category : #tests } 112 | MalReaderTest >> testReadStringHashMap [ 113 | | parsed expectedItems | 114 | parsed := MalReader readString: '{:foo 1}'. 115 | self assert: parsed class equals: MalHashMap. 116 | expectedItems := Dictionary 117 | with: ((MalKeyword withValue: ':foo') -> (MalInteger withValue: 1)). 118 | self assert: parsed value equals: expectedItems 119 | ] 120 | 121 | { #category : #tests } 122 | MalReaderTest >> testReadStringList [ 123 | | parsed expectedItems | 124 | parsed := MalReader readString: '(1 2)'. 125 | self assert: parsed class equals: MalList. 126 | expectedItems := OrderedCollection with: (MalInteger withValue: 1) with: (MalInteger withValue: 2). 127 | self assert: parsed value equals: expectedItems 128 | ] 129 | 130 | { #category : #tests } 131 | MalReaderTest >> testReadStringUnclosed [ 132 | self should: [ MalReader readString: '(' ] raise: MalSyntaxError 133 | ] 134 | 135 | { #category : #tests } 136 | MalReaderTest >> testReadStringUnopened [ 137 | "todo: We don't consider foo) to be a syntax error because we only read one form." 138 | self should: [MalReader readString: ')'] raise: MalSyntaxError. 139 | ] 140 | 141 | { #category : #tests } 142 | MalReaderTest >> testReadStringVector [ 143 | | parsed expectedItems | 144 | parsed := MalReader readString: '[1 2]'. 145 | self assert: parsed class equals: MalVector. 146 | expectedItems := OrderedCollection 147 | with: (MalInteger withValue: 1) 148 | with: (MalInteger withValue: 2). 149 | self assert: parsed value equals: expectedItems 150 | ] 151 | 152 | { #category : #tests } 153 | MalReaderTest >> testReadStringWithComment [ 154 | | parsed | 155 | parsed := MalReader readString: ';foo 156 | 123'. 157 | self assert: parsed equals: (MalInteger withValue: 123) 158 | ] 159 | 160 | { #category : #tests } 161 | MalReaderTest >> testReadStringWithCommentLineFeed [ 162 | | parsed | 163 | parsed := MalReader readString: '(do ;' , Character lf asString , ')'. 164 | self 165 | assert: parsed 166 | equals: 167 | (MalList 168 | with: (MalSymbol withValue: 'do')) 169 | ] 170 | 171 | { #category : #tests } 172 | MalReaderTest >> testReaderMacroDeref [ 173 | | parsed | 174 | parsed := MalReader readString: '@foo'. 175 | self 176 | assert: parsed 177 | equals: 178 | (MalList 179 | with: (MalSymbol withValue: 'deref') 180 | with: (MalSymbol withValue: 'foo')) 181 | ] 182 | 183 | { #category : #tests } 184 | MalReaderTest >> testReaderMacroQuasiquote [ 185 | | parsed expected | 186 | parsed := MalReader readString: '`~foo'. 187 | expected := MalReader readString: '(quasiquote (unquote foo))'. 188 | self 189 | assert: parsed 190 | equals: 191 | expected 192 | ] 193 | 194 | { #category : #tests } 195 | MalReaderTest >> testReaderMacroWithMeta [ 196 | | parsed expected | 197 | parsed := MalReader readString: '(def! foo ^{} (fn* [a] a))'. 198 | expected := MalReader readString: '(def! foo (with-meta (fn* [a] a) {}))'. 199 | self 200 | assert: parsed 201 | equals: 202 | expected 203 | ] 204 | 205 | { #category : #tests } 206 | MalReaderTest >> testReaderMacroWithMetaInsufficentArgs [ 207 | self should: [ MalReader readString: '^ 123' ] raise: MalError 208 | ] 209 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalRestTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalRestTest is a test class for testing the behavior of MalRest 3 | " 4 | Class { 5 | #name : #MalRestTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalRestTest >> testCallWithContext [ 12 | | expr expected | 13 | expr := Mal read: '(rest (list 1 2))'. 14 | expected := Mal read: '(2)'. 15 | self assert: (expr evalIn: MalContext default) equals: expected 16 | ] 17 | 18 | { #category : #tests } 19 | MalRestTest >> testCallWithContextNil [ 20 | | expr | 21 | expr := Mal read: '(rest nil)'. 22 | self assert: (expr evalIn: MalContext default) class equals: MalList 23 | ] 24 | 25 | { #category : #tests } 26 | MalRestTest >> testCallWithContextVector [ 27 | | expr expected result | 28 | expr := Mal read: '(rest [1 2])'. 29 | expected := Mal read: '(2)'. 30 | result := (expr evalIn: MalContext default). 31 | self assert: result equals: expected. 32 | self assert: result class equals: MalList 33 | ] 34 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalSeqTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalSeqTest is a test class for testing the behavior of MalSeq 3 | " 4 | Class { 5 | #name : #MalSeqTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalSeqTest >> testCallWithContext [ 12 | | result | 13 | result := (Mal read: '(seq "ab")') evalIn: MalContext default. 14 | self assert: result equals: (MalList with: (MalString withValue: 'a') with: (MalString withValue: 'b') ) 15 | ] 16 | 17 | { #category : #tests } 18 | MalSeqTest >> testCallWithContextEmpty [ 19 | | result | 20 | result := (Mal read: '(seq "")') evalIn: MalContext default. 21 | self 22 | assert: result 23 | equals: 24 | (MalNil new) 25 | ] 26 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalSpecialFormTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Utility tests to ensure special forms are uniquely named. 3 | " 4 | Class { 5 | #name : #MalSpecialFormTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalSpecialFormTest >> testSubclassesHaveUniqueNames [ 12 | | nameCounts | 13 | nameCounts := Dictionary new. 14 | MalSpecialForm 15 | allSubclassesDo: [ :func | 16 | | count | 17 | count := nameCounts at: func malName ifAbsent: 0. 18 | nameCounts at: func malName put: count + 1 ]. 19 | nameCounts 20 | associationsDo: [ :assoc | 21 | self 22 | assert: assoc value = 1 23 | description: 24 | ('{1} classes with malName {2}' 25 | format: 26 | {assoc value. 27 | assoc key}) ] 28 | ] 29 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalStrTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalStrTest is a test class for testing the behavior of MalStr 3 | " 4 | Class { 5 | #name : #MalStrTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalStrTest >> testCallWithContext [ 12 | | ctx expr | 13 | expr := Mal read: '(str {:foo "bar"})'. 14 | ctx := MalContext default. 15 | self 16 | assert: (expr evalIn: ctx) 17 | equals: 18 | (MalString 19 | withValue: '{:foo bar}') 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalStringTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing string literals. 3 | " 4 | Class { 5 | #name : #MalStringTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalStringTest >> testPrint [ 12 | | string contents | 13 | contents := 'foo"bar\baz' , Character lf asString , 'biz'. 14 | string := MalString 15 | withValue: 16 | contents. 17 | self assert: string asReadableString equals: '"foo\"bar\\baz\nbiz"' 18 | ] 19 | 20 | { #category : #tests } 21 | MalStringTest >> testReadMalformed [ 22 | "Ensure that an unclosed string literal produces a MalError." 23 | 24 | self should: [MalReader readString: '"foo'] raise: MalError 25 | ] 26 | 27 | { #category : #tests } 28 | MalStringTest >> testReadPrintRoundTrip [ 29 | "Ensure that reading and then printing a string gives us the original input." 30 | 31 | | string input | 32 | input := '"foo\"bar\\baz\nbiz boz"'. 33 | string := MalReader readString: input. 34 | self assert: string asReadableString equals: input 35 | ] 36 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalSubtractTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalSubtractTest is a test class for testing the behavior of MalSubtract 3 | " 4 | Class { 5 | #name : #MalSubtractTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalSubtractTest >> testCallWithContext [ 12 | | sexp | 13 | sexp := Mal read: '(- 3 2)'. 14 | self 15 | assert: (sexp evalIn: MalContext default) 16 | equals: (MalInteger withValue: 1) 17 | ] 18 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalSwapTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalSwapTest is a test class for testing the behavior of MalSwap 3 | " 4 | Class { 5 | #name : #MalSwapTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalSwapTest >> testCallWithContext [ 12 | | result expr | 13 | expr := Mal read: '(do (def! n (atom 1)) (swap! n + 2 3) @n)'. 14 | result := expr evalIn: MalContext default. 15 | self assert: result equals: (MalInteger withValue: 6) 16 | ] 17 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalSymbolTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing symbols, both bound and unbound. 3 | " 4 | Class { 5 | #name : #MalSymbolTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalSymbolTest >> testEvalIn [ 12 | "Test that we lookup values in the environment." 13 | 14 | | fooSym env one ctx | 15 | fooSym := MalSymbol withValue: 'foo'. 16 | one := MalInteger withValue: 1. 17 | env := Dictionary new 18 | at: 'foo' put: one; 19 | yourself. 20 | ctx := MalContext new env: env; yourself. 21 | self assert: (fooSym evalIn: ctx) equals: one 22 | ] 23 | 24 | { #category : #tests } 25 | MalSymbolTest >> testEvalInUnbound [ 26 | "Test that we error on unbound symbols." 27 | 28 | | fooSym ctx | 29 | fooSym := MalSymbol withValue: 'foo'. 30 | ctx := MalContext new env: (Dictionary new); yourself. 31 | self should: [ fooSym evalIn: ctx ] raise: MalUnboundSymbol 32 | ] 33 | 34 | { #category : #tests } 35 | MalSymbolTest >> testPrint [ 36 | "Ensure we can convert to a printable representation." 37 | 38 | | symValue | 39 | symValue := MalSymbol withValue: 'foo'. 40 | self assert: symValue asReadableString equals: 'foo' 41 | ] 42 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A WMalTest is a test class for testing the behavior of WMal 3 | " 4 | Class { 5 | #name : #MalTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalTest >> assertReadEval: src equals: expected [ 12 | | expr | 13 | expr := Mal read: src. 14 | self assert: (expr evalIn: MalContext default) equals: expected 15 | ] 16 | 17 | { #category : #tests } 18 | MalTest >> testDef [ 19 | | defExpr ctx | 20 | defExpr := Mal read: '(def! x 42)'. 21 | ctx := MalContext default. 22 | defExpr evalIn: ctx. 23 | self 24 | assert: ((MalSymbol withValue: 'x') evalIn: ctx) 25 | equals: (MalInteger withValue: 42) 26 | ] 27 | 28 | { #category : #tests } 29 | MalTest >> testDo [ 30 | self 31 | assertReadEval: '(do (def! x 1) x)' 32 | equals: (MalInteger withValue: 1) 33 | ] 34 | 35 | { #category : #tests } 36 | MalTest >> testEvalIn [ 37 | | val ctx | 38 | val := Mal read: '(+ (* 2 3) 1)'. 39 | ctx := MalContext default. 40 | self assert: (val evalIn: ctx) equals: (MalInteger withValue: 7) 41 | ] 42 | 43 | { #category : #tests } 44 | MalTest >> testFn [ 45 | | expr | 46 | expr := Mal read: '(fn* (x) 1)'. 47 | self 48 | assert: (expr evalIn: MalContext default) class 49 | equals: MalClosure 50 | ] 51 | 52 | { #category : #tests } 53 | MalTest >> testFnBadParams [ 54 | | expr | 55 | expr := Mal read: '(fn* (x 1 "foo") 1)'. 56 | self should: [ expr evalIn: MalContext default ] raise: MalError 57 | ] 58 | 59 | { #category : #tests } 60 | MalTest >> testFnBadParamsVariadic [ 61 | | expr | 62 | expr := Mal read: '(fn* (x & foo bar) 1)'. 63 | self should: [ expr evalIn: MalContext default ] raise: MalError 64 | ] 65 | 66 | { #category : #tests } 67 | MalTest >> testFnBadParamsVariadicTwice [ 68 | | expr | 69 | expr := Mal read: '(fn* (x & &) 1)'. 70 | self should: [ expr evalIn: MalContext default ] raise: MalError 71 | ] 72 | 73 | { #category : #tests } 74 | MalTest >> testFnCall [ 75 | self 76 | assertReadEval: '((fn* (x) (+ x 1)) 2)' 77 | equals: (MalInteger withValue: 3) 78 | ] 79 | 80 | { #category : #tests } 81 | MalTest >> testFnVariadic [ 82 | | expr result | 83 | expr := Mal read: '(fn* (x y & rest) rest)'. 84 | result := expr evalIn: MalContext default. 85 | self assert: result variadicSym equals: (MalSymbol withValue: 'rest'). 86 | self 87 | assert: result bindings 88 | equals: 89 | (OrderedCollection 90 | with: (MalSymbol withValue: 'x') 91 | with: (MalSymbol withValue: 'y')) 92 | ] 93 | 94 | { #category : #tests } 95 | MalTest >> testFnVariadicCall [ 96 | | expr two three | 97 | expr := Mal read: '((fn* (x & args) args) 1 2 3)'. 98 | two := MalInteger withValue: 2. 99 | three := MalInteger withValue: 3. 100 | self 101 | assert: (expr evalIn: MalContext default) 102 | equals: (MalList with: two with: three) 103 | ] 104 | 105 | { #category : #tests } 106 | MalTest >> testIfFalse [ 107 | | ctx expr | 108 | expr := Mal read: '(if false (no-such-fun) 1)'. 109 | ctx := MalContext default. 110 | self assert: (expr evalIn: ctx) equals: (MalInteger withValue: 1) 111 | ] 112 | 113 | { #category : #tests } 114 | MalTest >> testIfNil [ 115 | self assertReadEval: '(if nil (no-such-fun) 1)' equals: (MalInteger withValue: 1) 116 | ] 117 | 118 | { #category : #tests } 119 | MalTest >> testIfOneArg [ 120 | 121 | self assertReadEval: '(if true 1)' equals: (MalInteger withValue: 1) 122 | ] 123 | 124 | { #category : #tests } 125 | MalTest >> testIfOneArgFalse [ 126 | self assertReadEval: '(if false 1)' equals: MalNil new 127 | ] 128 | 129 | { #category : #tests } 130 | MalTest >> testIfTrue [ 131 | self assertReadEval: '(if true 1 (no-such-fun))' equals: (MalInteger withValue: 1) 132 | ] 133 | 134 | { #category : #tests } 135 | MalTest >> testLet [ 136 | self 137 | assertReadEval: '(let* (x 1) 2 x)' 138 | equals: (MalInteger withValue: 1) 139 | ] 140 | 141 | { #category : #tests } 142 | MalTest >> testLetBindingNotSymbol [ 143 | | letExpr | 144 | letExpr := Mal read: '(let* (1 2) x)'. 145 | self should: [ letExpr evalIn: MalContext default ] raise: MalError 146 | ] 147 | 148 | { #category : #tests } 149 | MalTest >> testLetOddBindings [ 150 | | letExpr | 151 | letExpr := Mal read: '(let* (x 1 2) x)'. 152 | self should: [ letExpr evalIn: MalContext default ] raise: MalError 153 | ] 154 | 155 | { #category : #tests } 156 | MalTest >> testLetWrongArgs [ 157 | | letExpr | 158 | letExpr := Mal read: '(let* 3 x)'. 159 | self should: [ letExpr evalIn: MalContext default ] raise: MalError 160 | ] 161 | 162 | { #category : #tests } 163 | MalTest >> testOrGensym [ 164 | self 165 | assertReadEval: '(let* [or_FIXME 23] (or false (+ or_FIXME 100)))' 166 | equals: (MalInteger withValue: 123) 167 | ] 168 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalTokenizerTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A WMalTokenizerTest is a test class for testing the behavior of WMalTokenizer. 3 | " 4 | Class { 5 | #name : #MalTokenizerTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalTokenizerTest >> testFromString [ 12 | | tokens expected | 13 | tokens := MalTokenizer fromString: ' foo bar'. 14 | expected := OrderedCollection with: 'foo' with: 'bar'. 15 | self assert: tokens equals: expected 16 | ] 17 | 18 | { #category : #tests } 19 | MalTokenizerTest >> testFromStringCommas [ 20 | | tokens expected | 21 | tokens := MalTokenizer fromString: ' ,,foo ,'. 22 | expected := OrderedCollection with: 'foo'. 23 | self assert: tokens equals: expected 24 | ] 25 | 26 | { #category : #tests } 27 | MalTokenizerTest >> testFromStringHashMap [ 28 | | tokens expected | 29 | tokens := MalTokenizer fromString: '{:foo 1}'. 30 | expected := OrderedCollection 31 | with: '{' 32 | with: ':foo' 33 | with: '1' 34 | with: '}'. 35 | self assert: tokens equals: expected 36 | ] 37 | 38 | { #category : #tests } 39 | MalTokenizerTest >> testFromStringNewline [ 40 | | tokens expected | 41 | tokens := MalTokenizer fromString: 'foo 42 | bar'. 43 | expected := OrderedCollection with: 'foo' with: 'bar'. 44 | self assert: tokens equals: expected 45 | ] 46 | 47 | { #category : #tests } 48 | MalTokenizerTest >> testFromStringVector [ 49 | | tokens expected | 50 | tokens := MalTokenizer fromString: '[1]'. 51 | expected := OrderedCollection with: '[' 52 | with: '1' 53 | with: ']'. 54 | self assert: tokens equals: expected 55 | ] 56 | 57 | { #category : #tests } 58 | MalTokenizerTest >> testFromStringWithComment [ 59 | | tokens expected | 60 | tokens := MalTokenizer 61 | fromString: 62 | '; a comment 63 | foo ; another comment 64 | bar 65 | ; more comment'. 66 | expected := OrderedCollection with: 'foo' with: 'bar'. 67 | self assert: tokens equals: expected 68 | ] 69 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalTryTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A MalTryTest is a test class for testing the behavior of MalTry 3 | " 4 | Class { 5 | #name : #MalTryTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalTryTest >> testCallWithContext [ 12 | | result | 13 | result := (Mal read: '(try* (throw 1) (catch* exc (+ exc 1)))') 14 | evalIn: MalContext default. 15 | self assert: result equals: (MalInteger withValue: 2) 16 | ] 17 | 18 | { #category : #tests } 19 | MalTryTest >> testCallWithContextBuiltinError [ 20 | | result | 21 | result := (Mal 22 | read: '(try* (no-such-func) (catch* exc (str "error is: " exc)))') 23 | evalIn: MalContext default. 24 | self assert: result class equals: MalString 25 | ] 26 | 27 | { #category : #tests } 28 | MalTryTest >> testCallWithContextNoCatch [ 29 | | result | 30 | result := (Mal read: '(try* 1)') evalIn: MalContext default. 31 | self assert: result equals: (MalInteger withValue: 1) 32 | ] 33 | -------------------------------------------------------------------------------- /MakeALisp-Tests/MalVectorTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Testing printing and evaluating of vectors. 3 | " 4 | Class { 5 | #name : #MalVectorTest, 6 | #superclass : #TestCase, 7 | #category : #'MakeALisp-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | MalVectorTest >> testEval [ 12 | "Evaluate a vector and ensure elements are evaluated." 13 | 14 | | val expected | 15 | val := Mal read: '[1 (+ 2 3)]'. 16 | expected := Mal read: '[1 5]'. 17 | self assert: (val evalIn: MalContext default) equals: expected 18 | ] 19 | 20 | { #category : #tests } 21 | MalVectorTest >> testEvalEmpty [ 22 | "Empty vector should evaluate to itself." 23 | 24 | | val | 25 | val := MalVector new. 26 | self assert: (val evalIn: nil) equals: val 27 | ] 28 | 29 | { #category : #tests } 30 | MalVectorTest >> testPrint [ 31 | | val first second items | 32 | first := MalInteger withValue: 1. 33 | second := MalInteger withValue: 2. 34 | items := OrderedCollection with: first with: second. 35 | val := MalVector withValue: items. 36 | self assert: val asReadableString equals: '[1 2]' 37 | ] 38 | -------------------------------------------------------------------------------- /MakeALisp-Tests/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'MakeALisp-Tests' } 2 | -------------------------------------------------------------------------------- /MakeALisp/Mal.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a Make-A-Lisp (MAL) interpreter. 3 | 4 | You can use me from a CLI (see MalStep) or see: 5 | 6 | Mal demo. 7 | 8 | for an example of running. 9 | " 10 | Class { 11 | #name : #Mal, 12 | #superclass : #Object, 13 | #category : #MakeALisp 14 | } 15 | 16 | { #category : #evaluating } 17 | Mal class >> demo [ 18 | | val | 19 | val := Mal read: '(/ (+ 5 6) 2)'. 20 | ^ val evalIn: MalContext default 21 | ] 22 | 23 | { #category : #evaluating } 24 | Mal class >> eval: aForm in: ctx [ 25 | ^ aForm evalIn: ctx 26 | ] 27 | 28 | { #category : #'as yet unclassified' } 29 | Mal class >> prelude [ 30 | ^ '(do 31 | (def! not (fn* (a) (if a false true))) 32 | (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\n)"))))) 33 | (defmacro! cond 34 | (fn* (& xs) 35 | (if (> (count xs) 0) 36 | (list ''if 37 | (first xs) 38 | (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) 39 | (cons ''cond (rest (rest xs))))))) 40 | 41 | (def! *host-language* "pharo") 42 | 43 | (def! inc (fn* [x] (+ x 1))) 44 | (def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc)))))) 45 | (defmacro! or 46 | (fn* (& xs) 47 | (if (empty? xs) 48 | nil 49 | (if (= 1 (count xs)) 50 | (first xs) 51 | (let* (condvar (gensym)) 52 | `(let* (~condvar ~(first xs)) 53 | (if ~condvar ~condvar (or ~@(rest xs))))))))) 54 | 55 | (def! *ARGV* nil) 56 | )' 57 | ] 58 | 59 | { #category : #printing } 60 | Mal class >> print: aValue [ 61 | ^ aValue asReadableString 62 | ] 63 | 64 | { #category : #'meta-object-protocol' } 65 | Mal class >> read: aString [ 66 | ^ MalReader readString: aString 67 | ] 68 | 69 | { #category : #'as yet unclassified' } 70 | Mal class >> rep: aString [ 71 | ^ self rep: aString in: MalContext default 72 | ] 73 | 74 | { #category : #'as yet unclassified' } 75 | Mal class >> rep: aString in: env [ 76 | ^ self print: (self eval: (self read: aString) in: env) 77 | ] 78 | -------------------------------------------------------------------------------- /MakeALisp/MalAdd.class.st: -------------------------------------------------------------------------------- 1 | " 2 | The built-in function + in MAL. 3 | " 4 | Class { 5 | #name : #MalAdd, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalAdd class >> malName [ 12 | ^ '+' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalAdd >> call: args withContext: ctx [ 17 | "Add args together." 18 | 19 | | total | 20 | self ensure: args haveType: MalInteger. 21 | total := (args collect: #value) sum. 22 | ^ MalInteger withValue: total 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalApplyFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the apply function. 3 | " 4 | Class { 5 | #name : #MalApplyFunction, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalApplyFunction class >> malName [ 12 | ^ 'apply' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalApplyFunction >> call: args withContext: ctx [ 17 | | func funcArgs | 18 | args size < 2 19 | ifTrue: [ MalError signal: 'apply requires at least two arguments' ]. 20 | func := args first. 21 | func isCallable 22 | ifFalse: [ MalError signal: 'first argument to apply must be a callable' ]. 23 | funcArgs := OrderedCollection new. 24 | funcArgs addAll: args allButFirst allButLast. 25 | args last isIterable ifFalse: [ MalError signal: 'the last argument to apply must be iterable' ]. 26 | funcArgs addAll: args last value. 27 | ^ func call: funcArgs withContext: ctx 28 | ] 29 | -------------------------------------------------------------------------------- /MakeALisp/MalAssoc.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the assoc function. 3 | " 4 | Class { 5 | #name : #MalAssoc, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalAssoc class >> malName [ 12 | ^ 'assoc' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalAssoc >> call: args withContext: ctx [ 17 | | items extraItems | 18 | args isEmpty 19 | ifTrue: [ MalError signal: 'assoc requires an argument' ]. 20 | args first class = MalHashMap 21 | ifFalse: [ MalError signal: 'first argument to assoc must be a hash map' ]. 22 | items := args first value copy. 23 | extraItems := args allButFirst. 24 | extraItems size even 25 | ifFalse: [ MalError signal: 'assoc requires an even number of key-values' ]. 26 | extraItems pairsDo: [ :k :v | items at: k put: v ]. 27 | ^ MalHashMap withValue: items 28 | ] 29 | -------------------------------------------------------------------------------- /MakeALisp/MalAtom.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent atom values in MAL. 3 | " 4 | Class { 5 | #name : #MalAtom, 6 | #superclass : #MalType, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalAtom >> asReadableString [ 12 | ^ '(atom ', self value asReadableString , ')' 13 | ] 14 | -------------------------------------------------------------------------------- /MakeALisp/MalAtomFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the function that creates atom values in MAL. 3 | " 4 | Class { 5 | #name : #MalAtomFunction, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalAtomFunction class >> malName [ 12 | ^ 'atom' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalAtomFunction >> callArg: arg withContext: ctx [ 17 | ^ MalAtom withValue: arg 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalAtomPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the atom? function in MAL. 3 | " 4 | Class { 5 | #name : #MalAtomPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalAtomPredicate class >> malName [ 12 | ^ 'atom?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalAtomPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: (arg class = MalAtom) 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalBool.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent boolean values (true and false) in MAL. 3 | " 4 | Class { 5 | #name : #MalBool, 6 | #superclass : #MalType, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalBool >> asReadableString [ 12 | ^ self value asString 13 | ] 14 | 15 | { #category : #accessing } 16 | MalBool >> isTruthy [ 17 | ^ self value 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalBoolLiteral.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I convert true and false strings to MAL values. 3 | " 4 | Class { 5 | #name : #MalBoolLiteral, 6 | #superclass : #MalLiteral, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #testing } 11 | MalBoolLiteral class >> fromToken: aString [ 12 | aString = 'true' ifTrue: [ ^ MalBool withValue: true ] ifFalse: [ ^MalBool withValue: false ] 13 | ] 14 | 15 | { #category : #testing } 16 | MalBoolLiteral class >> matches: aString [ 17 | 18 | ^ (aString = 'true') | (aString = 'false') 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp/MalCallable.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I'm the base class for all callable values in MAL. 3 | 4 | This covers both built-in functions and user-defined functions. Note 5 | that macros are special cases of functions. 6 | " 7 | Class { 8 | #name : #MalCallable, 9 | #superclass : #MalType, 10 | #category : #MakeALisp 11 | } 12 | 13 | { #category : #accessing } 14 | MalCallable >> isCallable [ ^ true 15 | ] 16 | -------------------------------------------------------------------------------- /MakeALisp/MalClosure.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent (fn* ...) expressions in MAL. 3 | " 4 | Class { 5 | #name : #MalClosure, 6 | #superclass : #MalCallable, 7 | #instVars : [ 8 | 'env', 9 | 'bindings', 10 | 'variadicSym', 11 | 'body', 12 | 'isMacro' 13 | ], 14 | #category : #MakeALisp 15 | } 16 | 17 | { #category : #accessing } 18 | MalClosure >> asReadableString [ 19 | isMacro ifTrue: [ ^'#' ] ifFalse: [ 20 | ^ '#'] 21 | ] 22 | 23 | { #category : #accessing } 24 | MalClosure >> bindings [ 25 | ^ bindings 26 | ] 27 | 28 | { #category : #accessing } 29 | MalClosure >> bindings: anObject [ 30 | bindings := anObject 31 | ] 32 | 33 | { #category : #accessing } 34 | MalClosure >> body: anObject [ 35 | body := anObject 36 | ] 37 | 38 | { #category : #evaluating } 39 | MalClosure >> call: args withContext: callingCtx [ 40 | | bodyEnv result bodyCtx | 41 | args size < bindings size 42 | ifTrue: [ MalWrongArity signal: 'not enough arguments to closure' ]. 43 | args size > bindings size & variadicSym isNil 44 | ifTrue: [ MalWrongArity signal: 'too many arguments to closure' ]. 45 | "Create an environment combining the closure env and the bound symbols." 46 | bodyEnv := MalEnv withOuter: env. 47 | bindings withIndexDo: [ :sym :i | bodyEnv at: sym put: (args at: i) ]. 48 | variadicSym isNotNil 49 | ifTrue: [ bodyEnv 50 | at: variadicSym 51 | put: (MalList withValue: (args allButFirst: bindings size)) ]. 52 | bodyCtx := callingCtx withEnv: bodyEnv. 53 | 54 | "Evaluate the body and return the value of the last item." 55 | result := nil. 56 | body do: [ :e | result := e evalIn: bodyCtx ]. 57 | ^ result 58 | ] 59 | 60 | { #category : #accessing } 61 | MalClosure >> env: anEnv [ 62 | env := anEnv 63 | ] 64 | 65 | { #category : #accessing } 66 | MalClosure >> isMacro [ 67 | ^ isMacro 68 | ] 69 | 70 | { #category : #accessing } 71 | MalClosure >> isMacro: anObject [ 72 | ^ isMacro := anObject 73 | ] 74 | 75 | { #category : #accessing } 76 | MalClosure >> isMacroCall [ 77 | ^ isMacro 78 | ] 79 | 80 | { #category : #printing } 81 | MalClosure >> printOn: aStream [ 82 | | inner | 83 | inner := ' ' join: (body collect: #printString). 84 | aStream 85 | nextPutAll: 'a MalClosure('; 86 | nextPutAll: inner; 87 | nextPutAll: ')' 88 | ] 89 | 90 | { #category : #accessing } 91 | MalClosure >> variadicSym [ 92 | ^ variadicSym 93 | ] 94 | 95 | { #category : #accessing } 96 | MalClosure >> variadicSym: anObject [ 97 | variadicSym := anObject 98 | ] 99 | -------------------------------------------------------------------------------- /MakeALisp/MalConcat.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the concat function in MAL. 3 | " 4 | Class { 5 | #name : #MalConcat, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalConcat class >> malName [ 12 | ^ 'concat' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalConcat >> call: args withContext: ctx [ 17 | | result | 18 | args do: [ :arg | arg isIterable ifFalse: [ MalError signal: 'concat requires iterable arguments' ] ]. 19 | result := OrderedCollection new. 20 | args do: [ :arg | result addAll: arg value ]. 21 | ^ MalList withValue: result 22 | ] 23 | -------------------------------------------------------------------------------- /MakeALisp/MalConj.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the conj function. 3 | " 4 | Class { 5 | #name : #MalConj, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalConj class >> malName [ 12 | ^ 'conj' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalConj >> call: args withContext: ctx [ 17 | | items extraItems | 18 | self ensure: args haveMinArity: 1. 19 | args first isIterable 20 | ifFalse: [ MalError signal: 'conj requires an iterable as its first argument' ]. 21 | items := args first value copy. 22 | extraItems := args allButFirst. 23 | args first class = MalList 24 | ifTrue: [ extraItems do: [ :item | items addFirst: item ]. 25 | ^MalList withValue: items ] 26 | ifFalse: [ extraItems do: [ :item | items addLast: item ]. 27 | ^MalVector withValue: items ] 28 | ] 29 | -------------------------------------------------------------------------------- /MakeALisp/MalCons.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the cons function in MAL. 3 | " 4 | Class { 5 | #name : #MalCons, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalCons class >> malName [ 12 | ^ 'cons' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalCons >> call: args withContext: ctx [ 17 | | result | 18 | self ensure: args haveArity: 2. 19 | result := OrderedCollection with: args first. 20 | args second isIterable 21 | ifFalse: [ MalError signal: 'second argument to cons should be iterable' ]. 22 | result addAll: args second value. 23 | ^ MalList withValue: result 24 | ] 25 | -------------------------------------------------------------------------------- /MakeALisp/MalContainsPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the contains? function. 3 | " 4 | Class { 5 | #name : #MalContainsPredicate, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalContainsPredicate class >> malName [ 12 | ^ 'contains?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalContainsPredicate >> call: args withContext: ctx [ 17 | | hashmap | 18 | self ensure: args haveArity: 2. 19 | hashmap := args first. 20 | hashmap class = MalHashMap 21 | ifFalse: [ MalError signal: 'first argument to contains must be a hash map' ]. 22 | ^ hashmap value at: args second ifPresent: [ MalBool withValue: true ] ifAbsent: [ MalBool withValue: false ] 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalContext.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the state needed to evaluate MAL expressions. 3 | 4 | To evaluate MAl programs with a full environment use: 5 | 6 | MalContext default. 7 | " 8 | Class { 9 | #name : #MalContext, 10 | #superclass : #Object, 11 | #instVars : [ 12 | 'env', 13 | 'stdout' 14 | ], 15 | #category : #MakeALisp 16 | } 17 | 18 | { #category : #accessing } 19 | MalContext class >> default [ 20 | "Initialise the MAL context with a full environment." 21 | 22 | | ctx | 23 | ctx := self new 24 | env: MalEnv default; 25 | yourself. 26 | (Mal read: (Mal prelude)) evalIn: ctx . 27 | ^ ctx 28 | ] 29 | 30 | { #category : #accessing } 31 | MalContext >> env [ 32 | ^ env 33 | ] 34 | 35 | { #category : #accessing } 36 | MalContext >> env: bindings [ 37 | env := bindings 38 | ] 39 | 40 | { #category : #accessing } 41 | MalContext >> globalEnv [ 42 | | result | 43 | result := env. 44 | [ result outer isNotNil ] whileTrue: [ result := result outer ]. 45 | ^ result 46 | ] 47 | 48 | { #category : #'as yet unclassified' } 49 | MalContext >> setArgv: cliArgs [ 50 | | argv args | 51 | args := cliArgs arguments. 52 | argv := MalList withValue: (args collect: [:arg | MalString withValue: arg]). 53 | env at: (MalSymbol withValue: '*ARGV*') put: argv 54 | ] 55 | 56 | { #category : #accessing } 57 | MalContext >> stdout [ 58 | ^ stdout 59 | ] 60 | 61 | { #category : #accessing } 62 | MalContext >> stdout: anObject [ 63 | stdout := anObject 64 | ] 65 | 66 | { #category : #accessing } 67 | MalContext >> withEnv: newEnv [ 68 | "Return a copy of self with a different environment." 69 | ^ self class 70 | new 71 | env: newEnv; 72 | stdout: stdout; 73 | yourself 74 | ] 75 | -------------------------------------------------------------------------------- /MakeALisp/MalCount.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the count function in MAL. 3 | " 4 | Class { 5 | #name : #MalCount, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalCount class >> malName [ 12 | ^ 'count' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalCount >> callArg: arg withContext: ctx [ 17 | "MAL requires nil to return 0, so return 0 for any non-list." 18 | 19 | arg isIterable 20 | ifFalse: [ ^ MalInteger withValue: 0 ]. 21 | ^ MalInteger withValue: arg size 22 | ] 23 | -------------------------------------------------------------------------------- /MakeALisp/MalDef.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the def! special form in MAL. 3 | " 4 | Class { 5 | #name : #MalDef, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalDef class >> call: args withContext: ctx [ 12 | | sym val | 13 | args size = 2 14 | ifFalse: [ MalWrongArity 15 | signal: ('def! requires 2 arguments (got {1}' format: {args size}) ]. 16 | sym := args first. 17 | sym class = MalSymbol 18 | ifFalse: [ MalError signal: 'The first argument to def! must be a symbol' ]. 19 | val := args second evalIn: ctx. 20 | ctx globalEnv at: sym put: val. 21 | ^ val 22 | ] 23 | 24 | { #category : #accessing } 25 | MalDef class >> malName [ 26 | ^ 'def!' 27 | ] 28 | -------------------------------------------------------------------------------- /MakeALisp/MalDefmacro.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the defmacro! special form. 3 | " 4 | Class { 5 | #name : #MalDefmacro, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalDefmacro class >> call: args withContext: ctx [ 12 | | sym val | 13 | args size = 2 14 | ifFalse: [ MalWrongArity 15 | signal: ('defmacro! requires 2 arguments (got {1}' format: {args size}) ]. 16 | sym := args first. 17 | sym class = MalSymbol 18 | ifFalse: [ MalError signal: 'The first argument to def! must be a symbol' ]. 19 | val := args second evalIn: ctx. 20 | "Ensure we don't modify the original function." 21 | val := val copy. 22 | val isMacro: true. 23 | ctx globalEnv at: sym put: val. 24 | ^ val 25 | ] 26 | 27 | { #category : #accessing } 28 | MalDefmacro class >> malName [ 29 | ^ 'defmacro!' 30 | ] 31 | -------------------------------------------------------------------------------- /MakeALisp/MalDeref.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the deref function in MAL. 3 | " 4 | Class { 5 | #name : #MalDeref, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalDeref class >> malName [ 12 | ^ 'deref' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalDeref >> callArg: arg withContext: env [ 17 | arg class = MalAtom ifFalse: [ MalError signal: 'deref requires an atom' ]. 18 | ^ arg value 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp/MalDissoc.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the dissoc function. 3 | " 4 | Class { 5 | #name : #MalDissoc, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalDissoc class >> malName [ 12 | ^ 'dissoc' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalDissoc >> call: args withContext: ctx [ 17 | | items keysToRemove | 18 | args isEmpty 19 | ifTrue: [ MalError signal: 'dissoc requires an argument' ]. 20 | args first class = MalHashMap 21 | ifFalse: [ MalError signal: 'first argument to dissoc must be a hash map' ]. 22 | items := args first value copy. 23 | keysToRemove := args allButFirst. 24 | keysToRemove do: [ :k | items removeKey: k ifAbsent: [ ] ]. 25 | ^ MalHashMap withValue: items 26 | ] 27 | -------------------------------------------------------------------------------- /MakeALisp/MalDivide.class.st: -------------------------------------------------------------------------------- 1 | " 2 | The built-in function / in MAL. 3 | " 4 | Class { 5 | #name : #MalDivide, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalDivide class >> malName [ 12 | ^ '/' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalDivide >> call: args withContext: ctx [ 17 | "Divide the first argument by the others." 18 | 19 | | result | 20 | self ensure: args haveMinArity: 1. 21 | self ensure: args haveType: MalInteger. 22 | result := args first value. 23 | args allButFirstDo: [ :arg | result := result // arg value ]. 24 | ^ MalInteger withValue: result 25 | ] 26 | -------------------------------------------------------------------------------- /MakeALisp/MalDo.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the do special form in MAL. 3 | " 4 | Class { 5 | #name : #MalDo, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalDo class >> call: args withContext: ctx [ 12 | | result | 13 | result := nil. 14 | args do: [ :expr | result := expr evalIn: ctx ]. 15 | ^ result 16 | ] 17 | 18 | { #category : #accessing } 19 | MalDo class >> malName [ 20 | ^ 'do' 21 | ] 22 | -------------------------------------------------------------------------------- /MakeALisp/MalEmptyPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the empty? function in MAL. 3 | " 4 | Class { 5 | #name : #MalEmptyPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalEmptyPredicate class >> malName [ 12 | ^ 'empty?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalEmptyPredicate >> callArg: arg withContext: ctx [ 17 | arg isIterable 18 | ifFalse: [ ^ MalBool withValue: false ]. 19 | ^ MalBool withValue: arg value isEmpty 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalEnv.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent environments in MAL. I look up symbols, and can defer to 3 | outer environments if a symbol isn't present in my bindings. 4 | 5 | My API roughly follows Dictionary. 6 | 7 | I also hold references to Smalltalk objects that MAL needs, such as stdout. 8 | " 9 | Class { 10 | #name : #MalEnv, 11 | #superclass : #Object, 12 | #instVars : [ 13 | 'bindings', 14 | 'outer', 15 | 'stdout' 16 | ], 17 | #category : #MakeALisp 18 | } 19 | 20 | { #category : #'instance creation' } 21 | MalEnv class >> default [ 22 | | env | 23 | env := self new. 24 | MalFunction allSubclassesDo: [ :func | env at: (MalSymbol withValue: func malName) put: func new ]. 25 | ^ env 26 | 27 | ] 28 | 29 | { #category : #'instance creation' } 30 | MalEnv class >> new [ 31 | ^ super new 32 | bindings: Dictionary new; 33 | yourself 34 | ] 35 | 36 | { #category : #'instance creation' } 37 | MalEnv class >> withOuter: env [ 38 | self 39 | assert: [ env class = self ] 40 | description: [ 'Outer env class should match this env' ]. 41 | ^ self new 42 | outer: env; 43 | yourself 44 | ] 45 | 46 | { #category : #acccessing } 47 | MalEnv >> at: aSymbol [ 48 | | key | 49 | self 50 | assert: [ aSymbol class = MalSymbol ] 51 | description: 'env keys should be symbols'. 52 | key := aSymbol value. 53 | ^ self 54 | at: key 55 | ifAbsent: [ MalUnboundSymbol signal: 'Unbound variable: ' , key ] 56 | ] 57 | 58 | { #category : #acccessing } 59 | MalEnv >> at: aSymbol ifAbsent: aBlock [ 60 | | key | 61 | key := aSymbol value. 62 | ^ bindings 63 | at: key 64 | ifAbsent: [ outer 65 | ifNotNil: [ ^ outer at: key ifAbsent: aBlock ] 66 | ifNil: [ aBlock value ] ] 67 | ] 68 | 69 | { #category : #acccessing } 70 | MalEnv >> at: aSymbol ifPresent: presentBlock ifAbsent: absentBlock [ 71 | | key | 72 | key := aSymbol value. 73 | ^ bindings 74 | at: key 75 | ifPresent: [ :value | ^ presentBlock cull: value ] 76 | ifAbsent: [ outer 77 | ifNotNil: [ ^ outer at: key ifPresent: presentBlock ifAbsent: absentBlock ] 78 | ifNil: [ absentBlock value ] ] 79 | ] 80 | 81 | { #category : #setter } 82 | MalEnv >> at: aSymbol put: value [ 83 | "Insert this symbol at this level" 84 | 85 | | key | 86 | self 87 | assert: [ aSymbol class = MalSymbol ] 88 | description: 'env keys should be symbols'. 89 | key := aSymbol value. 90 | bindings at: key put: value 91 | ] 92 | 93 | { #category : #setter } 94 | MalEnv >> bindings: aDictionary [ 95 | bindings := aDictionary 96 | ] 97 | 98 | { #category : #accessing } 99 | MalEnv >> outer [ 100 | ^ outer 101 | ] 102 | 103 | { #category : #setter } 104 | MalEnv >> outer: aLinkedDictionary [ 105 | outer := aLinkedDictionary 106 | ] 107 | -------------------------------------------------------------------------------- /MakeALisp/MalEqual.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the = function in MAL. 3 | " 4 | Class { 5 | #name : #MalEqual, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalEqual class >> malName [ 12 | ^ '=' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalEqual >> call: args withContext: ctx [ 17 | self ensure: args haveArity: 2. 18 | ^ MalBool withValue: args first = args second 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp/MalError.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am the base class for all exceptions in MAL. 3 | " 4 | Class { 5 | #name : #MalError, 6 | #superclass : #Error, 7 | #category : #MakeALisp 8 | } 9 | -------------------------------------------------------------------------------- /MakeALisp/MalEval.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the eval built-in function in MAL. 3 | 4 | I do not handle evaluation (see the evalIn: message), but I expose evaluation to the user. 5 | " 6 | Class { 7 | #name : #MalEval, 8 | #superclass : #MalFunctionOneArg, 9 | #category : #MakeALisp 10 | } 11 | 12 | { #category : #accessing } 13 | MalEval class >> malName [ 14 | ^ 'eval' 15 | ] 16 | 17 | { #category : #evaluating } 18 | MalEval >> callArg: arg withContext: ctx [ 19 | | evalCtx | 20 | "Eval may not access local variables, according to the MAL test suite." 21 | evalCtx := ctx withEnv: ctx globalEnv. 22 | ^ arg evalIn: evalCtx 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalFalsePredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the false? function. 3 | " 4 | Class { 5 | #name : #MalFalsePredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalFalsePredicate class >> malName [ 12 | ^ 'false?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalFalsePredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: (arg = (MalBool withValue: false)) 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalFirst.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the first function. 3 | " 4 | Class { 5 | #name : #MalFirst, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalFirst class >> malName [ 12 | ^ 'first' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalFirst >> callArg: arg withContext: ctx [ 17 | arg isPair 18 | ifTrue: [ ^ arg value first ] 19 | ifFalse: [ ^ MalNil new ]. 20 | 21 | ] 22 | -------------------------------------------------------------------------------- /MakeALisp/MalFn.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the fn* special form, and create a MalClosure. 3 | " 4 | Class { 5 | #name : #MalFn, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalFn class >> call: args withContext: ctx [ 12 | | wrappedParams params body variadicSym | 13 | args isEmpty 14 | ifTrue: [ MalWrongArity signal: 'fn* requires a list of parameters' ]. 15 | wrappedParams := args first. 16 | wrappedParams isIterable 17 | ifFalse: [ MalError signal: 'fn* parameters must be iterable' ]. 18 | params := wrappedParams value. 19 | variadicSym := nil. 20 | params 21 | doWithIndex: [ :param :i | 22 | param class = MalSymbol 23 | ifFalse: [ MalError signal: 'fn* parameters must be symbols: ' , param asReadableString ]. 24 | param value = '&' 25 | ifTrue: [ i = (params size - 1) 26 | ifFalse: [ MalError signal: '& must be in the penultimate position' ]. 27 | variadicSym := params last ] ]. 28 | variadicSym isNotNil 29 | ifTrue: [ params := params allButLast: 2 ]. 30 | body := args allButFirst. 31 | ^ MalClosure new 32 | env: ctx env; 33 | bindings: params; 34 | variadicSym: variadicSym; 35 | body: body; 36 | isMacro: false; 37 | yourself 38 | ] 39 | 40 | { #category : #accessing } 41 | MalFn class >> malName [ 42 | ^ 'fn*' 43 | ] 44 | -------------------------------------------------------------------------------- /MakeALisp/MalFnPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the fn? function. 3 | " 4 | Class { 5 | #name : #MalFnPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalFnPredicate class >> malName [ 12 | ^ 'fn?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalFnPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: (arg isCallable and: [arg isMacro not]) 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent built-in functions in MAL. 3 | 4 | If a child implements the malName method, it will be included in the default environment. 5 | " 6 | Class { 7 | #name : #MalFunction, 8 | #superclass : #MalCallable, 9 | #category : #MakeALisp 10 | } 11 | 12 | { #category : #accessing } 13 | MalFunction class >> malName [ 14 | ^ nil 15 | ] 16 | 17 | { #category : #accessing } 18 | MalFunction >> asReadableString [ 19 | ^ '#' 20 | ] 21 | 22 | { #category : #evaluating } 23 | MalFunction >> call: args withContext: ctx [ 24 | self subclassResponsibility 25 | ] 26 | 27 | { #category : #'as yet unclassified' } 28 | MalFunction >> ensure: arg hasType: aClass [ 29 | arg class = aClass 30 | ifFalse: [ MalError 31 | signal: 32 | ('{1} requires an argument of type {2}' 33 | format: 34 | {self class malName. 35 | aClass name asString}) ] 36 | ] 37 | 38 | { #category : #evaluating } 39 | MalFunction >> ensure: args haveArity: arity [ 40 | | msg | 41 | msg := 'The function {1} takes {2} argument{3} (got {4})' 42 | format: 43 | {self class malName. 44 | arity. 45 | (arity = 1 46 | ifTrue: [ '' ] 47 | ifFalse: [ 's' ]). args size}. 48 | args size = arity 49 | ifFalse: [ MalWrongArity signal: msg ] 50 | ] 51 | 52 | { #category : #'as yet unclassified' } 53 | MalFunction >> ensure: args haveMinArity: arity [ 54 | | msg | 55 | msg := 'The function {1} requires at least {2} argument{3} (got {4})' 56 | format: 57 | {self class malName. 58 | arity. 59 | (arity = 1 60 | ifTrue: [ '' ] 61 | ifFalse: [ 's' ]). 62 | args size}. 63 | args size < arity 64 | ifTrue: [ MalWrongArity signal: msg ] 65 | ] 66 | 67 | { #category : #'as yet unclassified' } 68 | MalFunction >> ensure: args haveType: aClass [ 69 | args 70 | do: [ :arg | 71 | self ensure: arg hasType: aClass ] 72 | ] 73 | -------------------------------------------------------------------------------- /MakeALisp/MalFunctionOneArg.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I'm a base class for built-in function that take exactly one argument. 3 | " 4 | Class { 5 | #name : #MalFunctionOneArg, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalFunctionOneArg >> call: args withContext: env [ 12 | self ensure: args haveArity: 1. 13 | ^ self callArg: args first withContext: env 14 | ] 15 | 16 | { #category : #evaluating } 17 | MalFunctionOneArg >> callArg: arg withContext: ctx [ 18 | self subclassResponsibility 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp/MalGet.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the get function. 3 | " 4 | Class { 5 | #name : #MalGet, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalGet class >> malName [ 12 | ^ 'get' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalGet >> call: args withContext: ctx [ 17 | | hashmap | 18 | self ensure: args haveArity: 2. 19 | hashmap := args first. 20 | hashmap class = MalHashMap 21 | ifFalse: [ ^ MalNil new ]. 22 | ^ hashmap value at: args second ifAbsent: [ MalNil new ] 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalGreaterThan.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the > function in MAL. 3 | " 4 | Class { 5 | #name : #MalGreaterThan, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalGreaterThan class >> malName [ 12 | ^ '>' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalGreaterThan >> call: args withContext: ctx [ 17 | | x y | 18 | self ensure: args haveArity: 2. 19 | self ensure: args haveType: MalInteger . 20 | x := args first. 21 | y := args second. 22 | ^ MalBool withValue: x value > y value 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalGreaterThanOrEqual.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the >= function in MAL. 3 | " 4 | Class { 5 | #name : #MalGreaterThanOrEqual, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalGreaterThanOrEqual class >> malName [ 12 | ^ '>=' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalGreaterThanOrEqual >> call: args withContext: ctx [ 17 | | x y | 18 | self ensure: args haveArity: 2. 19 | self ensure: args haveType: MalInteger. 20 | x := args first. 21 | y := args second. 22 | ^ MalBool withValue: x value >= y value 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalHashMap.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent hash maps {:foo ""bar""} in MAL. 3 | " 4 | Class { 5 | #name : #MalHashMap, 6 | #superclass : #MalType, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #initialization } 11 | MalHashMap class >> withItems: items [ 12 | | value | 13 | value := Dictionary new. 14 | items pairsDo: [ :k :v | value at: k put: v ]. 15 | ^ self withValue: value 16 | ] 17 | 18 | { #category : #accessing } 19 | MalHashMap >> asReadableString [ 20 | | printedItems | 21 | printedItems := OrderedCollection new. 22 | value 23 | associationsDo: [ :assoc | 24 | printedItems add: assoc key asReadableString. 25 | printedItems add: assoc value asReadableString ]. 26 | ^ '{' , (' ' join: printedItems) , '}' 27 | ] 28 | 29 | { #category : #accessing } 30 | MalHashMap >> asString [ 31 | | printedItems | 32 | printedItems := OrderedCollection new. 33 | value 34 | associationsDo: [ :assoc | 35 | printedItems add: assoc key asString. 36 | printedItems add: assoc value asString ]. 37 | ^ '{' , (' ' join: printedItems) , '}' 38 | ] 39 | 40 | { #category : #accessing } 41 | MalHashMap >> evalIn: ctx [ 42 | | evalledItems | 43 | evalledItems := self value 44 | associations collect: [ :assoc | ((assoc key) evalIn: ctx) -> ((assoc value) evalIn: ctx) ]. 45 | ^ MalHashMap withValue: (Dictionary newFrom: evalledItems) 46 | ] 47 | -------------------------------------------------------------------------------- /MakeALisp/MalHashMapFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the hash-map function. 3 | " 4 | Class { 5 | #name : #MalHashMapFunction, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalHashMapFunction class >> malName [ 12 | ^ 'hash-map' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalHashMapFunction >> call: args withContext: ctx [ 17 | args size even 18 | ifFalse: [ MalError signal: 'hash-map takes an even number of arguments' ]. 19 | ^ MalHashMap withItems: args 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalIf.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the if special form in MAL. 3 | " 4 | Class { 5 | #name : #MalIf, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalIf class >> call: args withContext: ctx [ 12 | | condition result | 13 | args size < 2 14 | ifTrue: [ MalWrongArity signal: 'if requires at least two arguments' ]. 15 | condition := args first evalIn: ctx. 16 | condition isTruthy 17 | ifTrue: [ ^ args second evalIn: ctx ]. 18 | result := MalNil new. 19 | (args allButFirst: 2) do: [ :arg | result := arg evalIn: ctx ]. 20 | ^ result 21 | ] 22 | 23 | { #category : #accessing } 24 | MalIf class >> malName [ 25 | ^ 'if' 26 | ] 27 | -------------------------------------------------------------------------------- /MakeALisp/MalInteger.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent whole numbers in MAL. 3 | " 4 | Class { 5 | #name : #MalInteger, 6 | #superclass : #MalType, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalInteger >> asReadableString [ 12 | ^ self value asString 13 | ] 14 | -------------------------------------------------------------------------------- /MakeALisp/MalKeys.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the keys function. 3 | " 4 | Class { 5 | #name : #MalKeys, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalKeys class >> malName [ 12 | ^ 'keys' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalKeys >> callArg: arg withContext: ctx [ 17 | arg class = MalHashMap 18 | ifFalse: [ MalError signal: 'keys requires a hash map argument' ]. 19 | ^ MalList withValue: (OrderedCollection newFrom: arg value keys) 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalKeyword.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent keywords in MAL. 3 | 4 | Keywords are symbols that start with :, e.g. :foo. 5 | 6 | Keywords evaluate to themselves. 7 | " 8 | Class { 9 | #name : #MalKeyword, 10 | #superclass : #MalType, 11 | #category : #MakeALisp 12 | } 13 | 14 | { #category : #accessing } 15 | MalKeyword >> asReadableString [ 16 | ^ value 17 | ] 18 | -------------------------------------------------------------------------------- /MakeALisp/MalKeywordFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the keyword function. 3 | " 4 | Class { 5 | #name : #MalKeywordFunction, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalKeywordFunction class >> malName [ 12 | ^ 'keyword' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalKeywordFunction >> callArg: arg withContext: ctx [ 17 | arg class = MalString 18 | ifFalse: [ MalError signal: 'keyword requires a string argument' ]. 19 | ^ MalKeyword withValue: ':' ,arg value 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalKeywordLiteral.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I convert strings ':foo' into MalKeyword values. 3 | " 4 | Class { 5 | #name : #MalKeywordLiteral, 6 | #superclass : #MalLiteral, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #testing } 11 | MalKeywordLiteral class >> fromToken: aString [ 12 | ^ MalKeyword withValue: aString 13 | ] 14 | 15 | { #category : #testing } 16 | MalKeywordLiteral class >> matches: aString [ 17 | ^ aString first = $: 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalKeywordPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the keyword? function. 3 | " 4 | Class { 5 | #name : #MalKeywordPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalKeywordPredicate class >> malName [ 12 | ^ 'keyword?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalKeywordPredicate >> callArg: arg withContext: ctx [ 17 | 18 | ^ MalBool withValue: arg class = MalKeyword 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp/MalLessThan.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the < function in MAL. 3 | " 4 | Class { 5 | #name : #MalLessThan, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalLessThan class >> malName [ 12 | ^ '<' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalLessThan >> call: args withContext: ctx [ 17 | | x y | 18 | self ensure: args haveArity: 2. 19 | self ensure: args haveType: MalInteger. 20 | x := args first. 21 | y := args second. 22 | ^ MalBool withValue: x value < y value 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalLessThanOrEqual.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the <= function in MAL. 3 | " 4 | Class { 5 | #name : #MalLessThanOrEqual, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalLessThanOrEqual class >> malName [ 12 | ^ '<=' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalLessThanOrEqual >> call: args withContext: ctx [ 17 | | x y | 18 | self ensure: args haveArity: 2. 19 | self ensure: args haveType: MalInteger. 20 | x := args first. 21 | y := args second. 22 | ^ MalBool withValue: x value <= y value 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalLet.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent let* in MAL. 3 | " 4 | Class { 5 | #name : #MalLet, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalLet class >> call: args withContext: ctx [ 12 | | newEnv bindings result newCtx | 13 | args isEmpty 14 | ifTrue: [ MalWrongArity signal: 'let* requires a list of bindings' ]. 15 | newEnv := MalEnv withOuter: ctx env. 16 | newCtx := ctx withEnv: newEnv. 17 | bindings := args first. 18 | ({ MalList. MalVector } includes: (bindings class)) 19 | ifFalse: [ MalError signal: 'let* requires a list of bindings' ]. 20 | (bindings value size isDivisibleBy: 2) 21 | ifFalse: [ MalError signal: 'let* requires an even number of bindings' ]. 22 | bindings value 23 | withIndexDo: [ :b :i | 24 | (i isDivisibleBy: 2) 25 | ifFalse: [ b class = MalSymbol 26 | ifFalse: [ MalError signal: 'Expected a symbol for let binding' ] ] ]. 27 | bindings value 28 | pairsDo: [ :var :rawVal | 29 | | val | 30 | val := rawVal evalIn: newCtx. 31 | newCtx env at: var put: val ]. 32 | result := nil. 33 | args allButFirst do: [ :expr | result := expr evalIn: newCtx ]. 34 | ^ result 35 | ] 36 | 37 | { #category : #accessing } 38 | MalLet class >> malName [ 39 | ^ 'let*' 40 | ] 41 | -------------------------------------------------------------------------------- /MakeALisp/MalList.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a list value in MAL. 3 | 4 | My API is similar to OrderedCollection for convenience. 5 | " 6 | Class { 7 | #name : #MalList, 8 | #superclass : #MalType, 9 | #category : #MakeALisp 10 | } 11 | 12 | { #category : #'instance creation' } 13 | MalList class >> with: value [ 14 | ^ self withValue: (OrderedCollection with: value) 15 | ] 16 | 17 | { #category : #'instance creation' } 18 | MalList class >> with: value1 with: value2 [ 19 | ^ self withValue: (OrderedCollection with: value1 with: value2) 20 | ] 21 | 22 | { #category : #'instance creation' } 23 | MalList class >> with: value1 with: value2 with: value3 [ 24 | ^ self withValue: (OrderedCollection with: value1 with: value2 with: value3) 25 | ] 26 | 27 | { #category : #accessing } 28 | MalList >> allButFirst [ 29 | ^ self allButFirst: 1 30 | ] 31 | 32 | { #category : #accessing } 33 | MalList >> allButFirst: n [ 34 | ^ self class withValue: (value allButFirst: n) 35 | ] 36 | 37 | { #category : #accessing } 38 | MalList >> asReadableString [ 39 | | inner | 40 | inner := ' ' join: (value collect: #asReadableString). 41 | ^ '(', inner, ')' 42 | ] 43 | 44 | { #category : #converting } 45 | MalList >> asString [ 46 | | inner | 47 | inner := ' ' join: (value collect: #asString). 48 | ^ '(' , inner , ')' 49 | ] 50 | 51 | { #category : #accessing } 52 | MalList >> evalIn: ctx [ 53 | | items evalledItems func expanded | 54 | expanded := self macroexpandAllIn: ctx. 55 | items := expanded value. 56 | "A call is a non-empty list after macro expansion." 57 | expanded isPair 58 | ifFalse: [ expanded class = MalList 59 | ifTrue: [ "Empty list evaluates to itself." ^ expanded ] 60 | ifFalse: [ "E.g. symbol" ^ expanded evalIn: ctx ] ]. 61 | "Special forms." 62 | (MalSpecialForm matchesSymbol: items first) 63 | ifNotNil: [ :f | ^ f call: items allButFirst withContext: ctx ]. 64 | "Evaluate all the items in the list, then call the first arg with the rest." 65 | evalledItems := items collect: [ :item | item evalIn: ctx ]. 66 | func := evalledItems first. 67 | ^ func call: evalledItems allButFirst withContext: ctx 68 | ] 69 | 70 | { #category : #accessing } 71 | MalList >> initialize [ 72 | super initialize . 73 | value := OrderedCollection new. 74 | ] 75 | 76 | { #category : #accessing } 77 | MalList >> isIterable [ ^ true 78 | ] 79 | 80 | { #category : #accessing } 81 | MalList >> isPair [ 82 | ^ self value isNotEmpty 83 | ] 84 | 85 | { #category : #accessing } 86 | MalList >> macroexpandIn: ctx [ 87 | | head headVal | 88 | self value ifEmpty: [ ^ self ]. 89 | head := self value first. 90 | "If the first item evaluates to a macro." 91 | head class = MalSymbol 92 | ifFalse: [ ^ self ]. 93 | headVal := [ head evalIn: ctx ] 94 | on: MalUnboundSymbol 95 | do: [ ^ self ]. 96 | headVal isMacro 97 | ifTrue: [ ^ headVal call: (self value allButFirst) withContext: ctx ] 98 | ifFalse: [ ^ self ]. 99 | ] 100 | 101 | { #category : #accessing } 102 | MalList >> size [ 103 | ^ value size 104 | ] 105 | -------------------------------------------------------------------------------- /MakeALisp/MalListFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the list function in MAL. 3 | " 4 | Class { 5 | #name : #MalListFunction, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalListFunction class >> malName [ 12 | ^ 'list' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalListFunction >> call: args withContext: ctx [ 17 | ^ MalList withValue: args 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalListPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the list? function in MAL. 3 | " 4 | Class { 5 | #name : #MalListPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalListPredicate class >> malName [ 12 | ^ 'list?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalListPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: arg class = MalList 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalLiteral.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent atoms in MAL. My subclasses can convert lexemes (a string) to a MAL value. 3 | " 4 | Class { 5 | #name : #MalLiteral, 6 | #superclass : #Object, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #testing } 11 | MalLiteral class >> fromToken: token [ 12 | self subclassResponsibility 13 | ] 14 | 15 | { #category : #testing } 16 | MalLiteral class >> matches: aString [ 17 | self subclassResponsibility 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalMacroPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the macro? function. 3 | " 4 | Class { 5 | #name : #MalMacroPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalMacroPredicate class >> malName [ 12 | ^ 'macro?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalMacroPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: arg isMacro 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalMacroexpand.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the macroexpand special form exposed to the user. 3 | 4 | For internal macro expansion logic, see implementors of macroexpandIn:. 5 | " 6 | Class { 7 | #name : #MalMacroexpand, 8 | #superclass : #MalSpecialForm, 9 | #category : #MakeALisp 10 | } 11 | 12 | { #category : #evaluating } 13 | MalMacroexpand class >> call: args withContext: ctx [ 14 | args size = 1 15 | ifFalse: [ MalWrongArity signal: 'macroexpand takes one argument' ]. 16 | ^ args first macroexpandAllIn: ctx 17 | ] 18 | 19 | { #category : #accessing } 20 | MalMacroexpand class >> malName [ 21 | ^ 'macroexpand' 22 | ] 23 | -------------------------------------------------------------------------------- /MakeALisp/MalMapFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the map function. 3 | " 4 | Class { 5 | #name : #MalMapFunction, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalMapFunction class >> malName [ 12 | ^ 'map' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalMapFunction >> call: args withContext: ctx [ 17 | | func result | 18 | self ensure: args haveArity: 2. 19 | func := args first. 20 | func isCallable 21 | ifFalse: [ MalError signal: 'first argument to map must be a callable' ]. 22 | result := OrderedCollection new. 23 | args second isIterable 24 | ifFalse: [ MalError signal: 'the second argument to map must be iterable' ]. 25 | result := args second value collect: [ :arg | func call: (OrderedCollection with: arg) withContext: ctx ]. 26 | ^ MalList withValue: result 27 | ] 28 | -------------------------------------------------------------------------------- /MakeALisp/MalMapPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the map? function. 3 | " 4 | Class { 5 | #name : #MalMapPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalMapPredicate class >> malName [ 12 | ^ 'map?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalMapPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: arg class = MalHashMap 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalMetaFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the meta function that extracts metadata from callables. 3 | " 4 | Class { 5 | #name : #MalMetaFunction, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalMetaFunction class >> malName [ 12 | ^ 'meta' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalMetaFunction >> callArg: arg withContext: ctx [ 17 | ^arg meta ifNil: [ MalNil new ] 18 | 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp/MalMultiply.class.st: -------------------------------------------------------------------------------- 1 | " 2 | The built-in function * in MAL. 3 | " 4 | Class { 5 | #name : #MalMultiply, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalMultiply class >> malName [ 12 | ^ '*' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalMultiply >> call: args withContext: ctx [ 17 | "Multiply args together." 18 | 19 | | total | 20 | self ensure: args haveType: MalInteger. 21 | total := 1. 22 | args do: [ :arg | total := total * arg value ]. 23 | ^ MalInteger withValue: total 24 | ] 25 | -------------------------------------------------------------------------------- /MakeALisp/MalNil.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the nil value in MAL. 3 | " 4 | Class { 5 | #name : #MalNil, 6 | #superclass : #MalType, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalNil >> asReadableString [ 12 | ^ 'nil' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalNil >> isTruthy [ 17 | ^ false 18 | ] 19 | 20 | { #category : #accessing } 21 | MalNil >> printOn: aStream [ 22 | aStream 23 | nextPutAll: 'a WMalNil' 24 | ] 25 | -------------------------------------------------------------------------------- /MakeALisp/MalNilLiteral.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I convert the string 'nil' to the MAL nil value. 3 | " 4 | Class { 5 | #name : #MalNilLiteral, 6 | #superclass : #MalLiteral, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #testing } 11 | MalNilLiteral class >> fromToken: aString [ 12 | ^ MalNil new 13 | ] 14 | 15 | { #category : #testing } 16 | MalNilLiteral class >> matches: aString [ 17 | ^ aString = 'nil' 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalNilPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the nil? function. 3 | " 4 | Class { 5 | #name : #MalNilPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalNilPredicate class >> malName [ 12 | ^ 'nil?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalNilPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: (arg = (MalNil new)) 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalNotCallable.class.st: -------------------------------------------------------------------------------- 1 | " 2 | The error when a MAL program tries to call something that isn't a function. 3 | " 4 | Class { 5 | #name : #MalNotCallable, 6 | #superclass : #MalError, 7 | #category : #MakeALisp 8 | } 9 | -------------------------------------------------------------------------------- /MakeALisp/MalNth.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the nth function. 3 | " 4 | Class { 5 | #name : #MalNth, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalNth class >> malName [ 12 | ^ 'nth' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalNth >> call: args withContext: ctx [ 17 | self ensure: args haveArity: 2. 18 | args first isIterable 19 | ifFalse: [ MalError signal: 'first argument to nth should be iterable' ]. 20 | args second class = MalInteger 21 | ifFalse: [ MalError signal: 'second argument to nth should be an integer' ]. 22 | [ ^ args first value at: args second value + 1 ] 23 | on: SubscriptOutOfBounds 24 | do: [ MalError 25 | signal: 26 | ('Out of bounds: cannot access {1} in a {2} item iterable' 27 | format: 28 | {args second value. 29 | args first size}) ] 30 | ] 31 | -------------------------------------------------------------------------------- /MakeALisp/MalNumberLiteral.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I convert number literals to number values in MAL. 3 | " 4 | Class { 5 | #name : #MalNumberLiteral, 6 | #superclass : #MalLiteral, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #testing } 11 | MalNumberLiteral class >> fromToken: token [ 12 | ^ MalInteger withValue: token asInteger 13 | ] 14 | 15 | { #category : #testing } 16 | MalNumberLiteral class >> matches: token [ 17 | ^ token isAllDigits 18 | | (token first = $- & token allButFirst isAllDigits) 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp/MalNumberPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the number? function. 3 | " 4 | Class { 5 | #name : #MalNumberPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalNumberPredicate class >> malName [ 12 | ^ 'number?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalNumberPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: arg class = MalInteger 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalPrStr.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I repressent the pr-str function in MAL. 3 | " 4 | Class { 5 | #name : #MalPrStr, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalPrStr class >> malName [ 12 | ^ 'pr-str' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalPrStr >> call: args withContext: ctx [ 17 | | printedArgs | 18 | printedArgs := args collect: [ :arg | arg asReadableString ]. 19 | ^ MalString withValue: (' ' join: printedArgs) 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalPrintln.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the println function in MAL. 3 | " 4 | Class { 5 | #name : #MalPrintln, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalPrintln class >> malName [ 12 | ^ 'println' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalPrintln >> call: args withContext: ctx [ 17 | ctx stdout 18 | << (' ' join: (args collect: #asString)); 19 | lf. 20 | ^ MalNil new 21 | ] 22 | -------------------------------------------------------------------------------- /MakeALisp/MalPrn.class.st: -------------------------------------------------------------------------------- 1 | " 2 | The built-in prn function in MAL. 3 | " 4 | Class { 5 | #name : #MalPrn, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalPrn class >> malName [ 12 | ^ 'prn' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalPrn >> call: args withContext: ctx [ 17 | | printedArgs | 18 | printedArgs := args collect: [ :arg | arg asReadableString ]. 19 | ctx stdout 20 | << (' ' join: printedArgs); 21 | lf. 22 | ^ MalNil new 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalQuasiquote.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the quasiquote special form in MAL. 3 | " 4 | Class { 5 | #name : #MalQuasiquote, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalQuasiquote class >> call: args withContext: ctx [ 12 | | arg | 13 | args size = 1 14 | ifFalse: [ MalWrongArity 15 | signal: ('quasiquote requires 1 argument (got {1})' format: {args size}) ]. 16 | arg := args first. 17 | ^ (self unquote: arg) evalIn: ctx 18 | ] 19 | 20 | { #category : #accessing } 21 | MalQuasiquote class >> malName [ 22 | ^ 'quasiquote' 23 | ] 24 | 25 | { #category : #evaluating } 26 | MalQuasiquote class >> unquote: ast [ 27 | "Rewrite quasiquoted expr as a series of calls to concat with quoted expressions. 28 | `foo -> 'foo 29 | `(x ~@y z) -> (concat 'x value-of-y 'z)" 30 | 31 | | head | 32 | ast isPair 33 | ifFalse: [ ^ MalList with: (MalSymbol withValue: 'quote') with: ast ]. 34 | head := ast value first. 35 | head = (MalSymbol withValue: 'unquote') 36 | ifTrue: [ ^ ast value second ]. 37 | "((~@foo) x y) -> (concat foo 'x 'y)" 38 | head isPair 39 | ifTrue: [ head value first = (MalSymbol withValue: 'splice-unquote') 40 | ifTrue: [ ^ MalList 41 | with: (MalSymbol withValue: 'concat') 42 | with: head value second 43 | with: (self unquote: ast allButFirst) ] ]. 44 | ^ MalList 45 | with: (MalSymbol withValue: 'cons') 46 | with: (self unquote: ast value first) 47 | with: (self unquote: ast allButFirst) 48 | ] 49 | -------------------------------------------------------------------------------- /MakeALisp/MalQuote.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the quote special form in MAL. 3 | " 4 | Class { 5 | #name : #MalQuote, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalQuote class >> call: args withContext: ctx [ 12 | args size = 1 13 | ifFalse: [ MalWrongArity 14 | signal: ('quote requires 1 argument (got {1})' format: {args size}) ]. 15 | ^ args first 16 | ] 17 | 18 | { #category : #accessing } 19 | MalQuote class >> malName [ 20 | ^ 'quote' 21 | ] 22 | -------------------------------------------------------------------------------- /MakeALisp/MalReadLine.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I'm a utility class for reading lines from stdin. 3 | " 4 | Class { 5 | #name : #MalReadLine, 6 | #superclass : #Object, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #'user interaction' } 11 | MalReadLine class >> read: stdout withPrompt: prompt [ 12 | stdout << prompt. 13 | ^ (Stdio stdin upTo: Character lf asInteger) asString 14 | ] 15 | -------------------------------------------------------------------------------- /MakeALisp/MalReadString.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the read-string built-in function in MAL. 3 | " 4 | Class { 5 | #name : #MalReadString, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalReadString class >> malName [ 12 | ^ 'read-string' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalReadString >> callArg: arg withContext: ctx [ 17 | arg class = MalString 18 | ifFalse: [ ^ MalError signal: 'Expected a string' ]. 19 | ^ Mal read: arg value 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalReader.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I convert MAL source code to an AST instance of MalType. 3 | 4 | I return an OrderedCollection of forms read. 5 | 6 | To get started, use #readString: 7 | 8 | MalReader readString: '(+ 1 2)'. 9 | 10 | " 11 | Class { 12 | #name : #MalReader, 13 | #superclass : #Object, 14 | #instVars : [ 15 | 'tokens', 16 | 'index' 17 | ], 18 | #category : #MakeALisp 19 | } 20 | 21 | { #category : #parsing } 22 | MalReader class >> isClose: aString [ 23 | ^ (#(')' ']' '}') includes: aString) 24 | 25 | ] 26 | 27 | { #category : #parsing } 28 | MalReader class >> isClose: aString expected: close [ 29 | (self isClose: aString) 30 | ifFalse: [ ^ false ]. 31 | aString = close 32 | ifFalse: [ MalSyntaxError signal: 'wrong closing paren character' ]. 33 | ^ true 34 | ] 35 | 36 | { #category : #parsing } 37 | MalReader class >> readAll: aString [ 38 | "Read all the expressions in the string provided." 39 | 40 | | tokens stream result | 41 | tokens := MalTokenizer fromString: aString. 42 | stream := tokens readStream. 43 | result := OrderedCollection new. 44 | [stream atEnd] whileFalse: [ result add: (self readForm: stream) ]. 45 | ^ result 46 | ] 47 | 48 | { #category : #parsing } 49 | MalReader class >> readAtom: aStream [ 50 | "Parse a single mal type." 51 | 52 | | token firstChar | 53 | token := aStream next. 54 | token 55 | ifNil: [ MalSyntaxError signal: 'unbalanced open paren: missing ) ] or }' ]. 56 | firstChar := token first: 1. 57 | (self isClose: token) 58 | ifTrue: [ MalSyntaxError signal: 'Unexpected ) ] or }' ]. 59 | MalLiteral 60 | allSubclassesDo: [ :atom | 61 | (atom matches: token) 62 | ifTrue: [ ^ atom fromToken: token ] ]. 63 | ^ MalSymbol withValue: token 64 | ] 65 | 66 | { #category : #parsing } 67 | MalReader class >> readForm: aTokenStream [ 68 | | current readerMacros | 69 | current := aTokenStream peek. 70 | current = '(' 71 | ifTrue: [ aTokenStream next. 72 | ^ self readList: aTokenStream withClose: ')' ]. 73 | current = '[' 74 | ifTrue: [ aTokenStream next. 75 | ^ self readList: aTokenStream withClose: ']' ]. 76 | current = '{' 77 | ifTrue: [ aTokenStream next. 78 | ^ self readList: aTokenStream withClose: '}' ]. 79 | readerMacros := Dictionary 80 | with: '@' -> 'deref' 81 | with: '''' -> 'quote' 82 | with: '`' -> 'quasiquote' 83 | with: '~' -> 'unquote' 84 | with: '~@' -> 'splice-unquote' 85 | with: '^' -> 'with-meta'. 86 | readerMacros 87 | at: current 88 | ifPresent: [ :symName | 89 | aTokenStream next. 90 | symName = 'with-meta' 91 | ifTrue: [ |val meta| 92 | meta := self readForm: aTokenStream. 93 | val := self readForm: aTokenStream. 94 | ^ MalList 95 | with: (MalSymbol withValue: symName) 96 | with: val 97 | with: meta ]. 98 | ^ MalList 99 | with: (MalSymbol withValue: symName) 100 | with: (self readForm: aTokenStream) ]. 101 | ^ self readAtom: aTokenStream 102 | ] 103 | 104 | { #category : #parsing } 105 | MalReader class >> readList: aTokenStream withClose: delimiter [ 106 | | items current finished | 107 | items := OrderedCollection new. 108 | finished := false. 109 | "Always initialised, but the browser can't see that the 110 | loop is executed at least once.." 111 | current := nil. 112 | [ finished ] 113 | whileFalse: [ current := aTokenStream peek. 114 | (self isClose: current expected: delimiter) 115 | ifTrue: [ finished := true. 116 | aTokenStream next ] 117 | ifFalse: [ items add: (self readForm: aTokenStream) ] ]. 118 | (self isClose: current expected: delimiter) 119 | ifFalse: [ MalError signal: 'Unclosed ( [ or {' ]. 120 | delimiter = ']' 121 | ifTrue: [ ^ MalVector withValue: items ]. 122 | delimiter = '}' 123 | ifTrue: [ ^ MalHashMap withItems: items ]. 124 | ^ MalList withValue: items 125 | ] 126 | 127 | { #category : #parsing } 128 | MalReader class >> readString: aString [ 129 | "Lex and parse a string of MAL source code." 130 | 131 | | tokens stream | 132 | tokens := MalTokenizer fromString: aString. 133 | stream := tokens readStream. 134 | ^ self readForm: stream 135 | ] 136 | -------------------------------------------------------------------------------- /MakeALisp/MalReadlineFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the readline function. 3 | " 4 | Class { 5 | #name : #MalReadlineFunction, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalReadlineFunction class >> malName [ 12 | ^ 'readline' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalReadlineFunction >> callArg: arg withContext: ctx [ 17 | self ensure: arg hasType: MalString. 18 | ^ MalString withValue: (MalReadLine read: ctx stdout withPrompt: arg value) 19 | ] 20 | -------------------------------------------------------------------------------- /MakeALisp/MalReset.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the reset! function in MAL. 3 | " 4 | Class { 5 | #name : #MalReset, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalReset class >> malName [ 12 | ^ 'reset!' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalReset >> call: args withContext: ctx [ 17 | | atom | 18 | self ensure: args haveArity: 2. 19 | atom := args first. 20 | atom class = MalAtom 21 | ifFalse: [ MalError signal: 'first argument to reset! must be an atom' ]. 22 | atom value: args second. 23 | ^ args second 24 | ] 25 | -------------------------------------------------------------------------------- /MakeALisp/MalRest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the rest function. 3 | " 4 | Class { 5 | #name : #MalRest, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalRest class >> malName [ 12 | ^ 'rest' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalRest >> callArg: arg withContext: ctx [ 17 | arg class = MalNil ifTrue: [ ^ MalList new ]. 18 | arg isIterable 19 | ifFalse: [ ^ MalNil new ]. 20 | ^ MalList withValue: arg value allButFirst 21 | ] 22 | -------------------------------------------------------------------------------- /MakeALisp/MalSeq.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the seq function. 3 | " 4 | Class { 5 | #name : #MalSeq, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalSeq class >> malName [ 12 | ^ 'seq' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalSeq >> callArg: arg withContext: ctx [ 17 | arg isPair 18 | ifTrue: [ ^ MalList withValue: arg value ]. 19 | arg class = MalString & (arg value = '') 20 | ifTrue: [ ^ MalNil new ]. 21 | arg class = MalString 22 | ifTrue: [ ^ MalList 23 | withValue: 24 | (arg value 25 | collect: [ :c | MalString withValue: c asString ] 26 | into: OrderedCollection new) ]. 27 | ^ MalNil new 28 | ] 29 | -------------------------------------------------------------------------------- /MakeALisp/MalSequentialPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the sequential? function. 3 | " 4 | Class { 5 | #name : #MalSequentialPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalSequentialPredicate class >> malName [ 12 | ^ 'sequential?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalSequentialPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: arg isIterable 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalSlurp.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the slurp built-in function in MAL. 3 | " 4 | Class { 5 | #name : #MalSlurp, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalSlurp class >> malName [ 12 | ^ 'slurp' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalSlurp >> callArg: arg withContext: ctx [ 17 | arg class = MalString 18 | ifFalse: [ ^ MalError signal: 'Expected a string' ]. 19 | ^ MalString withValue: (arg value asFileReference readStream upToEnd) 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalSpecialForm.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent special forms in MAL. 3 | 4 | Special forms choose whether to evaluate their arguments, and cannot be shadowed by variables. 5 | " 6 | Class { 7 | #name : #MalSpecialForm, 8 | #superclass : #Object, 9 | #instVars : [ 10 | 'value' 11 | ], 12 | #category : #MakeALisp 13 | } 14 | 15 | { #category : #evaluating } 16 | MalSpecialForm class >> call: args withContext: ctx [ 17 | self subclassResponsibility 18 | ] 19 | 20 | { #category : #accessing } 21 | MalSpecialForm class >> malName [ 22 | self subclassResponsibility 23 | ] 24 | 25 | { #category : #accessing } 26 | MalSpecialForm class >> matchesSymbol: aSymbol [ 27 | self 28 | subclassesDo: [ :f | 29 | f malName = aSymbol value 30 | ifTrue: [ ^ f ] ]. 31 | ^ nil 32 | ] 33 | -------------------------------------------------------------------------------- /MakeALisp/MalStep.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am the base class for all Mal command line handlers. I write a prompt, read input from the user, then dispatch. 3 | " 4 | Class { 5 | #name : #MalStep, 6 | #superclass : #CommandLineHandler, 7 | #instVars : [ 8 | 'ctx' 9 | ], 10 | #category : #MakeALisp 11 | } 12 | 13 | { #category : #accessing } 14 | MalStep class >> commandName [ 15 | ^ '' 16 | ] 17 | 18 | { #category : #activation } 19 | MalStep >> activate [ 20 | ctx setArgv: (self commandLine ). 21 | [ self activateUnchecked ] 22 | on: Error 23 | do: [ self stdout 24 | << thisContext longStack; 25 | lf. 26 | self exitFailure ] 27 | ] 28 | 29 | { #category : #activation } 30 | MalStep >> activateUnchecked [ 31 | | input | 32 | input := self readInputLine . 33 | [ input isEmptyOrNil ] 34 | whileFalse: [ self stdout 35 | << (self rep: input) asString; 36 | lf. 37 | input := self readInputLine ]. 38 | self stdout lf. 39 | self exitSuccess 40 | ] 41 | 42 | { #category : #activation } 43 | MalStep >> evalFile: path [ 44 | | input fileRef source | 45 | fileRef := path asFileReference. 46 | fileRef exists 47 | ifFalse: [ self stdout 48 | << 'No such file'; 49 | lf. 50 | ^ self exitFailure ]. 51 | fileRef isFile ifFalse: [ self stdout 52 | << 'Not a file'; 53 | lf. ]. 54 | source := fileRef readStream upToEnd. 55 | self exitSuccess 56 | ] 57 | 58 | { #category : #initialization } 59 | MalStep >> initialize [ 60 | super initialize. 61 | ctx := MalContext default 62 | stdout: self stdout; 63 | yourself. 64 | 65 | ] 66 | 67 | { #category : #activation } 68 | MalStep >> readInputLine [ 69 | ^ MalReadLine read: self stdout withPrompt: 'user> ' 70 | ] 71 | 72 | { #category : #activation } 73 | MalStep >> rep: aString [ 74 | ^ [ Mal rep: aString in: ctx ] 75 | on: MalError 76 | do: [ :ex | ex messageText ] 77 | ] 78 | -------------------------------------------------------------------------------- /MakeALisp/MalStep0.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am the simplest Mal REPL, simply echoing my input to the user. 3 | " 4 | Class { 5 | #name : #MalStep0, 6 | #superclass : #MalStep, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalStep0 class >> commandName [ 12 | ^ 'step0_mal' 13 | ] 14 | 15 | { #category : #activation } 16 | MalStep0 >> rep: aString [ 17 | ^ aString 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalStep1.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a simple Mal REPL, parsing then printing my input. 3 | " 4 | Class { 5 | #name : #MalStep1, 6 | #superclass : #MalStep, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalStep1 class >> commandName [ 12 | ^ 'step1_mal' 13 | ] 14 | 15 | { #category : #activation } 16 | MalStep1 >> rep: aString [ 17 | ^ [Mal print: (Mal read: aString)] on: MalError do: [ :ex | ex messageText ] 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalStep2.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a CLI interface for executing Mal expressions. 3 | 4 | You can use me as follows: 5 | 6 | $ echo '(+ 1 2)' | ~/Pharo/vms/70-x64/pharo -headless ~/Pharo/images/WMal/WMal.image wmal 2>/dev/null 7 | " 8 | Class { 9 | #name : #MalStep2, 10 | #superclass : #MalStep, 11 | #classInstVars : [ 12 | 'env' 13 | ], 14 | #category : #MakeALisp 15 | } 16 | 17 | { #category : #accessing } 18 | MalStep2 class >> commandName [ 19 | ^ 'step2_mal' 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalStep3.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a CLI interface for executing Mal expressions, supporting binding of variables. 3 | 4 | You can use me as follows: 5 | 6 | $ echo '(+ 1 2)' | ~/Pharo/vms/70-x64/pharo -headless ~/Pharo/images/WMal/WMal.image step3_mal 2>/dev/null 7 | " 8 | Class { 9 | #name : #MalStep3, 10 | #superclass : #MalStep, 11 | #classInstVars : [ 12 | 'env' 13 | ], 14 | #category : #MakeALisp 15 | } 16 | 17 | { #category : #accessing } 18 | MalStep3 class >> commandName [ 19 | ^ 'step3_mal' 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalStep4.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a CLI interface for executing Mal expressions, supporting binding of variables. 3 | 4 | You can use me as follows: 5 | 6 | $ echo '(+ 1 2)' | ~/Pharo/vms/70-x64/pharo -headless ~/Pharo/images/WMal/WMal.image step4_mal 2>/dev/null 7 | " 8 | Class { 9 | #name : #MalStep4, 10 | #superclass : #MalStep, 11 | #classInstVars : [ 12 | 'env' 13 | ], 14 | #category : #MakeALisp 15 | } 16 | 17 | { #category : #accessing } 18 | MalStep4 class >> commandName [ 19 | ^ 'step4_mal' 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalStep5.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a CLI interface for executing Mal expressions. 3 | 4 | You can use me as follows: 5 | 6 | $ echo '(+ 1 2)' | ~/Pharo/vms/70-x64/pharo -headless ~/Pharo/images/WMal/WMal.image step5_mal 2>/dev/null 7 | " 8 | Class { 9 | #name : #MalStep5, 10 | #superclass : #MalStep, 11 | #classInstVars : [ 12 | 'env' 13 | ], 14 | #category : #MakeALisp 15 | } 16 | 17 | { #category : #accessing } 18 | MalStep5 class >> commandName [ 19 | ^ 'step5_mal' 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalStep6.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a CLI interface for executing Mal expressions. 3 | 4 | You can use me as follows: 5 | 6 | $ echo '(+ 1 2)' | ~/Pharo/vms/70-x64/pharo -headless ~/Pharo/images/WMal/WMal.image step6_mal 2>/dev/null 7 | " 8 | Class { 9 | #name : #MalStep6, 10 | #superclass : #MalStep, 11 | #classInstVars : [ 12 | 'env' 13 | ], 14 | #category : #MakeALisp 15 | } 16 | 17 | { #category : #accessing } 18 | MalStep6 class >> commandName [ 19 | ^ 'step6_mal' 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalStep7.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a CLI interface for executing Mal expressions. 3 | 4 | You can use me as follows: 5 | 6 | Interactively: 7 | 8 | $ ~/Pharo/vms/70-x64/pharo -headless ~/Pharo/images/WMal/WMal.image step7_mal 2>/dev/null 9 | 10 | One-off execution: 11 | 12 | $ echo '(+ 1 2)' | ~/Pharo/vms/70-x64/pharo -headless ~/Pharo/images/WMal/WMal.image step7_mal 2>/dev/null 13 | 14 | If you encounter a bug and want to use Pharo's debugger: 15 | 16 | $ echo '(+ 1 2)' |~/Pharo/vms/70-x64/pharo ~/Pharo/images/WMal/WMal.image step7_mal 17 | " 18 | Class { 19 | #name : #MalStep7, 20 | #superclass : #MalStep, 21 | #classInstVars : [ 22 | 'env' 23 | ], 24 | #category : #MakeALisp 25 | } 26 | 27 | { #category : #accessing } 28 | MalStep7 class >> commandName [ 29 | ^ 'step7_mal' 30 | ] 31 | -------------------------------------------------------------------------------- /MakeALisp/MalStr.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the str built-in function in MAL. 3 | " 4 | Class { 5 | #name : #MalStr, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalStr class >> malName [ 12 | ^ 'str' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalStr >> call: args withContext: ctx [ 17 | | stringArgs | 18 | stringArgs := args collect: #asString. 19 | ^ MalString withValue: ('' join: stringArgs) 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalString.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent string values in MAL. 3 | " 4 | Class { 5 | #name : #MalString, 6 | #superclass : #MalType, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalString >> asReadableString [ 12 | | inner | 13 | inner := self value copyReplaceAll: '\' with: '\\'. 14 | inner := inner copyReplaceAll: Character lf asString with: '\n'. 15 | inner := inner copyReplaceAll: Character cr asString with: '\r'. 16 | inner := inner copyReplaceAll: '"' with: '\"'. 17 | ^ '"' , inner , '"' 18 | ] 19 | 20 | { #category : #converting } 21 | MalString >> asString [ 22 | ^ value 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalStringLiteral.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I convert strings '""foo""' into MAL strings. 3 | " 4 | Class { 5 | #name : #MalStringLiteral, 6 | #superclass : #MalLiteral, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #testing } 11 | MalStringLiteral class >> fromToken: token [ 12 | ^ MalString withValue: (self stringContents: token) 13 | ] 14 | 15 | { #category : #testing } 16 | MalStringLiteral class >> matches: aString [ 17 | ^ aString first = $" 18 | ] 19 | 20 | { #category : #testing } 21 | MalStringLiteral class >> stringContents: token [ 22 | | chars isEscape | 23 | "Remove the double quotes and unescape a string literal." 24 | token = '"' 25 | ifTrue: [ MalError signal: 'unbalanced string literal (missing closing ")' ]. 26 | isEscape := false. 27 | chars := OrderedCollection new. 28 | token allButFirst allButLast 29 | do: [ :char | 30 | isEscape 31 | ifTrue: [ chars add: (self unescapeChar: char). 32 | isEscape := false ] 33 | ifFalse: [ char = $\ 34 | ifTrue: [ isEscape := true ] 35 | ifFalse: [ chars add: char ] ] ]. 36 | ^ '' join: chars 37 | ] 38 | 39 | { #category : #testing } 40 | MalStringLiteral class >> unescapeChar: char [ 41 | | escapeChars | 42 | "Converts 'n' from '\n' to a newline and so on." 43 | escapeChars := Dictionary 44 | with: $n -> Character lf 45 | with: $r -> Character cr. 46 | ^ escapeChars at: char ifAbsent: char 47 | ] 48 | -------------------------------------------------------------------------------- /MakeALisp/MalStringPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the string? function. 3 | " 4 | Class { 5 | #name : #MalStringPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalStringPredicate class >> malName [ 12 | ^ 'string?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalStringPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: arg class = MalString 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalSubtract.class.st: -------------------------------------------------------------------------------- 1 | " 2 | The built-in function - in MAL. 3 | " 4 | Class { 5 | #name : #MalSubtract, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalSubtract class >> malName [ 12 | ^ '-' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalSubtract >> call: args withContext: ctx [ 17 | "Subtract args." 18 | 19 | | total | 20 | self ensure: args haveType: MalInteger. 21 | args ifEmpty: [ ^ MalInteger withValue: 0 ]. 22 | args size = 1 23 | ifTrue: [ ^ MalInteger withValue: args first value negated ]. 24 | total := args first value. 25 | args allButFirst do: [ :arg | total := total - arg value ]. 26 | ^ MalInteger withValue: total 27 | ] 28 | -------------------------------------------------------------------------------- /MakeALisp/MalSwap.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the swap! function in MAL. 3 | " 4 | Class { 5 | #name : #MalSwap, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalSwap class >> malName [ 12 | ^ 'swap!' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalSwap >> call: args withContext: ctx [ 17 | | atom func funcArgs newValue | 18 | self ensure: args haveMinArity: 2. 19 | atom := args first. 20 | atom class = MalAtom 21 | ifFalse: [ MalError signal: 'first argument to swap! must be an atom' ]. 22 | func := args second. 23 | func isCallable 24 | ifFalse: [ MalError signal: 'second argument to swap! must be a function' ]. 25 | funcArgs := OrderedCollection with: atom value. 26 | funcArgs addAll: (args allButFirst: 2). 27 | newValue := func call: funcArgs withContext: ctx. 28 | atom value: newValue. 29 | ^ newValue 30 | ] 31 | -------------------------------------------------------------------------------- /MakeALisp/MalSymbol.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent symbols in MAL. 3 | 4 | I use Smalltalk strings to represent a MAL symbol rather than Smalltalk symbols. This is 5 | to avoid issues with MAL symbols that aren't valid Smalltalk symbols. 6 | 7 | Two symbols are equal if they have the same string value. 8 | " 9 | Class { 10 | #name : #MalSymbol, 11 | #superclass : #MalType, 12 | #category : #MakeALisp 13 | } 14 | 15 | { #category : #'initialize-release' } 16 | MalSymbol class >> withValue: aString [ 17 | | instance | 18 | instance := self new. 19 | ^instance value: aString. 20 | 21 | ] 22 | 23 | { #category : #accessing } 24 | MalSymbol >> asReadableString [ 25 | ^ value 26 | ] 27 | 28 | { #category : #accessing } 29 | MalSymbol >> evalIn: ctx [ 30 | ctx env 31 | at: self value 32 | ifPresent: [ :currentValue | ^ currentValue ] 33 | ifAbsent: 34 | [ MalUnboundSymbol signal: '''' , self value , ''' not found' ] 35 | ] 36 | -------------------------------------------------------------------------------- /MakeALisp/MalSymbolFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the symbol function. 3 | " 4 | Class { 5 | #name : #MalSymbolFunction, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalSymbolFunction class >> malName [ 12 | ^ 'symbol' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalSymbolFunction >> callArg: arg withContext: ctx [ 17 | arg class = MalString 18 | ifFalse: [ MalError signal: 'symbol requires a string argument' ]. 19 | ^ MalSymbol withValue: arg value 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalSymbolPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the symbol? function. 3 | " 4 | Class { 5 | #name : #MalSymbolPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalSymbolPredicate class >> malName [ 12 | ^ 'symbol?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalSymbolPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: arg class = MalSymbol 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalSyntaxError.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent syntax errors in MAL. 3 | " 4 | Class { 5 | #name : #MalSyntaxError, 6 | #superclass : #MalError, 7 | #category : #MakeALisp 8 | } 9 | -------------------------------------------------------------------------------- /MakeALisp/MalThrow.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the built-in throw function. 3 | " 4 | Class { 5 | #name : #MalThrow, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalThrow class >> malName [ 12 | ^ 'throw' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalThrow >> callArg: arg withContext: ctx [ 17 | MalError signal: 'Exception: ' , arg asReadableString withTag: arg 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalTimeMs.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the time-ms function. 3 | " 4 | Class { 5 | #name : #MalTimeMs, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalTimeMs class >> malName [ 12 | ^ 'time-ms' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalTimeMs >> call: args withContext: ctx [ 17 | | now milliseconds | 18 | self ensure: args haveArity: 0. 19 | now := DateAndTime now asUTC. 20 | milliseconds := (now second * 1000) + (now nanoSecond // 1000000). 21 | ^ MalInteger withValue: milliseconds 22 | 23 | ] 24 | -------------------------------------------------------------------------------- /MakeALisp/MalTokenizer.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I parse MAL tokens from a string. 3 | " 4 | Class { 5 | #name : #MalTokenizer, 6 | #superclass : #Object, 7 | #classVars : [ 8 | 'TokenPattern' 9 | ], 10 | #category : #MakeALisp 11 | } 12 | 13 | { #category : #'instance creation' } 14 | MalTokenizer class >> fromString: aString [ 15 | "Return a collection of all the tokens in our string." 16 | 17 | | pattern matcher result | 18 | "This isn't exactly the same as the MAL docs. 19 | We are forced to treat [ and ] separately due to syntax limitations 20 | in the regex engine (a range cannot contain [, see 21 | https://stackoverflow.com/questions/45824000/) and 22 | we ban carriage return/line feeds in comments." 23 | pattern := '[\s,]*(~@|\[|\]|[{}()''`~^@]|"(\\.|[^\\"])*"|;[^' 24 | , Character cr asString , Character lf asString 25 | , ']*|"|([^]\s{}(''"`,;)])*)'. 26 | matcher := RxMatcher forString: pattern. 27 | result := matcher 28 | matchesOnStream: aString readStream 29 | collect: [ :s | matcher subexpression: 2 ]. 30 | ^ result reject: [ :str | str isEmpty or: [ str first = $; ] ] 31 | ] 32 | -------------------------------------------------------------------------------- /MakeALisp/MalTruePredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the true? function. 3 | " 4 | Class { 5 | #name : #MalTruePredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalTruePredicate class >> malName [ 12 | ^ 'true?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalTruePredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: (arg = (MalBool withValue: true)) 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalTry.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the try* special form. 3 | " 4 | Class { 5 | #name : #MalTry, 6 | #superclass : #MalSpecialForm, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #evaluating } 11 | MalTry class >> call: args withContext: ctx [ 12 | | catchExpr | 13 | args isEmpty 14 | ifTrue: [ MalError signal: 'try* requires at least one argument' ]. 15 | catchExpr := nil. 16 | args size = 2 17 | ifTrue: [ catchExpr := args second ]. 18 | catchExpr ifNil: [ ^ args first evalIn: ctx ]. 19 | ^ [ args first evalIn: ctx ] 20 | on: MalError 21 | do: [ :ex | self evalCatch: catchExpr withException: ex andContext: ctx ] 22 | ] 23 | 24 | { #category : #accessing } 25 | MalTry class >> evalCatch: expr withException: ex andContext: ctx [ 26 | "Evaluate a (catch* exc ...) expression." 27 | 28 | | excValue newEnv newCtx excSym | 29 | expr isPair 30 | ifFalse: [ MalError signal: 'catch* expression must be a non-empty list' ]. 31 | expr value first = (MalSymbol withValue: 'catch*') 32 | ifFalse: [ MalError signal: 'catch* expression must start with catch*' ]. 33 | expr size = 3 34 | ifFalse: [ MalError 35 | signal: 'catch* expression is wrong size: should be catch*, sym, expr' ]. 36 | excSym := expr value second. 37 | excSym class = MalSymbol 38 | ifFalse: [ MalError signal: 'catch* requires a symbol to bind the exception' ]. 39 | "Use the value passed to throw, or the error text for built-in errors." 40 | excValue := (ex tag isKindOf: MalType) 41 | ifTrue: [ ex tag ] 42 | ifFalse: [ MalString withValue: ex messageText ]. 43 | newEnv := MalEnv withOuter: ctx env. 44 | newEnv at: excSym put: excValue. 45 | newCtx := ctx withEnv: newEnv. 46 | ^ expr value third evalIn: newCtx 47 | ] 48 | 49 | { #category : #accessing } 50 | MalTry class >> malName [ 51 | ^ 'try*' 52 | ] 53 | -------------------------------------------------------------------------------- /MakeALisp/MalType.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am the base class for all MAL types. Every type wraps an instance variable 'value', 3 | and knows how to print and evaluate. 4 | " 5 | Class { 6 | #name : #MalType, 7 | #superclass : #Object, 8 | #instVars : [ 9 | 'value', 10 | 'meta' 11 | ], 12 | #category : #MakeALisp 13 | } 14 | 15 | { #category : #initialization } 16 | MalType class >> withValue: aDictionary [ 17 | | instance | 18 | instance := self new. 19 | instance value: aDictionary. 20 | ^ instance 21 | ] 22 | 23 | { #category : #comparing } 24 | MalType >> = anObject [ 25 | (anObject isKindOf: MalType ) ifFalse: [ ^ false ]. 26 | (self isIterable & anObject isIterable) ifTrue: [^ value = anObject value]. 27 | self class = anObject class ifFalse: [ ^ false ]. 28 | ^ value = anObject value 29 | ] 30 | 31 | { #category : #accessing } 32 | MalType >> asReadableString [ 33 | self subclassResponsibility 34 | ] 35 | 36 | { #category : #converting } 37 | MalType >> asString [ 38 | ^ self asReadableString 39 | ] 40 | 41 | { #category : #evaluating } 42 | MalType >> call: args withContext: ctx [ 43 | "Try to call this value as a function." 44 | 45 | MalNotCallable signal: 'Not a function: ' , self asReadableString 46 | ] 47 | 48 | { #category : #accessing } 49 | MalType >> evalIn: ctx [ 50 | "Default behaviour is that types evaluate to themselves." 51 | 52 | ^ self 53 | ] 54 | 55 | { #category : #comparing } 56 | MalType >> hash [ 57 | ^ self value hash 58 | ] 59 | 60 | { #category : #accessing } 61 | MalType >> isCallable [ 62 | ^ false 63 | ] 64 | 65 | { #category : #accessing } 66 | MalType >> isIterable [ 67 | ^ false 68 | ] 69 | 70 | { #category : #accessing } 71 | MalType >> isMacro [ 72 | ^ false 73 | ] 74 | 75 | { #category : #accessing } 76 | MalType >> isPair [ 77 | ^ false 78 | ] 79 | 80 | { #category : #accessing } 81 | MalType >> isTruthy [ 82 | ^ true 83 | ] 84 | 85 | { #category : #accessing } 86 | MalType >> macroexpandAllIn: ctx [ 87 | | val previousVal | 88 | val := self. 89 | previousVal := nil. 90 | [ val ~~ previousVal ] whileTrue: [ previousVal := val. val := val macroexpandIn: ctx ]. 91 | ^ val 92 | ] 93 | 94 | { #category : #accessing } 95 | MalType >> macroexpandIn: ctx [ 96 | ^ self 97 | ] 98 | 99 | { #category : #accessing } 100 | MalType >> meta [ 101 | ^ meta 102 | ] 103 | 104 | { #category : #accessing } 105 | MalType >> meta: anObject [ 106 | meta := anObject 107 | ] 108 | 109 | { #category : #printing } 110 | MalType >> printOn: aStream [ 111 | super printOn: aStream. 112 | aStream 113 | nextPutAll: '('; 114 | nextPutAll: value printString ; 115 | nextPutAll: ')' 116 | ] 117 | 118 | { #category : #accessing } 119 | MalType >> value [ 120 | ^ value 121 | ] 122 | 123 | { #category : #accessing } 124 | MalType >> value: aSmalltalkValue [ 125 | value := aSmalltalkValue. 126 | ] 127 | -------------------------------------------------------------------------------- /MakeALisp/MalUnboundSymbol.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Error raised when we attempt to evaluate a MAL symbol that isn't defined. 3 | " 4 | Class { 5 | #name : #MalUnboundSymbol, 6 | #superclass : #MalError, 7 | #category : #MakeALisp 8 | } 9 | -------------------------------------------------------------------------------- /MakeALisp/MalVals.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the vals function. 3 | " 4 | Class { 5 | #name : #MalVals, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalVals class >> malName [ 12 | ^ 'vals' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalVals >> callArg: arg withContext: ctx [ 17 | arg class = MalHashMap 18 | ifFalse: [ MalError signal: 'vals requires a hash map argument' ]. 19 | ^ MalList withValue: (OrderedCollection newFrom: arg value values) 20 | ] 21 | -------------------------------------------------------------------------------- /MakeALisp/MalVector.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent vectors [ 1 2 3 ] in MAL. 3 | " 4 | Class { 5 | #name : #MalVector, 6 | #superclass : #MalType, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #'as yet unclassified' } 11 | MalVector >> allButFirst [ 12 | ^ self class withValue: (self value allButFirst: 1) 13 | ] 14 | 15 | { #category : #accessing } 16 | MalVector >> asReadableString [ 17 | | inner | 18 | inner := ' ' join: (value collect: #asReadableString). 19 | ^ '[' , inner , ']' 20 | ] 21 | 22 | { #category : #accessing } 23 | MalVector >> asString [ 24 | | inner | 25 | inner := ' ' join: (value collect: #asString). 26 | ^ '[' , inner , ']' 27 | ] 28 | 29 | { #category : #accessing } 30 | MalVector >> evalIn: ctx [ 31 | "A vector evaluates all its elements." 32 | ^ MalVector 33 | withValue: (self value collect: [ :item | item evalIn: ctx ]) 34 | ] 35 | 36 | { #category : #accessing } 37 | MalVector >> initialize [ 38 | value := OrderedCollection new 39 | ] 40 | 41 | { #category : #accessing } 42 | MalVector >> isIterable [ 43 | ^ true 44 | ] 45 | 46 | { #category : #accessing } 47 | MalVector >> isPair [ 48 | ^ self value isNotEmpty 49 | ] 50 | 51 | { #category : #accessing } 52 | MalVector >> size [ 53 | ^ value size 54 | ] 55 | -------------------------------------------------------------------------------- /MakeALisp/MalVectorFunction.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the vector function. 3 | " 4 | Class { 5 | #name : #MalVectorFunction, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalVectorFunction class >> malName [ 12 | ^ 'vector' 13 | ] 14 | 15 | { #category : #accessing } 16 | MalVectorFunction >> call: args withContext: ctx [ 17 | ^ MalVector withValue: args 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalVectorPredicate.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the vector? function. 3 | " 4 | Class { 5 | #name : #MalVectorPredicate, 6 | #superclass : #MalFunctionOneArg, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalVectorPredicate class >> malName [ 12 | ^ 'vector?' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalVectorPredicate >> callArg: arg withContext: ctx [ 17 | ^ MalBool withValue: arg class = MalVector 18 | ] 19 | -------------------------------------------------------------------------------- /MakeALisp/MalWithMeta.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the with-meta function. 3 | " 4 | Class { 5 | #name : #MalWithMeta, 6 | #superclass : #MalFunction, 7 | #category : #MakeALisp 8 | } 9 | 10 | { #category : #accessing } 11 | MalWithMeta class >> malName [ 12 | ^ 'with-meta' 13 | ] 14 | 15 | { #category : #evaluating } 16 | MalWithMeta >> call: args withContext: ctx [ 17 | | newVal | 18 | self ensure: args haveArity: 2. 19 | newVal := args first copy. 20 | newVal meta: args second. 21 | ^ newVal 22 | ] 23 | -------------------------------------------------------------------------------- /MakeALisp/MalWrongArity.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Error when calling functions with the wrong number of arguments. 3 | " 4 | Class { 5 | #name : #MalWrongArity, 6 | #superclass : #MalError, 7 | #category : #MakeALisp 8 | } 9 | -------------------------------------------------------------------------------- /MakeALisp/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #MakeALisp } 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Make A Lisp 2 | 3 | An implementation of [MAL](https://github.com/kanaka/mal) using [Pharo 4 | Smalltalk](http://pharo.org/). 5 | 6 | This implementation is almost complete, and passes the self-hosting 7 | MAL test suite. 8 | 9 | ## Code Organisation 10 | 11 | ### Tests 12 | 13 | This implementation includes over 100 unit tests in the 14 | `MakeALisp-Tests` diretory. This is in addition to the invaluable MAL 15 | test suite. 16 | 17 | Smalltalk has brilliant TDD tooling and supports 18 | edit-and-continue-execution from the debugger, so it was often easier 19 | to start features/bugfixes with a unit test. 20 | 21 | ### Steps 22 | 23 | Most MAL implementation have a shared library of functionality, then a 24 | different step1, step2 etc file with an increasingly complex `MAL` 25 | class. 26 | 27 | Smalltalk is image oriented, so all the code is stored 28 | together. Maintaining 10 different images would be very cumbersome, so 29 | I've used the same implementation for all the steps. 30 | 31 | ### Dispatching Evaluation 32 | 33 | MAL convention is to implement evaluation using an `EVAL` function 34 | that switches on the name of special forms, and an `eval_ast` function 35 | that switches on the runtime type (symbol, list, etc). 36 | 37 | Smalltalk strongly prefers dynamic dispatch here. See the `evalIn:` 38 | method on `MalList` for evaluation logic. 39 | 40 | ### Dispatching Special Forms and Built-Ins 41 | 42 | Each special form (`if`, `let*`, etc) and built-in function (`+`, 43 | `cons`, etc) is a self-contained class. To avoid needing to register 44 | the classes elsewhere, each class implements `malName` and I use 45 | reflection to find the correct special form or function. 46 | 47 | This is from `MalSpecialForm`: 48 | 49 | ``` 50 | matchesSymbol: aSymbol 51 | self 52 | subclassesDo: [ :f | 53 | f malName = aSymbol value 54 | ifTrue: [ ^ f ] ]. 55 | ^ nil 56 | ``` 57 | 58 | ### Tail-call Optimisation 59 | 60 | Smalltalk allocates stack frames on the heap. You can't get stack 61 | overflows: if you infinitely recurse you will eventually OOM instead. 62 | 63 | Looking at the `sum2` function from `step5_tco.mal`: 64 | 65 | ``` 66 | (def! sum2 67 | (fn* (n acc) 68 | (if (= n 0) 69 | acc 70 | (sum2 (- n 1) (+ n acc))))) 71 | ``` 72 | 73 | TCO means this function uses O(1) stack, whereas this implementation 74 | uses O(N) stack. The function is still O(N) in both cases if you allow 75 | arbitrary size numbers. 76 | 77 | Smalltalk favours letting the stack grow: the built-in implementation 78 | of factorial is a simple recursive function. 79 | 80 | This implementation therefore doesn't implement TCO, but still passes 81 | the TCO tests. I think it makes the code more readable and 82 | definitely helps keep stack traces useful, but it feels like a slight 83 | cheat. 84 | 85 | ## License 86 | 87 | Licensed under MPL 2.0 (Mozilla Public License 2.0), consistent with 88 | the other MAL implementations. 89 | --------------------------------------------------------------------------------