API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Mar 19th, 2017
87
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Scheme 28.39 KB | None | 0 0
raw download clone embed print report
  1. #lang racket
  2.  
  3. ;;Worked on with Kevin Wang
  4.  
  5. (struct constant (label val))
  6.  
  7. ;; Throws an error if there is a circular constant dependency
  8. (define (check-dep-chain consts target)
  9.   (define (check-dep-help lst visited target)
  10.   (cond
  11.     [(check-for-duplicates visited target) (error "circular")]
  12.     [(empty? lst) (void)]
  13.     [(symbol=? (constant-label (car lst)) target)
  14.      (if (symbol? (constant-val (car lst)))
  15.          (check-dep-help consts (cons target visited) (constant-val (car lst)))
  16.          (void))]
  17.     [else (check-dep-help (cdr lst) visited target)]))
  18.   (check-dep-help consts empty target))
  19.  
  20. ;;Helper for circular checking
  21. (define (check-for-duplicates lst target)
  22.   (define (help lst target count)
  23.     (cond
  24.       [(= count 2) #t]
  25.       [(empty? lst) #f]
  26.       [(equal? (car lst) target) (help (cdr lst) target (add1 count))]
  27.       [else (help (cdr lst) target count)]))
  28.   (help lst target 0))
  29.  
  30. ;;Another helper for circular
  31. (define (circular-check lst)
  32.   (define (help c)
  33.     (unless (empty? c)
  34.       (check-dep-chain lst (constant-label (car c)))
  35.       (help (cdr c))))
  36.   (help lst))
  37.  
  38. ;;Gets all consts from an A-PRIMP program
  39. (define (get-constants instrs)
  40.   (define (help instrs consts)
  41.     (if (empty? instrs)
  42.         consts
  43.     (match (car instrs)
  44.         [`(const ,name ,val) (help (cdr instrs) (cons (constant name val) consts))]
  45.         [x (help (cdr instrs) consts)])))
  46.   (help instrs empty))
  47.  
  48. (define (check-dups list)
  49.   (define (help l)
  50.     (unless (empty? l)
  51.       (when (check-for-duplicates list (car l))
  52.           (error "duplicate"))
  53.       (help (cdr l))))
  54.   (help list))
  55.  
  56. ;; Pre-processes the program, producing a list of the following:
  57. ;; car: the semi-assembled code (data and consts replaced)
  58. ;; cadr: a list of pairs (label, line num)
  59. ;; caddr: a list of pairs representing constants (name, value)
  60. ;; cadddr: a list of pairs representing data (name, first line)
  61. (define (primp-process program)
  62.   (define (help program labels consts data res lc)
  63.     (if (empty? program)
  64.         (list (reverse res) labels consts data)
  65.         (match (car program)
  66.           [`(const ,name ,val) (help (cdr program) labels (cons (cons name val) consts) data res lc)]
  67.           [`(data ,name (,n ,val)) (help (cdr program) labels consts (cons (cons name lc) data) (append (build-list n (λ (x) val)) res) (+ lc val))]
  68.           [`(data ,name ,val ...) (help (cdr program) labels consts (cons (cons name lc) data) (append (reverse val) res) (+ lc (length val)))]
  69.           [`(label ,name) (help (cdr program) (cons (cons name lc) labels) consts data res lc)]
  70.           [`(lit ,val) (help (cdr program) labels consts data (cons val res) (add1 lc))]
  71.           ['(halt) (help (cdr program) labels consts data (cons 0 res) (add1 lc))]
  72.           [x (help (cdr program) labels consts data (cons x res) (add1 lc))])))
  73.   (help program empty empty empty empty 0))
  74.  
  75. (define (primp-assemble program)
  76.   (circular-check (get-constants program))
  77.   (define processed (primp-process program))
  78.   (define intermediate (car processed))
  79.   (define labels (cadr processed))
  80.   (define consts (caddr processed))
  81.   (define data (cadddr processed))
  82.   (check-dups (append (map car labels) (append (map car data) (map car consts))))
  83.   (define (help prog assembled)
  84.     (if (empty? prog)
  85.         (reverse assembled)
  86.         (help (cdr prog) (cons
  87.          (match (car prog)
  88.              [`(,fun ,dest ,opr1 ,opr2) (list fun (cond
  89.                                                 [(symbol? dest) (cond
  90.                                                                   [(assoc dest data) => (λ (x) (list (cdr x)))]
  91.                                                                   [else (error "incorrect")])]
  92.                                                 [(list? dest) (cond
  93.                                                                   [(= (length dest) 1) (if (symbol? (car dest)) (error "incorrect") dest)]
  94.                                                                   [(and (symbol? (cadr dest)) (not (symbol? (car dest))))
  95.                                                                    (if (not (assoc (cadr dest) data))
  96.                                                                        (error "incorrect")
  97.                                                                        (list (car dest) (list (cdr (assoc (cadr dest) data)))))]
  98.                                                                    [(and (symbol? (cadr dest)) (symbol? (car dest)))
  99.                                                                     (if (or (not (assoc (cadr dest) data)) (not (assoc (car dest) consts)))
  100.                                                                         (error "incorrect")
  101.                                                                         (list (cdr (assoc (car dest) consts)) (list (cdr (assoc (cadr dest) data)))))]
  102.                                                                    [(symbol? (car dest))
  103.                                                                     (if (not (assoc (car dest) const))
  104.                                                                         (error "incorrect")
  105.                                                                         (list (cdr (assoc (car dest) consts)) (cadr dest)))]
  106.                                                                    [else dest])]
  107.                                                 [else (error "incorrect")])
  108.  
  109.                                               (cond
  110.                                                 [(symbol? opr1) (cond
  111.                                                                   [(assoc opr1 data) => (λ (x) (list (cdr x)))]
  112.                                                                   [(assoc opr1 consts) => cdr]
  113.                                                                   [else (error "incorrect")])]
  114.                                                 [(list? opr1) (cond
  115.                                                                   [(= (length opr1) 1) (if (symbol? (car opr1)) (error "incorrect") opr1)]
  116.                                                                   [(and (symbol? (cadr opr1)) (not (symbol? (car opr1))))
  117.                                                                    (if (not (assoc (cadr opr1) data))
  118.                                                                        (error "incorrect")
  119.                                                                        (list (car opr1) (list (cdr (assoc (cadr opr1) data)))))]
  120.                                                                    [(and (symbol? (cadr opr1)) (symbol? (car opr1)))
  121.                                                                     (if (or (not (assoc (cadr opr1) data)) (not (assoc (car opr1) consts)))
  122.                                                                         (error "incorrect")
  123.                                                                         (list (cdr (assoc (car opr1) consts)) (list (cdr (assoc (cadr opr1) data)))))]
  124.                                                                    [(symbol? (car opr1))
  125.                                                                     (if (not (assoc (car opr1) const))
  126.                                                                         (error "incorrect")
  127.                                                                         (list (cdr (assoc (car opr1) consts)) (cadr opr1)))]
  128.                                                                    [else opr1])]
  129.                                                 [else opr1])
  130.  
  131.                                               (cond
  132.                                                 [(symbol? opr2) (cond
  133.                                                                   [(assoc opr2 data) => (λ (x) (list (cdr x)))]
  134.                                                                   [(assoc opr2 consts) => cdr]
  135.                                                                   [else (error "incorrect")])]
  136.                                                 [(list? opr2) (cond
  137.                                                                   [(= (length opr2) 1) (if (symbol? (car opr2)) (error "incorrect") opr2)]
  138.                                                                   [(and (symbol? (cadr opr2)) (not (symbol? (car opr2))))
  139.                                                                    (if (not (assoc (cadr opr2) data))
  140.                                                                        (error "incorrect")
  141.                                                                        (list (car opr2) (list (cdr (assoc (cadr opr2) data)))))]
  142.                                                                    [(and (symbol? (cadr opr2)) (symbol? (car opr2)))
  143.                                                                     (if (or (not (assoc (cadr opr2) data)) (not (assoc (car opr2) consts)))
  144.                                                                         (error "incorrect")
  145.                                                                         (list (cdr (assoc (car opr2) consts)) (list (cdr (assoc (cadr opr2) data)))))]
  146.                                                                    [(symbol? (car opr2))
  147.                                                                     (if (not (assoc (car opr2) const))
  148.                                                                         (error "incorrect")
  149.                                                                         (list (cdr (assoc (car opr2) consts)) (cadr opr2)))]
  150.                                                                    [else opr2])]
  151.                                                 [else opr2]))]
  152.            [`(lnot ,dest ,opr1) (list 'lnot (cond
  153.                                                 [(symbol? dest) (cond
  154.                                                                   [(assoc dest data) => (λ (x) (list (cdr x)))]
  155.                                                                   [else (error "incorrect")])]
  156.                                                 [(list? dest) (cond
  157.                                                                   [(= (length dest) 1) (if (symbol? (car dest)) (error "incorrect") dest)]
  158.                                                                   [(and (symbol? (cadr dest)) (not (symbol? (car dest))))
  159.                                                                    (if (not (assoc (cadr dest) data))
  160.                                                                        (error "incorrect")
  161.                                                                        (list (car dest) (list (cdr (assoc (cadr dest) data)))))]
  162.                                                                    [(and (symbol? (cadr dest)) (symbol? (car dest)))
  163.                                                                     (if (or (not (assoc (cadr dest) data)) (not (assoc (car dest) consts)))
  164.                                                                         (error "incorrect")
  165.                                                                         (list (cdr (assoc (car dest) consts)) (list (cdr (assoc (cadr dest) data)))))]
  166.                                                                    [(symbol? (car dest))
  167.                                                                     (if (not (assoc (car dest) const))
  168.                                                                         (error "incorrect")
  169.                                                                         (list (cdr (assoc (car dest) consts)) (cadr dest)))]
  170.                                                                    [else dest])]
  171.                                                 [else (error "i think this is incorrect")])
  172.  
  173.                                               (cond
  174.                                                 [(symbol? opr1) (cond
  175.                                                                   [(assoc opr1 data) => (λ (x) (list (cdr x)))]
  176.                                                                   [(assoc opr1 consts) => cdr]
  177.                                                                   [else (error "incorrect")])]
  178.                                                 [(list? opr1) (cond
  179.                                                                   [(= (length opr1) 1) (if (symbol? (car opr1)) (error "incorrect") opr1)]
  180.                                                                   [(and (symbol? (cadr opr1)) (not (symbol? (car opr1))))
  181.                                                                    (if (not (assoc (cadr opr1) data))
  182.                                                                        (error "incorrect")
  183.                                                                        (list (car opr1) (list (cdr (assoc (cadr opr1) data)))))]
  184.                                                                    [(and (symbol? (cadr opr1)) (symbol? (car opr1)))
  185.                                                                     (if (or (not (assoc (cadr opr1) data)) (not (assoc (car opr1) consts)))
  186.                                                                         (error "incorrect")
  187.                                                                         (list (cdr (assoc (car opr1) consts)) (list (cdr (assoc (cadr opr1) data)))))]
  188.                                                                    [(symbol? (car opr1))
  189.                                                                     (if (not (assoc (car opr1) const))
  190.                                                                         (error "incorrect")
  191.                                                                         (list (cdr (assoc (car opr1) consts)) (cadr opr1)))]
  192.                                                                    [else opr1])]
  193.                                                 [else opr1]))]
  194.             [`(jump ,opr1) (list 'jump (cond
  195.                                                 [(symbol? opr1) (cond
  196.                                                                   [(assoc opr1 data) => (λ (x) (list (cdr x)))]
  197.                                                                   [(assoc opr1 consts) => cdr]
  198.                                                                   [(assoc opr1 labels) => cdr]
  199.                                                                   [else (error "incorrect")])]
  200.                                                 [(list? opr1) (cond
  201.                                                                   [(= (length opr1) 1) (if (symbol? (car opr1)) (error "incorrect") opr1)]
  202.                                                                   [(and (symbol? (cadr opr1)) (not (symbol? (car opr1))))
  203.                                                                    (if (not (assoc (cadr opr1) data))
  204.                                                                        (error "incorrect")
  205.                                                                        (list (car opr1) (list (cdr (assoc (cadr opr1) data)))))]
  206.                                                                    [(and (symbol? (cadr opr1)) (symbol? (car opr1)))
  207.                                                                     (if (or (not (assoc (cadr opr1) data)) (not (assoc (car opr1) consts)))
  208.                                                                         (error "incorrect")
  209.                                                                         (list (cdr (assoc (car opr1) consts)) (list (cdr (assoc (cadr opr1) data)))))]
  210.                                                                    [(symbol? (car opr1))
  211.                                                                     (if (not (assoc (car opr1) const))
  212.                                                                         (error "incorrect")
  213.                                                                         (list (cdr (assoc (car opr1) consts)) (cadr opr1)))]
  214.                                                                    [else opr1])]
  215.                                                 [else opr1]))]
  216.            [`(branch ,opr1 ,opr2) (list 'branch  (cond
  217.                                                 [(symbol? opr1) (cond
  218.                                                                   [(assoc opr1 data) => (λ (x) (list (cdr x)))]
  219.                                                                   [(assoc opr1 consts) => cdr]
  220.                                                                   [else (error "incorrect")])]
  221.                                                 [(list? opr1) (cond
  222.                                                                   [(= (length opr1) 1) (if (symbol? (car opr1)) (error "incorrect") opr1)]
  223.                                                                   [(and (symbol? (cadr opr1)) (not (symbol? (car opr1))))
  224.                                                                    (if (not (assoc (cadr opr1) data))
  225.                                                                        (error "incorrect")
  226.                                                                        (list (car opr1) (list (cdr (assoc (cadr opr1) data)))))]
  227.                                                                    [(and (symbol? (cadr opr1)) (symbol? (car opr1)))
  228.                                                                     (if (or (not (assoc (cadr opr1) data)) (not (assoc (car opr1) consts)))
  229.                                                                         (error "incorrect")
  230.                                                                         (list (cdr (assoc (car opr1) consts)) (list (cdr (assoc (cadr opr1) data)))))]
  231.                                                                    [(symbol? (car opr1))
  232.                                                                     (if (not (assoc (car opr1) const))
  233.                                                                         (error "incorrect")
  234.                                                                         (list (cdr (assoc (car opr1) consts)) (cadr opr1)))]
  235.                                                                    [else opr1])]
  236.                                                 [else opr1])
  237.  
  238.                                               (cond
  239.                                                 [(symbol? opr2) (cond
  240.                                                                   [(assoc opr2 data) => (λ (x) (list (cdr x)))]
  241.                                                                   [(assoc opr2 consts) => cdr]
  242.                                                                   [(assoc opr2 labels) => cdr]
  243.                                                                   [else (error "incorrect")])]
  244.                                                 [(list? opr2) (cond
  245.                                                                   [(= (length opr2) 1) (if (symbol? (car opr2)) (error "incorrect") opr2)]
  246.                                                                   [(and (symbol? (cadr opr2)) (not (symbol? (car opr2))))
  247.                                                                    (if (not (assoc (cadr opr2) data))
  248.                                                                        (error "incorrect")
  249.                                                                        (list (car opr2) (list (cdr (assoc (cadr opr2) data)))))]
  250.                                                                    [(and (symbol? (cadr opr2)) (symbol? (car opr2)))
  251.                                                                     (if (or (not (assoc (cadr opr2) data)) (not (assoc (car opr2) consts)))
  252.                                                                         (error "incorrect")
  253.                                                                         (list (cdr (assoc (car opr2) consts)) (list (cdr (assoc (cadr opr2) data)))))]
  254.                                                                    [(symbol? (car opr2))
  255.                                                                     (if (not (assoc (car opr2) const))
  256.                                                                         (error "incorrect")
  257.                                                                         (list (cdr (assoc (car opr2) consts)) (cadr opr2)))]
  258.                                                                    [else opr2])]
  259.                                                 [else opr2]))]
  260.            [`(move ,dest ,opr1) (list 'move (cond
  261.                                                 [(symbol? dest) (cond
  262.                                                                   [(assoc dest data) => (λ (x) (list (cdr x)))]
  263.                                                                   [else (error "incorrect")])]
  264.                                                 [(list? dest) (cond
  265.                                                                   [(= (length dest) 1) (if (symbol? (car dest)) (error "incorrect") dest)]
  266.                                                                   [(and (symbol? (cadr dest)) (not (symbol? (car dest))))
  267.                                                                    (if (not (assoc (cadr dest) data))
  268.                                                                        (error "incorrect")
  269.                                                                        (list (car dest) (list (cdr (assoc (cadr dest) data)))))]
  270.                                                                    [(and (symbol? (cadr dest)) (symbol? (car dest)))
  271.                                                                     (if (or (not (assoc (cadr dest) data)) (not (assoc (car dest) consts)))
  272.                                                                         (error "incorrect")
  273.                                                                         (list (cdr (assoc (car dest) consts)) (list (cdr (assoc (cadr dest) data)))))]
  274.                                                                    [(symbol? (car dest))
  275.                                                                     (if (not (assoc (car dest) const))
  276.                                                                         (error "incorrect")
  277.                                                                         (list (cdr (assoc (car dest) consts)) (cadr dest)))]
  278.                                                                    [else dest])]
  279.                                                 [else (error "i think this is incorrect")])
  280.  
  281.                                               (cond
  282.                                                 [(symbol? opr1) (cond
  283.                                                                   [(assoc opr1 data) => (λ (x) (list (cdr x)))]
  284.                                                                   [(assoc opr1 consts) => cdr]
  285.                                                                   [else (error "incorrect")])]
  286.                                                 [(list? opr1) (cond
  287.                                                                   [(= (length opr1) 1) (if (symbol? (car opr1)) (error "incorrect") opr1)]
  288.                                                                   [(and (symbol? (cadr opr1)) (not (symbol? (car opr1))))
  289.                                                                    (if (not (assoc (cadr opr1) data))
  290.                                                                        (error "incorrect")
  291.                                                                        (list (car opr1) (list (cdr (assoc (cadr opr1) data)))))]
  292.                                                                    [(and (symbol? (cadr opr1)) (symbol? (car opr1)))
  293.                                                                     (if (or (not (assoc (cadr opr1) data)) (not (assoc (car opr1) consts)))
  294.                                                                         (error "incorrect")
  295.                                                                         (list (cdr (assoc (car opr1) consts)) (list (cdr (assoc (cadr opr1) data)))))]
  296.                                                                    [(symbol? (car opr1))
  297.                                                                     (if (not (assoc (car opr1) const))
  298.                                                                         (error "incorrect")
  299.                                                                         (list (cdr (assoc (car opr1) consts)) (cadr opr1)))]
  300.                                                                    [else opr1])]
  301.                                                 [else opr1]))]
  302.            [`(print-val ,opr1) (list 'print-val (cond
  303.                                                 [(symbol? opr1) (cond
  304.                                                                   [(assoc opr1 data) => (λ (x) (list (cdr x)))]
  305.                                                                   [(assoc opr1 consts) => cdr]
  306.                                                                   [else (error "incorrect")])]
  307.                                                 [(list? opr1) (cond
  308.                                                                   [(= (length opr1) 1) (if (symbol? (car opr1)) (error "incorrect") opr1)]
  309.                                                                   [(and (symbol? (cadr opr1)) (not (symbol? (car opr1))))
  310.                                                                    (if (not (assoc (cadr opr1) data))
  311.                                                                        (error "incorrect")
  312.                                                                        (list (car opr1) (list (cdr (assoc (cadr opr1) data)))))]
  313.                                                                    [(and (symbol? (cadr opr1)) (symbol? (car opr1)))
  314.                                                                     (if (or (not (assoc (cadr opr1) data)) (not (assoc (car opr1) consts)))
  315.                                                                         (error "incorrect")
  316.                                                                         (list (cdr (assoc (car opr1) consts)) (list (cdr (assoc (cadr opr1) data)))))]
  317.                                                                    [(symbol? (car opr1))
  318.                                                                     (if (not (assoc (car opr1) const))
  319.                                                                         (error "incorrect")
  320.                                                                         (list (cdr (assoc (car opr1) consts)) (cadr opr1)))]
  321.                                                                    [else opr1])]
  322.                                                 [else opr1]))]
  323.            [x (if (symbol? x)
  324.                   (cond
  325.                     [(assoc x data) => cdr]
  326.                     [(assoc x consts) => cdr]
  327.                     [else (error "incorrect")])
  328.                   x)]) assembled))))
  329.   (help intermediate empty))
  330.  
  331. ;(primp-assemble '((data X 10)(data Y X) X Y))
  332. ;; Circular declaration
  333. ;(primp-assemble '((const X 10)
  334.  ;                 (data X 20)))
  335. ;(primp-assemble '((label X)
  336. ;                  (const A #t)
  337. ;                  (branch A X)))
  338. ;(primp-assemble '((label X)
  339. ;                  (const X 20)))
  340. ; Not sure what this test does
  341. ;(primp-assemble '((data X 10)
  342. ;                  (data X 10)))
  343.  
  344. ;(primp-assemble '((data X 10)
  345. ;                  (data Y 20)
  346. ;                  (data Z 0)
  347. ;                  (add Z X Y)))
  348. ;(primp-assemble '((data Y 10)
  349. ;                  (data Z 0)
  350. ;                  (add Z Y X)
  351. ;                  (data X 10)))
  352. ;(primp-assemble '((data Y 10)
  353. ;                  (data Z 0)
  354. ;                  (add Z Y X)
  355. ;                  (data X 10)))
  356. ;(primp-assemble '((data X 1 2 3 4)
  357. ;                  (jump 0)))
  358.  
  359. ;(primp-assemble '((data A 10)
  360. ;                  (data A A)))
  361. ;(primp-assemble '((print-val (2))
  362. ;                  (data X 1 2)
  363. ;                  0))
  364. ;(primp-assemble '((data A (1 1))
  365. ;                  (data B (10 10))
  366. ;                  (move A B)))
  367. ;(primp-assemble '((label first)
  368. ;                  (data A)
  369. ; ;                 (jump first)))
  370. ;(primp-assemble '((jump 0)))
  371.  
  372. ;(primp-assemble '((label start)
  373. ;                  (print-val temp)
  374. ;                  (print-string "\n")
  375. ;                  (add cnt cnt 1)
  376.  ;                 (mul temp temp 2)
  377. ;                  (lt cmp cnt 10)
  378. ;                  (branch cmp start)
  379. ;                  (data cnt 0)
  380. ;                  (data temp 1)
  381. ;                  (data cmp #t)))
  382.  
  383. ;(primp-assemble '((label start)
  384. ;                  (branch cmp start)
  385. ;                  (data cmp #t)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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!