SHARE
TWEET

Untitled

a guest Mar 17th, 2015 191 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #lang racket
  2.  
  3. (define translate (hash `> `gt
  4.                         `>= `ge
  5.                         `< `lt
  6.                         `<= `le
  7.                         `= `equal
  8.                         `and `land
  9.                         `or `lor
  10.                         `not `lnot
  11.                         `+ `add
  12.                         `- `sub
  13.                         `* `mul
  14.                         `div `div
  15.                         `mod `mod))
  16.  
  17. (define (prefix-symbol prefix symbol)
  18.   (string->symbol (string-append prefix (symbol->string symbol))))
  19.  
  20. (define (compile-simp prog)
  21.  
  22.   (define a-primp empty)
  23.   (define functions (make-hash))
  24.  
  25.   ; GENERAL HELPERS
  26.   (define (add-line line)
  27.     (set! a-primp (cons line a-primp)))
  28.  
  29.   (define (add-label sym)
  30.     (add-line `(label ,sym)))
  31.  
  32.   (define (val? exp)
  33.     (or (number? exp) (boolean? exp)))
  34.  
  35.   ; GET FUNCTION NAMES AND STACK WIDTHS
  36.   (for ([f prog])
  37.     (match f
  38.       [`(fun (,name ,args ...) (vars [,bindings ...] ,stmts ...))
  39.        
  40.        ; CHECK FOR DUPLICATE NAMES
  41.        (if (hash-has-key? functions name)
  42.            (error "duplicate")
  43.            (void))
  44.        
  45.        ; CREATE FUNCTION BINDING
  46.        (hash-set! functions name (list (length args) (+ 3 (length args) (length bindings))))
  47.        
  48.        ; CHECK FOR RETURNS
  49.        (match stmts
  50.              [`(,s ... (return ,aexp)) (void)]
  51.              [_ (error "return " name)])
  52.        
  53.        ; CHECK FOR DUPLICATE ARGUMENTS
  54.        (if (< (length (remove-duplicates (append args (map first bindings))))
  55.               (length (append args (map first bindings))))
  56.            (error "duplicates")
  57.            (void))
  58.        
  59.        ]
  60.       [_ (void)]))
  61.   ; BUILD FUNCTIONS
  62.   (for ([f prog])
  63.     (match f
  64.       [`(fun (,name ,args ...) (vars [,bindings ...] ,stmts ...))
  65.        
  66.        ; CREATE SUBROUTINE LABEL
  67.        (define label (prefix-symbol "FUNCTION_" name))
  68.        (add-label label)
  69.        
  70.        (define vars (make-hash))
  71.        (define c 3)
  72.        
  73.        (define (get-var var)
  74.          `(,(hash-ref vars var (lambda () (error "undefined"))) BSP))
  75.        
  76.        ; 0: RETURN VALUE
  77.        ; 1: RETURN PC
  78.        ; 2: RETURN BSP
  79.        
  80.        ; CREATE ARGUMENT TABLE
  81.        (for ([arg args])
  82.          (hash-set! vars arg c)
  83.          (set! c (add1 c)))
  84.        
  85.        ; CREATE VAR BINDINGS
  86.        (for ([binding bindings])
  87.          (hash-set! vars (first binding) c)
  88.          (add-line `(move (,c BSP) ,(second binding)))
  89.          (set! c (add1 c)))
  90.        
  91.        ; DEBUG FUNCTION POINTER
  92.        ;(add-line `(print-string "FUNCTION BEING CALLED:\n"))
  93.        ;(for ([i c])
  94.        ;  (add-line `(print-val (,i BSP)))
  95.        ;  (add-line `(print-string "\n")))
  96.        
  97.        ; DO COMPUTATION
  98.        
  99.        ; COMPILE FUNCTION
  100.        (define (compile-function exp)
  101.          (match exp
  102.            [`(,id ,ids ...)
  103.             ; LOOKUP FUNCTION
  104.             (define info (hash-ref functions id (lambda () (error "undefined" id))))
  105.             (if (= (length ids) (first info))
  106.                 (void)
  107.                 (error "arguments"))
  108.             ; SET IMPORTANT VALUES
  109.             ; 0: RETURN VALUE
  110.             ; 1: RETURN PC
  111.             (add-line `(move (2 SP) BSP)) ; 2: RETURN BSP
  112.             ; SET FAKE BSP (AT RETURN VALUE)
  113.             (add-line `(move (0 SP) SP))
  114.             ; ADVANCE SP TO PARAMS
  115.             (add-line `(add SP SP 3))
  116.             (define bk 3)
  117.             (for ([i ids])
  118.               (compile-exp i) ; 2+n: nth argument
  119.               (set! bk (add1 bk))
  120.               )
  121.             ; SET NEW SP
  122.             (add-line `(add SP SP ,(- (second info) (+ 3 (first info)))))
  123.             ; SET REAL BSP
  124.             (add-line `(move BSP (,(- 0 (second info)) SP)))
  125.             ; JSR MESS
  126.             (add-line `(jsr (1 BSP) ,(prefix-symbol "FUNCTION_" id)))
  127.             ]
  128.            [x x]))
  129.        
  130.        ; COMPILE EXPRESSION
  131.        (define (compile-exp exp)
  132.          ;(printf "  compiling expression ~a\n" exp)
  133.          (match exp
  134.            [(? val? exp)
  135.             (add-line `(move (0 SP) ,exp))
  136.             (add-line `(add SP SP 1))]
  137.            [(? symbol? exp)
  138.             (add-line `(move (0 SP) ,(get-var exp)))
  139.             (add-line `(add SP SP 1))]
  140.            [`(,bin ,exp1 ,exp2)
  141.             (if (hash-has-key? translate bin)
  142.                 (begin (compile-exp exp1)
  143.                        (compile-exp exp2)
  144.                        (add-line `(,(hash-ref translate bin) (-2 SP) (-2 SP) (-1 SP)))
  145.                        (add-line `(sub SP SP 1)))
  146.                 (compile-function exp))]
  147.            [`(,un ,ex)
  148.             (if (hash-has-key? translate un)
  149.                 (begin (compile-exp ex)
  150.                        (add-line `(,(hash-ref translate un) (-1 SP) (-1 SP))))
  151.                 (compile-function exp))]
  152.            [x (compile-function exp)]))
  153.        
  154.        ; COMPILE STATEMENT
  155.        (define (compile-stmt stmt)
  156.          ;(printf "compiling statement ~a\n" stmt)
  157.          (match stmt
  158.            ; SEQ
  159.            [`(seq ,stmts ...)
  160.             (for [(s stmts)]
  161.               (compile-stmt s))]
  162.            ; SET
  163.            [`(set ,id ,exp)
  164.             ;(printf "  compiling set expression ~a ~a\n" id exp)
  165.             (compile-exp exp)
  166.             (add-line `(sub SP SP 1))
  167.             (add-line `(move ,(get-var id) (0 SP)))]
  168.            ; IIF
  169.            [`(iif ,exp ,s1 ,s2)
  170.             ;   create label names
  171.             (define label (gensym "IF_"))
  172.             (define true-label (prefix-symbol "TRUE_" label))
  173.             (define end-label (prefix-symbol "END_" label))
  174.             ;   handle check
  175.             (compile-exp exp)
  176.             (add-line `(sub SP SP 1))
  177.             (add-line `(branch (0 SP) ,true-label))
  178.             ;   false case
  179.             (compile-stmt s2)
  180.             (add-line `(jump ,end-label))
  181.             ;   true case
  182.             (add-label true-label)
  183.             (compile-stmt s1)
  184.             (add-label end-label)
  185.             ]
  186.            ; WHILE
  187.            [`(while ,exp ,stmts ...)
  188.             ;   create label names
  189.             (define label (gensym "WHILE_"))
  190.             (define top-label (prefix-symbol "TOP_" label))
  191.             (define cont-label (prefix-symbol "CONT_" label))
  192.             (define end-label (prefix-symbol "END_" label))
  193.             ;   handle check
  194.             (add-label top-label)
  195.             (compile-exp exp)
  196.             (add-line `(sub SP SP 1))
  197.             (add-line `(branch (0 SP) ,cont-label))
  198.             (add-line `(jump ,end-label))
  199.             ;   continue
  200.             (add-label cont-label)
  201.             ;   compile all statements
  202.             (for [(s stmts)]
  203.               (compile-stmt s))
  204.            
  205.             (add-line `(jump ,top-label))
  206.             (add-label end-label)]
  207.            ; PRINT
  208.            [`(print ,exp)
  209.             (if (string? exp)
  210.                 (add-line `(print-string ,exp))
  211.                 (begin (compile-exp exp)
  212.                        (add-line `(sub SP SP 1))
  213.                        (add-line `(print-val (0 SP)))))]
  214.            ; RETURN
  215.            [`(return ,exp)
  216.             (compile-exp exp)
  217.             (add-line `(move (0 BSP) (-1 SP)))  ; SET RETURN VAL
  218.             (add-line `(move JMP (1 BSP)))      ; SET JUMP POINT
  219.             (add-line `(add SP BSP 1))          ; RESET SP
  220.             (add-line `(move BSP (1 SP)))       ; RESET BSP
  221.             (add-line `(jump JMP))              ; END FUNCTION
  222.             ]
  223.            ; SKIP (do nothing)
  224.            [`(skip) (void)]
  225.            ; OOPS
  226.            [_ ;(add-line stmt)
  227.               (error "test")
  228.             ]))
  229.        
  230.        ; PARSE STATEMENTS
  231.        (for ([stmt stmts])
  232.          (compile-stmt stmt))
  233.        ]
  234.       [_ (void)]))
  235.  
  236.   ; APPLY MAIN IF IT EXISTS
  237.  
  238.   (append (if (hash-has-key? functions `main)
  239.               `((add SP SP ,(second (hash-ref functions `main)))
  240.                 (jsr (1 BSP) FUNCTION_main)
  241.                 (halt)
  242.                 )
  243.               `((halt)))
  244.           (reverse a-primp)
  245.           `((data JMP 0)
  246.             (data BSP X)
  247.             (data SP X)
  248.             (data X 0)))
  249.  
  250.   )
  251.  
  252.  
  253. #|
  254. (define prog '((fun (test id) (vars [(i 10)] (return (+ 5 4))))
  255.                (fun (main) (vars [(i 1) (j 0) (acc 0)]
  256.                     (while (<= i 1000)
  257.                            (set j 1)
  258.                            (set acc 0)
  259.                            (while (< j i)
  260.                                   (iif (= (mod i j) 0)
  261.                                        (set acc (+ acc j))
  262.                                        (skip))
  263.                                   (set j (+ j 1)))
  264.                            (iif (= acc i)
  265.                                 (seq
  266.                                  (print i)
  267.                                  (print "\n"))
  268.                                 (skip))
  269.                            (set i (+ i 1))))))
  270.   )
  271. |#
  272. #|
  273. (define prog '((fun (add a1 a2) (vars [] (return (+ a1 a2))))
  274.                (fun (main) (vars [(i 1) (j 2) (k 3)]
  275.                                  (print i)
  276.                                  (print " ")
  277.                                  (print j)
  278.                                  (print " ")
  279.                                  (print k)
  280.                                  (print "\n")
  281.                                  (print (add i j))
  282.                                  (print "\n")
  283.                                  (print i)
  284.                                  (print " ")
  285.                                  (print j)
  286.                                  (print " ")
  287.                                  (print k)
  288.                                  (print "\n")
  289.                                  (print (add j k))
  290.                                  (print "\n")
  291.                                  (print (add (add i j) k)))))
  292.                                  
  293.                                  
  294.   )|#
  295.  
  296. #|
  297. (define prog `((fun (fact n) (vars [(r 1)]
  298.                                    (iif (> n 1)
  299.                                         (set r (* n (fact (- n 1))))
  300.                                         (skip))
  301.                                    (return r)))
  302.                (fun (main) (vars [(n 5)]
  303.                                  (print (fact n)))))
  304.   )|#
  305. #|
  306. (define prog `(
  307.                (fun (main) (vars [] (print (fib (fib 8)))))
  308.                (fun (fib n) (vars [(r 0)]
  309.                                   (iif (= n 0)
  310.                                        (set r 0)
  311.                                        (iif (= n 1)
  312.                                             (set r 1)
  313.                                             (set r (+ (fib (- n 1)) (fib (- n 2))))))
  314.                                   (return r)))
  315.  
  316.                )
  317.   )
  318. |#
  319. #|
  320. (define prog `((fun (main) (vars [(x 10) (y 20)]
  321.                                  (set x (oh x y 10))
  322.                                  (print x)))
  323.                (fun (oh my g k) (vars [(l 1)]
  324.                                     (set my (+ my (+ g k)))
  325.                                     (return my)))
  326.                ))
  327. |#
  328.  
  329. (define prog '(
  330.                (fun (perfect? n) (vars [(i 1) (acc 0)]
  331.                                        (while (< i n)
  332.                                               (iif (= (mod n i) 0)
  333.                                                    (set acc (+ acc i))
  334.                                                    (skip))
  335.                                               (set i (+ i 1)))
  336.                                        (iif (= n acc)
  337.                                             (set acc n)
  338.                                             (set acc 0))
  339.                                        (return acc))
  340.                                        )
  341.                (fun (main) (vars [(i 1) (max 500)]
  342.                                  (while (< i max)
  343.                                         (iif (> (perfect? i) 0)
  344.                                              (seq (print i)
  345.                                                   (print " is perfect !!\n"))
  346.                                              (skip))
  347.                                         (set i (+ i 1)))
  348.                                  (return 0)))
  349.                )
  350.   )
  351. #|
  352. (define prog '(
  353.                (fun (tadd a1 a2 a3) (vars [(j 0)]
  354.                                           (set a1 (+ a1 j))
  355.                                           (set a2 (+ a2 a3))
  356.                                           (set a1 (+ a1 a2))
  357.                                           (return a1)))
  358.                (fun (add a1 a2) (vars [(j 1)]
  359.                                       (set a1 (+ a1 a2))
  360.                                       (return a1)))
  361.                (fun (main) (vars [(a 1) (b 2) (c 3)]
  362.                                 (set a (add a b))
  363.                                 (set b (add b c))
  364.                                 (set c (add a b))
  365.                                 (print c)
  366.                                 (print "\n")
  367.                                 (print (add (add a b) (tadd a (add a b) c)))
  368.                                 (print "\n")
  369.                                 (print a)
  370.                                 (print b)
  371.                                 (print c)
  372.                                 (return c)
  373.                                 ))
  374.                ))|#
  375.  
  376. (compile-simp prog)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top