Permalink
Browse files

Lexer handles more generic cases, AST-builder draft

  • Loading branch information...
1 parent 3e9586d commit ce2a689eb74a691cd03f426f03a83bf9c02b1c29 @txus committed Feb 20, 2011
View
@@ -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'
View
@@ -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!
View
@@ -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))
View
@@ -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))
View
@@ -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))
View
@@ -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)))
View
@@ -0,0 +1,5 @@
+(let ((x 2) (y 3))
+ (let ((x 7) (z 8))
+ (write (+ x z))
+ (write (+ x y)))
+ (write (+ x y)))
View
@@ -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)))
View
@@ -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))
+
@@ -0,0 +1,6 @@
+(define (func a b)
+ (lambda (x)
+ (+ a b x)))
+
+(write ((func 4 5) 10))
+
@@ -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))
+
View
@@ -1,4 +1,6 @@
require 'schemer/lexer'
+require 'schemer/ast'
+require 'schemer/parser'
module Schemer
# Your code goes here...
View
@@ -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
View
@@ -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
Oops, something went wrong. Retry.

0 comments on commit ce2a689

Please sign in to comment.