Lexer handles more generic cases, AST-builder draft

Gemfile

@@ -2,3 +2,4 @@ source "http://rubygems.org"
 
 # Specify your gem's dependencies in schemer.gemspec
 gemspec
+gem 'parslet', :git => 'git://github.com/txus/parslet', :branch => 'improve_rspec_matcher'

Gemfile.lock

@@ -1,8 +1,15 @@
+GIT
+  remote: git://github.com/txus/parslet
+  revision: 4c7962d1cf4425674099962fb6f51c3b5b057533
+  branch: improve_rspec_matcher
+  specs:
+    parslet (1.1.1)
+      blankslate (~> 2.0)
+
 PATH
   remote: .
   specs:
     schemer (0.0.1)
-      parslet
 
 GEM
   remote: http://rubygems.org/
@@ -20,8 +27,6 @@ GEM
       rake (>= 0.8.1)
     open_gem (1.4.2)
       launchy (~> 0.3.5)
-    parslet (1.1.1)
-      blankslate (~> 2.0)
     rake (0.8.7)
     rb-fsevent (0.3.10)
     rspec (2.5.0)
@@ -40,6 +45,7 @@ PLATFORMS
 DEPENDENCIES
   guard
   guard-rspec
+  parslet!
   rb-fsevent
   rspec (~> 2.5.0)
   schemer!

examples/bintree.scm

