Skip to content

Commit

Permalink
Add support for '(and or not)
Browse files Browse the repository at this point in the history
  • Loading branch information
Oskar Wickström committed Nov 29, 2015
1 parent 56f03ac commit 3bfcb33
Show file tree
Hide file tree
Showing 3 changed files with 87 additions and 24 deletions.
9 changes: 9 additions & 0 deletions experiments/working/src/logic/main.oden
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
(pkg logic/main)

(import fmt)

(define (main)
(fmt.Println
(if (or (not (and true false)) false)
"yey"
"ney")))
57 changes: 34 additions & 23 deletions odenc/go-backend.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@
[(? symbol? t) t]))

(define (infix-operator? op)
(member op '(+ - * / % == != < > <= >=)))
(member op '(+ - * / % == != < > <= >= and or)))

(define (codegen-return typed-expr)
(match typed-expr
Expand All @@ -41,6 +41,12 @@
[te (format "return ~a\n"
(codegen-expr te))]))

(define (translate-infix-operator op)
(match op
['and "&&"]
['or "||"]
[_ (symbol->string op)]))

(define (codegen-expr typed-expr)
(match typed-expr
[(? number? x) (~a x)]
Expand All @@ -50,17 +56,12 @@
['unit ""]
[(? symbol? s) (translate-identifier s)]
[(? string? s) (~v s)]
[(list
(list
(list
(list (? infix-operator? op) ': _)
(list a ': _))
':
(list _ '-> _))
(list b ': _))
[`((not : (bool -> bool)) (,v : bool))
(format "!~a" (codegen-expr v))]
[`((((,(? infix-operator? op) : ,_) (,a : ,_)) : (,_ -> ,_)) (,b : ,_))
(format "(~a ~a ~a)"
(codegen-expr a)
op
(translate-infix-operator op)
(codegen-expr b))]
[`(fn () (,e : ,et))
(format "(func () ~a {\n~a})"
Expand All @@ -80,7 +81,7 @@
(codegen-expr e)
(codegen-return `(,b : ,bt)))]
[`(if ,c (,a : ,t) (,b : ,t))
(format "(func() ~a {\nif ~a {\n~a} else {\n~a}\n})()\n"
(format "(func() ~a {\nif ~a {\n~a} else {\n~a}\n})()"
(codegen-type t)
(codegen-expr c)
(codegen-return `(,a : ,t))
Expand Down Expand Up @@ -146,40 +147,50 @@
(define (codegen-single-expression expr)
(codegen-expr (infer (explode expr))))

(test-case "empty pkg"
(test-case "empty pkg"
(check-equal?
(codegen-pkg (compiled-pkg 'foo '() '() '() '()))
"package foo\n\n// imports\n\n// monomorphed\n\n// definitions\n"))

(test-case "int literal"
(test-case "int literal"
(check-equal?
(codegen-single-expression 123)
"123"))

(test-case "bool literal"
(test-case "bool literal"
(check-equal?
(codegen-single-expression 'true)
"true"))

(test-case "fn -> func"
(test-case "not"
(check-equal?
(codegen-single-expression '(not true))
"!true"))

(test-case "logic operators"
(check-equal?
(codegen-single-expression '(not (and true (or true false))))
"!(true && (true || false))"))

(test-case "fn -> func"
(check-equal?
(codegen-single-expression
'(fn ([q : int]) q))
"(func (q int) int {\nreturn q\n})"))

(test-case "fn with no arguments -> func()"
(test-case "fn with no arguments -> func()"
(check-equal?
(codegen-single-expression
'(fn () 1))
"(func () int {\nreturn 1\n})"))

(test-case "apply no-argument function"
(test-case "apply no-argument function"
(check-equal?
(codegen-single-expression
'((fn () 1)))
"(func () int {\nreturn 1\n})()"))

(test-case "let no-argument function"
(test-case "let no-argument function"
(check-equal?
(codegen-single-expression
'(let ([x (fn () 1)]) 2))
Expand All @@ -190,17 +201,17 @@
(codegen-single-expression '(let ([name-with-dashes 1]) name-with-dashes))
"(func () int {\nvar nameWithDashes int = 1\nreturn nameWithDashes\n}())"))

(test-case "partial application"
(test-case "partial application"
(check-equal?
(codegen-single-expression '(((fn (x y) x) 1) 2))
"(func (x int) func (int) (int) {\nreturn (func (y int) int {\nreturn x\n})\n})(1)(2)"))

(test-case "let"
(test-case "let"
(check-equal?
(codegen-single-expression '(let ([x 1]) (+ x 2)))
"(func () int {\nvar x int = 1\nreturn (x + 2)\n}())"))

(test-case "let type annotated"
(test-case "let type annotated"
(check-equal?
(codegen-single-expression '(let ([[x : int] 1]) (+ x 2)))
"(func () int {\nvar x int = 1\nreturn (x + 2)\n}())"))
Expand All @@ -215,12 +226,12 @@
(codegen-single-expression '(fn ([x : string]) (let ([y x]) (fmt.Println y))))
"(func (x string) {\n(func () {\nvar y string = x\nfmt.Println(y)\nreturn\n}())\nreturn\n})"))

(test-case "higher-order functions"
(test-case "higher-order functions"
(check-equal?
(codegen-single-expression '(((fn (x y) (x y)) (fn (x) x)) 1))
"(func (x func (int) (int)) func (int) (int) {\nreturn (func (y int) int {\nreturn x(y)\n})\n})((func (x int) int {\nreturn x\n}))(1)"))

(test-case "call by name"
(test-case "call by name"
(check-equal?
(codegen-single-expression '(let ([make-num (fn () 3)]) (* (make-num) (make-num))))
"(func () int {\nvar makeNum func () (int) = (func () int {\nreturn 3\n})\nreturn (makeNum() * makeNum())\n}())")))
45 changes: 44 additions & 1 deletion odenc/inferencer/arith-operatoro.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,51 @@
(== ot 'int)
(== `(,ot -> (,ot -> ,ot)) t)]
[(membero o '(== !=))
(membero ot '(int float string))
(membero ot '(int float string bool))
(== `(,ot -> (,ot -> bool)) t)]
[(== 'not o)
(== '(bool -> bool) t)]
[(membero o '(and or))
(== ot 'bool)
(== '(bool -> (bool -> bool)) t)]
[(membero o '(> < >= <=))
(membero ot '(int float))
(== `(,ot -> (,ot -> bool)) t)])))

(module+ test
(require rackunit)

(test-case "+"
(check-equal? (list->set (run* (q) (arith-operatoro '+ q)))
(list->set '((int -> (int -> int))
(float -> (float -> float))
(string -> (string -> string))))))

(test-case "-"
(check-equal? (list->set (run* (q) (arith-operatoro '- q)))
(list->set '((int -> (int -> int))
(float -> (float -> float))))))

(test-case "%"
(check-equal? (run* (q) (arith-operatoro '% q))
'((int -> (int -> int)))))

(test-case "=="
(check-equal? (list->set (run* (q) (arith-operatoro '== q)))
(list->set '((int -> (int -> bool))
(float -> (float -> bool))
(string -> (string -> bool))
(bool -> (bool -> bool))))))

(test-case "<"
(check-equal? (list->set (run* (q) (arith-operatoro '< q)))
(list->set '((int -> (int -> bool))
(float -> (float -> bool))))))

(test-case "and"
(check-equal? (run* (q) (arith-operatoro 'and q))
'((bool -> (bool -> bool)))))

(test-case "not"
(check-equal? (run* (q) (arith-operatoro 'not q))
'((bool -> bool)))))

0 comments on commit 3bfcb33

Please sign in to comment.