fork download 
  1. (def flc-program 
  2.   '((module Main ()
  3.  
  4.             (begin)
  5.  
  6.             (gets BatchCode)
  7.  
  8.             (while (!= "" BatchCode)
  9.  
  10.               (getn DimensionA)
  11.               (getn DimensionB)
  12.               (getn DimensionC)
  13.  
  14.               (if (!= DimensionA (max DimensionA DimensionB DimensionC))
  15.  
  16.                 (report error to user "Invalid data")
  17.  
  18.                 (else)
  19.  
  20.                 (if (== "Y" (call check_Pythagoras DimensionA DimensionB DimensionC))
  21.  
  22.                   (show answer "Batch code: " BatchCode " is right angled")
  23.  
  24.                   (else)
  25.  
  26.                   (show answer "Batch code: " BatchCode " is not right angled")
  27.  
  28.                   (end if))
  29.  
  30.                 (end if))
  31.  
  32.               (gets BatchCode)
  33.  
  34.               (end while))
  35.  
  36.             (end))
  37.  
  38.      (module check_Pythagoras (ADim BDim CDim)
  39.  
  40.              (begin)
  41.  
  42.              (if (== (* ADim ADim) 
  43.                      (+ (* BDim BDim) 
  44.                         (* CDim CDim)))
  45.  
  46.                (return "Y")
  47.  
  48.                (else)
  49.  
  50.                (return "N")
  51.  
  52.                (end if))
  53.  
  54.              (end))))
  55.  
  56. (defn run [program]
  57.   (let [env-stack (atom (list {}))
  58.         modules (into {} (map #(vector (-> % second str) %) program))
  59.         cur-module (atom "")
  60.         return-value (atom nil)
  61.  
  62.         exec (fn exec [instr]       
  63.                (let [[cmd & args] instr cur-env (first @env-stack)]
  64.                  (cond
  65.                    (seq? cmd)
  66.                    (exec cmd)
  67.  
  68.                    (= cmd 'module) 
  69.                    (do (reset! cur-module (-> args first str))
  70.                      (reset! return-value nil)
  71.                      (loop [instrs (drop 3 instr)]
  72.                        (when-not (or (empty? instrs) @return-value)
  73.                          (exec (first instrs))
  74.                          (recur (rest instrs)))))
  75.  
  76.                    (#{'begin 'end 'else} cmd) nil
  77.  
  78.                    (= (take 2 instr) '(show answer)) 
  79.                    (println (apply str (map #(exec [%]) (drop 2 instr))))
  80.  
  81.                    (= (take 4 instr) '(report error to user))
  82.                    (println (apply str (map #(exec [%]) (drop 4 instr))))
  83.  
  84.                    (#{'gets 'getn} cmd)
  85.                    (let [var-name (str @cur-module "#" (first args))
  86.                          var-value ((if (= cmd 'gets) identity #(Double. %)) (read-line))
  87.                          new-env (assoc cur-env var-name var-value)]
  88.                      (swap! env-stack #(cons new-env (rest %))))
  89.  
  90.                    (= cmd 'if)
  91.                    (let [con (-> args first list exec)
  92.                          tbody (rest (take-while #(not= % '(else)) args))
  93.                          fbody       (drop-while #(not= % '(else)) args)]
  94.                      (if con
  95.                        (doseq [i tbody] (exec i))
  96.                        (doseq [i fbody] (exec i))))
  97.  
  98.                    (= cmd 'while)
  99.                    (let [body (rest args)]
  100.                      (loop [con (-> args first list exec)]
  101.                        (when con
  102.                          (doseq [i body] (exec i))
  103.                          (recur (-> args first list exec)))))
  104.  
  105.                    (= cmd 'call)
  106.                    (let [mdl-name (-> args first str)
  107.                          mdl (modules mdl-name)
  108.                          mdl-args (map #(exec [%]) (rest args))
  109.                          mdl-arg-names (nth mdl 2)
  110.                          caller @cur-module
  111.                          new-env (into cur-env (map #(vector (str mdl-name "#" %1) %2) 
  112.                                                     mdl-arg-names mdl-args))]
  113.                      (swap! env-stack conj new-env)
  114.                      (exec mdl)
  115.                      (reset! cur-module caller)
  116.                      (swap! env-stack rest)
  117.                      (let [ret @return-value]
  118.                        (reset! return-value nil) 
  119.                        ret))
  120.  
  121.                    (= cmd 'return)
  122.                    (reset! return-value (if args (-> args first list exec)))
  123.  
  124.                    (#{'< '> '<= '>= '+ '- '* '/ 'max} cmd)
  125.                    (apply (eval cmd) (map #(exec [%]) args))
  126.  
  127.                    (#{'== '!=} cmd)
  128.                    (apply ({'== = '!= not=} cmd) (map #(exec [%]) args))
  129.  
  130.                    (string? cmd) cmd
  131.                    (number? cmd) (Double. (str cmd))
  132.  
  133.                    (and (symbol? cmd) 
  134.                         (contains? cur-env (str @cur-module "#" cmd)))
  135.                    (cur-env (str @cur-module "#" cmd))                   
  136.  
  137.                    (symbol? cmd)
  138.                    (println "undefined variable" cmd)
  139.  
  140.                    :else 
  141.                    (println "unknown instruction" instr))))]
  142.  
  143.     (exec (modules "Main"))))
  144.  
  145. (run flc-program)
Success #stdin #stdout 1.49s 389120KB
comments (?)
stdin 
x99
5
4
3
x88
6
4
3
x77
3
4
5
x66
13
5
12
x55
2.5
1.5
2
stdout 
Batch code: x99 is right angled
Batch code: x88 is not right angled
Invalid data
Batch code: x66 is right angled
Batch code: x55 is right angled
https://ideone.com/VLQZCC
language:
Clojure (clojure 1.10.0)
created:
9 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!