Advertisement
Guest User

Untitled

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