gst/types.st

   1 Object subclass: MALObject [
   2     | type value meta |
   3
   4     type [ ^type ]
   5     value [ ^value ]
   6     meta [ ^meta ]
   7
   8     value: aValue [
   9         value := aValue.
  10     ]
  11
  12     meta: aMeta [
  13         meta := aMeta.
  14     ]
  15
  16     MALObject class >> new: type value: value meta: meta [
  17         | object |
  18         object := super new.
  19         object init: type value: value meta: meta.
  20         ^object
  21     ]
  22
  23     init: aType value: aValue meta: aMeta [
  24         type := aType.
  25         value := aValue.
  26         meta := aMeta.
  27     ]
  28
  29     withMeta: meta [
  30         | object |
  31         object := self deepCopy.
  32         object meta: meta.
  33         ^object
  34     ]
  35
  36     isPair [
  37         ^(self type = #list or: [ self type = #vector ]) and:
  38             [ self value notEmpty ]
  39     ]
  40
  41     printOn: stream [
  42         stream nextPutAll: '<';
  43             nextPutAll: self class printString;
  44             nextPutAll: ': ';
  45             nextPutAll: value printString.
  46         meta notNil ifTrue: [
  47             stream nextPutAll: ' | '
  48                 nextPutAll: meta printString.
  49         ].
  50         stream nextPutAll: '>'.
  51     ]
  52
  53     = x [
  54         self type ~= x type ifTrue: [ ^false ].
  55         ^self value = x value
  56     ]
  57
  58     hash [
  59         ^self value hash
  60     ]
  61 ]
  62
  63 MALObject subclass: MALTrue [
  64     MALTrue class >> new [
  65         ^super new: #true value: true meta: nil.
  66     ]
  67 ]
  68
  69 MALObject subclass: MALFalse [
  70     MALFalse class >> new [
  71         ^super new: #false value: false meta: nil.
  72     ]
  73 ]
  74
  75 MALObject subclass: MALNil [
  76     MALNil class >> new [
  77         ^super new: #nil value: nil meta: nil.
  78     ]
  79 ]
  80
  81 MALObject class extend [
  82     True := MALTrue new.
  83     False := MALFalse new.
  84     Nil := MALNil new.
  85
  86     True [ ^True ]
  87     False [ ^False ]
  88     Nil [ ^Nil ]
  89 ]
  90
  91 MALObject subclass: MALNumber [
  92     MALNumber class >> new: value [
  93         ^super new: #number value: value meta: nil.
  94     ]
  95 ]
  96
  97 MALObject subclass: MALString [
  98     MALString class >> new: value [
  99         ^super new: #string value: value meta: nil.
 100     ]
 101 ]
 102
 103 MALObject subclass: MALSymbol [
 104     MALSymbol class >> new: value [
 105         ^super new: #symbol value: value meta: nil.
 106     ]
 107 ]
 108
 109 MALObject subclass: MALKeyword [
 110     MALKeyword class >> new: value [
 111         ^super new: #keyword value: value meta: nil.
 112     ]
 113 ]
 114
 115 MALObject subclass: MALList [
 116     MALList class >> new: value [
 117         ^super new: #list value: value meta: nil.
 118     ]
 119
 120     = x [
 121         (x type ~= #list and: [ x type ~= #vector ]) ifTrue: [ ^false ].
 122         ^self value = x value
 123     ]
 124 ]
 125
 126 MALObject subclass: MALVector [
 127     MALVector class >> new: value [
 128         ^super new: #vector value: value meta: nil.
 129     ]
 130
 131     = x [
 132         (x type ~= #vector and: [ x type ~= #list ]) ifTrue: [ ^false ].
 133         ^self value = x value
 134     ]
 135 ]
 136
 137 MALObject subclass: MALMap [
 138     MALMap class >> new: value [
 139         ^super new: #map value: value meta: nil.
 140     ]
 141 ]
 142
 143 MALObject subclass: MALAtom [
 144     MALAtom class >> new: value [
 145         ^super new: #atom value: value meta: nil.
 146     ]
 147 ]
 148
 149 MALObject subclass: Fn [
 150     | fn |
 151
 152     fn [ ^fn ]
 153
 154     Fn class >> new: fn [
 155         | f |
 156         f := super new: #fn value: fn meta: nil.
 157         f init: fn.
 158         ^f
 159     ]
 160
 161     init: f [
 162         fn := f.
 163     ]
 164 ]
 165
 166 Error subclass: MALError [
 167     description [ ^'A MAL-related error' ]
 168     isResumable [ ^true ]
 169
 170     data [ ^self messageText ]
 171 ]
 172
 173 MALError subclass: MALUnterminatedSequence [
 174     MALUnterminatedSequence class >> new [ ^super new ]
 175
 176     messageText [ ^'expected ''', self basicMessageText, ''', got EOF' ]
 177 ]
 178
 179 MALError subclass: MALUnexpectedToken [
 180     MALUnexpectedToken class >> new [ ^super new ]
 181
 182     messageText [ ^'unexpected token: ''', self basicMessageText, '''']
 183 ]
 184
 185 MALError subclass: MALEmptyInput [
 186     MALEmptyInput class >> new [ ^super new ]
 187
 188     messageText [ ^'Empty input' ]
 189 ]
 190
 191 MALError subclass: MALUnknownSymbol [
 192     MALUnknownSymbol class >> new [ ^super new ]
 193
 194     messageText [ ^'''', self basicMessageText, ''' not found']
 195 ]
 196
 197 MALError subclass: MALOutOfBounds [
 198     MALOutOfBounds class >> new [ ^super new ]
 199
 200     messageText [ ^'Out of bounds' ]
 201 ]
 202
 203 MALError subclass: MALCustomError [
 204     MALCustomError class >> new [ ^super new ]
 205
 206     messageText [ ^Printer prStr: self basicMessageText printReadably: true ]
 207     data [ ^self basicMessageText ]
 208 ]