@@ -0,0 +1,44 @@
+; Abstraction of a binary tree. Each tree is recursively defined as a list
+; with the entry (data), left subtree and right subtree. Left and right can
+; be null.
+;
+(define (entry tree) (car tree))
+(define (left-branch tree) (cadr tree))
+(define (right-branch tree) (caddr tree))
+(define (make-tree entry left right)
+    (list entry left right))
+
+(define (make-new-set)
+    '())
+
+(define (element-of-set? x set)
+    (cond
+        ((null? set) #f)
+        ((= x (entry set)) #t)
+        ((< x (entry set)) (element-of-set? x (left-branch set)))
+        ((> x (entry set)) (element-of-set? x (right-branch set)))))
+
+(define (adjoin-set x set)
+    (cond 
+        ((null? set) (make-tree x '() '()))
+        ((= x (entry set)) set)
+        ((< x (entry set))
+            (make-tree  (entry set)
+                        (adjoin-set x (left-branch set))
+                        (right-branch set)))
+        ((> x (entry set))
+            (make-tree  (entry set)
+                        (left-branch set)
+                        (adjoin-set x (right-branch set))))))
+
+
+(define myset 
+    (adjoin-set 25 
+        (adjoin-set 13 
+            (adjoin-set 72
+                (adjoin-set 4 (make-new-set))))))
+
+(write (element-of-set? 4 myset))
+(write (element-of-set? 5 myset))
+(write (element-of-set? 26 myset))
+(write (element-of-set? 25 myset))

examples/closure.scm

@@ -0,0 +1,13 @@
+(define (make-withdraw balance)
+    (lambda (amount)
+        (if (>= balance amount)
+            (begin (set! balance (- balance amount))
+                    balance)
+            'no-funds)))
+
+(define W1 (make-withdraw 100))
+(define W2 (make-withdraw 500))
+(write (W1 20))
+(write (W2 30))
+(write (W1 80))
+(write (W2 100))

examples/equality.scm

@@ -0,0 +1,13 @@
+(write (eqv? #f #t))
+(write (eqv? #f #f))
+(write (eqv? '() '()))
+(write (eqv? 5 (+ 1 4)))
+(write (eqv? 6 #f))
+
+(define zara 'zara)
+(write (eqv? zara 'zara))
+(write (eqv? 'zara 'zara))
+
+(define joe '(1 2 3))
+(write (eqv? joe '(1 2 3)))
+(write (eqv? joe joe))

examples/func.scm

@@ -0,0 +1,13 @@
+(define (map proc lst)
+    (if (null? lst)
+        '()
+        (cons (proc (car lst)) (map proc (cdr lst)))))
+
+(define (filter proc lst)
+    (cond 
+        ((null? lst) '())
+        ((proc (car lst)) (cons (car lst) (filter proc (cdr lst))))
+        (else (filter proc (cdr lst)))))
+
+(write (map (lambda (x) (* x x)) '(1 2 3 4)))
+(write (filter (lambda (x) (> x 2)) '(1 2 3 4)))

examples/let.scm

@@ -0,0 +1,5 @@
+(let ((x 2) (y 3))
+    (let ((x 7) (z 8))
+        (write (+ x z))
+        (write (+ x y)))
+    (write (+ x y)))

examples/list.scm

@@ -0,0 +1,29 @@
+(define (list-length lst)
+    (if (null? lst)
+        0
+        (+ 1 (list-length (cdr lst)))))
+
+(define (append lst1 lst2)
+    (if (null? lst1)
+        lst2
+        (cons (car lst1) (append (cdr lst1) lst2))))
+
+(define (list-reverse lst)
+    (if (null? lst)
+        '()
+        (append (list-reverse (cdr lst)) (list (car lst)) )))
+
+; Takes a list and returns a list of (cons elem elem) for each elem in the 
+; given list.
+;
+(define (pairify lst)
+    (if (null? lst)
+        '()
+        (cons 
+            (cons (car lst) (car lst)) 
+            (pairify (cdr lst)))))
+
+(write (list-length (list 1 2 3 4 5)))
+(write (append '(1 2 3 4) (list 9)))
+(write (list-reverse (list 1 2 3 4 5)))
+(write (pairify (list 1 2 3 4)))

examples/queue.scm

@@ -0,0 +1,47 @@
+; queue data structure example from SICP 3.3.2
+;
+(define (front-ptr queue) (car queue))
+(define (rear-ptr queue) (cdr queue))
+(define (set-front-ptr! queue item) (set-car! queue item))
+(define (set-rear-ptr! queue item) (set-cdr! queue item))
+
+(define (empty-queue? queue) (null? (front-ptr queue)))
+
+
+(define (make-queue) (cons '() '()))
+
+(define (front-queue queue)
+  (if (empty-queue? queue)
+      (write 'ERROR)
+      (car (front-ptr queue))))
+
+(define (insert-queue! queue item)
+  (let ((new-pair (cons item '())))
+    (cond ((empty-queue? queue)
+           (set-front-ptr! queue new-pair)
+           (set-rear-ptr! queue new-pair)
+           queue)
+          (else
+           (set-cdr! (rear-ptr queue) new-pair)
+           (set-rear-ptr! queue new-pair)
+           queue)))) 
+
+(define (delete-queue! queue)
+  (cond ((empty-queue? queue)
+         (write 'ERROR)) 
+        (else
+         (set-front-ptr! queue (cdr (front-ptr queue)))
+         queue))) 
+
+; Note: the output here will expose the internal representation of the queue
+; as a cons of the front pointer and rear pointer. The contents of the queue
+; are visible in the front pointer.
+;
+(define q (make-queue))
+(write (insert-queue! q 'a))
+(write (insert-queue! q 'b))
+(write (delete-queue! q))
+(write (insert-queue! q 'c))
+(write (insert-queue! q 'd))
+(write (delete-queue! q))
+

examples/simple_func.scm

@@ -0,0 +1,6 @@
+(define (func a b)
+  (lambda (x)
+    (+ a b x)))
+
+(write ((func 4 5) 10))
+

examples/ycombinator.scm

@@ -0,0 +1,19 @@
+; The applicative-order Y combinator
+;
+(define Y
+ (lambda (X)
+  ((lambda (procedure)
+     (X (lambda (arg) ((procedure procedure) arg))))
+   (lambda (procedure)
+     (X (lambda (arg) ((procedure procedure) arg)))))))
+
+(define F*
+ (lambda (func-arg)
+  (lambda (n)
+    (if (zero? n)
+        1
+        (* n (func-arg (- n 1)))))))
+
+(define fact (Y F*))
+(write (fact 8))
+

lib/schemer.rb

@@ -1,4 +1,6 @@
 require 'schemer/lexer'
+require 'schemer/ast'
+require 'schemer/parser'
 
 module Schemer
   # Your code goes here...

lib/schemer/ast.rb

@@ -0,0 +1,78 @@
+module Schemer
+  module AST
+
+    class CharacterLiteral
+      attr_reader :value
+
+      def initialize(character)
+        @value = character.bytes.first
+      end
+
+      def inspect
+        "#<Char::#{@value}>"
+      end
+    end
+
+    class Identifier
+      attr_reader :value
+
+      def initialize(identifier)
+        @value = identifier
+      end
+
+      def inspect
+        "#<Identifier::#{@value}>"
+      end
+    end
+
+    class Expression
+      attr_reader :proc, :args
+
+      def initialize(expression)
+        @proc = expression[:proc]
+        @args = expression[:args].empty? ? nil : expression[:args]
+      end
+
+      def inspect
+        "#<Expression @proc=#{@proc.inspect} @args=#{@args || 'nil'}>"
+      end
+    end
+
+    class AddOperator
+      def inspect
+        "#<Operator::Add>"
+      end
+    end
+    class SubtractOperator
+      def inspect
+        "#<Operator::Subtract>"
+      end
+    end
+    class MultiplyOperator
+      def inspect
+        "#<Operator::Multiply>"
+      end
+    end
+    class DivideOperator
+      def inspect
+        "#<Operator::Divide>"
+      end
+    end
+    class GtOperator
+      def inspect
+        "#<Operator::GreaterThan>"
+      end
+    end
+    class LtOperator
+      def inspect
+        "#<Operator::LowerThan>"
+      end
+    end
+    class EqualOperator
+      def inspect
+        "#<Operator::Equal>"
+      end
+    end
+
+  end
+end

lib/schemer/lexer.rb

@@ -2,12 +2,12 @@ module Schemer
   class Lexer < Parslet::Parser
     alias_method :`, :str
 
-    rule(:lparen)     { `(` }
-    rule(:rparen)     { `)` }
-
     rule(:space)      { match('\s').repeat(1) }
     rule(:space?)     { space.maybe }
 
+    rule(:lparen)     { `(` >> space? }
+    rule(:rparen)     { space? >> `)` }
+
     rule(:text)       { any.repeat }
 
     rule :single_quote_string do
@@ -21,31 +21,36 @@ class Lexer < Parslet::Parser
     rule(:string)     { single_quote_string | double_quote_string }
 
     rule(:letter)     { match('[a-zA-Z]') }
-    rule(:underscore) { `_` }
-    rule(:dash)       { `-` }
-    rule(:dot)        { `.` }
-    rule(:number)     { match('\d') }
-    rule(:numeric)    { number.repeat(1) >> (dot >> number.repeat(1)).maybe }
+    rule(:dot)       { `.` } 
+    rule(:special_symbol) { `_` | `-` | `?` }
+
+
+    rule(:integer)    { match('\d').repeat(1) }
+    rule(:float)      { integer.repeat(1) >> dot >> integer.repeat(1) }
+    rule(:numeric)    { float.as(:float) | integer.as(:integer) }
 
     rule(:character)  { `#\\` >> letter.as(:char) }
     rule(:boolean)    { `#` >> (`t` | `f`).as(:boolean) }
-    rule(:literal)    { numeric.as(:numeric) | string | character | boolean }
+    rule(:literal)    { numeric | string | character | boolean }
 
     rule(:quote)      { `'` >> list.as(:quoted_list) }
-    rule(:list)       { lparen >> (space? >> (symbol | literal | expression)).repeat(1) >> space? >> rparen }
+    rule(:vector)     { `#` >> list.as(:vector) }
+    rule(:pair)       { lparen >> arg >> space >> dot >> space >> args >> rparen }
+    rule(:list)       { lparen >> args >> rparen }
 
-    rule(:symbol)     { (letter >> (letter | underscore | dash | number).repeat(0)).as(:symbol) }
+    rule(:symbol)     { (letter >> (letter | integer | special_symbol).repeat(0)).as(:identifier) }
 
     rule(:operator)   { [`+`, `-`, `*`, `/`, `>`, `<`, `=`].inject(:|) }
 
-    rule(:arg)        { (symbol | literal | expression | quote) }
+
+    rule(:arg)        { (symbol | quote | literal | expression | pair | vector | list) }
     rule(:args)       { (arg >> space?).repeat.as(:args) }
 
     rule(:newline)    { str("\n") }
     rule(:comment)    { `;`.repeat(1,3) >> (`\n`.absnt? >> any).repeat.as(:comment) }
-    rule(:expression) { (lparen >> space? >> (symbol | operator | expression).as(:proc) >> (space? >> args).maybe >> space? >> rparen).as(:expression) }
+    rule(:expression) { (lparen >> (symbol | operator.as(:operator) | expression).as(:proc) >> (space? >> args).maybe >> rparen).as(:expression) }
 
-    rule(:body)       { (quote | expression | comment | space).repeat }
+    rule(:body)       { (quote | expression | comment | space).repeat(0) }
     root :body
 
   end